[commit: ghc] master: Fix non-termination of SpecConstr (see #5550). ForceSpecConstr will now only specialise recursive types a finite number of times. There is a new option -fspec-constr-recursive, with a default value of 3. (81d55a9)

Amos Robinson amos.robinson at gmail.com
Wed Apr 3 08:39:31 CEST 2013


Hi Simon,
No problem, I'll commit the extra notes tomorrow.
I put the test case in simplCore/should_compile/T5550.hs. Does that seem
like a reasonable place? I couldn't see any directory specifically for
sanity-checking optimisations or specialise.

Amos


On Tue, Apr 2, 2013 at 9:37 PM, Simon Peyton-Jones <simonpj at microsoft.com>wrote:

> Amos
>
> Thanks for doing this.
>
> Could you pls add a
>         Note [Limit recursive specialisation]
> in SpecConstr, that explains (a) the problem, with an example, and (b) the
> solution.  Plus, mention the relevant Trac tickets.
>
> It'll take you a few minutes to write, but it's worth it.  That way in
> five years time, when your successor is staring at your code, he or she
> will have an insight into your thinking.
>
> Also is there a test case you can give, in the testsuite, which sends GHC
> into a loop without it, but works fine with it?
>
> Thanks
>
> Simon
>
> | -----Original Message-----
> | From: ghc-commits-bounces at haskell.org [mailto:ghc-commits-
> | bounces at haskell.org] On Behalf Of Amos Robinson
> | Sent: 28 March 2013 04:25
> | To: ghc-commits at haskell.org
> | Subject: [commit: ghc] master: Fix non-termination of SpecConstr (see
> | #5550). ForceSpecConstr will now only specialise recursive types a
> | finite number of times. There is a new option -fspec-constr-recursive,
> | with a default value of 3. (81d55a9)
> |
> | Repository : http://darcs.haskell.org/ghc.git/
> |
> | On branch  : master
> |
> | https://github.com/ghc/ghc/commit/81d55a9ec28d9d7c8b1492516ebd58c5ff90c0
> | e8
> |
> | >---------------------------------------------------------------
> |
> | commit 81d55a9ec28d9d7c8b1492516ebd58c5ff90c0e8
> | Author: Amos Robinson <amos.robinson at gmail.com>
> | Date:   Thu Mar 28 12:37:42 2013 +1100
> |
> |     Fix non-termination of SpecConstr (see #5550).
> |     ForceSpecConstr will now only specialise recursive types a finite
> | number of times.
> |     There is a new option -fspec-constr-recursive, with a default value
> | of 3.
> |
> | >---------------------------------------------------------------
> |
> |  compiler/main/DynFlags.hs          |  4 +++
> |  compiler/specialise/SpecConstr.lhs | 64 +++++++++++++++++++++++++++----
> | -------
> |  2 files changed, 50 insertions(+), 18 deletions(-)
> |
> | diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index
> | 3c82fd0..2f76c35 100644
> | --- a/compiler/main/DynFlags.hs
> | +++ b/compiler/main/DynFlags.hs
> | @@ -569,6 +569,8 @@ data DynFlags = DynFlags {
> |    simplTickFactor       :: Int,         -- ^ Multiplier for simplifier
> | ticks
> |    specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
> |    specConstrCount       :: Maybe Int,   -- ^ Max number of
> | specialisations for any one function
> | +  specConstrRecursive   :: Int,         -- ^ Max number of
> | specialisations for recursive types
> | +                                        --   Not optional; otherwise
> | ForceSpecConstr can diverge.
> |    liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
> |    floatLamArgs          :: Maybe Int,   -- ^ Arg count for lambda
> | floating
> |                                          --   See
> | CoreMonad.FloatOutSwitches
> | @@ -1217,6 +1219,7 @@ defaultDynFlags mySettings =
> |          simplTickFactor         = 100,
> |          specConstrThreshold     = Just 2000,
> |          specConstrCount         = Just 3,
> | +        specConstrRecursive     = 3,
> |          liberateCaseThreshold   = Just 2000,
> |          floatLamArgs            = Just 0, -- Default: float only if no
> | fvs
> |          historySize             = 20,
> | @@ -2227,6 +2230,7 @@ dynamic_flags = [
> |    , Flag "fno-spec-constr-threshold"   (noArg (\d -> d{
> | specConstrThreshold = Nothing }))
> |    , Flag "fspec-constr-count"          (intSuffix (\n d -> d{
> | specConstrCount = Just n }))
> |    , Flag "fno-spec-constr-count"       (noArg (\d -> d{ specConstrCount
> | = Nothing }))
> | +  , Flag "fspec-constr-recursive"      (intSuffix (\n d -> d{
> | specConstrRecursive = n }))
> |    , Flag "fliberate-case-threshold"    (intSuffix (\n d -> d{
> | liberateCaseThreshold = Just n }))
> |    , Flag "fno-liberate-case-threshold" (noArg (\d -> d{
> | liberateCaseThreshold = Nothing }))
> |    , Flag "frule-check"                 (sepArg (\s d -> d{ ruleCheck =
> | Just s }))
> | diff --git a/compiler/specialise/SpecConstr.lhs
> | b/compiler/specialise/SpecConstr.lhs
> | index c02b34a..d03baf0 100644
> | --- a/compiler/specialise/SpecConstr.lhs
> | +++ b/compiler/specialise/SpecConstr.lhs
> | @@ -31,6 +31,7 @@ import DataCon
> |  import Coercion         hiding( substTy, substCo )
> |  import Rules
> |  import Type             hiding ( substTy )
> | +import TyCon            ( isRecursiveTyCon )
> |  import Id
> |  import MkCore           ( mkImpossibleExpr )
> |  import Var
> | @@ -457,6 +458,8 @@ sc_force to True when calling specLoop. This flag
> | does three things:
> |          (see specialise)
> |    * Specialise even for arguments that are not scrutinised in the loop
> |          (see argToPat; Trac #4488)
> | +  * Only specialise on recursive types a finite number of times
> | +        (see is_too_recursive; Trac #5550)
> |
> |  This flag is inherited for nested non-recursive bindings (which are
> | likely to  be join points and hence should be fully specialised) but
> | reset for nested @@ -619,21 +622,25 @@ specConstrProgram guts
> |
> | %***********************************************************************
> | *
> |
> |  \begin{code}
> | -data ScEnv = SCE { sc_dflags :: DynFlags,
> | -                   sc_size  :: Maybe Int,       -- Size threshold
> | -                   sc_count :: Maybe Int,       -- Max # of
> | specialisations for any one fn
> | +data ScEnv = SCE { sc_dflags    :: DynFlags,
> | +                   sc_size      :: Maybe Int,   -- Size threshold
> | +                   sc_count     :: Maybe Int,   -- Max # of
> | specialisations for any one fn
> |                                                  -- See Note [Avoiding
> | exponential blowup]
> | -                   sc_force :: Bool,            -- Force
> | specialisation?
> | +
> | +                   sc_recursive :: Int,         -- Max # of
> | specialisations over recursive type.
> | +                                                -- Stops
> | ForceSpecConstr from diverging.
> | +
> | +                   sc_force     :: Bool,        -- Force
> | specialisation?
> |                                                  -- See Note [Forcing
> | specialisation]
> |
> | -                   sc_subst :: Subst,           -- Current substitution
> | +                   sc_subst     :: Subst,       -- Current substitution
> |                                                  -- Maps InIds to
> | OutExprs
> |
> |                     sc_how_bound :: HowBoundEnv,
> |                          -- Binds interesting non-top-level variables
> |                          -- Domain is OutVars (*after* applying the
> | substitution)
> |
> | -                   sc_vals  :: ValueEnv,
> | +                   sc_vals      :: ValueEnv,
> |                          -- Domain is OutIds (*after* applying the
> | substitution)
> |                          -- Used even for top-level bindings (but not
> | imported ones)
> |
> | @@ -665,13 +672,14 @@ instance Outputable Value where
> |  ---------------------
> |  initScEnv :: DynFlags -> UniqFM SpecConstrAnnotation -> ScEnv
> | initScEnv dflags anns
> | -  = SCE { sc_dflags = dflags,
> | -          sc_size = specConstrThreshold dflags,
> | -          sc_count = specConstrCount dflags,
> | -          sc_force = False,
> | -          sc_subst = emptySubst,
> | -          sc_how_bound = emptyVarEnv,
> | -          sc_vals = emptyVarEnv,
> | +  = SCE { sc_dflags      = dflags,
> | +          sc_size        = specConstrThreshold dflags,
> | +          sc_count       = specConstrCount     dflags,
> | +          sc_recursive   = specConstrRecursive dflags,
> | +          sc_force       = False,
> | +          sc_subst       = emptySubst,
> | +          sc_how_bound   = emptyVarEnv,
> | +          sc_vals        = emptyVarEnv,
> |            sc_annotations = anns }
> |
> |  data HowBound = RecFun  -- These are the recursive functions for which
> | @@ -1518,15 +1526,35 @@ callsToPats :: ScEnv -> [OneSpec] -> [ArgOcc] ->
> | [Call] -> UniqSM (Bool, [CallPa  callsToPats env done_specs bndr_occs
> | calls
> |    = do  { mb_pats <- mapM (callToPats env bndr_occs) calls
> |
> | -        ; let good_pats :: [CallPat]
> | +        ; let good_pats :: [(CallPat, ValueEnv)]
> |                good_pats = catMaybes mb_pats
> |                done_pats = [p | OS p _ _ _ <- done_specs]
> |                is_done p = any (samePat p) done_pats
> | +              no_recursive = map fst (filterOut (is_too_recursive env)
> | + good_pats)
> |
> |          ; return (any isNothing mb_pats,
> | -                  filterOut is_done (nubBy samePat good_pats)) }
> | +                  filterOut is_done (nubBy samePat no_recursive)) }
> | +
> | +is_too_recursive :: ScEnv -> (CallPat, ValueEnv) -> Bool
> | +    -- Count the number of recursive constructors in a call pattern,
> | +    -- filter out if there are more than the maximum.
> | +    -- This is only necessary if ForceSpecConstr is in effect:
> | +    -- otherwise specConstrCount will cause specialisation to
> | terminate.
> | +is_too_recursive env ((_,exprs), val_env)  = sc_force env && maximum
> | +(map go exprs) > sc_recursive env  where
> | +  go e
> | +   | Just (ConVal (DataAlt dc) args) <- isValue val_env e
> | +   , isRecursiveTyCon (dataConTyCon dc)
> | +   = 1 + sum (map go args)
> | +
> | +   |App f a                          <- e
> | +   = go f + go a
> | +
> | +   | otherwise
> | +   = 0
> |
> | -callToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe CallPat)
> | +callToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe (CallPat,
> | +ValueEnv))
> |          -- The [Var] is the variables to quantify over in the rule
> |          --      Type variables come first, since they may scope
> |          --      over the following term variables
> | @@ -1553,9 +1581,9 @@ callToPats env bndr_occs (con_env, args)
> |                sanitise id   = id `setIdType` expandTypeSynonyms (idType
> | id)
> |                  -- See Note [Free type variables of the qvar types]
> |
> | -        ; -- pprTrace "callToPats"  (ppr args $$ ppr prs $$ ppr
> | bndr_occs) $
> | +        ; -- pprTrace "callToPats"  (ppr args $$ ppr bndr_occs) $
> |            if interesting
> | -          then return (Just (qvars', pats))
> | +          then return (Just ((qvars', pats), con_env))
> |            else return Nothing }
> |
> |      -- argToPat takes an actual argument, and returns an abstracted
> |
> |
> |
> | _______________________________________________
> | ghc-commits mailing list
> | ghc-commits at haskell.org
> | http://www.haskell.org/mailman/listinfo/ghc-commits
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/ghc-devs/attachments/20130403/eda341f3/attachment-0001.htm>


More information about the ghc-devs mailing list