### Demand: Interleave usage and strictness demands (#18903)

```As outlined in #18903, interleaving usage and strictness demands not
only means a more compact demand representation, but also allows us to
express demands that we weren't easily able to express before.

Call demands are *relative* in the sense that a call demand `Cn(cd)`
on `g` says "`g` is called `n` times. *Whenever `g` is called*, the
result is used according to `cd`". Example from #18903:

```hs
h :: Int -> Int
h m =
let g :: Int -> (Int,Int)
g 1 = (m, 0)
g n = (2 * n, 2 `div` n)
{-# NOINLINE g #-}
in case m of
1 -> 0
2 -> snd (g m)
_ -> uncurry (+) (g m)
```

Without the interleaved representation, we would just get `L` for the
strictness demand on `g`. Now we are able to express that whenever
`g` is called, its second component is used strictly in denoting `g`
by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the
division, for example.

Fixes #18903.
While fixing regressions, I also discovered and fixed #18957.

Metric Decrease:
T13253-spj```
parent 321d1bd8
 ... ... @@ -319,7 +319,7 @@ cprAnalBind top_lvl env id rhs -- See Note [CPR for thunks] stays_thunk = is_thunk && not_strict is_thunk = not (exprIsHNF rhs) && not (isJoinId id) not_strict = not (isStrictDmd (idDemandInfo id)) not_strict = not (isStrUsedDmd (idDemandInfo id)) -- See Note [CPR for sum types] (_, ret_ty) = splitPiTys (idType id) not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty) ... ...
