[Git][ghc/ghc][wip/simplifier-tweaks] 3 commits: Comments about floating joins
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Sat Feb 3 11:36:02 UTC 2024
Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC
Commits:
78a5bb00 by Simon Peyton Jones at 2024-02-02T23:42:46+00:00
Comments about floating joins
- - - - -
4e3e37c4 by Simon Peyton Jones at 2024-02-02T23:44:07+00:00
Improve occurrence analyis for bottoming function calls
See Note [Bottoming function calls]
- - - - -
e9f9f068 by Simon Peyton Jones at 2024-02-02T23:44:33+00:00
Test output wibbles
- - - - -
9 changed files:
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- testsuite/tests/dmdanal/sigs/T21081.stderr
- testsuite/tests/lib/integer/Makefile
- testsuite/tests/simplCore/should_compile/T20103.stderr
- testsuite/tests/simplCore/should_compile/T23491a.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_compile/spec-inline.stderr
Changes:
=====================================
compiler/GHC/Core/Opt/FloatOut.hs
=====================================
@@ -109,52 +109,6 @@ which might usefully be separated to
@
Well, maybe. We don't do this at the moment.
-Note [Join points]
-~~~~~~~~~~~~~~~~~~
-Every occurrence of a join point must be a tail call (see Note [Invariants on
-join points] in GHC.Core), so we must be careful with how far we float them. The
-mechanism for doing so is the *join ceiling*, detailed in Note [Join ceiling]
-in GHC.Core.Opt.SetLevels. For us, the significance is that a binder might be marked to be
-dropped at the nearest boundary between tail calls and non-tail calls. For
-example:
-
- (< join j = ... in
- let x = < ... > in
- case < ... > of
- A -> ...
- B -> ...
- >) < ... > < ... >
-
-Here the join ceilings are marked with angle brackets. Either side of an
-application is a join ceiling, as is the scrutinee position of a case
-expression or the RHS of a let binding (but not a join point).
-
-Why do we *want* do float join points at all? After all, they're never
-allocated, so there's no sharing to be gained by floating them. However, the
-other benefit of floating is making RHSes small, and this can have a significant
-impact. In particular, stream fusion has been known to produce nested loops like
-this:
-
- joinrec j1 x1 =
- joinrec j2 x2 =
- joinrec j3 x3 = ... jump j1 (x3 + 1) ... jump j2 (x3 + 1) ...
- in jump j3 x2
- in jump j2 x1
- in jump j1 x
-
-(Assume x1 and x2 do *not* occur free in j3.)
-
-Here j1 and j2 are wholly superfluous---each of them merely forwards its
-argument to j3. Since j3 only refers to x3, we can float j2 and j3 to make
-everything one big mutual recursion:
-
- joinrec j1 x1 = jump j2 x1
- j2 x2 = jump j3 x2
- j3 x3 = ... jump j1 (x3 + 1) ... jump j2 (x3 + 1) ...
- in jump j1 x
-
-Now the simplifier will happily inline the trivial j1 and j2, leaving only j3.
-Without floating, we're stuck with three loops instead of one.
************************************************************************
* *
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -55,7 +55,7 @@ import GHC.Types.Tickish
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.Var
-import GHC.Types.Demand ( argOneShots, argsOneShots )
+import GHC.Types.Demand ( argOneShots, argsOneShots, isDeadEndSig )
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -2579,7 +2579,12 @@ occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr]
occAnalArgs !env fun args !one_shots
= go emptyDetails fun args one_shots
where
- env_args = setNonTailCtxt OccVanilla env
+ env_args = setNonTailCtxt encl env
+
+ -- Make bottoming functions interesting
+ -- See Note [Bottoming function calls]
+ encl | Var f <- fun, isDeadEndSig (idDmdSig f) = OccScrut
+ | otherwise = OccVanilla
go uds fun [] _ = WUD uds fun
go uds fun (arg:args) one_shots
@@ -2598,6 +2603,22 @@ occAnalArgs !env fun args !one_shots
Applications are dealt with specially because we want
the "build hack" to work.
+Note [Bottoming function calls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ let x = (a,b) in
+ case p of
+ A -> ...(error x)..
+ B -> ...(ertor x)...
+
+postInlineUnconditionally may duplicate x's binding, but sometimes it
+does so only if the use site IsInteresting. Pushing allocation into error
+branches is good, so we try to make bottoming calls look interesting, by
+setting occ_encl = OccScrut for such calls.
+
+The slightly-artificial test T21128 is a good example. It's probably
+not a huge deal.
+
Note [Arguments of let-bound constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
=====================================
compiler/GHC/Core/Opt/SetLevels.hs
=====================================
@@ -795,8 +795,10 @@ I think this is obsolete; the flag seems always on.]
Note [Floating join point bindings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Mostly we only float a join point if it can /stay/ a join point. But
-there is one exception: if it can go to the top level (#13286).
+Mostly we don't float join points at all -- we want them to /stay/ join points.
+This decision is made in `wantToFloat`.
+
+But there is one exception: if it can go to the top level (#13286).
Consider
f x = joinrec j y n = <...j y' n'...>
in jump j x 0
@@ -812,6 +814,47 @@ It shouldn't make a lot of difference, but these tests
and one nofib program, all improve if you do float to top, because
of the resulting inlining of f. So ok, let's do it.
+However there are also bad consequences of floating join point to the top:
+
+* If a continuation consumes (let $j x = Just x in case y of {...})
+ we may get much less duplication of the continuation if we don't
+ float $j to the top, because the contination goes into $j's RHS
+
+* See #21392 for an example of how demand analysis can get worse if you
+ float a join point to the top level.
+
+Compromise: we control float-joins-to-the-top with the FloatOutSwitch
+floatJoinsToTop. We don't do it in the first invocation of FloatOut, but
+we /do/ do it in the second iteration near the end of the pipeline.
+
+Missed opportunity
+------------------
+There is another benfit of floating local join points. Stream fusion
+has been known to produce nested loops like this:
+
+ joinrec j1 x1 =
+ joinrec j2 x2 =
+ joinrec j3 x3 = ... jump j1 (x3 + 1) ... jump j2 (x3 + 1) ...
+ in jump j3 x2
+ in jump j2 x1
+ in jump j1 x
+
+(Assume x1 and x2 do *not* occur free in j3.)
+
+Here j1 and j2 are wholly superfluous---each of them merely forwards its
+argument to j3. Since j3 only refers to x3, we can float j2 and j3 to make
+everything one big mutual recursion:
+
+ joinrec j1 x1 = jump j2 x1
+ j2 x2 = jump j3 x2
+ j3 x3 = ... jump j1 (x3 + 1) ... jump j2 (x3 + 1) ...
+ in jump j1 x
+
+Now the simplifier will happily inline the trivial j1 and j2, leaving only j3.
+Without floating, we're stuck with three loops instead of one.
+
+Currently we don't do this -- a missed opportunity.
+
Note [Free join points]
~~~~~~~~~~~~~~~~~~~~~~~
We never float a MFE that has a free join-point variable. You might think
@@ -1242,15 +1285,8 @@ wantToFloat env dest_lvl is_join is_top_bindable
-- bit brutal, but unlifted bindings aren't expensive either
| is_join -- Join points either stay put, or float to top
- -- See Note [Floating join points]
+ -- See Note [Floating join point bindings]
= isTopLvl dest_lvl && floatJoinsToTop (le_switches env)
- -- Try not floating join points at all
- -- If a continuation consumes (let $j x = Just x in case y of {...})
- -- we may get much less duplication of the continuation if we don't
- -- float $j to the top, because the contination goes into $j's RHS
- --
- -- Moreover see #21392 for another bad consequence of floating
- -- a join to the top.
| otherwise
= True -- Yes! Float me
=====================================
testsuite/tests/dmdanal/sigs/T21081.stderr
=====================================
@@ -15,7 +15,7 @@ T21081.fst': <1!P(1L,A)>
T21081.g: <ML>
T21081.h: <MP(ML,ML)><1!P(1L)>
T21081.h2: <L><S!P(SL)>
-T21081.i: <1L><1L><MP(ML,ML)>
+T21081.i: <1L><1L><LP(ML,ML)>
T21081.j: <S!P(1L,1L)>
T21081.myfoldl: <LC(S,C(1,L))><1L><1L>
T21081.snd': <1!P(A,1L)>
@@ -61,7 +61,7 @@ T21081.fst': <1!P(1L,A)>
T21081.g: <ML>
T21081.h: <MP(ML,ML)><1!P(1L)>
T21081.h2: <L><1!P(SL)>
-T21081.i: <1L><1L><MP(ML,ML)>
+T21081.i: <1L><1L><LP(ML,ML)>
T21081.j: <1!P(1L,1L)>
T21081.myfoldl: <LC(S,C(1,L))><1L><1L>
T21081.snd': <1!P(A,1L)>
=====================================
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/simplCore/should_compile/T20103.stderr
=====================================
@@ -2,11 +2,11 @@
T20103.hs:7:24: warning: [GHC-63394] [-Wx-partial (in -Wextended-warnings)]
In the use of ‘head’
(imported from Prelude, but defined in GHC.List):
- "This is a partial function, it throws an error on empty lists. Use pattern matching or Data.List.uncons instead. Consider refactoring to use Data.List.NonEmpty."
+ "This is a partial function, it throws an error on empty lists. Use pattern matching, 'Data.List.uncons' or 'Data.Maybe.listToMaybe' instead. Consider refactoring to use "Data.List.NonEmpty"."
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 137, types: 88, coercions: 25, joins: 1/1}
+ = {terms: 136, types: 88, coercions: 25, joins: 0/0}
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl :: Int
@@ -105,20 +105,19 @@ lvl15 :: [Char]
[GblId]
lvl15 = GHC.CString.unpackCString# lvl14
--- RHS size: {terms: 7, types: 9, coercions: 4, joins: 0/0}
-lvl16 :: CallStack -> GHC.Prim.Int#
+-- RHS size: {terms: 6, types: 5, coercions: 4, joins: 0/0}
+lvl16 :: CallStack -> ([Char], SrcLoc)
[GblId, Arity=1, Str=<S>b, Cpr=b, Unf=OtherCon []]
lvl16
= \ (wild1 :: CallStack) ->
- case GHC.List.head1
- @([Char], SrcLoc)
- ((GHC.Stack.Types.PushCallStack lvl9 lvl7 wild1)
- `cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N)
- :: CallStack ~R# (?callStack::CallStack)))
- of {}
+ GHC.List.head1
+ @([Char], SrcLoc)
+ ((GHC.Stack.Types.PushCallStack lvl9 lvl7 wild1)
+ `cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N)
+ :: CallStack ~R# (?callStack::CallStack)))
Rec {
--- RHS size: {terms: 44, types: 40, coercions: 21, joins: 1/1}
+-- 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=<SL><1L>, Unf=OtherCon []]
@@ -126,25 +125,22 @@ T20103.$wfoo
= \ ($dIP :: HasCallStack) (ww :: GHC.Prim.Int#) ->
case ww of ds {
__DEFAULT ->
- join {
- $j [Dmd=1C(1,L)] :: HasCallStack => GHC.Prim.Int#
- [LclId[JoinId(1)(Just [!])], Arity=1, Str=<SL>, Unf=OtherCon []]
- $j (arg [OS=OneShot] :: HasCallStack)
- = T20103.$wfoo arg (GHC.Prim.-# ds 1#) } in
case $dIP
`cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N
:: (?callStack::CallStack) ~R# CallStack)
of wild1 {
__DEFAULT ->
- jump $j
+ T20103.$wfoo
((GHC.Stack.Types.PushCallStack lvl15 lvl13 wild1)
`cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N)
- :: CallStack ~R# (?callStack::CallStack)));
+ :: CallStack ~R# (?callStack::CallStack)))
+ (GHC.Prim.-# ds 1#);
GHC.Stack.Types.FreezeCallStack ds1 ->
- jump $j
+ T20103.$wfoo
(wild1
`cast` (Sym (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N)
:: CallStack ~R# (?callStack::CallStack)))
+ (GHC.Prim.-# ds 1#)
};
0# ->
case getCallStack
@@ -157,7 +153,7 @@ T20103.$wfoo
`cast` (GHC.Classes.N:IP[0] <"callStack">_N <CallStack>_N
:: (?callStack::CallStack) ~R# CallStack)
of wild1 {
- __DEFAULT -> lvl16 wild1;
+ __DEFAULT -> case lvl16 wild1 of {};
GHC.Stack.Types.FreezeCallStack ds1 ->
case GHC.List.head1
@([Char], SrcLoc)
=====================================
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/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'])
=====================================
testsuite/tests/simplCore/should_compile/spec-inline.stderr
=====================================
@@ -1,154 +1,41 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 150, types: 60, coercions: 0, joins: 0/0}
+ = {terms: 57, types: 17, coercions: 0, joins: 1/1}
--- 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
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-lvl :: GHC.Prim.Addr#
-[GblId, Unf=OtherCon []]
-lvl = "spec-inline.hs:(19,5)-(29,25)|function go"#
-
--- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0}
-Roman.foo3 :: ()
-[GblId, Str=b, Cpr=b]
-Roman.foo3
- = Control.Exception.Base.patError @GHC.Types.LiftedRep @() lvl
-
-Rec {
--- RHS size: {terms: 40, types: 5, coercions: 0, joins: 0/0}
-Roman.foo_$s$wgo [Occ=LoopBreaker]
- :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=2, Str=<A><L>, Unf=OtherCon []]
-Roman.foo_$s$wgo
- = \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) ->
- case GHC.Prim.<=# sc1 0# of {
- __DEFAULT ->
- case GHC.Prim.<# sc1 100# of {
- __DEFAULT ->
- case GHC.Prim.<# sc1 500# of {
- __DEFAULT ->
- Roman.foo_$s$wgo (GHC.Prim.*# 14# sc) (GHC.Prim.-# sc1 1#);
- 1# -> Roman.foo_$s$wgo (GHC.Prim.*# 7# sc) (GHC.Prim.-# sc1 3#)
- };
- 1# -> Roman.foo_$s$wgo sc (GHC.Prim.-# sc1 2#)
- };
- 1# -> 0#
- }
-end Rec }
-
--- RHS size: {terms: 61, types: 18, coercions: 0, joins: 0/0}
-Roman.$wgo [InlPrag=[2]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
-[GblId[StrictWorker([!, !])],
- Arity=2,
- Str=<1L><1L>,
+-- RHS size: {terms: 48, types: 11, coercions: 0, joins: 1/1}
+Roman.$wfoo [InlPrag=[2]] :: Int -> GHC.Prim.Int#
+[GblId[StrictWorker([!])],
+ Arity=1,
+ Str=<1L>,
Unf=Unf{Src=<vanilla>, TopLvl=True,
Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [61 30] 249 0}]
-Roman.$wgo
- = \ (u :: Maybe Int) (ds :: Maybe Int) ->
- case ds of {
- Nothing -> case Roman.foo3 of {};
- Just x ->
- case x of { GHC.Types.I# ipv ->
- case u of {
- Nothing -> Roman.foo_$s$wgo (GHC.Prim.*# 7# ipv) 10#;
- Just n ->
- case n of { GHC.Types.I# x2 ->
- case GHC.Prim.<=# x2 0# of {
- __DEFAULT ->
- case GHC.Prim.<# x2 100# of {
- __DEFAULT ->
- case GHC.Prim.<# x2 500# of {
- __DEFAULT ->
- Roman.foo_$s$wgo (GHC.Prim.*# 14# ipv) (GHC.Prim.-# x2 1#);
- 1# -> Roman.foo_$s$wgo (GHC.Prim.*# 7# ipv) (GHC.Prim.-# x2 3#)
- };
- 1# -> Roman.foo_$s$wgo ipv (GHC.Prim.-# x2 2#)
- };
- 1# -> 0#
- }
- }
- }
- }
+ Guidance=IF_ARGS [20] 78 0}]
+Roman.$wfoo
+ = \ (n :: Int) ->
+ case n of { GHC.Types.I# ipv ->
+ joinrec {
+ $sgo [Occ=LoopBreaker, Dmd=SC(S,C(1,L))]
+ :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
+ [LclId[JoinId(2)(Nothing)], Arity=2, Str=<A><L>, Unf=OtherCon []]
+ $sgo (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#)
+ = case GHC.Prim.<=# sc1 0# of {
+ __DEFAULT ->
+ case GHC.Prim.<# sc1 100# of {
+ __DEFAULT ->
+ case GHC.Prim.<# sc1 500# of {
+ __DEFAULT -> jump $sgo (GHC.Prim.*# 14# sc) (GHC.Prim.-# sc1 1#);
+ 1# -> jump $sgo (GHC.Prim.*# 7# sc) (GHC.Prim.-# sc1 3#)
+ };
+ 1# -> jump $sgo sc (GHC.Prim.-# sc1 2#)
+ };
+ 1# -> 0#
+ }; } in
+ jump $sgo 6# ipv
}
--- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0}
-Roman.foo_go [InlPrag=[2]] :: Maybe Int -> Maybe Int -> Int
-[GblId[StrictWorker([!, !])],
- Arity=2,
- Str=<1L><1L>,
- Cpr=1,
- Unf=Unf{Src=StableSystem, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
- Tmpl= \ (u [Occ=Once1] :: Maybe Int)
- (ds [Occ=Once1] :: Maybe Int) ->
- case Roman.$wgo u ds of ww [Occ=Once1] { __DEFAULT ->
- GHC.Types.I# ww
- }}]
-Roman.foo_go
- = \ (u :: Maybe Int) (ds :: Maybe Int) ->
- case Roman.$wgo u ds of ww { __DEFAULT -> GHC.Types.I# ww }
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-Roman.foo2 :: Int
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-Roman.foo2 = GHC.Types.I# 6#
-
--- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
-Roman.foo1 :: Maybe Int
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True,
- Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [] 10 10}]
-Roman.foo1 = GHC.Maybe.Just @Int Roman.foo2
-
--- RHS size: {terms: 11, types: 4, coercions: 0, joins: 0/0}
-foo :: Int -> Int
+-- RHS size: {terms: 7, types: 2, coercions: 0, joins: 0/0}
+foo [InlPrag=[2]] :: Int -> Int
[GblId,
Arity=1,
Str=<1L>,
@@ -156,22 +43,13 @@ foo :: Int -> Int
Unf=Unf{Src=StableSystem, TopLvl=True,
Value=True, ConLike=True, WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
- Tmpl= \ (n [Occ=Once1!] :: Int) ->
- case n of n1 [Occ=Once1] { GHC.Types.I# _ [Occ=Dead] ->
- Roman.foo_go (GHC.Maybe.Just @Int n1) Roman.foo1
+ Tmpl= \ (n [Occ=Once1] :: Int) ->
+ case Roman.$wfoo n of ww [Occ=Once1] { __DEFAULT ->
+ GHC.Types.I# ww
}}]
foo
= \ (n :: Int) ->
- case n of { GHC.Types.I# ipv ->
- case Roman.foo_$s$wgo 6# ipv of ww { __DEFAULT -> GHC.Types.I# ww }
- }
-
+ case Roman.$wfoo n of ww { __DEFAULT -> GHC.Types.I# ww }
------- Local rules for imported ids --------
-"SC:$wgo0" [2]
- forall (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#).
- Roman.$wgo (GHC.Maybe.Just @Int (GHC.Types.I# sc1))
- (GHC.Maybe.Just @Int (GHC.Types.I# sc))
- = Roman.foo_$s$wgo sc sc1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/890f62a68727548401bf7be7461bcf10e497270e...e9f9f06839b94a10a0b4a8f81a903a639e2e0034
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/890f62a68727548401bf7be7461bcf10e497270e...e9f9f06839b94a10a0b4a8f81a903a639e2e0034
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/20240203/670e1fea/attachment-0001.html>
More information about the ghc-commits
mailing list