diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-01-06 10:14:13 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-01-17 05:52:26 -0500 |
commit | 84dcb8440e94fab5aaba66e613de27d89264f076 (patch) | |
tree | 5b04cd3e7ba11352b61c3b042d23d8d8f2f47f52 /compiler/GHC | |
parent | 55a8f86024098ae62d6a2aa00ae850de0e2bc79d (diff) | |
download | haskell-84dcb8440e94fab5aaba66e613de27d89264f076.tar.gz |
Revert "Remove SpecConstrAnnotation (#13681)" (#19168)
This reverts commit 7bc3a65b467c4286377b9bded277d5a2f69160b3.
NoSpecConstr is used in the wild (see #19168)
Diffstat (limited to 'compiler/GHC')
-rw-r--r-- | compiler/GHC/Core/Opt/SpecConstr.hs | 105 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 2 |
2 files changed, 80 insertions, 27 deletions
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs index 1abe9f7ab3..02c1c3cf2e 100644 --- a/compiler/GHC/Core/Opt/SpecConstr.hs +++ b/compiler/GHC/Core/Opt/SpecConstr.hs @@ -1,18 +1,23 @@ {- +ToDo [Oct 2013] +~~~~~~~~~~~~~~~ +1. Nuke ForceSpecConstr for good (it is subsumed by GHC.Types.SPEC in ghc-prim) +2. Nuke NoSpecConstr + (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +\section[SpecConstr]{Specialise over constructors} -} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} --- | Specialise over constructors -module GHC.Core.Opt.SpecConstr - ( specConstrProgram - ) -where +module GHC.Core.Opt.SpecConstr( + specConstrProgram, + SpecConstrAnnotation(..) + ) where #include "HsVersions.h" @@ -31,7 +36,7 @@ import GHC.Core.DataCon import GHC.Core.Coercion hiding( substCo ) import GHC.Core.Rules import GHC.Core.Type hiding ( substTy ) -import GHC.Core.TyCon ( tyConUnique ) +import GHC.Core.TyCon ( tyConUnique, tyConName ) import GHC.Core.Multiplicity import GHC.Types.Id import GHC.Core.Ppr ( pprParendExpr ) @@ -46,6 +51,7 @@ import GHC.Driver.Ppr import GHC.Data.Maybe ( orElse, catMaybes, isJust, isNothing ) import GHC.Types.Demand import GHC.Types.Cpr +import GHC.Serialized ( deserializeWithData ) import GHC.Utils.Misc import GHC.Data.Pair import GHC.Types.Unique.Supply @@ -58,6 +64,8 @@ import Control.Monad ( zipWithM ) import Data.List import GHC.Builtin.Names ( specTyConKey ) import GHC.Unit.Module +import GHC.Core.TyCon ( TyCon ) +import GHC.Exts( SpecConstrAnnotation(..) ) import Data.Ord( comparing ) {- @@ -449,19 +457,32 @@ With stream fusion and in other similar cases, we want to fully specialise some (but not necessarily all!) loops regardless of their size and the number of specialisations. -We allow a library to force the specialisation by adding a parameter of type -GHC.Types.SPEC (from ghc-prim) to the loop body. +We allow a library to do this, in one of two ways (one which is +deprecated): + + 1) Add a parameter of type GHC.Types.SPEC (from ghc-prim) to the loop body. + + 2) (Deprecated) Annotate a type with ForceSpecConstr from GHC.Exts, + and then add *that* type as a parameter to the loop body - Historical note: in the past any datatype could be used in place of - GHC.Types.SPEC as long as it was annotated with GHC.Exts.ForceSpecConstr. It - has been deprecated because it required GHCi, which isn't available for - things like a cross compiler using stage1. +The reason #2 is deprecated is because it requires GHCi, which isn't +available for things like a cross compiler using stage1. Here's a (simplified) example from the `vector` package. You may bring the special 'force specialization' type into scope by saying: import GHC.Types (SPEC(..)) +or by defining your own type (again, deprecated): + + data SPEC = SPEC | SPEC2 + {-# ANN type SPEC ForceSpecConstr #-} + +(Note this is the exact same definition of GHC.Types.SPEC, just +without the annotation.) + +After that, you say: + foldl :: (a -> b -> a) -> a -> Stream b -> a {-# INLINE foldl #-} foldl f z (Stream step s _) = foldl_loop SPEC z s @@ -483,7 +504,7 @@ foldl_loop. Note that This is all quite ugly; we ought to come up with a better design. -SPEC arguments are spotted in scExpr' and scTopBinds which then set +ForceSpecConstr arguments are spotted in scExpr' and scTopBinds which then set sc_force to True when calling specLoop. This flag does four things: * Ignore specConstrThreshold, to specialise functions of arbitrary size @@ -526,8 +547,8 @@ What alternatives did I consider? user (e.g., the accumulator here) but we still want to specialise as much as possible. -Alternatives to SPEC -~~~~~~~~~~~~~~~~~~~~ +Alternatives to ForceSpecConstr +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Instead of giving the loop an extra argument of type SPEC, we also considered *wrapping* arguments in SPEC, thus data SPEC a = SPEC a | SPEC2 @@ -551,13 +572,13 @@ this doesn't look like a specialisable call. Note [Limit recursive specialisation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is possible for SPEC to cause an infinite loop of specialisation. +It is possible for ForceSpecConstr to cause an infinite loop of specialisation. Because there is no limit on the number of specialisations, a recursive call with a recursive constructor as an argument (for example, list cons) will generate a specialisation for that constructor. If the resulting specialisation also contains a recursive call with the constructor, this could proceed indefinitely. -For example, if SPEC is on: +For example, if ForceSpecConstr is on: loop :: [Int] -> [Int] -> [Int] loop z [] = z loop z (x:xs) = loop (x:z) xs @@ -587,6 +608,16 @@ more than N times (controlled by -fspec-constr-recursive=N) we check See #5550. Also #13623, where this test had become over-aggressive, and we lost a wonderful specialisation that we really wanted! +Note [NoSpecConstr] +~~~~~~~~~~~~~~~~~~~ +The ignoreDataCon stuff allows you to say + {-# ANN type T NoSpecConstr #-} +to mean "don't specialise on arguments of this type". It was added +before we had ForceSpecConstr. Lacking ForceSpecConstr we specialised +regardless of size; and then we needed a way to turn that *off*. Now +that we have ForceSpecConstr, this NoSpecConstr is probably redundant. +(Used only for PArray, TODO: remove?) + ----------------------------------------------------- Stuff not yet handled ----------------------------------------------------- @@ -674,10 +705,11 @@ specConstrProgram guts = do dflags <- getDynFlags us <- getUniqueSupplyM + (_, annos) <- getFirstAnnotations deserializeWithData guts this_mod <- getModule let binds' = reverse $ fst $ initUs us $ do -- Note [Top-level recursive groups] - (env, binds) <- goEnv (initScEnv dflags this_mod) + (env, binds) <- goEnv (initScEnv dflags this_mod annos) (mg_binds guts) -- binds is identical to (mg_binds guts), except that the -- binders on the LHS have been replaced by extendBndr @@ -793,7 +825,7 @@ data ScEnv = SCE { sc_dflags :: DynFlags, -- See Note [Avoiding exponential blowup] sc_recursive :: Int, -- Max # of specialisations over recursive type. - -- Stops SPEC from diverging. + -- Stops ForceSpecConstr from diverging. sc_keen :: Bool, -- Specialise on arguments that are known -- constructors, even if they are not @@ -810,13 +842,15 @@ data ScEnv = SCE { sc_dflags :: DynFlags, -- 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) -- The range of the ValueEnv is *work-free* values -- such as (\x. blah), or (Just v) -- but NOT (Just (expensive v)) -- See Note [Work-free values only in environment] + + sc_annotations :: UniqFM Name SpecConstrAnnotation } --------------------- @@ -833,8 +867,8 @@ instance Outputable Value where ppr LambdaVal = text "<Lambda>" --------------------- -initScEnv :: DynFlags -> Module -> ScEnv -initScEnv dflags this_mod +initScEnv :: DynFlags -> Module -> UniqFM Name SpecConstrAnnotation -> ScEnv +initScEnv dflags this_mod anns = SCE { sc_dflags = dflags, sc_uf_opts = unfoldingOpts dflags, sc_module = this_mod, @@ -845,7 +879,8 @@ initScEnv dflags this_mod sc_force = False, sc_subst = emptySubst, sc_how_bound = emptyVarEnv, - sc_vals = emptyVarEnv } + sc_vals = emptyVarEnv, + sc_annotations = anns } data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -970,7 +1005,21 @@ decreaseSpecCount env n_specs --------------------------------------------------- -- See Note [Forcing specialisation] +ignoreType :: ScEnv -> Type -> Bool +ignoreDataCon :: ScEnv -> DataCon -> Bool forceSpecBndr :: ScEnv -> Var -> Bool + +ignoreDataCon env dc = ignoreTyCon env (dataConTyCon dc) + +ignoreType env ty + = case tyConAppTyCon_maybe ty of + Just tycon -> ignoreTyCon env tycon + _ -> False + +ignoreTyCon :: ScEnv -> TyCon -> Bool +ignoreTyCon env tycon + = lookupUFM (sc_annotations env) (tyConName tycon) == Just NoSpecConstr + forceSpecBndr env var = forceSpecFunTy env . snd . splitForAllTyCoVars . varType $ var forceSpecFunTy :: ScEnv -> Type -> Bool @@ -984,6 +1033,7 @@ forceSpecArgTy env ty | Just (tycon, tys) <- splitTyConApp_maybe ty , tycon /= funTyCon = tyConUnique tycon == specTyConKey + || lookupUFM (sc_annotations env) (tyConName tycon) == Just ForceSpecConstr || any (forceSpecArgTy env) tys forceSpecArgTy _ _ = False @@ -1846,9 +1896,9 @@ by trim_pats. of specialisations for a given function to N. * -fno-spec-constr-count sets the sc_count field to Nothing, - which switches off the limit. + which switches of the limit. -* The ghastly SPEC trick also switches off the limit +* The ghastly ForceSpecConstr trick also switches of the limit for a particular function * Otherwise we sort the patterns to choose the most general @@ -2121,6 +2171,7 @@ argToPat env in_scope val_env (Case scrut _ _ [(_, _, rhs)]) arg_occ -} argToPat env in_scope val_env (Cast arg co) arg_occ + | not (ignoreType env ty2) = do { (interesting, arg') <- argToPat env in_scope val_env arg arg_occ ; if not interesting then wildCardPat ty2 @@ -2151,6 +2202,7 @@ argToPat in_scope val_env arg arg_occ -- NB: this *precedes* the Var case, so that we catch nullary constrs argToPat env in_scope val_env arg arg_occ | Just (ConVal (DataAlt dc) args) <- isValue val_env arg + , not (ignoreDataCon env dc) -- See Note [NoSpecConstr] , Just arg_occs <- mb_scrut dc = do { let (ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) args ; (_, args') <- argsToPats env in_scope val_env rest_args arg_occs @@ -2171,10 +2223,11 @@ argToPat env in_scope val_env arg arg_occ -- In that case it counts as "interesting" argToPat env in_scope val_env (Var v) arg_occ | sc_force env || case arg_occ of { UnkOcc -> False; _other -> True }, -- (a) - is_value -- (b) + is_value, -- (b) -- Ignoring sc_keen here to avoid gratuitously incurring Note [Reboxing] -- So sc_keen focused just on f (I# x), where we have freshly-allocated -- box that we can eliminate in the caller + not (ignoreType env (varType v)) = return (True, Var v) where is_value diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 109d854526..8e92fc974f 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -466,7 +466,7 @@ data DynFlags = DynFlags { 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 SPEC can diverge. + -- Not optional; otherwise ForceSpecConstr can diverge. binBlobThreshold :: Word, -- ^ Binary literals (e.g. strings) whose size is above -- this threshold will be dumped in a binary file -- by the assembler code generator (0 to disable) |