Commit 0aec78b6 authored by Sebastian Graf's avatar Sebastian Graf Committed by Marge Bot

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
......@@ -2283,7 +2283,7 @@ section "Exceptions"
-- DEFAULT -> case ma of MVar a -> ...
-- 0# -> maskAsyncExceptions# (\st -> case ma of MVar a -> ...)
-- The outer case just decides whether to mask exceptions, but we don't want
-- thereby to hide the strictness in 'ma'! Hence the use of strictApply1Dmd
-- thereby to hide the strictness in 'ma'! Hence the use of strictOnceApply1Dmd
-- in mask and unmask. But catch really is lazy in its first argument, see
-- #11555. So for IO actions 'ma' we often use a wrapper around it that is
-- head-strict in 'ma': GHC.IO.catchException.
......@@ -2329,7 +2329,7 @@ primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
with
strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv }
strictness = { \ _arity -> mkClosedStrictSig [strictOnceApply1Dmd,topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
out_of_line = True
has_side_effects = True
......@@ -2338,7 +2338,7 @@ primop MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
with
strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv }
strictness = { \ _arity -> mkClosedStrictSig [strictOnceApply1Dmd,topDmd] topDiv }
out_of_line = True
has_side_effects = True
......@@ -2346,7 +2346,7 @@ primop UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
with
strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv }
strictness = { \ _arity -> mkClosedStrictSig [strictOnceApply1Dmd,topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
out_of_line = True
has_side_effects = True
......@@ -2367,7 +2367,7 @@ primop AtomicallyOp "atomically#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #) )
-> State# RealWorld -> (# State# RealWorld, a #)
with
strictness = { \ _arity -> mkClosedStrictSig [strictApply1Dmd,topDmd] topDiv }
strictness = { \ _arity -> mkClosedStrictSig [strictManyApply1Dmd,topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
out_of_line = True
has_side_effects = True
......
......@@ -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 <S, U(AAAA)>, for some
-- For seqDmd, it should behave like <S(AAAA)>, 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=<S,U><S,U><S,U>, Unf=OtherCon []]
[GblId, Arity=3, Str=<MU><MU><MU>, 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=<S,1*U><S,U><S,U><S,U><S,U>,
Str=<SU><MU><MU><MU><MU>,
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=<L,1*U(A,A,A,A,A,A,1*C1(U))><C(S),1*C1(U)>,
Str=<1P(A,A,A,A,A,A,1C1(U))><SCS(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=<S,U>,
Str=<MU>,
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=<C(C(S)),1*C1(C1(U))><L,U>,
Str=<SCS(CS(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=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=<S,U><S,U>, Unf=OtherCon []]
[GblId, Arity=2, Str=<MU><MU>, 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[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int#
[GblId, Arity=1, Str=<S,1*U>, Unf=OtherCon []]
F3.$wfac [InlPrag=[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int#
[GblId, Arity=1, Str=<SU>, 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[2]] :: Int -> Int
fac [InlPrag=[2]] :: Int -> Int
[GblId,
Arity=1,
Str=<S(S),1*U(1*U)>,
Str=<SP(SU)>,
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=<S(S),1*U(1*U)>,
Str=<SP(SU)>,
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=<S,1*U(U)>,
Str=<SP(U)>,
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[2], Occ=LoopBreaker] :: (Int -> Int) -> GHC.Prim.Int# -> Int
[GblId, Arity=2, Str=<C(S),1*C1(U)><S,1*U>, Unf=OtherCon []]
F4.$wf4h [InlPrag=[2], Occ=LoopBreaker] :: (Int -> Int) -> GHC.Prim.Int# -> Int
[GblId, Arity=2, Str=<SCS(U)><SU>, 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[2]] :: (Int -> Int) -> Int -> Int
f4h [InlPrag=[2]] :: (Int -> Int) -> Int -> Int
[GblId,
Arity=2,
Str=<C(S),1*C1(U)><S(S),1*U(1*U)>,
Str=<SCS(U)><SP(SU)>,
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=<S(C(C(S))LLLLLL),U(1*C1(C1(U)),A,A,A,A,A,1*C1(U))><L,1*C1(U)><L,U>,
Str=<MP(SCS(CS(U)),A,A,A,A,A,1C1(U))><1C1(U)><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[2]] :: forall {a} {t}. (a -> a -> a) -> (Integer -> a) -> (t -> a) -> t -> (t -> a) -> a
[GblId, Arity=5, Str=<C(C(S)),C(C1(U))><L,1*C1(U)><L,1*C1(U)><L,U><L,1*C1(U)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60 60 0 60] 120 0}]
F5.$wf5h [InlPrag=[2]] :: forall {a} {t}. (a -> a -> a) -> (Integer -> a) -> (t -> a) -> t -> (t -> a) -> a
[GblId, Arity=5, Str=<MCM(CS(U))><1C1(U)><1C1(U)><U><1C1(U)>, Unf=Unf{Src=<vanilla>, 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[2]] :: forall {a} {t}. Num a => (t -> a) -> t -> (t -> a) -> a
f5h [InlPrag=[2]] :: forall {a} {t}. Num a => (t -> a) -> t -> (t -> a) -> a
[GblId,
Arity=4,
Str=<S(C(C(S))LLLLLL),1*U(C(C1(U)),A,A,A,A,A,1*C1(U))><L,1*C1(U)><L,U><L,1*C1(U)>,
Str=<SP(MCM(CS(U)),A,A,A,A,A,1C1(U))><1C1(U)><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=<S,1*U>,
Str=<SU>,
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=<S,U>, Unf=OtherCon []]
[GblId, Arity=1, Str=<MU>, 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=<S,U>, Unf=OtherCon []]
[GblId, Arity=1, Str=<MU>, 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[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p
[GblId, Arity=4, Str=<C(C(S)),C(C1(U))><L,U(A,C(C1(U)),A,A,A,A,C(U))><L,U(C(C1(U)),A,A,A,A,A,1*C1(U))><L,U>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 460 0}]
F11.$wfib [InlPrag=[2]] :: forall {a} {p}. (a -> a -> Bool) -> (Num a, Num p) => a -> p
[GblId, Arity=4, Str=<MCM(CS(U))><UP(A,UCU(CS(U)),A,A,A,A,UCU(U))><UP(UCU(CS(U)),A,A,A,A,A,1C1(U))><U>, Unf=Unf{Src=<vanilla>, 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=<L,U>, Unf=OtherCon []]
[LclId, Arity=1, Str=<U>, 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[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p
fib [InlPrag=[2]] :: forall {a} {p}. (Eq a, Num a, Num p) => a -> p
[GblId,
Arity=4,
Str=<S(C(C(S))L),1*U(C(C1(U)),A)><L,U(A,C(C1(U)),A,A,A,A,C(U))><L,U(C(C1(U)),A,A,A,A,A,C(U))><L,U>,
Str=<SP(MCM(CS(U)),A)><UP(A,UCU(CS(U)),A,A,A,A,UCU(U))><UP(UCU(CS(U)),A,A,A,A,A,UCU(U))><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) (@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,