[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)

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
3 messages Options
Reply | Threaded
Open this post in threaded view
|

[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)

Simon Peyton Jones
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


Reply | Threaded
Open this post in threaded view
|

[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
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>

Reply | Threaded
Open this post in threaded view
|

[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)

Simon Peyton Jones
Fine, thank you. I've added the test case to the ticket.

Simon

From: Amos Robinson [mailto:amos.robinson at gmail.com]
Sent: 03 April 2013 07:40
To: Simon Peyton-Jones
Cc: ghc-devs at haskell.org; Manuel Chakravarty
Subject: Re: [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)

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<mailto: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> [mailto:ghc-commits-<mailto:ghc-commits->
| bounces at haskell.org<mailto:bounces at haskell.org>] On Behalf Of Amos Robinson
| Sent: 28 March 2013 04:25
| To: ghc-commits at haskell.org<mailto: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<mailto: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<mailto: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/a37c2117/attachment-0001.htm>