diff options
19 files changed, 313 insertions, 62 deletions
diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 4159dd67cf..928b0381d5 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -5,7 +5,7 @@ \section[Demand]{@Demand@: A decoupled implementation of a demand domain} -} -{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances, RecordWildCards #-} module Demand ( StrDmd, UseDmd(..), Count(..), @@ -37,7 +37,7 @@ module Demand ( appIsBottom, isBottomingSig, pprIfaceStrictSig, trimCPRInfo, returnsCPR_maybe, StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig, - isTopSig, splitStrictSig, increaseStrictSigArity, + isTopSig, hasDemandEnvSig, splitStrictSig, increaseStrictSigArity, seqDemand, seqDemandList, seqDmdType, seqStrictSig, @@ -52,7 +52,8 @@ module Demand ( trimToType, TypeShape(..), useCount, isUsedOnce, reuseEnv, - killUsageDemand, killUsageSig, zapUsageDemand, + killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig, + zapUsedOnceDemand, zapUsedOnceSig, strictifyDictDmd ) where @@ -1677,6 +1678,9 @@ increaseStrictSigArity arity_increase (StrictSig (DmdType env dmds res)) isTopSig :: StrictSig -> Bool isTopSig (StrictSig ty) = isTopDmdType ty +hasDemandEnvSig :: StrictSig -> Bool +hasDemandEnvSig (StrictSig (DmdType env _ _)) = not (isEmptyVarEnv env) + isBottomingSig :: StrictSig -> Bool -- True if the signature diverges or throws an exception isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res @@ -1861,9 +1865,31 @@ of absence or one-shot information altogether. This is only used for performanc tests, to see how important they are. -} +zapUsageEnvSig :: StrictSig -> StrictSig +-- Remove the usage environment from the demand +zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r + zapUsageDemand :: Demand -> Demand -- Remove the usage info, but not the strictness info, from the demand -zapUsageDemand = kill_usage (True, True) +zapUsageDemand = kill_usage $ KillFlags + { kf_abs = True + , kf_used_once = True + , kf_called_once = True + } + +-- | Remove all 1* information (but not C1 information) from the demand +zapUsedOnceDemand :: Demand -> Demand +zapUsedOnceDemand = kill_usage $ KillFlags + { kf_abs = False + , kf_used_once = True + , kf_called_once = False + } + +-- | Remove all 1* information (but not C1 information) from the strictness +-- signature +zapUsedOnceSig :: StrictSig -> StrictSig +zapUsedOnceSig (StrictSig (DmdType env ds r)) + = StrictSig (DmdType env (map zapUsedOnceDemand ds) r) killUsageDemand :: DynFlags -> Demand -> Demand -- See Note [Killing usage information] @@ -1877,35 +1903,39 @@ killUsageSig dflags sig@(StrictSig (DmdType env ds r)) | Just kfs <- killFlags dflags = StrictSig (DmdType env (map (kill_usage kfs) ds) r) | otherwise = sig -type KillFlags = (Bool, Bool) +data KillFlags = KillFlags + { kf_abs :: Bool + , kf_used_once :: Bool + , kf_called_once :: Bool + } killFlags :: DynFlags -> Maybe KillFlags -- See Note [Killing usage information] killFlags dflags - | not kill_abs && not kill_one_shot = Nothing - | otherwise = Just (kill_abs, kill_one_shot) + | not kf_abs && not kf_used_once = Nothing + | otherwise = Just (KillFlags {..}) where - kill_abs = gopt Opt_KillAbsence dflags - kill_one_shot = gopt Opt_KillOneShot dflags + kf_abs = gopt Opt_KillAbsence dflags + kf_used_once = gopt Opt_KillOneShot dflags + kf_called_once = kf_used_once kill_usage :: KillFlags -> Demand -> Demand kill_usage kfs (JD {sd = s, ud = u}) = JD {sd = s, ud = zap_musg kfs u} zap_musg :: KillFlags -> ArgUse -> ArgUse -zap_musg (kill_abs, _) Abs - | kill_abs = useTop - | otherwise = Abs -zap_musg kfs (Use c u) = Use (zap_count kfs c) (zap_usg kfs u) - -zap_count :: KillFlags -> Count -> Count -zap_count (_, kill_one_shot) c - | kill_one_shot = Many - | otherwise = c +zap_musg kfs Abs + | kf_abs kfs = useTop + | otherwise = Abs +zap_musg kfs (Use c u) + | kf_used_once kfs = Use Many (zap_usg kfs u) + | otherwise = Use c (zap_usg kfs u) zap_usg :: KillFlags -> UseDmd -> UseDmd -zap_usg kfs (UCall c u) = UCall (zap_count kfs c) (zap_usg kfs u) -zap_usg kfs (UProd us) = UProd (map (zap_musg kfs) us) -zap_usg _ u = u +zap_usg kfs (UCall c u) + | kf_called_once kfs = UCall Many (zap_usg kfs u) + | otherwise = UCall c (zap_usg kfs u) +zap_usg kfs (UProd us) = UProd (map (zap_musg kfs) us) +zap_usg _ u = u -- If the argument is a used non-newtype dictionary, give it strict -- demand. Also split the product type & demand and recur in order to diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs index e55259b007..d5b78986ae 100644 --- a/compiler/basicTypes/Id.hs +++ b/compiler/basicTypes/Id.hs @@ -47,8 +47,9 @@ module Id ( setIdExported, setIdNotExported, globaliseId, localiseId, setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo, - zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapFragileIdInfo, - zapIdStrictness, + zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo, + zapIdUsedOnceInfo, + zapFragileIdInfo, zapIdStrictness, transferPolyIdInfo, -- ** Predicates on Ids @@ -785,6 +786,12 @@ zapIdDemandInfo = zapInfo zapDemandInfo zapIdUsageInfo :: Id -> Id zapIdUsageInfo = zapInfo zapUsageInfo +zapIdUsageEnvInfo :: Id -> Id +zapIdUsageEnvInfo = zapInfo zapUsageEnvInfo + +zapIdUsedOnceInfo :: Id -> Id +zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo + {- Note [transferPolyIdInfo] ~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/basicTypes/IdInfo.hs b/compiler/basicTypes/IdInfo.hs index fd61a9c6b9..849aea3ff8 100644 --- a/compiler/basicTypes/IdInfo.hs +++ b/compiler/basicTypes/IdInfo.hs @@ -24,7 +24,7 @@ module IdInfo ( -- ** Zapping various forms of Info zapLamInfo, zapFragileInfo, - zapDemandInfo, zapUsageInfo, + zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo, -- ** The ArityInfo type ArityInfo, @@ -470,6 +470,19 @@ zapDemandInfo info = Just (info {demandInfo = topDmd}) zapUsageInfo :: IdInfo -> Maybe IdInfo zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)}) +-- | Remove usage environment info from the strictness signature on the 'IdInfo' +zapUsageEnvInfo :: IdInfo -> Maybe IdInfo +zapUsageEnvInfo info + | hasDemandEnvSig (strictnessInfo info) + = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)}) + | otherwise + = Nothing + +zapUsedOnceInfo :: IdInfo -> Maybe IdInfo +zapUsedOnceInfo info + = Just $ info { strictnessInfo = zapUsedOnceSig (strictnessInfo info) + , demandInfo = zapUsedOnceDemand (demandInfo info) } + zapFragileInfo :: IdInfo -> Maybe IdInfo -- ^ Zap info that depends on free variables zapFragileInfo info diff --git a/compiler/coreSyn/CoreTidy.hs b/compiler/coreSyn/CoreTidy.hs index aed4e214ad..782e11a42a 100644 --- a/compiler/coreSyn/CoreTidy.hs +++ b/compiler/coreSyn/CoreTidy.hs @@ -18,6 +18,7 @@ import CoreSyn import CoreArity import Id import IdInfo +import Demand ( zapUsageEnvSig ) import Type( tidyType, tidyTyCoVarBndr ) import Coercion( tidyCo ) import Var @@ -187,6 +188,8 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs) -- -- Similarly for the demand info - on a let binder, this tells -- CorePrep to turn the let into a case. + -- But: Remove the usage demand here + -- (See Note [Zapping DmdEnv after Demand Analyzer] in WorkWrap) -- -- Similarly arity info for eta expansion in CorePrep -- @@ -196,7 +199,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs) new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` exprArity rhs - `setStrictnessInfo` strictnessInfo old_info + `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf diff --git a/compiler/simplCore/SimplCore.hs b/compiler/simplCore/SimplCore.hs index 98bcf2ad91..1ff0cee4f3 100644 --- a/compiler/simplCore/SimplCore.hs +++ b/compiler/simplCore/SimplCore.hs @@ -319,6 +319,11 @@ getCoreToDo dflags [simpl_phase 0 ["post-late-ww"] max_iter] ), + -- Final run of the demand_analyser, ensures that one-shot thunks are + -- really really one-shot thunks. Only needed if the demand analyser + -- has run at all. See Note [Final Demand Analyser run] in DmdAnal + runWhen (strictness || late_dmd_anal) CoreDoStrictness, + maybe_rule_check (Phase 0) ] diff --git a/compiler/stranal/DmdAnal.hs b/compiler/stranal/DmdAnal.hs index 20f65d5904..4d3fd09f09 100644 --- a/compiler/stranal/DmdAnal.hs +++ b/compiler/stranal/DmdAnal.hs @@ -1331,4 +1331,32 @@ of the Id, and start from "bottom". Nowadays the Id can have a current strictness, because interface files record strictness for nested bindings. To know when we are in the first iteration, we look at the ae_virgin field of the AnalEnv. + + +Note [Final Demand Analyser run] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Some of the information that the demand analyser determines is not always +preserved by the simplifier, for example, the simplifier will happily rewrite + \y [Demand=1*U] let x = y in x + x +to + \y [Demand=1*U] y + y +which is quite a lie. + +The once-used information is (currently) only used by the code generator, though. So we + * do not bother keeping this information up-to-date in the simplifier, or + removing it after the demand analyser is done (keeping in mind not to + critically rely on this information in, say, the simplifier). + It should still be fine to use this as in heuristics, e.g. when deciding to + inline things, as the data will usually be correct. + * Just before TidyCore, we add a pass of the demand analyse, without + subsequent worker/wrapper and simplifier, right before TidyCore. + This way, correct information finds its way into the module interface + (strictness signatures!) and the code generator (single-entry thunks!) + +Note that the single-call information (C1(..)) can be relied upon, as the +simplifier tends to be very careful about not duplicating actual function +calls. + +Also see #11731. -} diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index 7fde65f7a0..e557f44906 100644 --- a/compiler/stranal/WorkWrap.hs +++ b/compiler/stranal/WorkWrap.hs @@ -16,7 +16,6 @@ import IdInfo import UniqSupply import BasicTypes import DynFlags -import VarEnv ( isEmptyVarEnv ) import Demand import WwLib import Util @@ -107,7 +106,10 @@ wwExpr _ _ e@(Lit {}) = return e wwExpr _ _ e@(Var {}) = return e wwExpr dflags fam_envs (Lam binder expr) - = Lam binder <$> wwExpr dflags fam_envs expr + = Lam new_binder <$> wwExpr dflags fam_envs expr + where new_binder | isId binder = zapIdUsedOnceInfo binder + | otherwise = binder + -- See Note [Zapping Used Once info in WorkWrap] wwExpr dflags fam_envs (App f a) = App <$> wwExpr dflags fam_envs f <*> wwExpr dflags fam_envs a @@ -125,11 +127,16 @@ wwExpr dflags fam_envs (Let bind expr) wwExpr dflags fam_envs (Case expr binder ty alts) = do new_expr <- wwExpr dflags fam_envs expr new_alts <- mapM ww_alt alts - return (Case new_expr binder ty new_alts) + let new_binder = zapIdUsedOnceInfo binder + -- See Note [Zapping Used Once info in WorkWrap] + return (Case new_expr new_binder ty new_alts) where ww_alt (con, binders, rhs) = do new_rhs <- wwExpr dflags fam_envs rhs - return (con, binders, new_rhs) + let new_binders = [ if isId b then zapIdUsedOnceInfo b else b + | b <- binders ] + -- See Note [Zapping Used Once info in WorkWrap] + return (con, new_binders, new_rhs) {- ************************************************************************ @@ -279,9 +286,7 @@ tryWW dflags fam_envs is_rec fn_id rhs -- No point in worker/wrappering if the thing is never inlined! -- Because the no-inline prag will prevent the wrapper ever -- being inlined at a call site. - -- - -- Furthermore, don't even expose strictness info - = return [ (fn_id, rhs) ] + = return [ (new_fn_id, rhs) ] | not loop_breaker , Just stable_unf <- certainlyWillInline dflags fn_unf @@ -304,24 +309,58 @@ tryWW dflags fam_envs is_rec fn_id rhs fn_info = idInfo fn_id inline_act = inlinePragmaActivation (inlinePragInfo fn_info) fn_unf = unfoldingInfo fn_info + (wrap_dmds, res_info) = splitStrictSig (strictnessInfo fn_info) - -- In practice it always will have a strictness - -- signature, even if it's a uninformative one - strict_sig = strictnessInfo fn_info - StrictSig (DmdType env wrap_dmds res_info) = strict_sig - - -- new_fn_id has the DmdEnv zapped. - -- (a) it is never used again - -- (b) it wastes space - -- (c) it becomes incorrect as things are cloned, because - -- we don't push the substitution into it - new_fn_id | isEmptyVarEnv env = fn_id - | otherwise = fn_id `setIdStrictness` - mkClosedStrictSig wrap_dmds res_info + new_fn_id = zapIdUsedOnceInfo (zapIdUsageEnvInfo fn_id) + -- See Note [Zapping DmdEnv after Demand Analyzer] and + -- See Note [Zapping Used Once info in WorkWrap] is_fun = notNull wrap_dmds is_thunk = not is_fun && not (exprIsHNF rhs) +{- +Note [Zapping DmdEnv after Demand Analyzer] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In the worker-wrapper pass we zap the DmdEnv. + +Why? + (a) it is never used again + (b) it wastes space + (c) it becomes incorrect as things are cloned, because + we don't push the substitution into it + +Why here? + * Because we don’t want to do it in the Demand Analyzer, as we never know + there when we are doing the last pass. + * We want them to be still there at the end of DmdAnal, so that + -ddump-str-anal contains them. + * We don’t want a second pass just for that. + * WorkWrap looks at all bindings anyways. + +We also need to do it in TidyCore to clean up after the final, +worker/wrapper-less run of the demand analyser. + +Note [Zapping Used Once info in WorkWrap] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In the worker-wrapper pass we zap the used once info in demands and in +strictness signatures. + +Why? + * The simplifier may happen to transform code in a way that invalidates the + data (see #11731 for an example). + * It is not used in later passes, up to code generation. + +So as the data is useless and possibly wrong, we want to remove it. The most +convenient place to do that is the worker wrapper phase, as it runs after every +run of the demand analyser besides the very last one (which is the one where we +want to _keep_ the info for the code generator). + +We do not do it in the demand analyser for the same reasons outlined in +Note [Zapping DmdEnv after Demand Analyzer] above. +-} + --------------------- splitFun :: DynFlags -> FamInstEnvs -> Id -> IdInfo -> [Demand] -> DmdResult -> CoreExpr diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 022ed92142..46d6478f75 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -639,7 +639,7 @@ test('T9020', test('T9675', [ only_ways(['optasm']), compiler_stats_num_field('max_bytes_used', # Note [residency] - [(wordsize(64), 30837312, 15), + [(wordsize(64), 38776008, 15), # 2014-10-13 29596552 # 2014-10-13 26570896 seq the DmdEnv in seqDmdType as well # 2014-10-13 18582472 different machines giving different results.. @@ -647,12 +647,13 @@ test('T9675', # 2015-06-21 28056344 switch to `+RTS -G1`, tighten bound to 15% # 2015-10-28 23776640 emit Typeable at definition site # 2015-12-11 30837312 TypeInType (see #11196) + # 2016-04-14 38776008 Final demand analyzer run (wordsize(32), 18043224, 15) # 2015-07-11 15341228 (x86/Linux, 64-bit machine) use +RTS -G1 # 2016-04-06 18043224 (x86/Linux, 64-bit machine) ]), compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] - [(wordsize(64), 113, 15), + [(wordsize(64), 144, 15), # 2014-10-13 66 # 2014-10-13 58 seq the DmdEnv in seqDmdType as well # 2014-10-13 49 different machines giving different results... @@ -661,6 +662,7 @@ test('T9675', # 2015-06-21 105 switch to `+RTS -G1` # 2015-12-04 88 new pattern checker (D1535) # 2015-12-11 113 TypeInType (see #11196) + # 2016-04-14 144 Final demand analyzer run (wordsize(32), 56, 15) # 2015-07-11 56 (x86/Linux, 64-bit machine) use +RTS -G1 ]), @@ -771,10 +773,11 @@ test('T9961', test('T9233', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 999826288, 5), - # 2015-08-04 999826288 initial value - (wordsize(32), 515672240, 5) # Put in your value here if you hit this - # 2016-04-06 515672240 (x86/Linux) initial value + [(wordsize(64), 1066246248, 5), + # 2015-08-04 999826288 initial value + # 2016-04-14 1066246248 Final demand analyzer run + (wordsize(32), 515672240, 5) # Put in your value here if you hit this + # 2016-04-06 515672240 (x86/Linux) initial value ]), extra_clean(['T9233a.hi', 'T9233a.o']) ], @@ -784,17 +787,19 @@ test('T9233', test('T10370', [ only_ways(['optasm']), compiler_stats_num_field('max_bytes_used', # Note [residency] - [(wordsize(64), 22823976, 15), + [(wordsize(64), 28256896, 15), # 2015-10-22 19548720 # 2016-02-24 22823976 Changing Levity to RuntimeRep; not sure why this regresses though, even after some analysis + # 2016-04-14 28256896 final demand analyzer run (wordsize(32), 11371496, 15), # 2015-10-22 11371496 ]), compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] - [(wordsize(64), 76, 15), - # 2015-10-22 76 - (wordsize(32), 39, 15), - # 2015-10-22 39 + [(wordsize(64), 101, 15), + # 2015-10-22 76 + # 2016-04-14 101 final demand analyzer run + (wordsize(32), 39, 15), + # 2015-10-22 39 ]), # Use `+RTS -G1` for more stable residency measurements. Note [residency]. extra_hc_opts('+RTS -G1 -RTS') diff --git a/testsuite/tests/simplCore/should_compile/T4908.stderr b/testsuite/tests/simplCore/should_compile/T4908.stderr index 947d16a206..7136bd1f51 100644 --- a/testsuite/tests/simplCore/should_compile/T4908.stderr +++ b/testsuite/tests/simplCore/should_compile/T4908.stderr @@ -33,7 +33,7 @@ T4908.$trModule = Rec { -- RHS size: {terms: 19, types: 5, coercions: 0} T4908.f_$s$wf [Occ=LoopBreaker] :: Int -> Int# -> Int# -> Bool -[GblId, Arity=3, Caf=NoCafRefs, Str=<L,A><L,U><S,1*U>] +[GblId, Arity=3, Caf=NoCafRefs, Str=<L,A><L,1*U><S,1*U>] T4908.f_$s$wf = \ (sc :: Int) (sc1 :: Int#) (sc2 :: Int#) -> case sc2 of ds { @@ -51,7 +51,7 @@ T4908.$wf [InlPrag=[0]] :: Int# -> (Int, Int) -> Bool [GblId, Arity=2, Caf=NoCafRefs, - Str=<S,1*U><L,1*U(A,U(U))>, + Str=<S,1*U><L,1*U(A,1*U(1*U))>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 20] 101 20}] T4908.$wf = @@ -74,7 +74,7 @@ f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool [GblId, Arity=2, Caf=NoCafRefs, - Str=<S(S),1*U(1*U)><L,1*U(A,U(U))>, + Str=<S(S),1*U(1*U)><L,1*U(A,1*U(1*U))>, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr index 441b4ed391..64bf015a26 100644 --- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr +++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr @@ -43,7 +43,7 @@ Rec { -- RHS size: {terms: 55, types: 9, coercions: 0} Roman.foo_$s$wgo [Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><L,U>] +[GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><S,U>] Roman.foo_$s$wgo = \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) -> let { @@ -151,7 +151,7 @@ foo :: Int -> Int [GblId, Arity=1, Caf=NoCafRefs, - Str=<S,1*U(U)>m, + Str=<S(S),1*U(U)>m, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 042c0974d9..7fd181296b 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -71,4 +71,4 @@ test('T9128', normal, compile_and_run, ['']) test('T9390', normal, compile_and_run, ['']) test('T10830', extra_run_opts('+RTS -K100k -RTS'), compile_and_run, ['']) test('T11172', normal, compile_and_run, ['']) -test('T11731', expect_broken(11731), compile_and_run, ['-fspec-constr']) +test('T11731', normal, compile_and_run, ['-fspec-constr']) diff --git a/testsuite/tests/stranal/should_compile/T10694.stderr b/testsuite/tests/stranal/should_compile/T10694.stderr index 1908a08afe..06fc3a7a8a 100644 --- a/testsuite/tests/stranal/should_compile/T10694.stderr +++ b/testsuite/tests/stranal/should_compile/T10694.stderr @@ -1,5 +1,66 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 59, types: 41, coercions: 0} + +-- RHS size: {terms: 39, types: 23, coercions: 0} +pm [InlPrag=NOINLINE] :: Int -> Int -> (Int, Int) [GblId, Arity=2, Str=<L,U(U)><L,U(U)>m] +pm = + \ (x_axr :: Int) (y_axs :: Int) -> + let { + l_sVj :: Int + [LclId] + l_sVj = + case x_axr of { GHC.Types.I# x1_aUL -> case y_axs of { GHC.Types.I# y1_aUP -> GHC.Types.I# (GHC.Prim.+# x1_aUL y1_aUP) } } } in + let { + l1_sVl :: Int + [LclId] + l1_sVl = + case x_axr of { GHC.Types.I# x1_aUV -> case y_axs of { GHC.Types.I# y1_aUZ -> GHC.Types.I# (GHC.Prim.-# x1_aUV y1_aUZ) } } } in + let { + l2_sVk :: [Int] + [LclId] + l2_sVk = GHC.Types.: @ Int l1_sVl (GHC.Types.[] @ Int) } in + let { + l3_sVa :: [Int] + [LclId] + l3_sVa = GHC.Types.: @ Int l_sVj l2_sVk } in + (GHC.List.$w!! @ Int l3_sVa 0#, GHC.List.$w!! @ Int l3_sVa 1#) + +-- RHS size: {terms: 8, types: 7, coercions: 0} +m :: Int -> Int -> Int +[GblId, + Arity=2, Str=<L,U(U)><L,U(U)>, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (x_aCt [Occ=Once] :: Int) (y_aCu [Occ=Once] :: Int) -> + case pm x_aCt y_aCu of { (_ [Occ=Dead], mr_aCw [Occ=Once]) -> mr_aCw }}] +m = \ (x_aCt :: Int) (y_aCu :: Int) -> case pm x_aCt y_aCu of { (pr_aCv, mr_aCw) -> mr_aCw } + +-- RHS size: {terms: 2, types: 0, coercions: 0} +T10694.$trModule2 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] +T10694.$trModule2 = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +T10694.$trModule1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] +T10694.$trModule1 = GHC.Types.TrNameS "T10694"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +T10694.$trModule :: GHC.Types.Module +[GblId, + Caf=NoCafRefs, Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +T10694.$trModule = GHC.Types.Module T10694.$trModule2 T10694.$trModule1 + + + diff --git a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr index 4bc1e3f379..ee36ca357f 100644 --- a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr +++ b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr @@ -5,3 +5,10 @@ BottomFromInnerLambda.expensive: <S(S),1*U(U)>m BottomFromInnerLambda.f: <S(S),1*U(U)> + +==================== Strictness signatures ==================== +BottomFromInnerLambda.$trModule: m +BottomFromInnerLambda.expensive: <S(S),1*U(U)>m +BottomFromInnerLambda.f: <S(S),1*U(U)> + + diff --git a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr index d06e4ca86a..fb898f7e22 100644 --- a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr +++ b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr @@ -12,3 +12,17 @@ DmdAnalGADTs.hasCPR: m DmdAnalGADTs.hasStrSig: <S,1*U(U)>m + +==================== Strictness signatures ==================== +DmdAnalGADTs.$tc'A: m +DmdAnalGADTs.$tc'B: m +DmdAnalGADTs.$tcD: m +DmdAnalGADTs.$trModule: m +DmdAnalGADTs.diverges: b +DmdAnalGADTs.f: <S,1*U> +DmdAnalGADTs.f': <S,1*U>m +DmdAnalGADTs.g: <S,1*U> +DmdAnalGADTs.hasCPR: m +DmdAnalGADTs.hasStrSig: <S,1*U(U)>m + + diff --git a/testsuite/tests/stranal/sigs/HyperStrUse.stderr b/testsuite/tests/stranal/sigs/HyperStrUse.stderr index 442576db56..21077d243f 100644 --- a/testsuite/tests/stranal/sigs/HyperStrUse.stderr +++ b/testsuite/tests/stranal/sigs/HyperStrUse.stderr @@ -4,3 +4,9 @@ HyperStrUse.$trModule: m HyperStrUse.f: <S(S(S)L),1*U(1*U(U),A)><S,1*U>m + +==================== Strictness signatures ==================== +HyperStrUse.$trModule: m +HyperStrUse.f: <S(S(S)L),1*U(1*U(U),A)><S,1*U>m + + diff --git a/testsuite/tests/stranal/sigs/StrAnalExample.stderr b/testsuite/tests/stranal/sigs/StrAnalExample.stderr index bd82226bee..4cc6f01905 100644 --- a/testsuite/tests/stranal/sigs/StrAnalExample.stderr +++ b/testsuite/tests/stranal/sigs/StrAnalExample.stderr @@ -4,3 +4,9 @@ StrAnalExample.$trModule: m StrAnalExample.foo: <S,1*U> + +==================== Strictness signatures ==================== +StrAnalExample.$trModule: m +StrAnalExample.foo: <S,1*U> + + diff --git a/testsuite/tests/stranal/sigs/T8569.stderr b/testsuite/tests/stranal/sigs/T8569.stderr index 84636c1916..10d962ec45 100644 --- a/testsuite/tests/stranal/sigs/T8569.stderr +++ b/testsuite/tests/stranal/sigs/T8569.stderr @@ -7,3 +7,12 @@ T8569.$trModule: m T8569.addUp: <S,1*U><L,U> + +==================== Strictness signatures ==================== +T8569.$tc'Rdata: m +T8569.$tc'Rint: m +T8569.$tcRep: m +T8569.$trModule: m +T8569.addUp: <S,1*U><L,U> + + diff --git a/testsuite/tests/stranal/sigs/T8598.stderr b/testsuite/tests/stranal/sigs/T8598.stderr index 28d5dd0c7d..c084e15a99 100644 --- a/testsuite/tests/stranal/sigs/T8598.stderr +++ b/testsuite/tests/stranal/sigs/T8598.stderr @@ -4,3 +4,9 @@ T8598.$trModule: m T8598.fun: <S(S),1*U(U)>m + +==================== Strictness signatures ==================== +T8598.$trModule: m +T8598.fun: <S(S),1*U(U)>m + + diff --git a/testsuite/tests/stranal/sigs/UnsatFun.stderr b/testsuite/tests/stranal/sigs/UnsatFun.stderr index f5093981eb..1ea2fa4773 100644 --- a/testsuite/tests/stranal/sigs/UnsatFun.stderr +++ b/testsuite/tests/stranal/sigs/UnsatFun.stderr @@ -10,3 +10,15 @@ UnsatFun.h2: <S,1*U><L,1*C1(U(U))> UnsatFun.h3: <C(S),1*C1(U)>m + +==================== Strictness signatures ==================== +UnsatFun.$trModule: m +UnsatFun.f: <B,1*U(U)><B,A>x +UnsatFun.g: <B,1*U(U)>x +UnsatFun.g': <L,1*U(U)> +UnsatFun.g3: <L,U(U)>m +UnsatFun.h: <C(S),1*C1(U(U))> +UnsatFun.h2: <S,1*U><L,1*C1(U(U))> +UnsatFun.h3: <C(S),1*C1(U)>m + + |