This diff is collapsed.
 ... ... @@ -67,7 +67,6 @@ import GHC.Types.Id.Info import GHC.Types.Basic import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Demand import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) import GHC.Types.Unique.FM import GHC.Types.Name.Ppr ... ... @@ -1096,6 +1095,6 @@ dmdAnal dflags fam_envs binds = do } binds_plus_dmds = dmdAnalProgram opts fam_envs binds Err.dumpIfSet_dyn dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText \$ dumpIdInfoOfProgram (pprIfaceStrictSig . strictnessInfo) binds_plus_dmds dumpIdInfoOfProgram (ppr . strictnessInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds
 ... ... @@ -103,7 +103,7 @@ import GHC.Types.Unique.Set ( nonDetStrictFoldUniqSet ) import GHC.Types.Unique.DSet ( getUniqDSet ) import GHC.Types.Var.Env import GHC.Types.Literal ( litIsTrivial ) import GHC.Types.Demand ( StrictSig, Demand, isStrictDmd, splitStrictSig, prependArgsStrictSig ) import GHC.Types.Demand ( StrictSig, Demand, isStrUsedDmd, splitStrictSig, prependArgsStrictSig ) import GHC.Types.Cpr ( mkCprSig, botCpr ) import GHC.Types.Name ( getOccName, mkSystemVarName ) import GHC.Types.Name.Occurrence ( occNameString ) ... ... @@ -469,7 +469,7 @@ lvlApp env orig_expr ((_,AnnVar fn), args) lvl_arg :: [Demand] -> CoreExprWithFVs -> LvlM ([Demand], LevelledExpr) lvl_arg strs arg | (str1 : strs') <- strs , is_val_arg arg = do { arg' <- lvlMFE env (isStrictDmd str1) arg = do { arg' <- lvlMFE env (isStrUsedDmd str1) arg ; return (strs', arg') } | otherwise = do { arg' <- lvlMFE env False arg ... ...
 ... ... @@ -41,7 +41,7 @@ import GHC.Core.Opt.Monad ( Tick(..), SimplMode(..) ) import GHC.Core import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) import GHC.Types.Demand ( StrictSig(..), Demand, dmdTypeDepth, isStrictDmd import GHC.Types.Demand ( StrictSig(..), Demand, dmdTypeDepth, isStrUsedDmd , mkClosedStrictSig, topDmd, seqDmd, isDeadEndDiv ) import GHC.Types.Cpr ( mkCprSig, botCpr ) import GHC.Core.Ppr ( pprCoreExpr ) ... ... @@ -2481,7 +2481,7 @@ There have been various earlier versions of this patch: scrut_is_demanded_var :: CoreExpr -> Bool scrut_is_demanded_var (Cast s _) = scrut_is_demanded_var s scrut_is_demanded_var (Var _) = isStrictDmd (idDemandInfo case_bndr) scrut_is_demanded_var (Var _) = isStrUsedDmd (idDemandInfo case_bndr) scrut_is_demanded_var _ = False This only fired if the scrutinee was a /variable/, which seems ... ... @@ -2709,7 +2709,7 @@ doCaseToLet scrut case_bndr | otherwise -- Scrut has a lifted type = exprIsHNF scrut || isStrictDmd (idDemandInfo case_bndr) || isStrUsedDmd (idDemandInfo case_bndr) -- See Note [Case-to-let for strictly-used binders] -------------------------------------------------- ... ...
 ... ... @@ -329,7 +329,7 @@ addCastTo ai co = ai { ai_args = CastBy co : ai_args ai } isStrictArgInfo :: ArgInfo -> Bool -- True if the function is strict in the next argument isStrictArgInfo (ArgInfo { ai_dmds = dmds }) | dmd:_ <- dmds = isStrictDmd dmd | dmd:_ <- dmds = isStrUsedDmd dmd | otherwise = False argInfoAppArgs :: [ArgSpec] -> [OutExpr] ... ... @@ -582,7 +582,7 @@ mkArgInfo env fun rules n_val_args call_cont | Just (_, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty -- Add strict-type info , dmd : rest_dmds <- dmds , let dmd' = case isLiftedType_maybe arg_ty of Just False -> strictenDmd dmd Just False -> strictifyDmd dmd _ -> dmd = dmd' : add_type_strictness fun_ty' rest_dmds -- If the type is levity-polymorphic, we can't know whether it's ... ...
 ... ... @@ -1724,11 +1724,12 @@ calcSpecStrictness fn qvars pats go env _ _ = env go_one :: DmdEnv -> Demand -> CoreExpr -> DmdEnv go_one env d (Var v) = extendVarEnv_C bothDmd env v d go_one env d e | Just ds <- splitProdDmd_maybe d -- NB: d does not have to be strict , (Var _, args) <- collectArgs e = go env ds args go_one env _ _ = env go_one env d (Var v) = extendVarEnv_C plusDmd env v d go_one env (_n :* cd) e -- NB: _n does not have to be strict | (Var _, args) <- collectArgs e , Just ds <- viewProd (length args) cd = go env ds args go_one env _ _ = env {- Note [spec_usg includes rhs_usg] ... ...
 ... ... @@ -610,7 +610,7 @@ wantToUnbox :: FamInstEnvs -> Bool -> Type -> Demand -> Maybe ([Demand], DataCon wantToUnbox fam_envs has_inlineable_prag ty dmd = case deepSplitProductType_maybe fam_envs ty of Just dcac@DataConAppContext{ dcac_arg_tys = con_arg_tys } | isStrictDmd dmd | isStrUsedDmd dmd -- See Note [Unpacking arguments with product and polymorphic demands] , Just cs <- split_prod_dmd_arity dmd (length con_arg_tys) -- See Note [Do not unpack class dictionaries] ... ... @@ -621,12 +621,11 @@ wantToUnbox fam_envs has_inlineable_prag ty dmd = _ -> Nothing where split_prod_dmd_arity dmd arty -- For seqDmd, splitProdDmd_maybe will return Nothing (because how would -- it know the arity?), but it should behave like , for some -- For seqDmd, it should behave like , for some -- suitable arity | isSeqDmd dmd = Just (replicate arty absDmd) -- Otherwise splitProdDmd_maybe does the job | otherwise = splitProdDmd_maybe dmd | isSeqDmd dmd = Just (replicate arty absDmd) | _ :* Prod ds <- dmd = Just ds | otherwise = Nothing unbox_one :: DynFlags -> FamInstEnvs -> Var -> [Demand] ... ...
 ... ... @@ -46,7 +46,7 @@ import GHC.Driver.Session import GHC.Platform.Ways import GHC.Driver.Ppr import GHC.Types.ForeignCall import GHC.Types.Demand ( isUsedOnce ) import GHC.Types.Demand ( isUsedOnceDmd ) import GHC.Builtin.PrimOps ( PrimCall(..) ) import GHC.Types.SrcLoc ( mkGeneralSrcSpan ) import GHC.Builtin.Names ( unsafeEqualityProofName ) ... ... @@ -714,8 +714,8 @@ mkTopStgRhs dflags this_mod ccs bndr rhs where unticked_rhs = stripStgTicksTopE (not . tickishIsCode) rhs upd_flag | isUsedOnce (idDemandInfo bndr) = SingleEntry | otherwise = Updatable upd_flag | isUsedOnceDmd (idDemandInfo bndr) = SingleEntry | otherwise = Updatable -- CAF cost centres generated for -fcaf-all caf_cc = mkAutoCC bndr modl ... ... @@ -756,8 +756,8 @@ mkStgRhs bndr rhs where unticked_rhs = stripStgTicksTopE (not . tickishIsCode) rhs upd_flag | isUsedOnce (idDemandInfo bndr) = SingleEntry | otherwise = Updatable upd_flag | isUsedOnceDmd (idDemandInfo bndr) = SingleEntry | otherwise = Updatable {- SDM: disabled. Eval/Apply can't handle functions with arity zero very ... ...
 ... ... @@ -1359,7 +1359,7 @@ mkFloat dmd is_unlifted bndr rhs -- See Note [Pin demand info on floats] where is_hnf = exprIsHNF rhs is_strict = isStrictDmd dmd is_strict = isStrUsedDmd dmd emptyFloats :: Floats emptyFloats = Floats OkToSpec nilOL ... ... @@ -1446,7 +1446,7 @@ canFloat (Floats ok_to_spec fs) rhs wantFloatNested :: RecFlag -> Demand -> Bool -> Floats -> CpeRhs -> Bool wantFloatNested is_rec dmd is_unlifted floats rhs = isEmptyFloats floats || isStrictDmd dmd || isStrUsedDmd dmd || is_unlifted || (allLazyNested is_rec floats && exprIsHNF rhs) -- Why the test for allLazyNested? ... ...
 ... ... @@ -1465,7 +1465,7 @@ instance Outputable IfaceInfoItem where <> colon <+> ppr unf ppr (HsInline prag) = text "Inline:" <+> ppr prag ppr (HsArity arity) = text "Arity:" <+> int arity ppr (HsStrictness str) = text "Strictness:" <+> pprIfaceStrictSig str ppr (HsStrictness str) = text "Strictness:" <+> ppr str ppr (HsCpr cpr) = text "CPR:" <+> ppr cpr ppr HsNoCafRefs = text "HasNoCafRefs" ppr HsLevity = text "Never levity-polymorphic" ... ...
 ... ... @@ -95,7 +95,7 @@ import Data.Maybe ( mapMaybe ) -- -- * 'ClosureSk', representing closure allocation. -- * 'RhsSk', representing a RHS of a binding and how many times it's called -- by an appropriate 'DmdShell'. -- by an appropriate 'Card'. -- * 'AltSk', 'BothSk' and 'NilSk' for choice, sequence and empty element. -- -- This abstraction is mostly so that the main analysis function 'closureGrowth' ... ... @@ -124,7 +124,7 @@ freeVarsOfRhs (StgRhsClosure fvs _ _ _ _) = fvs -- closures, multi-shot lambdas and case expressions. data Skeleton = ClosureSk !Id !DIdSet {- ^ free vars -} !Skeleton | RhsSk !DmdShell {- ^ how often the RHS was entered -} !Skeleton | RhsSk !Card {- ^ how often the RHS was entered -} !Skeleton | AltSk !Skeleton !Skeleton | BothSk !Skeleton !Skeleton | NilSk ... ... @@ -139,7 +139,7 @@ altSk NilSk b = b altSk a NilSk = a altSk a b = AltSk a b rhsSk :: DmdShell -> Skeleton -> Skeleton rhsSk :: Card -> Skeleton -> Skeleton rhsSk _ NilSk = NilSk rhsSk body_dmd skel = RhsSk body_dmd skel ... ... @@ -172,22 +172,12 @@ instance Outputable Skeleton where ] ppr (BothSk l r) = ppr l \$\$ ppr r ppr (ClosureSk f fvs body) = ppr f <+> ppr fvs \$\$ nest 2 (ppr body) ppr (RhsSk body_dmd body) = hcat [ text "λ[" , ppr str , text ", " , ppr use , text "]. " ppr (RhsSk card body) = hcat [ lambda , ppr card , dot , ppr body ] where str | isStrictDmd body_dmd = '1' | otherwise = '0' use | isAbsDmd body_dmd = '0' | isUsedOnce body_dmd = '1' | otherwise = 'ω' instance Outputable BinderInfo where ppr = ppr . binderInfoBndr ... ... @@ -333,19 +323,19 @@ tagSkeletonRhs bndr (StgRhsClosure fvs ccs upd bndrs body) where bndrs' = map BoringBinder bndrs (body_skel, body_arg_occs, body') = tagSkeletonExpr body rhs_skel = rhsSk (rhsDmdShell bndr) body_skel rhs_skel = rhsSk (rhsCard bndr) body_skel -- | How many times will the lambda body of the RHS bound to the given -- identifier be evaluated, relative to its defining context? This function -- computes the answer in form of a 'DmdShell'. rhsDmdShell :: Id -> DmdShell rhsDmdShell bndr | is_thunk = oneifyDmd ds -- computes the answer in form of a 'Card'. rhsCard :: Id -> Card rhsCard bndr | is_thunk = oneifyCard n | otherwise = peelManyCalls (idArity bndr) cd where is_thunk = idArity bndr == 0 -- Let's pray idDemandInfo is still OK after unarise... (ds, cd) = toCleanDmd (idDemandInfo bndr) n :* cd = idDemandInfo bndr tagSkeletonAlt :: CgStgAlt -> (Skeleton, IdSet, LlStgAlt) tagSkeletonAlt (con, bndrs, rhs) ... ... @@ -550,7 +540,7 @@ closureGrowth expander sizer group abs_ids = go -- Lifting @f@ removes @f@ from the closure but adds all @newbies@ cost = nonDetStrictFoldDVarSet (\id size -> sizer id + size) 0 newbies - n_occs -- Using a non-deterministic fold is OK here because addition is commutative. go (RhsSk body_dmd body) go (RhsSk n body) -- The conservative assumption would be that -- 1. Every RHS with positive growth would be called multiple times, -- modulo thunks. ... ... @@ -561,11 +551,11 @@ closureGrowth expander sizer group abs_ids = go -- considering information from the demand analyser, which provides us -- with conservative estimates on minimum and maximum evaluation -- cardinality. The @body_dmd@ part of 'RhsSk' is the result of -- 'rhsDmdShell' and accurately captures the cardinality of the RHSs body -- 'rhsCard' and accurately captures the cardinality of the RHSs body -- relative to its defining context. | isAbsDmd body_dmd = 0 | cg <= 0 = if isStrictDmd body_dmd then cg else 0 | isUsedOnce body_dmd = cg | otherwise = infinity | isAbs n = 0 | cg <= 0 = if isStrict n then cg else 0 | isUsedOnce n = cg | otherwise = infinity where cg = go body
This source diff could not be displayed because it is too large. You can view the blob instead.
 ... ... @@ -704,7 +704,7 @@ isStrictId id not (isJoinId id) && ( (isStrictType (idType id)) || -- Take the best of both strictnesses - old and new (isStrictDmd (idDemandInfo id)) (isStrUsedDmd (idDemandInfo id)) ) --------------------------------- ... ...
 ... ... @@ -636,7 +636,7 @@ zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand}) -> occ { occ_tail = NoTailCallInfo } _other -> occ is_safe_dmd dmd = not (isStrictDmd dmd) is_safe_dmd dmd = not (isStrUsedDmd dmd) -- | Remove all demand info on the 'IdInfo' zapDemandInfo :: IdInfo -> Maybe IdInfo ... ...
 ... ... @@ -515,9 +515,9 @@ mkDictSelId name clas strict_sig = mkClosedStrictSig [arg_dmd] topDiv arg_dmd | new_tycon = evalDmd | otherwise = mkManyUsedDmd \$ mkProdDmd [ if name == sel_name then evalDmd else absDmd | sel_name <- sel_names ] | otherwise = C_1N :* Prod [ if name == sel_name then evalDmd else absDmd | sel_name <- sel_names ] mkDictSelRhs :: Class -> Int -- 0-indexed selector among (superclasses ++ methods) ... ...
 ... ... @@ -35,6 +35,7 @@ module GHC.Utils.Outputable ( doubleQuotes, angleBrackets, semi, comma, colon, dcolon, space, equals, dot, vbar, arrow, lollipop, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt, lambda, lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore, mulArrow, blankLine, forAllLit, bullet, (<>), (<+>), hcat, hsep, ... ... @@ -648,7 +649,7 @@ quotes d = sdocOption sdocCanUseUnicode \$ \case | otherwise -> Pretty.quotes pp_d semi, comma, colon, equals, space, dcolon, underscore, dot, vbar :: SDoc arrow, lollipop, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt :: SDoc arrow, lollipop, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt, lambda :: SDoc lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc blankLine = docToSDoc \$ Pretty.text "" ... ... @@ -661,6 +662,7 @@ arrowt = unicodeSyntax (char '⤚') (docToSDoc \$ Pretty.text ">-") larrowt = unicodeSyntax (char '⤙') (docToSDoc \$ Pretty.text "-<") arrowtt = unicodeSyntax (char '⤜') (docToSDoc \$ Pretty.text ">>-") larrowtt = unicodeSyntax (char '⤛') (docToSDoc \$ Pretty.text "-<<") lambda = unicodeSyntax (char 'λ') (char '\\') semi = docToSDoc \$ Pretty.semi comma = docToSDoc \$ Pretty.comma colon = docToSDoc \$ Pretty.colon ... ...
 ... ... @@ -10,7 +10,7 @@ F1.f2 = 1 Rec { -- RHS size: {terms: 18, types: 4, coercions: 0, joins: 0/0} F1.f1_h1 [Occ=LoopBreaker] :: Integer -> Integer -> Integer -> Integer [GblId, Arity=3, Str=, Unf=OtherCon []] [GblId, Arity=3, Str=, Unf=OtherCon []] F1.f1_h1 = \ (n :: Integer) (x :: Integer) (eta :: Integer) -> case GHC.Num.Integer.integerCompare x n of { ... ... @@ -33,7 +33,7 @@ f1 = F1.f1_h1 F1.f3 F1.f2 F1.f3 g :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer [GblId, Arity=5, Str=, Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=5,unsat_ok=True,boring_ok=False) Tmpl= \ (x1 [Occ=Once1] :: Integer) (x2 [Occ=Once1] :: Integer) (x3 [Occ=Once1] :: Integer) (x4 [Occ=Once1] :: Integer) (x5 [Occ=Once1] :: Integer) -> GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd x1 x2) x3) x4) x5}] g = \ (x1 :: Integer) (x2 :: Integer) (x3 :: Integer) (x4 :: Integer) (x5 :: Integer) -> GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd x1 x2) x3) x4) x5 ... ... @@ -47,7 +47,7 @@ F1.s1 = 3 s :: forall {t1} {t2}. Num t1 => (t1 -> t2) -> t2 [GblId, Arity=2, Str=, Str=<1P(A,A,A,A,A,A,1C1(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= \ (@t) (@t1) (\$dNum [Occ=Once1] :: Num t) (f [Occ=Once1!] :: t -> t1) -> f (fromInteger @t \$dNum F1.s1)}] s = \ (@t) (@t1) (\$dNum :: Num t) (f :: t -> t1) -> f (fromInteger @t \$dNum F1.s1) ... ... @@ -61,7 +61,7 @@ F1.h1 = 24 h :: Integer -> Integer [GblId, Arity=1, Str=, Str=, 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) Tmpl= \ (x5 [Occ=Once1] :: Integer) -> GHC.Num.Integer.integerAdd F1.h1 x5}] h = \ (x5 :: Integer) -> GHC.Num.Integer.integerAdd F1.h1 x5 ... ...
 ... ... @@ -11,7 +11,7 @@ F2.f1 = 0 f2f :: forall {t1} {t2}. (t1 -> Integer -> t2) -> t1 -> t2 [GblId, Arity=2, Str=, Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True) Tmpl= \ (@t) (@t1) (h [Occ=Once1!] :: t -> Integer -> t1) (x [Occ=Once1] :: t) -> h x F2.f1}] f2f = \ (@t) (@t1) (h :: t -> Integer -> t1) (x :: t) -> h x F2.f1 ... ... @@ -24,7 +24,7 @@ lvl = 1 Rec { -- RHS size: {terms: 16, types: 3, coercions: 0, joins: 0/0} F2.f2_g [Occ=LoopBreaker] :: Integer -> Integer -> Integer [GblId, Arity=2, Str=, Unf=OtherCon []] [GblId, Arity=2, Str=, Unf=OtherCon []] F2.f2_g = \ (x :: Integer) (y :: Integer) -> case GHC.Num.Integer.integerCompare x F2.f1 of { ... ...
 ... ... @@ -4,8 +4,8 @@ Result size of Tidy Core = {terms: 29, types: 13, coercions: 0, joins: 0/0} Rec { -- RHS size: {terms: 15, types: 3, coercions: 0, joins: 0/0} F3.\$wfac [InlPrag=NOUSERINLINE, Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# [GblId, Arity=1, Str=, Unf=OtherCon []] F3.\$wfac [InlPrag=, Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# [GblId, Arity=1, Str=, Unf=OtherCon []] F3.\$wfac = \ (ww :: GHC.Prim.Int#) -> case ww of wild { ... ... @@ -15,10 +15,10 @@ F3.\$wfac end Rec } -- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} fac [InlPrag=NOUSERINLINE] :: Int -> Int fac [InlPrag=] :: Int -> Int [GblId, Arity=1, Str=, Str=, Cpr=m1, 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) Tmpl= \ (w [Occ=Once1!] :: Int) -> case w of { GHC.Types.I# ww1 [Occ=Once1] -> case F3.\$wfac ww1 of ww2 [Occ=Once1] { __DEFAULT -> GHC.Types.I# ww2 } }}] ... ... @@ -28,7 +28,7 @@ fac = \ (w :: Int) -> case w of { GHC.Types.I# ww1 -> case F3.\$wfac ww1 of ww2 { f3 :: Int -> Int [GblId, Arity=1, Str=, Str=, Cpr=m1, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True) Tmpl= fac}] ... ...
 ... ... @@ -6,7 +6,7 @@ Result size of Tidy Core = {terms: 39, types: 24, coercions: 0, joins: 0/0} f4g :: Int -> Int [GblId, Arity=1, Str=, Str=, Cpr=m1, 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) Tmpl= \ (y [Occ=Once1!] :: Int) -> case y of { GHC.Types.I# x [Occ=Once1] -> GHC.Types.I# (GHC.Prim.+# x 1#) }}] ... ... @@ -19,8 +19,8 @@ lvl = GHC.Types.I# 0# Rec { -- RHS size: {terms: 13, types: 4, coercions: 0, joins: 0/0} F4.\$wf4h [InlPrag=NOUSERINLINE, Occ=LoopBreaker] :: (Int -> Int) -> GHC.Prim.Int# -> Int [GblId, Arity=2, Str=, Unf=OtherCon []] F4.\$wf4h [InlPrag=, Occ=LoopBreaker] :: (Int -> Int) -> GHC.Prim.Int# -> Int [GblId, Arity=2, Str=, Unf=OtherCon []] F4.\$wf4h = \ (w :: Int -> Int) (ww :: GHC.Prim.Int#) -> case ww of wild { ... ... @@ -30,10 +30,10 @@ F4.\$wf4h end Rec } -- RHS size: {terms: 8, types: 5, coercions: 0, joins: 0/0} f4h [InlPrag=NOUSERINLINE] :: (Int -> Int) -> Int -> Int f4h [InlPrag=] :: (Int -> Int) -> Int -> Int [GblId, Arity=2, Str=, Str=, 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= \ (w [Occ=Once1] :: Int -> Int) (w1 [Occ=Once1!] :: Int) -> case w1 of { GHC.Types.I# ww1 [Occ=Once1] -> F4.\$wf4h w ww1 }}] f4h = \ (w :: Int -> Int) (w1 :: Int) -> case w1 of { GHC.Types.I# ww1 -> F4.\$wf4h w ww1 } ... ...
 ... ... @@ -11,21 +11,21 @@ F5.f5g1 = 1 f5g :: forall {a} {t}. Num a => (t -> a) -> t -> a [GblId, Arity=3, Str=, Str=<1C1(U)>, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@t) (\$dNum :: Num a) (h [Occ=Once1!] :: t -> a) (z [Occ=Once1] :: t) -> + @a \$dNum (h z) (fromInteger @a \$dNum F5.f5g1)}] f5g = \ (@a) (@t) (\$dNum :: Num a) (h :: t -> a) (z :: t) -> + @a \$dNum (h z) (fromInteger @a \$dNum F5.f5g1) -- RHS size: {terms: 15, types: 14, coercions: 0, joins: 0/0} F5.\$wf5h [InlPrag=NOUSERINLINE] :: forall {a} {t}. (a -> a -> a) -> (Integer -> a) -> (t -> a) -> t -> (t -> a) -> a [GblId, Arity=5, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60 60 0 60] 120 0}] F5.\$wf5h [InlPrag=] :: forall {a} {t}. (a -> a -> a) -> (Integer -> a) -> (t -> a) -> t -> (t -> a) -> a [GblId, Arity=5, Str=<1C1(U)><1C1(U)><1C1(U)>, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60 60 0 60] 120 0}] F5.\$wf5h = \ (@a) (@t) (ww :: a -> a -> a) (ww1 :: Integer -> a) (w :: t -> a) (w1 :: t) (w2 :: t -> a) -> ww (w w1) (ww (w2 w1) (ww1 F5.f5g1)) -- RHS size: {terms: 15, types: 32, coercions: 0, joins: 0/0} f5h [InlPrag=NOUSERINLINE] :: forall {a} {t}. Num a => (t -> a) -> t -> (t -> a) -> a f5h [InlPrag=] :: forall {a} {t}. Num a => (t -> a) -> t -> (t -> a) -> a [GblId, Arity=4, Str=, Str=<1C1(U)><1C1(U)>, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@t) (w [Occ=Once1!] :: Num a) (w1 [Occ=Once1] :: t -> a) (w2 [Occ=Once1] :: t) (w3 [Occ=Once1] :: t -> a) -> case w of { GHC.Num.C:Num ww1 [Occ=Once1] _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] ww7 [Occ=Once1] -> F5.\$wf5h @a @t ww1 ww7 w1 w2 w3 }}] f5h = \ (@a) (@t) (w :: Num a) (w1 :: t -> a) (w2 :: t) (w3 :: t -> a) -> case w of { GHC.Num.C:Num ww1 ww2 ww3 ww4 ww5 ww6 ww7 -> F5.\$wf5h @a @t ww1 ww7 w1 w2 w3 } ... ... @@ -34,7 +34,7 @@ f5h = \ (@a) (@t) (w :: Num a) (w1 :: t -> a) (w2 :: t) (w3 :: t -> a) -> case w f5y :: Integer -> Integer [GblId, Arity=1, Str=, Str=, 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) Tmpl= \ (y [Occ=Once1] :: Integer) -> GHC.Num.Integer.integerAdd y F5.f5g1}] f5y = \ (y :: Integer) -> GHC.Num.Integer.integerAdd y F5.f5g1 ... ...
 ... ... @@ -20,7 +20,7 @@ F9.f1 = 10 Rec { -- RHS size: {terms: 15, types: 2, coercions: 0, joins: 0/0} F9.f91_f [Occ=LoopBreaker] :: Integer -> Integer [GblId, Arity=1, Str=, Unf=OtherCon []] [GblId, Arity=1, Str=, Unf=OtherCon []] F9.f91_f = \ (n :: Integer) -> case GHC.Num.Integer.integerCompare n lvl of { ... ...
 ... ... @@ -20,7 +20,7 @@ F11.fib2 = 2 Rec { -- RHS size: {terms: 24, types: 3, coercions: 0, joins: 0/0} F11.f11_fib [Occ=LoopBreaker] :: Integer -> Integer [GblId, Arity=1, Str=, Unf=OtherCon []] [GblId, Arity=1, Str=, Unf=OtherCon []] F11.f11_fib = \ (ds :: Integer) -> case GHC.Num.Integer.integerEq# ds F11.fib1 of { ... ... @@ -34,8 +34,8 @@ F11.f11_fib end Rec } -- RHS size: {terms: 52, types: 28, coercions: 0, joins: 0/5} F11.\$wfib [InlPrag=NOUSERINLINE] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p [GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.\$wfib [InlPrag=] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p [GblId, Arity=4, Str=, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}] F11.\$wfib = \ (@a) (@p) (ww :: a -> a -> Bool) (w :: Num a) (w1 :: Num p) (w2 :: a) -> let { ... ... @@ -56,7 +56,7 @@ F11.\$wfib lvl3 = fromInteger @a w F11.fib1 } in letrec { fib4 [Occ=LoopBreaker] :: a -> p [LclId, Arity=1, Str=, Unf=OtherCon []] [LclId, Arity=1, Str=, Unf=OtherCon []] fib4 = \ (ds :: a) -> case ww ds lvl3 of { ... ... @@ -70,10 +70,10 @@ F11.\$wfib fib4 w2 -- RHS size: {terms: 14, types: 21, coercions: 0, joins: 0/0} fib [InlPrag=NOUSERINLINE] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p fib [InlPrag=] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p [GblId, Arity=4, Str=, Str=, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@p) (w [Occ=Once1!] :: Eq a) (w1 [Occ=Once1] :: Num a) (w2 [Occ=Once1] :: Num p) (w3 [Occ=Once1] :: a) -> case w of { GHC.Classes.C:Eq ww1 [Occ=Once1] _ [Occ=Dead] -> F11.\$wfib @a @p ww1 w1 w2 w3 }}] fib = \ (@a) (@p) (w :: Eq a) (w1 :: Num a) (w2 :: Num p) (w3 :: a) -> case w of { GHC.Classes.C:Eq ww1 ww2 -> F11.\$wfib @a @p ww1 w1 w2 w3 } ... ... @@ -92,7 +92,7 @@ F11.f11_x = F11.f11_fib F11.f3 F11.f11f1 :: Integer -> Integer [GblId, Arity=1,