[Git][ghc/ghc][wip/apk/unfold-dicts] Tweak inlining discout for unary class ops.
Andreas Klebinger pushed to branch wip/apk/unfold-dicts at Glasgow Haskell Compiler / GHC Commits: f84c3214 by Andreas Klebinger at 2026-09-30T15:49:21+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 T13056 Metric Increase: T12234 T21839c T21839r T16473 T5321FD T5321Fun hard_hole_fits T18223 ------------------------- - - - - - 14 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/perf/compiler/T25723.hs - 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/perf/compiler/T25723.hs ===================================== @@ -9,6 +9,12 @@ {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -flate-specialise -O2 #-} +-- The purpose of this test it to ensure we get a nice recursive loop inside main. +-- Where otherwise we would allocate a intermediate tuple if we fail to inline a join +-- point (#25723). +-- As unfolding guidance changed the join point never materialized so we use a +-- different threshold to ensure we still test the expect behaviour. +{-# OPTIONS_GHC -funfolding-use-threshold=120 #-} module Main (main) where ===================================== 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/-/commit/f84c3214bbd23fbb9d46ad678285654c... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f84c3214bbd23fbb9d46ad678285654c... 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
participants (1)
-
Andreas Klebinger (＠AndreasK)