[Git][ghc/ghc][wip/simplifier-tweaks] 2 commits: Testsuite message changes from simplifier improvements
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Fri Mar 29 20:33:36 UTC 2024
Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC
Commits:
724bb252 by Simon Peyton Jones at 2024-03-29T20:33:15+00:00
Testsuite message changes from simplifier improvements
- - - - -
a2af3150 by Simon Peyton Jones at 2024-03-29T20:33:15+00:00
Account for bottoming functions in OccurAnal
This fixes #24582, a small but long-standing bug
- - - - -
28 changed files:
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- testsuite/tests/arityanal/should_compile/Arity01.stderr
- testsuite/tests/arityanal/should_compile/Arity02.stderr
- testsuite/tests/arityanal/should_compile/Arity09.stderr
- testsuite/tests/arityanal/should_compile/Arity13.stderr
- testsuite/tests/cpranal/should_compile/T18401.stderr
- testsuite/tests/driver/inline-check.stderr
- testsuite/tests/lib/integer/Makefile
- testsuite/tests/numeric/should_compile/T19641.stderr
- testsuite/tests/perf/compiler/T15630.hs
- + testsuite/tests/perf/compiler/T15630a.hs
- testsuite/tests/simplCore/should_compile/T18730.hs → testsuite/tests/perf/compiler/T18730.hs
- testsuite/tests/simplCore/should_compile/T18730_A.hs → testsuite/tests/perf/compiler/T18730_A.hs
- + testsuite/tests/perf/compiler/T24582.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/simplCore/should_compile/T12877.hs
- testsuite/tests/simplCore/should_compile/T15631.stdout
- testsuite/tests/simplCore/should_compile/T18013.stderr
- testsuite/tests/simplCore/should_compile/T20040.stderr
- testsuite/tests/simplCore/should_compile/T20103.stderr
- testsuite/tests/simplCore/should_compile/T22317.hs
- testsuite/tests/simplCore/should_compile/T22428.stderr
- testsuite/tests/simplCore/should_compile/T23491a.stderr
- testsuite/tests/simplCore/should_compile/T24229a.stderr
- testsuite/tests/simplCore/should_compile/T24229b.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_compile/spec-inline.stderr
Changes:
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -983,7 +983,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine
| mb_join@(JoinPoint {}) <- idJoinPointHood bndr
= -- Analyse the RHS and /then/ the body
let -- Analyse the rhs first, generating rhs_uds
- !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env ire mb_join bndr rhs
+ !(rhs_uds_s, bndr', rhs') = occAnalNonRecRhs env lvl ire mb_join bndr rhs
rhs_uds = foldr1 orUDs rhs_uds_s -- NB: orUDs. See (W4) of
-- Note [Occurrence analysis for join points]
@@ -1009,7 +1009,7 @@ occAnalBind !env lvl ire (NonRec bndr rhs) thing_inside combine
-- => join arity O of Note [Join arity prediction based on joinRhsArity]
(tagged_bndr, mb_join) = tagNonRecBinder lvl occ bndr
- !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env ire mb_join tagged_bndr rhs
+ !(rhs_uds_s, final_bndr, rhs') = occAnalNonRecRhs env lvl ire mb_join tagged_bndr rhs
in WUD (foldr andUDs body_uds rhs_uds_s) -- Note `andUDs`
(combine [NonRec final_bndr rhs'] body)
@@ -1024,10 +1024,10 @@ occAnalNonRecBody env bndr thing_inside
in WUD inner_uds (occ, res)
-----------------
-occAnalNonRecRhs :: OccEnv -> ImpRuleEdges -> JoinPointHood
- -> Id -> CoreExpr
+occAnalNonRecRhs :: OccEnv -> TopLevelFlag -> ImpRuleEdges
+ -> JoinPointHood -> Id -> CoreExpr
-> ([UsageDetails], Id, CoreExpr)
-occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs
+occAnalNonRecRhs !env lvl imp_rule_edges mb_join bndr rhs
| null rules, null imp_rule_infos
= -- Fast path for common case of no rules. This is only worth
-- 0.1% perf on average, but it's also only a line or two of code
@@ -1046,7 +1046,7 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs
-- j will never be scrutinised.
env1 | is_join_point = setTailCtxt env
| otherwise = setNonTailCtxt rhs_ctxt env -- Zap occ_join_points
- rhs_ctxt = mkNonRecRhsCtxt bndr unf
+ rhs_ctxt = mkNonRecRhsCtxt lvl bndr unf
-- See Note [Sources of one-shot information]
rhs_env = addOneShotsFromDmd bndr env1
@@ -1092,9 +1092,9 @@ occAnalNonRecRhs !env imp_rule_edges mb_join bndr rhs
[ l `andUDs` adjustTailArity mb_join r
| (_,l,r) <- rules_w_uds ]
-mkNonRecRhsCtxt :: Id -> Unfolding -> OccEncl
+mkNonRecRhsCtxt :: TopLevelFlag -> Id -> Unfolding -> OccEncl
-- Precondition: Id is not a join point
-mkNonRecRhsCtxt bndr unf
+mkNonRecRhsCtxt lvl bndr unf
| certainly_inline = OccVanilla -- See Note [Cascading inlines]
| otherwise = OccRhs
where
@@ -1103,11 +1103,12 @@ mkNonRecRhsCtxt bndr unf
-- has set the OccInfo for this binder before calling occAnalNonRecRhs
case idOccInfo bndr of
OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1 }
- -> active && not_stable
+ -> active && not stable_unf && not top_bottoming
_ -> False
active = isAlwaysActive (idInlineActivation bndr)
- not_stable = not (isStableUnfolding unf)
+ stable_unf = isStableUnfolding unf
+ top_bottoming = isTopLevel lvl && isDeadEndId bndr
-----------------
occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)]
@@ -2410,7 +2411,7 @@ float ==>
This is worse than the slow cascade, so we only want to say "certainly_inline"
if it really is certain. Look at the note with preInlineUnconditionally
-for the various clauses.
+for the various clauses. See #24582 for an example of the two getting out of sync.
************************************************************************
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -751,7 +751,7 @@ prepareRhs env top_lvl occ rhs0
| is_expandable = anfise rhs0
| otherwise = return (emptyLetFloats, rhs0)
where
- -- We can' use exprIsExpandable because the WHOLE POINT is that
+ -- We can't use exprIsExpandable because the WHOLE POINT is that
-- we want to treat (K <big>) as expandable, because we are just
-- about "anfise" the <big> expression. exprIsExpandable would
-- just say no!
=====================================
testsuite/tests/arityanal/should_compile/Arity01.stderr
=====================================
@@ -1,6 +1,6 @@
==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 65, types: 41, coercions: 0, joins: 0/0}
+Result size of Tidy Core = {terms: 71, types: 43, coercions: 0, joins: 0/0}
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F1.f2 :: Integer
@@ -8,14 +8,18 @@ F1.f2 :: Integer
F1.f2 = GHC.Num.Integer.IS 1#
Rec {
--- RHS size: {terms: 18, types: 4, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 24, types: 6, coercions: 0, joins: 0/0}
F1.f1_h1 [Occ=LoopBreaker] :: Integer -> Integer -> Integer -> Integer
-[GblId, Arity=3, Str=<SL><SL><SL>, Unf=OtherCon []]
+[GblId, Arity=3, Str=<1L><1L><SL>, Unf=OtherCon []]
F1.f1_h1
- = \ (n :: Integer) (x :: Integer) (eta :: Integer) ->
- case GHC.Num.Integer.integerLt x n of {
- False -> eta;
- True -> F1.f1_h1 n (GHC.Num.Integer.integerAdd x F1.f2) (GHC.Num.Integer.integerAdd x eta)
+ = \ (n :: Integer) (x :: Integer) (eta [OS=OneShot] :: Integer) ->
+ case x of x1 { __DEFAULT ->
+ case n of y1 { __DEFAULT ->
+ case GHC.Num.Integer.integerLt# x1 y1 of {
+ __DEFAULT -> eta;
+ 1# -> F1.f1_h1 y1 (GHC.Num.Integer.integerAdd x1 F1.f2) (GHC.Num.Integer.integerAdd x1 eta)
+ }
+ }
}
end Rec }
=====================================
testsuite/tests/arityanal/should_compile/Arity02.stderr
=====================================
@@ -23,14 +23,14 @@ F2.f2_g [Occ=LoopBreaker] :: Integer -> Integer -> Integer
[GblId, Arity=2, Str=<1L><SL>, Unf=OtherCon []]
F2.f2_g
= \ (x :: Integer) (y :: Integer) ->
- case x of wild {
- GHC.Num.Integer.IS x1 ->
- case GHC.Prim.># x1 0# of {
+ case x of x1 {
+ GHC.Num.Integer.IS x2 ->
+ case GHC.Prim.># x2 0# of {
__DEFAULT -> y;
- 1# -> F2.f2_g (GHC.Num.Integer.integerSub wild lvl) (GHC.Num.Integer.integerAdd wild y)
+ 1# -> F2.f2_g (GHC.Num.Integer.integerSub x1 lvl) (GHC.Num.Integer.integerAdd x1 y)
};
- GHC.Num.Integer.IP x1 -> F2.f2_g (GHC.Num.Integer.integerSub wild lvl) (GHC.Num.Integer.integerAdd wild y);
- GHC.Num.Integer.IN x1 -> y
+ GHC.Num.Integer.IP x2 -> F2.f2_g (GHC.Num.Integer.integerSub x1 lvl) (GHC.Num.Integer.integerAdd x1 y);
+ GHC.Num.Integer.IN x2 -> y
}
end Rec }
=====================================
testsuite/tests/arityanal/should_compile/Arity09.stderr
=====================================
@@ -18,14 +18,14 @@ F9.f91_f [Occ=LoopBreaker] :: Integer -> Integer
[GblId, Arity=1, Str=<1L>, Unf=OtherCon []]
F9.f91_f
= \ (n :: Integer) ->
- case n of wild {
- GHC.Num.Integer.IS x1 ->
- case GHC.Prim.<=# x1 100# of {
- __DEFAULT -> GHC.Num.Integer.integerSub wild F9.f1;
- 1# -> F9.f91_f (F9.f91_f (GHC.Num.Integer.integerAdd wild lvl))
+ case n of x1 {
+ GHC.Num.Integer.IS x ->
+ case GHC.Prim.<=# x 100# of {
+ __DEFAULT -> GHC.Num.Integer.integerSub x1 F9.f1;
+ 1# -> F9.f91_f (F9.f91_f (GHC.Num.Integer.integerAdd x1 lvl))
};
- GHC.Num.Integer.IP x1 -> GHC.Num.Integer.integerSub wild F9.f1;
- GHC.Num.Integer.IN x1 -> F9.f91_f (F9.f91_f (GHC.Num.Integer.integerAdd wild lvl))
+ GHC.Num.Integer.IP x -> GHC.Num.Integer.integerSub x1 F9.f1;
+ GHC.Num.Integer.IN x -> F9.f91_f (F9.f91_f (GHC.Num.Integer.integerAdd x1 lvl))
}
end Rec }
=====================================
testsuite/tests/arityanal/should_compile/Arity13.stderr
=====================================
@@ -1,20 +1,24 @@
==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 32, types: 16, coercions: 0, joins: 0/0}
+Result size of Tidy Core = {terms: 34, types: 19, coercions: 0, joins: 1/1}
--- RHS size: {terms: 31, types: 12, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 33, types: 15, coercions: 0, joins: 1/1}
f13 :: Int -> Int -> Int -> Int
[GblId,
Arity=3,
- Str=<S,1*U(U)><S,1*U(U)><S,1*U(U)>,
- Cpr=m1,
- 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)
+ Str=<1!P(L)><1!P(L)><1!P(L)>,
+ Cpr=1,
+ Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once1!] :: Int) (y [Occ=Once2!] :: Int) (eta [Occ=Once1!] :: Int) ->
- case eta of { GHC.Types.I# x1 [Occ=Once2] ->
+ case eta of { GHC.Types.I# x1 [Occ=Once1] ->
case x of { GHC.Types.I# x2 ->
+ join {
+ $j [Occ=Once2!T[1]] :: GHC.Prim.Int# -> Int
+ [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []]
+ $j (y1 [Occ=Once1, OS=OneShot] :: GHC.Prim.Int#) = GHC.Types.I# (GHC.Prim.+# x1 y1) } in
case GHC.Prim.># x2 0# of {
- __DEFAULT -> case y of { GHC.Types.I# y1 [Occ=Once1] -> GHC.Types.I# (GHC.Prim.+# x1 y1) };
- 1# -> case y of { GHC.Types.I# y1 [Occ=Once1] -> GHC.Types.I# (GHC.Prim.+# x1 (GHC.Prim.*# x2 y1)) }
+ __DEFAULT -> case y of { GHC.Types.I# y1 [Occ=Once1] -> jump $j y1 };
+ 1# -> case y of { GHC.Types.I# y1 [Occ=Once1] -> jump $j (GHC.Prim.*# x2 y1) }
}
}
}}]
@@ -22,9 +26,13 @@ f13
= \ (x :: Int) (y :: Int) (eta :: Int) ->
case eta of { GHC.Types.I# x1 ->
case x of { GHC.Types.I# x2 ->
+ join {
+ $j [Dmd=1C(1,!P(L))] :: GHC.Prim.Int# -> Int
+ [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []]
+ $j (y1 [OS=OneShot] :: GHC.Prim.Int#) = GHC.Types.I# (GHC.Prim.+# x1 y1) } in
case GHC.Prim.># x2 0# of {
- __DEFAULT -> case y of { GHC.Types.I# y1 -> GHC.Types.I# (GHC.Prim.+# x1 y1) };
- 1# -> case y of { GHC.Types.I# y1 -> GHC.Types.I# (GHC.Prim.+# x1 (GHC.Prim.*# x2 y1)) }
+ __DEFAULT -> case y of { GHC.Types.I# y1 -> jump $j y1 };
+ 1# -> case y of { GHC.Types.I# y1 -> jump $j (GHC.Prim.*# x2 y1) }
}
}
}
=====================================
testsuite/tests/cpranal/should_compile/T18401.stderr
=====================================
@@ -1,34 +1,37 @@
==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 52, types: 86, coercions: 0, joins: 0/0}
+Result size of Tidy Core = {terms: 58, types: 93, coercions: 0, joins: 1/1}
Rec {
-- RHS size: {terms: 18, types: 24, coercions: 0, joins: 0/0}
T18401.$w$spoly_$wgo1 :: forall a. a -> [a] -> (# [a] #)
T18401.$w$spoly_$wgo1
- = \ (@a_s1cL) (sc_s1cM :: a_s1cL) (sc1_s1cN :: [a_s1cL]) ->
- case sc1_s1cN of {
- [] -> (# GHC.Types.[] @a_s1cL #);
- : y_a1bH ys_a1bI -> (# GHC.Types.: @a_s1cL sc_s1cM (case T18401.$w$spoly_$wgo1 @a_s1cL y_a1bH ys_a1bI of { (# ww_s1cR #) -> ww_s1cR }) #)
+ = \ (@a_s1eu) (sc_s1ev :: a_s1eu) (sc1_s1ew :: [a_s1eu]) ->
+ case sc1_s1ew of {
+ [] -> (# GHC.Types.[] @a_s1eu #);
+ : y_a1dy ys_a1dz -> (# GHC.Types.: @a_s1eu sc_s1ev (case T18401.$w$spoly_$wgo1 @a_s1eu y_a1dy ys_a1dz of { (# ww_s1eA #) -> ww_s1eA }) #)
}
end Rec }
--- RHS size: {terms: 17, types: 22, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 23, types: 29, coercions: 0, joins: 1/1}
si :: forall a. [a] -> (Bool, [a])
si
- = \ (@a_s1bR) (xs0_s1bS :: [a_s1bR]) ->
- case xs0_s1bS of {
- [] -> (GHC.Types.False, GHC.Types.[] @a_s1bR);
- : y_a1bH ys_a1bI -> (GHC.Types.True, case T18401.$w$spoly_$wgo1 @a_s1bR y_a1bH ys_a1bI of { (# ww_s1cR #) -> ww_s1cR })
+ = \ (@a_s1dI) (xs0_s1dJ :: [a_s1dI]) ->
+ join {
+ $j_s1eq :: Bool %1 -> [a_s1dI] %1 -> (Bool, [a_s1dI])
+ $j_s1eq (ww_s1dX :: Bool) (ww1_s1dY :: [a_s1dI]) = (ww_s1dX, ww1_s1dY) } in
+ case xs0_s1dJ of {
+ [] -> jump $j_s1eq GHC.Types.False (GHC.Types.[] @a_s1dI);
+ : y_a1dy ys_a1dz -> jump $j_s1eq GHC.Types.True (case T18401.$w$spoly_$wgo1 @a_s1dI y_a1dy ys_a1dz of { (# ww_s1eA #) -> ww_s1eA })
}
-- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0}
safeInit :: forall a. [a] -> Maybe [a]
safeInit
- = \ (@a_aQu) (xs_awN :: [a_aQu]) ->
- case xs_awN of {
- [] -> GHC.Maybe.Nothing @[a_aQu];
- : y_a1bH ys_a1bI -> GHC.Maybe.Just @[a_aQu] (case T18401.$w$spoly_$wgo1 @a_aQu y_a1bH ys_a1bI of { (# ww_s1cR #) -> ww_s1cR })
+ = \ (@a_aQY) (xs_awU :: [a_aQY]) ->
+ case xs_awU of {
+ [] -> GHC.Internal.Maybe.Nothing @[a_aQY];
+ : y_a1dy ys_a1dz -> GHC.Internal.Maybe.Just @[a_aQY] (case T18401.$w$spoly_$wgo1 @a_aQY y_a1dy ys_a1dz of { (# ww_s1eA #) -> ww_s1eA })
}
=====================================
testsuite/tests/driver/inline-check.stderr
=====================================
@@ -6,8 +6,9 @@ Considering inlining: foo
is work-free: True
guidance IF_ARGS [0] 30 0
case depth = 0
+ inline depth = 0
depth based penalty = 0
- discounted size = 10
+ adjusted size = 10
ANSWER = YES
Inactive unfolding: foo1
Inactive unfolding: foo1
@@ -25,7 +26,8 @@ Considering inlining: foo
is work-free: True
guidance IF_ARGS [0] 30 0
case depth = 0
+ inline depth = 0
depth based penalty = 0
- discounted size = 20
+ adjusted size = 20
ANSWER = NO
Inactive unfolding: foo1
=====================================
testsuite/tests/lib/integer/Makefile
=====================================
@@ -17,16 +17,16 @@ integerConstantFolding:
! grep -q '\<100[0-9][0-9][0-9]\>' folding.simpl || { echo "Unfolded values found"; grep '\<100[0-9][0-9][0-9]\>' folding.simpl; }
$(call CHECK,\<200007\>,plusInteger)
$(call CHECK,\<683234160\>,timesInteger)
- $(call CHECK,-991\>,minusIntegerN)
+ $(call CHECK,991\>,minusIntegerN) # itos negates -991 so we see just 991
$(call CHECK,\<989\>,minusIntegerP)
- $(call CHECK,-200011\>,negateInteger)
+ $(call CHECK,200011\>,negateInteger) # Ditto negation
$(call CHECK,\<200019\>,absInteger)
$(call CHECK,\<50024\>,gcdInteger)
$(call CHECK,\<1001100300\>,lcmInteger)
$(call CHECK,\<532\>,andInteger)
$(call CHECK,\<239575\>,orInteger)
$(call CHECK,\<239041\>,xorInteger)
- $(call CHECK,-200059\>,complementInteger)
+ $(call CHECK,200059\>,complementInteger) # Ditto negation
$(call CHECK,\<813\>,quotRemInteger)
$(call CHECK,\<60\>,quotRemInteger)
$(call CHECK,\<219\>,divModInteger)
=====================================
testsuite/tests/numeric/should_compile/T19641.stderr
=====================================
@@ -14,8 +14,8 @@ integer_to_int
= \ eta ->
case eta of {
IS ipv -> Just (I# ipv);
- IP x2 -> Nothing;
- IN ds -> Nothing
+ IP x -> Nothing;
+ IN ds2 -> Nothing
}
=====================================
testsuite/tests/perf/compiler/T15630.hs
=====================================
@@ -1,5 +1,28 @@
module T15630 where
+{- This is a fansastic test cose.
+
+* It scales really easily (just add or remove fields).
+
+* It can demonstrate massive (exponental) blow up if you get inlining
+ for join points wrong.
+
+* I found that a more monomorphic variant, T15630a, tickled a very similar
+ exponential -blowup, but somehow in a slighlty different way. To be specific,
+ at the time of writing, HEAD was fine on T15630, but blew up on T15630a.
+ So both tests are valuable.
+
+* Also worth noting: even if it doesn't blow up, it can result in two
+ very different programs. Below are the good and bad versions for 5
+ fields. Note that the good version passes Maybes to the join points,
+ the ultimate values of the fields. But the bad version passes an
+ accumulating *function* to the join points. Lots of PAPs much less
+ efficient.
+
+See Note [Do not add unfoldings to join points at birth] in
+GHc.Core.Opt.Simplify.Iteration.
+-}
+
data IValue = IDefault
| IInt Int
| IBlob String
@@ -54,3 +77,220 @@ getMenuItem vs = fst $ (pure TestStructure, vs)
<+> (getInt ?)
<+> (getInt ?)
<+> (getString ?)
+
+
+{-
+------------- The good version (5 fields) ----------------
+getMenuItem
+ = \ (vs_az6 :: [IValue]) ->
+ case vs_az6 of {
+ [] -> case T15630.<+>1 of wild1_00 { };
+ : v_az3 vs1_az4 ->
+ case vs1_az4 of {
+ [] -> case T15630.<+>1 of wild2_00 { };
+ : v1_X4 vs2_X5 ->
+ case vs2_X5 of {
+ [] -> case T15630.<+>1 of wild3_00 { };
+ : v2_X7 vs3_X8 ->
+ case vs3_X8 of {
+ [] -> case T15630.<+>1 of wild4_00 { };
+ : v3_Xa vs4_Xb ->
+ case vs4_Xb of {
+ [] -> case T15630.<+>1 of wild5_00 { };
+ : v4_Xd vs5_Xe ->
+ case v_az3 of {
+ __DEFAULT -> T15630.getMenuItem1;
+ IInt i_ayQ ->
+ join {
+ $j_sPO [Dmd=MC(1,L)] :: Maybe String -> Either () TestStructure
+ [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []]
+ $j_sPO (y_Xf [OS=OneShot] :: Maybe String)
+ = join {
+ $j1_sPR [Dmd=MC(1,L)] :: Maybe Int -> Either () TestStructure
+ [LclId[JoinId(1)(Nothing)], Arity=1, Str=<L>, Unf=OtherCon []]
+ $j1_sPR (y1_Xg [OS=OneShot] :: Maybe Int)
+ = case v3_Xa of {
+ IDefault ->
+ case v4_Xd of {
+ IDefault ->
+ Data.Either.Right
+ @()
+ @TestStructure
+ (T15630.TestStructure
+ i_ayQ
+ y_Xf
+ y1_Xg
+ (Nothing @String)
+ (Nothing @Int));
+ IInt i1_Xk ->
+ Data.Either.Right
+ @()
+ @TestStructure
+ (T15630.TestStructure
+ i_ayQ
+ y_Xf
+ y1_Xg
+ (Nothing @String)
+ (Just @Int i1_Xk));
+ IBlob ipv_sPo -> T15630.getMenuItem1
+ };
+ IInt ipv_sPm -> T15630.getMenuItem1;
+ IBlob b_ayW ->
+ case v4_Xd of {
+ IDefault ->
+ Data.Either.Right
+ @()
+ @TestStructure
+ (T15630.TestStructure
+ i_ayQ
+ y_Xf
+ y1_Xg
+ (Just @String b_ayW)
+ (Nothing @Int));
+ IInt i1_Xk ->
+ Data.Either.Right
+ @()
+ @TestStructure
+ (T15630.TestStructure
+ i_ayQ
+ y_Xf
+ y1_Xg
+ (Just @String b_ayW)
+ (Just @Int i1_Xk));
+ IBlob ipv_sPo -> T15630.getMenuItem1
+ }
+ } } in
+ case v2_X7 of {
+ IDefault -> jump $j1_sPR (Nothing @Int);
+ IInt i1_Xi -> jump $j1_sPR (Just @Int i1_Xi);
+ IBlob ipv_sPk -> T15630.getMenuItem1
+ } } in
+ case v1_X4 of {
+ IDefault -> jump $j_sPO (Nothing @String);
+ IInt ipv_sPi -> T15630.getMenuItem1;
+ IBlob b_ayW -> jump $j_sPO (Just @String b_ayW)
+ }}}}}}}
+
+
+------------- The bad version ----------------
+getMenuItem
+ = \ (vs_azD :: [IValue]) ->
+ case vs_azD of {
+ [] -> case T15630.<+>1 of wild1_00 { };
+ : v_azA vs1_azB ->
+ case vs1_azB of {
+ [] -> case T15630.<+>1 of wild2_00 { };
+ : v1_X5 vs2_X6 ->
+ case vs2_X6 of {
+ [] -> case T15630.<+>1 of wild3_00 { };
+ : v2_X9 vs3_Xa ->
+ case vs3_Xa of {
+ [] -> case T15630.<+>1 of wild4_00 { };
+ : v3_Xd vs4_Xe ->
+ case vs4_Xe of {
+ [] -> case T15630.<+>1 of wild5_00 { };
+ : v4_Xh vs5_Xi ->
+ case v_azA of {
+ __DEFAULT -> T15630.getMenuItem1;
+ IInt i_azn ->
+ join {
+ $j_sQw [Dmd=MC(1,L)]
+ :: (Maybe String -> Maybe Int -> TestStructure)
+ -> Either () TestStructure
+ [LclId[JoinId(1)(Nothing)],
+ Arity=1,
+ Str=<MC(1,C(1,L))>,
+ Unf=OtherCon []]
+ $j_sQw (f_aPr [OS=OneShot]
+ :: Maybe String -> Maybe Int -> TestStructure)
+ = case v3_Xd of {
+ IDefault ->
+ case v4_Xh of {
+ IDefault ->
+ Data.Either.Right
+ @()
+ @TestStructure
+ (f_aPr
+ (Nothing @String)
+ (Nothing @Int));
+ IInt i1_Xl ->
+ Data.Either.Right
+ @()
+ @TestStructure
+ (f_aPr
+ (Nothing @String)
+ (Just @Int i1_Xl));
+ IBlob ipv_sPM -> T15630.getMenuItem1
+ };
+ IInt ipv_sPK -> T15630.getMenuItem1;
+ IBlob b_azt ->
+ case v4_Xh of {
+ IDefault ->
+ Data.Either.Right
+ @()
+ @TestStructure
+ (f_aPr
+ (Just @String b_azt)
+ (Nothing @Int));
+ IInt i1_Xl ->
+ Data.Either.Right
+ @()
+ @TestStructure
+ (f_aPr
+ (Just @String b_azt)
+ (Just @Int i1_Xl));
+ IBlob ipv_sPM -> T15630.getMenuItem1
+ }
+ } } in
+ case v1_X5 of {
+ IDefault ->
+ case v2_X9 of {
+ IDefault ->
+ jump $j_sQw
+ (\ (ds_dNN [OS=OneShot] :: Maybe String)
+ (ds1_dNO [OS=OneShot] :: Maybe Int) ->
+ T15630.TestStructure
+ i_azn
+ (Nothing @String)
+ (Nothing @Int)
+ ds_dNN
+ ds1_dNO);
+ IInt i1_Xk ->
+ jump $j_sQw
+ (\ (ds_dNN [OS=OneShot] :: Maybe String)
+ (ds1_dNO [OS=OneShot] :: Maybe Int) ->
+ T15630.TestStructure
+ i_azn
+ (Nothing @String)
+ (Just @Int i1_Xk)
+ ds_dNN
+ ds1_dNO);
+ IBlob ipv_sPI -> T15630.getMenuItem1
+ };
+ IInt ipv_sPG -> T15630.getMenuItem1;
+ IBlob b_azt ->
+ case v2_X9 of {
+ IDefault ->
+ jump $j_sQw
+ (\ (ds_Xl [OS=OneShot] :: Maybe String)
+ (ds1_Xm [OS=OneShot] :: Maybe Int) ->
+ T15630.TestStructure
+ i_azn
+ (Just @String b_azt)
+ (Nothing @Int)
+ ds_Xl
+ ds1_Xm);
+ IInt i1_Xk ->
+ jump $j_sQw
+ (\ (ds_Xm [OS=OneShot] :: Maybe String)
+ (ds1_Xn [OS=OneShot] :: Maybe Int) ->
+ T15630.TestStructure
+ i_azn
+ (Just @String b_azt)
+ (Just @Int i1_Xk)
+ ds_Xm
+ ds1_Xn);
+ IBlob ipv_sPI -> T15630.getMenuItem1
+ }}}}}}}}
+
+-}
=====================================
testsuite/tests/perf/compiler/T15630a.hs
=====================================
@@ -0,0 +1,64 @@
+module T15630a where
+
+data IValue = IDefault
+ | IInt Int
+ | IBlob String
+
+(?) :: (IValue -> Either x a) -> IValue -> Either x (Maybe a)
+-- With this NOINLINE pragma we get good behaviour, but disastrous without
+-- {-# NOINLINE [0] (?) #-}
+(?) _ IDefault = pure Nothing
+(?) p x = Just <$> p x
+
+getInt :: IValue -> Either () Int
+{-# NOINLINE getInt #-}
+getInt (IInt i) = Right i
+getInt v = Left ()
+
+getString :: IValue -> Either () String
+{-# NOINLINE getString #-}
+getString (IBlob b) = Right $ b
+getString v = Left ()
+
+(<+>) :: (Either x (a -> b), [IValue]) -> (IValue -> Either x a) -> (Either x b, [IValue])
+(<+>) (f, (v:vs)) p = (f <*> (p v), vs)
+
+data TestStructure = TestStructure
+ { _param1 :: Int
+ , _param2 :: Maybe String
+ , _param3 :: Maybe Int
+ , _param4 :: Maybe String
+ , _param5 :: Maybe Int
+ , _param6 :: Maybe Int
+
+ , _param7 :: Maybe String
+ , _param8 :: Maybe String
+ , _param9 :: Maybe Int
+ , _param10 :: Maybe Int
+ , _param11 :: Maybe String
+ , _param12 :: Maybe String
+ , _param13 :: Maybe Int
+ , _param14 :: Maybe Int
+ , _param15 :: Maybe String
+
+ }
+
+getMenuItem :: [IValue] -> Either () TestStructure
+getMenuItem vs = fst $ (pure TestStructure, vs)
+ <+> getInt
+ <+> (getString ?)
+ <+> (getInt ?)
+ <+> (getString ?)
+ <+> (getInt ?)
+ <+> (getInt ?)
+
+ <+> (getString ?)
+ <+> (getString ?)
+ <+> (getInt ?)
+ <+> (getInt ?)
+ <+> (getString ?)
+ <+> (getString ?)
+ <+> (getInt ?)
+ <+> (getInt ?)
+ <+> (getString ?)
+
=====================================
testsuite/tests/simplCore/should_compile/T18730.hs → testsuite/tests/perf/compiler/T18730.hs
=====================================
=====================================
testsuite/tests/simplCore/should_compile/T18730_A.hs → testsuite/tests/perf/compiler/T18730_A.hs
=====================================
=====================================
testsuite/tests/perf/compiler/T24582.hs
=====================================
@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -fmax-simplifier-iterations=20 #-}
+-- This module made the Simplifier iterate for ever
+
+module T24582(woo) where
+
+
+foo :: String -> Int -> a
+{-# NOINLINE foo #-}
+foo s _ = error s
+
+f :: (Int->Int) -> Int
+{-# NOINLINE f #-}
+f g = g 3
+
+x :: Int -> a
+x = foo "urk"
+
+woo = f x
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -206,6 +206,15 @@ test('CoOpt_Singletons',
#########
+# Moved from simplCore/should_compile
+test('T18730',
+ [ only_ways(['optasm'])
+ , collect_compiler_stats('bytes allocated',1)
+ , extra_files(['T18730_A.hs'])
+ ],
+ multimod_compile,
+ ['T18730', '-v0 -O'])
+
# LargeRecord is subject to Note [Sensitivity to unique increment] in T12545.hs
# observed spread was 2.2%
test ('LargeRecord',
@@ -544,6 +553,11 @@ test('T15630',
],
compile,
['-O2'])
+test('T15630a',
+ [collect_compiler_stats()
+ ],
+ compile,
+ ['-O2'])
# See https://gitlab.haskell.org/ghc/ghc/merge_requests/312#note_186960
test ('WWRec',
@@ -716,3 +730,8 @@ test ('LookupFusion',
test('T24471',
[req_th, collect_compiler_stats('all', 5)],
multimod_compile, ['T24471', '-v0 -O'])
+
+test ('T24582',
+ [ collect_compiler_stats('bytes allocated',5) ],
+ compile,
+ ['-O'])
=====================================
testsuite/tests/simplCore/should_compile/T12877.hs
=====================================
@@ -21,7 +21,7 @@ test x = case x of
t -> case t + 1 of
3 -> "0"
4 -> "1"
- t -> case t + 1 of
+ t -> "n" {- case t + 1 of
4 -> "0"
5 -> "1"
t -> case t + 1 of
@@ -112,3 +112,4 @@ test x = case x of
34 -> "0"
35 -> "1"
_ -> "n"
+-}
=====================================
testsuite/tests/simplCore/should_compile/T15631.stdout
=====================================
@@ -1,8 +1,6 @@
- case GHC.Internal.List.$wlenAcc @a (Foo.f2 @a) 0# of v
case reverse @a xs of ys { __DEFAULT ->
case GHC.Internal.List.$wlenAcc @a xs 0# of ww1 { __DEFAULT ->
+ = case GHC.Internal.List.$wlenAcc
case ys of {
- [] -> case Foo.f1 @a of { GHC.Types.I# v1 -> GHC.Prim.+# ww1 v1 };
- case GHC.Internal.List.$wlenAcc
case Foo.$wf @a xs of ww [Occ=Once1] { __DEFAULT ->
case Foo.$wf @a xs of ww { __DEFAULT -> GHC.Types.I# ww }
=====================================
testsuite/tests/simplCore/should_compile/T18013.stderr
=====================================
@@ -17,6 +17,8 @@ Rule fired: Class op $p1Applicative (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @((), _) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op pure (BUILTIN)
Rule fired: Class op . (BUILTIN)
@@ -25,6 +27,8 @@ Rule fired: Class op $p1Applicative (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @((), _) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op $p1Arrow (BUILTIN)
Rule fired: Class op $p1Arrow (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
@@ -38,6 +42,8 @@ Rule fired: Class op $p1Applicative (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @((), _) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op first (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
@@ -48,6 +54,8 @@ Rule fired: Class op $p1Applicative (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @(_, ()) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op pure (BUILTIN)
Rule fired: Class op . (BUILTIN)
@@ -56,12 +64,16 @@ Rule fired: Class op $p1Applicative (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @((), _) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op . (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op $p1Applicative (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @(_, ()) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op pure (BUILTIN)
Rule fired: Class op . (BUILTIN)
@@ -70,6 +82,8 @@ Rule fired: Class op $p1Applicative (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @((), _) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op $p1Arrow (BUILTIN)
Rule fired: Class op $p1Arrow (BUILTIN)
Rule fired: Class op id (BUILTIN)
@@ -83,6 +97,8 @@ Rule fired: Class op $p1Applicative (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @((), _) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op ||| (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op $p1Applicative (BUILTIN)
@@ -90,6 +106,8 @@ Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @(_, ()) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op pure (BUILTIN)
Rule fired: Class op . (BUILTIN)
@@ -98,6 +116,8 @@ Rule fired: Class op $p1Applicative (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
+Rule fired: mkRule @((), _) (T18013a)
+Rule fired: Class op fmap (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op pure (BUILTIN)
Rule fired: Class op . (BUILTIN)
@@ -108,30 +128,10 @@ Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op pure (BUILTIN)
Rule fired: mkRule @((), _) (T18013a)
Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @((), _) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @((), _) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @(_, ()) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @((), _) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @((), _) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @((), _) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @((), _) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @((), _) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @(_, ()) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @(_, ()) (T18013a)
-Rule fired: Class op fmap (BUILTIN)
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 52, types: 95, coercions: 17, joins: 0/1}
+ = {terms: 38, types: 90, coercions: 17, joins: 0/1}
-- RHS size: {terms: 37, types: 78, coercions: 17, joins: 0/1}
mapMaybeRule [InlPrag=[2]]
@@ -221,46 +221,5 @@ mapMaybeRule
~R# (s -> Maybe a -> IO (Result s (Maybe b))))
}
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T18013.$trModule4 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 20 0}]
-T18013.$trModule4 = "main"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T18013.$trModule3 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T18013.$trModule3 = GHC.Types.TrNameS T18013.$trModule4
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T18013.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-T18013.$trModule2 = "T18013"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T18013.$trModule1 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T18013.$trModule1 = GHC.Types.TrNameS T18013.$trModule2
-
--- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T18013.$trModule :: GHC.Types.Module
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-T18013.$trModule
- = GHC.Types.Module T18013.$trModule3 T18013.$trModule1
-
=====================================
testsuite/tests/simplCore/should_compile/T20040.stderr
=====================================
@@ -1,8 +1,8 @@
==================== Final STG: ====================
-$WNil = CCS_DONT_CARE Nil! [];
+$WNil = Nil! [];
-$WCons = \r [conrep conrep] Cons [conrep conrep];
+$WCons = \r [conrep conrep1] Cons [conrep conrep1];
unSucc1 = \r [ds] ds;
@@ -11,7 +11,7 @@ unSucc = \r [eta] unSucc1 eta;
Rec {
ifoldl' =
\r [f z ds]
- case ds of {
+ case ds of wild {
Nil -> z;
Cons ipv2 ipv3 ->
case z of z1 {
@@ -25,7 +25,7 @@ Nil = \r [void] Nil [];
Cons = \r [void eta eta] Cons [eta eta];
-Z = CCS_DONT_CARE Z! [];
+Z = Z! [];
S = \r [eta] S [eta];
=====================================
testsuite/tests/simplCore/should_compile/T20103.stderr
=====================================
@@ -6,7 +6,7 @@ T20103.hs:7:24: warning: [GHC-63394] [-Wx-partial (in -Wextended-warnings)]
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 139, types: 89, coercions: 22, joins: 0/0}
+ = {terms: 136, types: 88, coercions: 25, joins: 0/0}
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl :: Int
@@ -117,7 +117,7 @@ lvl16
:: CallStack ~R# (?callStack::CallStack)))
Rec {
--- RHS size: {terms: 47, types: 42, coercions: 18, joins: 0/0}
+-- RHS size: {terms: 44, types: 41, coercions: 21, joins: 0/0}
T20103.$wfoo [InlPrag=[2], Occ=LoopBreaker]
:: HasCallStack => GHC.Prim.Int# -> GHC.Prim.Int#
[GblId[StrictWorker([!])], Arity=2, Str=<1L><1L>, Unf=OtherCon []]
@@ -150,8 +150,11 @@ T20103.$wfoo
{ __DEFAULT ->
case getCallStack wild1 of {
[] ->
- case wild1 of wild2 {
- __DEFAULT -> case lvl16 wild2 of {};
+ case $dIP
+ `cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N
+ :: (?callStack::CallStack) ~R# CallStack)
+ of wild1 {
+ __DEFAULT -> case lvl16 wild1 of {};
GHC.Stack.Types.FreezeCallStack ds1 ->
case GHC.List.head1
@([Char], SrcLoc)
=====================================
testsuite/tests/simplCore/should_compile/T22317.hs
=====================================
@@ -6,9 +6,9 @@ data T = T (Maybe Bool) (Maybe Bool) (Maybe Bool) (Maybe Bool)
m :: Maybe a -> Maybe a -> Maybe a
+-- Don't make this INLINE; if you do, ,it's not unreasonable to inline it
m (Just v1) Nothing = Just v1
m _ mb = mb
-{-# INLINE m #-}
f :: T -> T -> T
f (T a1 b1 c1 d1) (T a2 b2 c2 d2)
=====================================
testsuite/tests/simplCore/should_compile/T22428.stderr
=====================================
@@ -18,7 +18,7 @@ f :: Integer -> Integer -> Integer
Str=<SL><1L>,
Unf=Unf{Src=<vanilla>, TopLvl=True,
Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [0 0] 156 0}]
+ Guidance=IF_ARGS [0 0] 140 0}]
f = \ (x :: Integer) (y :: Integer) ->
joinrec {
go [InlPrag=INLINE (sat-args=1), Occ=LoopBreaker, Dmd=SC(S,L)]
=====================================
testsuite/tests/simplCore/should_compile/T23491a.stderr
=====================================
@@ -1,4 +1,136 @@
-==================== Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False}) ====================
-Result size of Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False})
-==================== Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) ====================
-Result size of Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True})
+[1 of 2] Compiling Main ( T23491.hs, T23491.o )
+
+==================== Float out(FOS {Lam = Just 0,
+ Consts = True,
+ JoinsToTop = False,
+ OverSatApps = False}) ====================
+Result size of Float out(FOS {Lam = Just 0,
+ Consts = True,
+ JoinsToTop = False,
+ OverSatApps = False})
+ = {terms: 25, types: 13, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl_sBH :: GHC.Prim.Addr#
+[LclId]
+lvl_sBH = "Hello world"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl_sBI :: [Char]
+[LclId]
+lvl_sBI = GHC.CString.unpackCString# lvl_sBH
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+main :: IO ()
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=False, ConLike=False, WorkFree=False, Expandable=False,
+ Guidance=IF_ARGS [] 80 0}]
+main = putStrLn lvl_sBI
+
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+:Main.main :: IO ()
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=False, ConLike=False, WorkFree=False, Expandable=False,
+ Guidance=IF_ARGS [] 20 0}]
+:Main.main = GHC.TopHandler.runMainIO @() main
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl_sBJ :: GHC.Prim.Addr#
+[LclId]
+lvl_sBJ = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl_sBK :: GHC.Types.TrName
+[LclId]
+lvl_sBK = GHC.Types.TrNameS lvl_sBJ
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl_sBL :: GHC.Prim.Addr#
+[LclId]
+lvl_sBL = "Main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl_sBM :: GHC.Types.TrName
+[LclId]
+lvl_sBM = GHC.Types.TrNameS lvl_sBL
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+Main.$trModule :: GHC.Types.Module
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 70 10}]
+Main.$trModule = GHC.Types.Module lvl_sBK lvl_sBM
+
+
+
+
+==================== Float out(FOS {Lam = Just 0,
+ Consts = True,
+ JoinsToTop = True,
+ OverSatApps = True}) ====================
+Result size of Float out(FOS {Lam = Just 0,
+ Consts = True,
+ JoinsToTop = True,
+ OverSatApps = True})
+ = {terms: 25, types: 13, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl_sBH :: GHC.Prim.Addr#
+[LclId]
+lvl_sBH = "Hello world"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl_sBI :: [Char]
+[LclId]
+lvl_sBI = GHC.CString.unpackCString# lvl_sBH
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+main :: IO ()
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=False, ConLike=False, WorkFree=False, Expandable=False,
+ Guidance=IF_ARGS [] 80 0}]
+main = putStrLn lvl_sBI
+
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+:Main.main :: IO ()
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=False, ConLike=False, WorkFree=False, Expandable=False,
+ Guidance=IF_ARGS [] 20 0}]
+:Main.main = GHC.TopHandler.runMainIO @() main
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl_sBJ :: GHC.Prim.Addr#
+[LclId]
+lvl_sBJ = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl_sBK :: GHC.Types.TrName
+[LclId]
+lvl_sBK = GHC.Types.TrNameS lvl_sBJ
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+lvl_sBL :: GHC.Prim.Addr#
+[LclId]
+lvl_sBL = "Main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+lvl_sBM :: GHC.Types.TrName
+[LclId]
+lvl_sBM = GHC.Types.TrNameS lvl_sBL
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+Main.$trModule :: GHC.Types.Module
+[LclIdX,
+ Unf=Unf{Src=<vanilla>, TopLvl=True,
+ Value=True, ConLike=True, WorkFree=True, Expandable=True,
+ Guidance=IF_ARGS [] 70 10}]
+Main.$trModule = GHC.Types.Module lvl_sBK lvl_sBM
+
+
+
+[2 of 2] Linking T23491
=====================================
testsuite/tests/simplCore/should_compile/T24229a.stderr
=====================================
@@ -1,6 +1,6 @@
==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 79, types: 106, coercions: 8, joins: 0/0}
+Result size of Tidy Core = {terms: 83, types: 113, coercions: 8, joins: 1/1}
Rec {
foo_$s$wfoo
@@ -14,9 +14,10 @@ end Rec }
foo
= \ @a ds ds1 ->
case ds of { I# ww ->
+ join { $j ww1 = Just ww1 } in
case ww of ds2 {
- __DEFAULT -> case ds1 `cast` <Co:4> :: ... of { (x, y) -> case foo_$s$wfoo y x (-# ds2 1#) of { (# ww1 #) -> Just ww1 } };
- 0# -> Just (ds1 `cast` <Co:4> :: ...)
+ __DEFAULT -> case ds1 `cast` <Co:4> :: ... of { (x, y) -> case foo_$s$wfoo y x (-# ds2 1#) of { (# ww1 #) -> jump $j ww1 } };
+ 0# -> jump $j (ds1 `cast` <Co:4> :: ...)
}
}
=====================================
testsuite/tests/simplCore/should_compile/T24229b.stderr
=====================================
@@ -1,6 +1,6 @@
==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 60, types: 83, coercions: 8, joins: 0/0}
+Result size of Tidy Core = {terms: 64, types: 90, coercions: 8, joins: 1/1}
Rec {
foo_$s$wfoo
@@ -14,9 +14,10 @@ end Rec }
foo
= \ @a ds ds1 ->
case ds of { I# ww ->
+ join { $j ww1 = Just ww1 } in
case ww of ds2 {
- __DEFAULT -> case ds1 `cast` <Co:4> :: ... of { (x, y) -> case foo_$s$wfoo y x (-# ds2 1#) of { (# ww1 #) -> Just ww1 } };
- 0# -> Just (ds1 `cast` <Co:4> :: ...)
+ __DEFAULT -> case ds1 `cast` <Co:4> :: ... of { (x, y) -> case foo_$s$wfoo y x (-# ds2 1#) of { (# ww1 #) -> jump $j ww1 } };
+ 0# -> jump $j (ds1 `cast` <Co:4> :: ...)
}
}
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -53,7 +53,7 @@ test('T3717', only_ways(['optasm']),
test('spec-inline', only_ways(['optasm']),
compile,
- ['-O2 -ddump-simpl -dsuppress-uniques -dsuppress-ticks'])
+ ['-O2 -ddump-simpl -dsuppress-uniques -dsuppress-ticks -dno-typeable-binds'])
test('T4908', only_ways(['optasm']),
compile,
['-O2 -ddump-simpl -dsuppress-uniques -dsuppress-ticks'])
@@ -320,7 +320,7 @@ test('T17930', [ grep_errmsg(r'^\$sfoo') ], compile, ['-O -ddump-spec -dsuppress
test('spec004', [ grep_errmsg(r'\$sfoo') ], compile, ['-O -ddump-spec -dsuppress-uniques'])
# NB: T17810: -fspecialise-aggressively
test('T17810', normal, multimod_compile, ['T17810', '-fspecialise-aggressively -dcore-lint -O -v0'])
-test('T18013', normal, multimod_compile, ['T18013', '-v0 -O'])
+test('T18013', normal, multimod_compile, ['T18013', '-v0 -O -dno-typeable-binds'])
test('T18098', normal, compile, ['-dcore-lint -O2'])
test('T18120', normal, compile, ['-dcore-lint -O'])
@@ -342,7 +342,6 @@ test('T18603', normal, compile, ['-dcore-lint -O'])
# T18649 should /not/ generate a specialisation rule
test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints'])
-test('T18730', normal, multimod_compile, ['T18730_A', '-dcore-lint -O'])
test('T18747A', normal, compile, [''])
test('T18747B', normal, compile, [''])
test('T18815', only_ways(['optasm']), makefile_test, ['T18815'])
=====================================
testsuite/tests/simplCore/should_compile/spec-inline.stderr
=====================================
@@ -1,48 +1,7 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 150, types: 60, coercions: 0, joins: 0/0}
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-Roman.$trModule4 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 20 0}]
-Roman.$trModule4 = "main"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-Roman.$trModule3 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-Roman.$trModule3 = GHC.Types.TrNameS Roman.$trModule4
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-Roman.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 30 0}]
-Roman.$trModule2 = "Roman"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-Roman.$trModule1 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-Roman.$trModule1 = GHC.Types.TrNameS Roman.$trModule2
-
--- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-Roman.$trModule :: GHC.Types.Module
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-Roman.$trModule
- = GHC.Types.Module Roman.$trModule3 Roman.$trModule1
+ = {terms: 136, types: 55, coercions: 0, joins: 0/0}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
lvl :: GHC.Prim.Addr#
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4dfbaad0d976a468815df21cabd0a62035e0c58f...a2af315023efb666745717a856aa07a66865fbe3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4dfbaad0d976a468815df21cabd0a62035e0c58f...a2af315023efb666745717a856aa07a66865fbe3
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240329/a88413c4/attachment-0001.html>
More information about the ghc-commits
mailing list