Andreas Klebinger pushed to branch wip/apk/unfold-dicts at Glasgow Haskell Compiler / GHC Commits: 38b4fe14 by Andreas Klebinger at 2026-09-29T19:46:59+00:00 Make T27225 test more stable. Rather than checking for all cost centres, only check for the hand inserted ones from Main. This means the test no longer depends on what sccs are in the boot libs. - - - - - df0eb780 by Andreas Klebinger at 2026-09-29T19:56:00+00:00 Tweak inlining discout for unary class ops. Correctly account for arguments applied to the result of the class op application when computing rhs size for unary classes. I also fixed handling of casts/ticks while in the area. Fixes #27802 Fixes #27818 ------------------------- Metric Decrease: CoOpt_Singletons Metric Increase: T12234 T21839c T21839r T5321FD T5321Fun hard_hole_fits T18223 ------------------------- - - - - - 16 changed files: - + changelog.d/T27802-classop-arg-size - + changelog.d/T27818-unfolding-size-casts-ticks - compiler/GHC/Core/Unfold.hs - testsuite/tests/arityanal/should_compile/Arity01.stderr - testsuite/tests/arityanal/should_compile/Arity05.stderr - testsuite/tests/arityanal/should_compile/Arity08.stderr - testsuite/tests/arityanal/should_compile/Arity11.stderr - testsuite/tests/arityanal/should_compile/Arity14.stderr - testsuite/tests/deSugar/should_compile/T16615.stderr - testsuite/tests/dmdanal/should_compile/T23398.stderr - testsuite/tests/ghci.debugger/scripts/break021.stdout - testsuite/tests/profiling/should_run/T27225.stdout - testsuite/tests/profiling/should_run/T27225b.stdout - testsuite/tests/profiling/should_run/all.T - testsuite/tests/simplCore/should_compile/T15205.stderr - testsuite/tests/simplCore/should_compile/T26117.stderr Changes: ===================================== changelog.d/T27802-classop-arg-size ===================================== @@ -0,0 +1,11 @@ +section: compiler +issues: #27802 +mrs: !16675 +synopsis: + Account for arguments applied to unary class methods when computing unfolding size. +description: { + Due to a bug we considered the application of arguments to a unary class method free + during expression size calculation. We now accurately calculate the discount again. + + This might make some functions heavy on single-class method use no longer inline. +} ===================================== changelog.d/T27818-unfolding-size-casts-ticks ===================================== @@ -0,0 +1,5 @@ +section: compiler +issues: #27818 +mrs: !16675 +synopsis: + Fixed a bug that caused newtypes and cost centres to affect inlining decisions. ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -335,6 +335,10 @@ isValFun :: CoreExpr -> Bool -- one top-level value lambda isValFun (Lam b e) | isRuntimeVar b = True | otherwise = isValFun e +-- A tick can be code which *can* change the runtime semantics here. +-- But we want to ignore it anyway. See Note [Ticks and Cast should not impact unfolding guidance] +isValFun (Tick _t e) = isValFun e +isValFun (Cast e _co) = isValFun e isValFun _ = False calcUnfoldingGuidance @@ -669,6 +673,11 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr is_inline_scrut (Var v) = isUnliftedType (idType v) -- isUnliftedType is OK here: scrutinees have a fixed RuntimeRep (search for FRRCase) + -- Even if this makes the check technically wrong we want to + -- look through ticks here. + -- See Note [Ticks and Cast should not impact unfolding guidance] + is_inline_scrut (Tick _t e) = is_inline_scrut e + is_inline_scrut (Cast e _co) = is_inline_scrut e is_inline_scrut scrut | (Var f, _) <- collectArgs scrut = case idDetails f of @@ -709,7 +718,7 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr FCallId _ -> sizeN (callSize (length val_args) voids) DataConWorkId dc -> conSize dc (length val_args) PrimOpId op _ -> primOpSize op (length val_args) - ClassOpId cls _ -> classOpSize opts cls top_args val_args + ClassOpId cls _ -> classOpSize opts cls top_args val_args voids _ | fun `hasKey` buildIdKey -> buildSize | fun `hasKey` augmentIdKey -> augmentSize | otherwise -> funSize opts top_args fun (length val_args) voids @@ -761,9 +770,11 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr -- and typePrimRep will crash isZeroBitId id = not (isJoinId id) && isZeroBitTy (idType id) - isZeroBitExpr (Var id) = isZeroBitId id - isZeroBitExpr (Tick _ e) = isZeroBitExpr e - isZeroBitExpr _ = False + -- [Ticks and Cast should not impact unfolding guidance] + isZeroBitExpr (Var id) = isZeroBitId id + isZeroBitExpr (Tick _t e) = isZeroBitExpr e + isZeroBitExpr (Cast e _co) = isZeroBitExpr e + isZeroBitExpr _ = False -- | Finds a nominal size of a string literal. litSize :: Literal -> Int @@ -777,21 +788,31 @@ litSize _other = 0 -- Must match size of nullary constructors -- Key point: if x |-> 4, then x must inline unconditionally -- (eg via case binding) -classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize +classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> Int -> ExprSize -- See (IA1) in Note [Interesting arguments] in GHC.Core.Opt.Simplify.Utils -classOpSize _opts _cls _top_args [] +classOpSize _opts _cls _top_args [] _voids = sizeZero -- A non-applied classop -classOpSize opts cls top_args (dict_arg:other_val_args) - = SizeIs size (arg_discount dict_arg) 0 +classOpSize opts cls top_args (dict_arg:other_val_args) voids + = SizeIs size dict_arg_discount 0 where - size | isUnaryClass cls = 0 -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon - | otherwise = 20 + (10 * length other_val_args) + -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon + op_app_size = if isUnaryClass cls then 0 else 20 + + -- Size penalty for applying the extracted class method to it's + -- arguments. + method_app_size + | null other_val_args = 0 -- we don't actually apply the result + | otherwise = callSize (length other_val_args) voids + + size = op_app_size + method_app_size -- If the class op is scrutinising a lambda bound dictionary then -- give it a discount, to encourage the inlining of this function - arg_discount (Cast arg _co) = arg_discount arg - arg_discount (Var dict) | dict `elem` top_args = unitBag (dict, dict_discount) - arg_discount _ = emptyBag + dict_arg_discount = case getIdFromTrivialExpr_maybe dict_arg of + Nothing -> emptyBag + Just var + | var `elem` top_args -> unitBag (var, dict_discount) + | otherwise -> emptyBag -- If we have (class-op d arg1 .. argn) then it's super-good to inline -- to expose `d`; not only can we do the dictionary selection @@ -1051,6 +1072,23 @@ In a function application (f a b) get a saturated application) Code for manipulating sizes + +Note [Ticks and Cast should not impact unfolding guidance] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We want to ignore ticks and casts when +computing unfolding guidance. The reason is simple: + +We want inlining to be robust if a user changes a type alias +to a newtype, if the code is otherwise the same. + +Similarly we want inlining to behave the same for a core expression +(<tick> e) as it does for `e`. +This is **independent** of the kind of tick we are dealing with. +Even for ticks that represent code at runtime we generally want +to inline as-if no tick is present. This way profiled code will +be closer to non-profiled code, which leads to more accurate profiles. + +So we take care to look through Cast/Ticks wherever possible. -} -- | The size of a candidate expression for unfolding ===================================== testsuite/tests/arityanal/should_compile/Arity01.stderr ===================================== @@ -45,7 +45,7 @@ F1.s1 = GHC.Internal.Bignum.Integer.IS 3# -- RHS size: {terms: 8, types: 7, coercions: 0, joins: 0/0} s :: forall {t1} {t2}. Num t1 => (t1 -> t2) -> t2 -[GblId, Arity=2, Str=<MP(A,A,A,A,A,A,1C(1,L))><1C(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 60] 50 0}] +[GblId, Arity=2, Str=<MP(A,A,A,A,A,A,1C(1,L))><1C(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 60] 60 0}] s = \ (@t) (@t1) ($dNum :: Num t) (f :: t -> t1) -> f (fromInteger @t $dNum F1.s1) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} ===================================== testsuite/tests/arityanal/should_compile/Arity05.stderr ===================================== @@ -9,12 +9,12 @@ F5.f5g1 = GHC.Internal.Bignum.Integer.IS 1# -- RHS size: {terms: 12, types: 9, coercions: 0, joins: 0/0} f5g :: forall {a} {t}. Num a => (t -> a) -> t -> a -[GblId, Arity=3, Str=<SP(1C(1,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [180 60 0] 90 0}] +[GblId, Arity=3, Str=<SP(1C(1,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [180 60 0] 110 0}] f5g = \ (@a) (@t) ($dNum :: Num a) (h :: t -> a) (z :: t) -> + @a $dNum (h z) (fromInteger @a $dNum F5.f5g1) -- RHS size: {terms: 17, types: 12, coercions: 0, joins: 0/0} f5h :: forall {a} {t}. Num a => (t -> a) -> t -> (t -> a) -> a -[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L><MC(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [270 60 0 60] 150 0}] +[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L><MC(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [270 60 0 60] 180 0}] f5h = \ (@a) (@t) ($dNum :: Num a) (f :: t -> a) (x :: t) (g :: t -> a) -> + @a $dNum (f x) (+ @a $dNum (g x) (fromInteger @a $dNum F5.f5g1)) -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} ===================================== testsuite/tests/arityanal/should_compile/Arity08.stderr ===================================== @@ -3,12 +3,12 @@ Result size of Tidy Core = {terms: 24, types: 18, coercions: 0, joins: 0/0} -- RHS size: {terms: 20, types: 10, coercions: 0, joins: 0/0} -f8f :: forall {p}. Num p => Bool -> p -> p -> p -[GblId, Arity=4, Str=<LP(SC(S,C(1,L)),A,MC(1,C(1,L)),A,A,A,A)><1L><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [270 30 0 0] 140 0}] +f8f :: forall {a}. Num a => Bool -> a -> a -> a +[GblId, Arity=4, Str=<LP(SC(S,C(1,L)),A,MC(1,C(1,L)),A,A,A,A)><1L><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [270 30 0 0] 170 0}] f8f - = \ (@p) ($dNum :: Num p) (b :: Bool) (x :: p) (y :: p) -> + = \ (@a) ($dNum :: Num a) (b :: Bool) (x :: a) (y :: a) -> case b of { - False -> + @p $dNum (+ @p $dNum x y) (* @p $dNum x x); + False -> + @a $dNum (+ @a $dNum x y) (* @a $dNum x x); True -> y } ===================================== testsuite/tests/arityanal/should_compile/Arity11.stderr ===================================== @@ -19,7 +19,7 @@ F11.fib1 = GHC.Internal.Bignum.Integer.IS 0# -- RHS size: {terms: 54, types: 27, coercions: 0, joins: 0/5} fib :: forall {t1} {t2}. (Eq t1, Num t1, Num t2) => t1 -> t2 -[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A)><LP(A,LC(L,C(1,L)),A,A,A,A,L)><LP(LC(S,C(1,L)),A,A,A,A,A,MC(1,L))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [180 450 180 0] 480 0}] +[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A)><LP(A,LC(L,C(1,L)),A,A,A,A,L)><LP(LC(S,C(1,L)),A,A,A,A,A,MC(1,L))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [180 450 180 0] 570 0}] fib = \ (@t) (@t1) ($dEq :: Eq t) ($dNum :: Num t) ($dNum1 :: Num t1) (eta :: t) -> let { @@ -105,7 +105,7 @@ F11.f11f1 = \ (y :: Integer) -> GHC.Internal.Bignum.Integer.integerAdd F11.f11_x -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} f11f :: forall {p}. p -> Integer -> Integer [GblId, Arity=2, Str=<A><SL>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}] -f11f = \ (@p) _ [Occ=Dead] -> F11.f11f1 +f11f = \ (@p) (z [Occ=Dead] :: p) -> F11.f11f1 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} F11.f5 :: Integer ===================================== testsuite/tests/arityanal/should_compile/Arity14.stderr ===================================== @@ -14,7 +14,7 @@ F14.f2 = GHC.Internal.Bignum.Integer.IS 1# -- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/3} f14 :: forall {t}. (Ord t, Num t) => t -> t -> t -> t -[GblId, Arity=4, Str=<SP(A,A,SC(S,C(1,L)),A,A,A,A,A)><LP(LC(L,C(1,L)),A,A,A,A,A,MC(1,L))><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 270 0 0] 310 0}] +[GblId, Arity=4, Str=<SP(A,A,SC(S,C(1,L)),A,A,A,A,A)><LP(LC(L,C(1,L)),A,A,A,A,A,MC(1,L))><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 270 0 0] 350 0}] f14 = \ (@t) ($dOrd :: Ord t) ($dNum :: Num t) (eta :: t) (eta1 :: t) -> let { ===================================== testsuite/tests/deSugar/should_compile/T16615.stderr ===================================== @@ -9,7 +9,7 @@ g :: Int -> Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [0] 120 10}] + Guidance=IF_ARGS [0] 140 10}] g = \ (i :: Int) -> case == @Int GHC.Internal.Classes.$fEqInt i (GHC.Internal.Types.I# 0#) @@ -23,7 +23,7 @@ f [Occ=LoopBreaker] :: Int -> Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [0] 120 10}] + Guidance=IF_ARGS [0] 140 10}] f = \ (i :: Int) -> case == @Int GHC.Internal.Classes.$fEqInt i (GHC.Internal.Types.I# 0#) ===================================== testsuite/tests/dmdanal/should_compile/T23398.stderr ===================================== @@ -10,7 +10,7 @@ foo :: forall a. PairDict a => a -> a -> String Str=<SP(SP(1C(1,C(1,L)),A),SP(A,1C(1,L),A))><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [90 0 0] 180 0}] + Guidance=IF_ARGS [90 0 0] 210 0}] foo = \ (@a) ($dCTuple2 :: PairDict a) (eta :: a) (eta1 :: a) -> case == ===================================== testsuite/tests/ghci.debugger/scripts/break021.stdout ===================================== @@ -41,7 +41,7 @@ _result :: IO () = _ ^^^^^^^^^^^^^^^^^ 13 in_another_module 0 Stopped in Main.in_another_decl, break020.hs:(6,21)-(7,30) -_result :: IO () = _ +_result :: m () = _ 5 vv 6 in_another_decl _ = do line1 0 @@ -49,25 +49,25 @@ _result :: IO () = _ ^^ 8 Stopped in Main.in_another_decl, break020.hs:6:24-30 -_result :: IO () = _ +_result :: m () = _ 5 6 in_another_decl _ = do line1 0 ^^^^^^^ 7 line2 0 Stopped in Main.line1, break020.hs:3:11-19 -_result :: IO () = _ +_result :: m () = _ 2 3 line1 _ = return () ^^^^^^^^^ 4 line2 _ = return () Stopped in Main.in_another_decl, break020.hs:7:24-30 -_result :: IO () = _ +_result :: m () = _ 6 in_another_decl _ = do line1 0 7 line2 0 ^^^^^^^ 8 Stopped in Main.line2, break020.hs:4:11-19 -_result :: IO () = _ +_result :: m () = _ 3 line1 _ = return () 4 line2 _ = return () ^^^^^^^^^ ===================================== testsuite/tests/profiling/should_run/T27225.stdout ===================================== @@ -1,7 +1,4 @@ -Cost-centre stack backtrace: - GHC.Internal.TopHandler.runMainIO1 (<no location info>) Main.Main.main (T27225.hs:23:1-4) Main.Main.top (T27225.hs:19:1-3) Main.Main.middle (T27225.hs:15:1-6) Main.Main.bottom (T27225.hs:9:1-6) - ===================================== testsuite/tests/profiling/should_run/T27225b.stdout ===================================== @@ -1,7 +1,4 @@ -Cost-centre stack backtrace: - GHC.Internal.TopHandler.runMainIO1 (<no location info>) Main.Main.main (T27225b.hs:29:1-4) Main.Main.top (T27225b.hs:25:1-3) Main.Main.middle (T27225b.hs:21:1-6) Main.Main.bottom (T27225b.hs:15:1-6) - ===================================== testsuite/tests/profiling/should_run/all.T ===================================== @@ -208,8 +208,13 @@ test('ignore_scc', [grep_prof("ignore_scc.hs"), test_opts_dot_prof], compile_and test('T21446', [], makefile_test, ['T21446']) -test('T27225', [only_ways(['prof'])], compile_and_run, ['-O']) -test('T27225b', [only_ways(['prof'])], compile_and_run, ['-O']) +# Only check the user-written cost centres: which library frames (runMainIO1, +# collectBacktraces', ...) show up depends on inlining and on whether the +# libraries were built with -fprof-late. +test('T27225', [only_ways(['prof']), filter_stdout_lines(r'.*Main\.Main\..*')], + compile_and_run, ['-O']) +test('T27225b', [only_ways(['prof']), filter_stdout_lines(r'.*Main\.Main\..*')], + compile_and_run, ['-O']) test('scc-prof-overloaded001', [grep_prof("scc-prof-overloaded001.hs"), test_opts_dot_prof], ===================================== testsuite/tests/simplCore/should_compile/T15205.stderr ===================================== @@ -10,7 +10,7 @@ f :: forall a b. C a b => a -> b Str=<1P(A,1C(1,C(1,L)))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [90 0] 40 0}] + Guidance=IF_ARGS [90 0] 50 0}] f = \ (@a) (@b) ($dC :: C a b) (eta :: a) -> op @a @b $dC eta eta ===================================== testsuite/tests/simplCore/should_compile/T26117.stderr ===================================== @@ -6,83 +6,7 @@ T26117.hs:17:10: warning: [GHC-06201] [-Wmissing-methods (in -Wdefault)] ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 196, types: 296, coercions: 2, joins: 0/0} - --- RHS size: {terms: 7, types: 18, coercions: 0, joins: 0/0} -op1 [InlPrag=[~]] :: forall a b. C a b => F a -> a -> b -> Int -[GblId[ClassOp], - Arity=1, - Str=<S!P(SL,A)>, - Unf=Unf{Src=StableSystem, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False) - Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: C a b) -> - case v of { T26117.C:C v2 [Occ=Once1] _ [Occ=Dead] -> v2 }}] -op1 - = \ (@a) (@b) (v :: C a b) -> - case v of v1 { T26117.C:C v2 v3 -> v2 } - --- RHS size: {terms: 7, types: 18, coercions: 0, joins: 0/0} -op2 [InlPrag=[~]] :: forall a b. C a b => F a -> a -> b -> Int -[GblId[ClassOp], - Arity=1, - Str=<S!P(A,SL)>, - Unf=Unf{Src=StableSystem, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False) - Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: C a b) -> - case v of { T26117.C:C _ [Occ=Dead] v3 [Occ=Once1] -> v3 }}] -op2 - = \ (@a) (@b) (v :: C a b) -> - case v of v1 { T26117.C:C v2 v3 -> v3 } - --- RHS size: {terms: 7, types: 17, coercions: 0, joins: 0/0} -T26117.$p1D [InlPrag=[~]] :: forall a b. D a b => Eq (F a) -[GblId[ClassOp], - Arity=1, - Str=<S!P(SL,A,A)>, - Unf=Unf{Src=StableSystem, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False) - Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: D a b) -> - case v of { T26117.C:D v2 [Occ=Once1] _ [Occ=Dead] _ [Occ=Dead] -> - v2 - }}] -T26117.$p1D - = \ (@a) (@b) (v :: D a b) -> - case v of v1 { T26117.C:D v2 v3 v4 -> v2 } - --- RHS size: {terms: 7, types: 17, coercions: 0, joins: 0/0} -dop1 [InlPrag=[~]] :: forall a b. D a b => a -> b -> b -[GblId[ClassOp], - Arity=1, - Str=<S!P(A,SL,A)>, - Unf=Unf{Src=StableSystem, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False) - Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: D a b) -> - case v of { T26117.C:D _ [Occ=Dead] v3 [Occ=Once1] _ [Occ=Dead] -> - v3 - }}] -dop1 - = \ (@a) (@b) (v :: D a b) -> - case v of v1 { T26117.C:D v2 v3 v4 -> v3 } - --- RHS size: {terms: 7, types: 17, coercions: 0, joins: 0/0} -dop2 [InlPrag=[~]] :: forall a b. D a b => a -> b -> b -[GblId[ClassOp], - Arity=1, - Str=<S!P(A,A,SL)>, - Unf=Unf{Src=StableSystem, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=False) - Tmpl= \ (@a) (@b) (v [Occ=Once1!] :: D a b) -> - case v of { T26117.C:D _ [Occ=Dead] _ [Occ=Dead] v4 [Occ=Once1] -> - v4 - }}] -dop2 - = \ (@a) (@b) (v :: D a b) -> - case v of v1 { T26117.C:D v2 v3 v4 -> v4 } + = {terms: 153, types: 148, coercions: 2, joins: 0/0} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} T26117.$fCaList1 :: GHC.Internal.Prim.Addr# @@ -92,28 +16,6 @@ T26117.$fCaList1 :: GHC.Internal.Prim.Addr# Guidance=IF_ARGS [] 70 0}] T26117.$fCaList1 = "T26117.hs:17:10-37|\CANop2\EM"# --- RHS size: {terms: 6, types: 15, coercions: 0, joins: 0/0} -T26117.$fCaList_$cop2 [InlPrag=[2]] - :: forall a b. (Eq (F a), D a b) => F a -> a -> [b] -> Int -[GblId, - Arity=2, - Str=<B><B>b, - Cpr=b, - Unf=Unf{Src=StableSystem, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True) - Tmpl= \ (@a) (@b) _ [Occ=Dead] _ [Occ=Dead] -> - GHC.Internal.Control.Exception.Base.noMethodBindingError - @GHC.Internal.Types.LiftedRep - @(F a -> a -> [b] -> Int) - T26117.$fCaList1}] -T26117.$fCaList_$cop2 - = \ (@a) (@b) _ [Occ=Dead] _ [Occ=Dead] -> - GHC.Internal.Control.Exception.Base.noMethodBindingError - @GHC.Internal.Types.LiftedRep - @(F a -> a -> [b] -> Int) - T26117.$fCaList1 - -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T26117.$fCaList3 :: Int [GblId, @@ -130,11 +32,48 @@ T26117.$fCaList2 :: Int Guidance=IF_ARGS [] 10 10}] T26117.$fCaList2 = GHC.Internal.Types.I# 3# +-- RHS size: {terms: 16, types: 16, coercions: 0, joins: 0/0} +T26117.$fCaList_$cop1 + :: forall a b. (Eq (F a), D a b) => F a -> a -> [b] -> Int +[GblId, + Arity=5, + Str=<1P(1C(1,C(1,L)),A)><A><L><A><A>, + Cpr=1, + Unf=Unf{Src=StableSystem, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=5,unsat_ok=True,boring_ok=False) + Tmpl= \ (@a) + (@b) + ($dEq [Occ=Once1] :: Eq (F a)) + ($dD [Occ=Dead] :: D a b) + (x :: F a) + (ds [Occ=Dead] :: a) + (ds1 [Occ=Dead] :: [b]) -> + case == @(F a) $dEq x x of { + False -> T26117.$fCaList3; + True -> T26117.$fCaList2 + }}] +T26117.$fCaList_$cop1 + = \ (@a) + (@b) + ($dEq :: Eq (F a)) + ($dD [Occ=Dead, OS=OneShot] :: D a b) + (x :: F a) + (ds [Occ=Dead] :: a) + (ds1 [Occ=Dead] :: [b]) -> + case == @(F a) $dEq x x of { + False -> T26117.$fCaList3; + True -> T26117.$fCaList2 + } + -- RHS size: {terms: 8, types: 7, coercions: 2, joins: 0/0} lvl :: forall b. F Int -> Int -> [b] -> Int -[GblId, Arity=3, Str=<1A><A><A>, Cpr=1, Unf=OtherCon []] +[GblId, Arity=3, Str=<SL><A><A>, Cpr=1, Unf=OtherCon []] lvl - = \ (@b) (x :: F Int) _ [Occ=Dead] _ [Occ=Dead] -> + = \ (@b) + (x :: F Int) + (ds [Occ=Dead] :: Int) + (ds1 [Occ=Dead] :: [b]) -> case x `cast` (Sub T26117.D:R:FInt :: F Int ~R# Bool) of lwild { __DEFAULT -> T26117.$fCaList2 @@ -164,7 +103,7 @@ T26117.$fCaList_$s$fCaList [InlPrag=CONLIKE] Unf=DFun: \ (@b) ($dD :: D Int b) -> T26117.C:C TYPE: Int TYPE: [b] - \ (x :: F Int) _ [Occ=Dead] _ [Occ=Dead] -> + \ (x :: F Int) (ds [Occ=Dead] :: Int) (ds1 [Occ=Dead] :: [b]) -> case GHC.Internal.Prim.dataToTagSmall# @GHC.Internal.Types.Lifted @Bool @@ -187,19 +126,10 @@ T26117.$fCaList_$s$fCaList [InlPrag=CONLIKE] @GHC.Internal.Types.LiftedRep @(F Int -> Int -> [b] -> Int) "T26117.hs:17:10-37|\CANop2\EM"#] -T26117.$fCaList_$s$fCaList = \ (@b) _ [Occ=Dead] -> lvl2 @b - --- RHS size: {terms: 4, types: 9, coercions: 0, joins: 0/0} -lvl3 :: forall b a. F a -> a -> [b] -> Int -[GblId, Str=b, Cpr=b] -lvl3 - = \ (@b) (@a) -> - GHC.Internal.Control.Exception.Base.noMethodBindingError - @GHC.Internal.Types.LiftedRep - @(F a -> a -> [b] -> Int) - T26117.$fCaList1 +T26117.$fCaList_$s$fCaList + = \ (@b) ($dD [Occ=Dead] :: D Int b) -> lvl2 @b --- RHS size: {terms: 18, types: 21, coercions: 0, joins: 0/0} +-- RHS size: {terms: 10, types: 20, coercions: 0, joins: 0/0} T26117.$fCaList [InlPrag=CONLIKE] :: forall a b. (Eq (F a), D a b) => C a [b] [GblId[DFunId], @@ -208,225 +138,203 @@ T26117.$fCaList [InlPrag=CONLIKE] Unf=DFun: \ (@a) (@b) (v :: Eq (F a)) (v1 :: D a b) -> T26117.C:C TYPE: a TYPE: [b] - \ (x :: F a) _ [Occ=Dead] _ [Occ=Dead] -> - case == @(F a) v x x of { - False -> T26117.$fCaList3; - True -> T26117.$fCaList2 - } - T26117.$fCaList_$cop2 @a @b v v1] + T26117.$fCaList_$cop1 @a @b v v1 + GHC.Internal.Control.Exception.Base.noMethodBindingError + @GHC.Internal.Types.LiftedRep + @(F a -> a -> [b] -> Int) + T26117.$fCaList1] T26117.$fCaList - = \ (@a) (@b) ($dEq :: Eq (F a)) _ [Occ=Dead] -> + = \ (@a) (@b) ($dEq :: Eq (F a)) ($dD :: D a b) -> T26117.C:C @a @[b] - (\ (x :: F a) _ [Occ=Dead] _ [Occ=Dead] -> - case == @(F a) $dEq x x of { - False -> T26117.$fCaList3; - True -> T26117.$fCaList2 - }) - (lvl3 @b @a) + (T26117.$fCaList_$cop1 @a @b $dEq $dD) + (GHC.Internal.Control.Exception.Base.noMethodBindingError + @GHC.Internal.Types.LiftedRep + @(F a -> a -> [b] -> Int) + T26117.$fCaList1) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26117.$trModule4 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26117.$trModule4 = "main"# +$trModule1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26117.$trModule3 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26117.$trModule3 = GHC.Internal.Types.TrNameS T26117.$trModule4 +$trModule2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule2 = GHC.Internal.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26117.$trModule2 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 30 0}] -T26117.$trModule2 = "T26117"# +$trModule3 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$trModule3 = "T26117"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26117.$trModule1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26117.$trModule1 = GHC.Internal.Types.TrNameS T26117.$trModule2 +$trModule4 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$trModule4 = GHC.Internal.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26117.$trModule :: GHC.Internal.Types.Module -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26117.$trModule - = GHC.Internal.Types.Module T26117.$trModule3 T26117.$trModule1 +T26117.$trModule [InlPrag=[~]] :: GHC.Internal.Types.Module +[GblId, Unf=OtherCon []] +T26117.$trModule = GHC.Internal.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} $krep :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] $krep = GHC.Internal.Types.KindRepFun - GHC.Internal.Types.krep$* GHC.Internal.Types.krep$Constraint + GHC.Internal.Types.KindRepType GHC.Internal.Types.KindRepConstraint -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26117.$tcC1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep1 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26117.$tcC1 - = GHC.Internal.Types.KindRepFun GHC.Internal.Types.krep$* $krep +$krep1 + = GHC.Internal.Types.KindRepFun + GHC.Internal.Types.KindRepType $krep -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep1 :: GHC.Internal.Types.KindRep +$krep2 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep1 = GHC.Internal.Types.KindRepVar 1# +$krep2 = GHC.Internal.Types.KindRepVar 1# -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep2 :: GHC.Internal.Types.KindRep +$krep3 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep2 = GHC.Internal.Types.KindRepFun $krep1 $krep1 +$krep3 = GHC.Internal.Types.KindRepFun $krep2 $krep2 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$krep3 :: GHC.Internal.Types.KindRep +$krep4 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep3 = GHC.Internal.Types.KindRepVar 0# +$krep4 = GHC.Internal.Types.KindRepVar 0# -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep4 :: GHC.Internal.Types.KindRep +$krep5 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep4 = GHC.Internal.Types.KindRepFun $krep3 $krep2 +$krep5 = GHC.Internal.Types.KindRepFun $krep4 $krep3 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26117.$tcD2 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26117.$tcD2 = "D"# +$tcD1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$tcD1 = "D"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26117.$tcD1 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26117.$tcD1 = GHC.Internal.Types.TrNameS T26117.$tcD2 +$tcD2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcD2 = GHC.Internal.Types.TrNameS $tcD1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26117.$tcD :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26117.$tcD [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26117.$tcD = GHC.Internal.Types.TyCon 18427868686024955676#Word64 4087453451394481638#Word64 T26117.$trModule - T26117.$tcD1 + $tcD2 0# - T26117.$tcC1 + $krep1 -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} -$krep5 :: [GHC.Internal.Types.KindRep] +$krep6 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep5 +$krep6 = GHC.Internal.Types.: @GHC.Internal.Types.KindRep - $krep1 + $krep2 (GHC.Internal.Types.[] @GHC.Internal.Types.KindRep) -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep6 :: [GHC.Internal.Types.KindRep] +$krep7 :: [GHC.Internal.Types.KindRep] [GblId, Unf=OtherCon []] -$krep6 - = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep3 $krep5 +$krep7 + = GHC.Internal.Types.: @GHC.Internal.Types.KindRep $krep4 $krep6 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep7 :: GHC.Internal.Types.KindRep +$krep8 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep7 = GHC.Internal.Types.KindRepTyConApp T26117.$tcD $krep6 +$krep8 = GHC.Internal.Types.KindRepTyConApp T26117.$tcD $krep7 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep8 :: GHC.Internal.Types.KindRep +$krep9 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -$krep8 = GHC.Internal.Types.KindRepFun $krep4 $krep7 +$krep9 = GHC.Internal.Types.KindRepFun $krep5 $krep8 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T26117.$tc'C:D1 [InlPrag=[~]] :: GHC.Internal.Types.KindRep +$krep10 :: GHC.Internal.Types.KindRep [GblId, Unf=OtherCon []] -T26117.$tc'C:D1 = GHC.Internal.Types.KindRepFun $krep4 $krep8 +$krep10 = GHC.Internal.Types.KindRepFun $krep5 $krep9 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26117.$tc'C:D3 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26117.$tc'C:D3 = "'C:D"# +$tc'C:D1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$tc'C:D1 = "'C:D"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26117.$tc'C:D2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26117.$tc'C:D2 = GHC.Internal.Types.TrNameS T26117.$tc'C:D3 +$tc'C:D2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tc'C:D2 = GHC.Internal.Types.TrNameS $tc'C:D1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26117.$tc'C:D :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26117.$tc'C:D [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26117.$tc'C:D = GHC.Internal.Types.TyCon 14714477993590114477#Word64 17388374250742016296#Word64 T26117.$trModule - T26117.$tc'C:D2 + $tc'C:D2 2# - T26117.$tc'C:D1 + $krep10 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -T26117.$tcC3 :: GHC.Internal.Prim.Addr# -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 20 0}] -T26117.$tcC3 = "C"# +$tcC1 :: GHC.Internal.Prim.Addr# +[GblId, Unf=OtherCon []] +$tcC1 = "C"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -T26117.$tcC2 :: GHC.Internal.Types.TrName -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] -T26117.$tcC2 = GHC.Internal.Types.TrNameS T26117.$tcC3 +$tcC2 :: GHC.Internal.Types.TrName +[GblId, Unf=OtherCon []] +$tcC2 = GHC.Internal.Types.TrNameS $tcC1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} -T26117.$tcC :: GHC.Internal.Types.TyCon -[GblId, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [] 10 10}] +T26117.$tcC [InlPrag=[~]] :: GHC.Internal.Types.TyCon +[GblId, Unf=OtherCon []] T26117.$tcC = GHC.Internal.Types.TyCon 6116531860557468422#Word64 17953227584944457497#Word64 T26117.$trModule - T26117.$tcC2 + $tcC2 0# - T26117.$tcC1 + $krep1 ------ Local rules for imported ids -------- +"USPEC $cop1 @Int @_" + forall (@b) ($dEq [Occ=Dead] :: Eq (F Int)) ($dD :: D Int b). + T26117.$fCaList_$cop1 @Int @b $dEq $dD + = \ (x :: F Int) (ds [Occ=Dead] :: Int) (ds1 [Occ=Dead] :: [b]) -> + case GHC.Internal.Prim.dataToTagSmall# + @GHC.Internal.Types.Lifted + @Bool + (x `cast` (Sub T26117.D:R:FInt :: F Int ~R# Bool)) + of a# [Occ=Once1] + { __DEFAULT -> + case GHC.Internal.Prim.dataToTagSmall# + @GHC.Internal.Types.Lifted + @Bool + (x `cast` (Sub T26117.D:R:FInt :: F Int ~R# Bool)) + of b# [Occ=Once1] + { __DEFAULT -> + case GHC.Internal.Prim.==# a# b# of { + __DEFAULT -> GHC.Internal.Types.I# 4#; + 1# -> GHC.Internal.Types.I# 3# + } + } + } "USPEC $fCaList @Int @_" - forall (@b) ($dD :: D Int b) ($dEq :: Eq (F Int)). + forall (@b) ($dEq [Occ=Dead] :: Eq (F Int)) ($dD :: D Int b). T26117.$fCaList @Int @b $dEq $dD = T26117.$fCaList_$s$fCaList @b $dD View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cdafca20cdfb2fc05e54435c7fa93b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5cdafca20cdfb2fc05e54435c7fa93b... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help