diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-04-22 17:04:53 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-05-05 03:23:31 -0400 |
commit | 7bc3a65b467c4286377b9bded277d5a2f69160b3 (patch) | |
tree | 1e5ec8bf7f03ef4c6622798d3701d686373a7b06 | |
parent | 1d8f80cd64edd1ea6a5d4c4aa2e09ad0d077ae1b (diff) | |
download | haskell-7bc3a65b467c4286377b9bded277d5a2f69160b3.tar.gz |
Remove SpecConstrAnnotation (#13681)
This has been deprecated since 2013. Use GHC.Types.SPEC instead.
Make GHC.Exts "not-home" for haddock
Metric Decrease:
haddock.base
-rw-r--r-- | compiler/GHC/Core/Opt/SpecConstr.hs | 103 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 2 | ||||
-rwxr-xr-x | libraries/base/GHC/Exts.hs | 25 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T5550.hs | 5 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T7944.hs | 6 |
5 files changed, 30 insertions, 111 deletions
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs index 0f65b487da..780c115857 100644 --- a/compiler/GHC/Core/Opt/SpecConstr.hs +++ b/compiler/GHC/Core/Opt/SpecConstr.hs @@ -1,23 +1,18 @@ {- -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 #-} -module GHC.Core.Opt.SpecConstr( - specConstrProgram, - SpecConstrAnnotation(..) - ) where +-- | Specialise over constructors +module GHC.Core.Opt.SpecConstr + ( specConstrProgram + ) +where #include "HsVersions.h" @@ -49,7 +44,6 @@ import GHC.Driver.Session ( DynFlags(..), GeneralFlag( Opt_SpecConstrKeen ) 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 @@ -61,8 +55,6 @@ import Control.Monad ( zipWithM ) import Data.List import GHC.Builtin.Names ( specTyConName ) import GHC.Unit.Module -import GHC.Core.TyCon ( TyCon ) -import GHC.Exts( SpecConstrAnnotation(..) ) import Data.Ord( comparing ) {- @@ -454,32 +446,19 @@ 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 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 +We allow a library to force the specialisation by adding a parameter of type +GHC.Types.SPEC (from ghc-prim) to the loop body. -The reason #2 is deprecated is because it requires GHCi, which isn't -available for things like a cross compiler using stage1. + 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. 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 @@ -501,7 +480,7 @@ foldl_loop. Note that This is all quite ugly; we ought to come up with a better design. -ForceSpecConstr arguments are spotted in scExpr' and scTopBinds which then set +SPEC 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 @@ -544,8 +523,8 @@ What alternatives did I consider? user (e.g., the accumulator here) but we still want to specialise as much as possible. -Alternatives to ForceSpecConstr -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Alternatives to SPEC +~~~~~~~~~~~~~~~~~~~~ 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 @@ -569,13 +548,13 @@ this doesn't look like a specialisable call. Note [Limit recursive specialisation] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It is possible for ForceSpecConstr to cause an infinite loop of specialisation. +It is possible for SPEC 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 ForceSpecConstr is on: +For example, if SPEC is on: loop :: [Int] -> [Int] -> [Int] loop z [] = z loop z (x:xs) = loop (x:z) xs @@ -605,16 +584,6 @@ 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 ----------------------------------------------------- @@ -702,11 +671,10 @@ 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 annos) + (env, binds) <- goEnv (initScEnv dflags this_mod) (mg_binds guts) -- binds is identical to (mg_binds guts), except that the -- binders on the LHS have been replaced by extendBndr @@ -821,7 +789,7 @@ data ScEnv = SCE { sc_dflags :: DynFlags, -- See Note [Avoiding exponential blowup] sc_recursive :: Int, -- Max # of specialisations over recursive type. - -- Stops ForceSpecConstr from diverging. + -- Stops SPEC from diverging. sc_keen :: Bool, -- Specialise on arguments that are known -- constructors, even if they are not @@ -838,15 +806,13 @@ 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 SpecConstrAnnotation } --------------------- @@ -863,8 +829,8 @@ instance Outputable Value where ppr LambdaVal = text "<Lambda>" --------------------- -initScEnv :: DynFlags -> Module -> UniqFM SpecConstrAnnotation -> ScEnv -initScEnv dflags this_mod anns +initScEnv :: DynFlags -> Module -> ScEnv +initScEnv dflags this_mod = SCE { sc_dflags = dflags, sc_module = this_mod, sc_size = specConstrThreshold dflags, @@ -874,8 +840,7 @@ initScEnv dflags this_mod anns sc_force = False, sc_subst = emptySubst, sc_how_bound = emptyVarEnv, - sc_vals = emptyVarEnv, - sc_annotations = anns } + sc_vals = emptyVarEnv } data HowBound = RecFun -- These are the recursive functions for which -- we seek interesting call patterns @@ -1000,21 +965,7 @@ 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) tycon == Just NoSpecConstr - forceSpecBndr env var = forceSpecFunTy env . snd . splitForAllTys . varType $ var forceSpecFunTy :: ScEnv -> Type -> Bool @@ -1028,7 +979,6 @@ forceSpecArgTy env ty | Just (tycon, tys) <- splitTyConApp_maybe ty , tycon /= funTyCon = tyConName tycon == specTyConName - || lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr || any (forceSpecArgTy env) tys forceSpecArgTy _ _ = False @@ -1898,9 +1848,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 of the limit. + which switches off the limit. -* The ghastly ForceSpecConstr trick also switches of the limit +* The ghastly SPEC trick also switches off the limit for a particular function * Otherwise we sort the patterns to choose the most general @@ -2173,7 +2123,6 @@ 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 @@ -2204,7 +2153,6 @@ 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 @@ -2225,11 +2173,10 @@ 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 b88b9b56ff..9d8eed590f 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -496,7 +496,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 ForceSpecConstr can diverge. + -- Not optional; otherwise SPEC 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) diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index a8ae03f903..894ffad509 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -2,6 +2,8 @@ {-# LANGUAGE MagicHash, UnboxedTuples, TypeFamilies, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, NoImplicitPrelude #-} +{-# OPTIONS_HADDOCK not-home #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.Exts @@ -83,9 +85,6 @@ module GHC.Exts -- * Event logging traceEvent, - -- * SpecConstr annotations - SpecConstrAnnotation(..), - -- * The call stack currentCallStack, @@ -111,7 +110,6 @@ import GHC.Stack import qualified Data.Coerce import Data.String import Data.OldList -import Data.Data import Data.Ord import Data.Version ( Version(..), makeVersion ) import qualified Debug.Trace @@ -161,25 +159,6 @@ traceEvent = Debug.Trace.traceEventIO {- ********************************************************************** * * -* SpecConstr annotation * -* * -********************************************************************** -} - --- Annotating a type with NoSpecConstr will make SpecConstr --- not specialise for arguments of that type. - --- This data type is defined here, rather than in the SpecConstr module --- itself, so that importing it doesn't force stupidly linking the --- entire ghc package at runtime - -data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr - deriving ( Data -- ^ @since 4.3.0.0 - , Eq -- ^ @since 4.3.0.0 - ) - - -{- ********************************************************************** -* * * The IsList class * * * ********************************************************************** -} diff --git a/testsuite/tests/simplCore/should_compile/T5550.hs b/testsuite/tests/simplCore/should_compile/T5550.hs index 025da505f3..25788c09e3 100644 --- a/testsuite/tests/simplCore/should_compile/T5550.hs +++ b/testsuite/tests/simplCore/should_compile/T5550.hs @@ -1,9 +1,6 @@ module T5550 where -import GHC.Exts ( SpecConstrAnnotation(..) ) - -data SPEC = SPEC | SPEC2 -{-# ANN type SPEC ForceSpecConstr #-} +import GHC.Types loop :: SPEC -> [Int] -> [Int] -> [Int] loop SPEC z [] = z diff --git a/testsuite/tests/simplCore/should_compile/T7944.hs b/testsuite/tests/simplCore/should_compile/T7944.hs index bb62427e0a..7f9acbf0c7 100644 --- a/testsuite/tests/simplCore/should_compile/T7944.hs +++ b/testsuite/tests/simplCore/should_compile/T7944.hs @@ -1,10 +1,6 @@ module T7944 where -import GHC.Exts - --- Force specialisation of "go" -data SPEC = SPEC | SPEC2 -{-# ANN type SPEC ForceSpecConstr #-} +import GHC.Types -- This is more or less just an ordinary fold go :: SPEC -> [a] -> IntMap a -> IntMap a |