[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