Commit 0bd60059 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Marge Bot

This patch addresses the exponential blow-up in the simplifier.

Specifically:
  #13253 exponential inlining
  #10421 ditto
  #18140 strict constructors
  #18282 another nested-function call case

This patch makes one really significant changes: change the way that
mkDupableCont handles StrictArg.  The details are explained in
GHC.Core.Opt.Simplify Note [Duplicating StrictArg].

Specific changes

* In mkDupableCont, when making auxiliary bindings for the other arguments
  of a call, add extra plumbing so that we don't forget the demand on them.
  Otherwise we haev to wait for another round of strictness analysis. But
  actually all the info is to hand.  This change affects:
  - Make the strictness list in ArgInfo be [Demand] instead of [Bool],
    and rename it to ai_dmds.
  - Add as_dmd to ValArg
  - Simplify.makeTrivial takes a Demand
  - mkDupableContWithDmds takes a [Demand]

There are a number of other small changes

1. For Ids that are used at most once in each branch of a case, make
   the occurrence analyser record the total number of syntactic
   occurrences.  Previously we recorded just OneBranch or
   MultipleBranches.

   I thought this was going to be useful, but I ended up barely
   using it; see Note [Note [Suppress exponential blowup] in
   GHC.Core.Opt.Simplify.Utils

   Actual changes:
     * See the occ_n_br field of OneOcc.
     * postInlineUnconditionally

2. I found a small perf buglet in SetLevels; see the new
   function GHC.Core.Opt.SetLevels.hasFreeJoin

3. Remove the sc_cci field of StrictArg.  I found I could get
   its information from the sc_fun field instead.  Less to get
   wrong!

4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler
   invariant: they line up with the value arguments beyond ai_args
   This allowed a bit of nice refactoring; see isStrictArgInfo,
   lazyArgcontext, strictArgContext

There is virtually no difference in nofib. (The runtime numbers
are bogus -- I tried a few manually.)

        Program           Size    Allocs   Runtime   Elapsed  TotalMem
--------------------------------------------------------------------------------
            fft          +0.0%     -2.0%    -48.3%    -49.4%      0.0%
     multiplier          +0.0%     -2.2%    -50.3%    -50.9%      0.0%
--------------------------------------------------------------------------------
            Min          -0.4%     -2.2%    -59.2%    -60.4%      0.0%
            Max          +0.0%     +0.1%     +3.3%     +4.9%      0.0%
 Geometric Mean          +0.0%     -0.0%    -33.2%    -34.3%     -0.0%

Test T18282 is an existing example of these deeply-nested strict calls.
We get a big decrease in compile time (-85%) because so much less
inlining takes place.

Metric Decrease:
    T18282
parent 0a815cea
Pipeline #22717 passed with stages
in 364 minutes and 44 seconds
......@@ -2866,7 +2866,7 @@ simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs
-- The bangs here have been observed to improve performance
-- significantly in optimized builds.
let kind_co = mkSymCo $
liftCoSubst Nominal lc (tyCoBinderType binder)
liftCoSubst Nominal lc (tyCoBinderType binder)
!casted_xi = xi `mkCastTy` kind_co
casted_co = mkCoherenceLeftCo role xi kind_co co
......
......@@ -832,7 +832,7 @@ occAnalNonRecBind env lvl imp_rule_edges bndr rhs body_usage
certainly_inline -- See Note [Cascading inlines]
= case occ of
OneOcc { occ_in_lam = NotInsideLam, occ_one_br = InOneBranch }
OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1 }
-> active && not_stable
_ -> False
......@@ -2563,7 +2563,7 @@ mkOneOcc id int_cxt arity
= emptyDetails
where
occ_info = OneOcc { occ_in_lam = NotInsideLam
, occ_one_br = InOneBranch
, occ_n_br = oneBranch
, occ_int_cxt = int_cxt
, occ_tail = AlwaysTailCalled arity }
......@@ -2967,11 +2967,15 @@ addOccInfo a1 a2 = ASSERT( not (isDeadOcc a1 || isDeadOcc a2) )
-- (orOccInfo orig new) is used
-- when combining occurrence info from branches of a case
orOccInfo (OneOcc { occ_in_lam = in_lam1, occ_int_cxt = int_cxt1
, occ_tail = tail1 })
(OneOcc { occ_in_lam = in_lam2, occ_int_cxt = int_cxt2
, occ_tail = tail2 })
= OneOcc { occ_one_br = MultipleBranches -- because it occurs in both branches
orOccInfo (OneOcc { occ_in_lam = in_lam1
, occ_n_br = nbr1
, occ_int_cxt = int_cxt1
, occ_tail = tail1 })
(OneOcc { occ_in_lam = in_lam2
, occ_n_br = nbr2
, occ_int_cxt = int_cxt2
, occ_tail = tail2 })
= OneOcc { occ_n_br = nbr1 + nbr2
, occ_in_lam = in_lam1 `mappend` in_lam2
, occ_int_cxt = int_cxt1 `mappend` int_cxt2
, occ_tail = tail1 `andTailCallInfo` tail2 }
......
......@@ -658,8 +658,8 @@ lvlMFE env strict_ctxt e@(_, AnnCase {})
lvlMFE env strict_ctxt ann_expr
| floatTopLvlOnly env && not (isTopLvl dest_lvl)
-- Only floating to the top level is allowed.
|| anyDVarSet isJoinId fvs -- If there is a free join, don't float
-- See Note [Free join points]
|| hasFreeJoin env fvs -- If there is a free join, don't float
-- See Note [Free join points]
|| isExprLevPoly expr
-- We can't let-bind levity polymorphic expressions
-- See Note [Levity polymorphism invariants] in GHC.Core
......@@ -755,6 +755,14 @@ lvlMFE env strict_ctxt ann_expr
&& floatConsts env
&& (not strict_ctxt || is_bot || exprIsHNF expr)
hasFreeJoin :: LevelEnv -> DVarSet -> Bool
-- Has a free join point which is not being floated to top level.
-- (In the latter case it won't be a join point any more.)
-- Not treating top-level ones specially had a massive effect
-- on nofib/minimax/Prog.prog
hasFreeJoin env fvs
= not (maxFvLevel isJoinId env fvs == tOP_LEVEL)
isBottomThunk :: Maybe (Arity, s) -> Bool
-- See Note [Bottoming floats] (2)
isBottomThunk (Just (0, _)) = True -- Zero arity
......
This diff is collapsed.
This diff is collapsed.
......@@ -433,7 +433,7 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst })
safe_to_inline IAmALoopBreaker{} = False
safe_to_inline IAmDead = True
safe_to_inline OneOcc{ occ_in_lam = NotInsideLam
, occ_one_br = InOneBranch } = True
, occ_n_br = 1 } = True
safe_to_inline OneOcc{} = False
safe_to_inline ManyOccs{} = False
......
......@@ -68,7 +68,7 @@ module GHC.Types.Basic (
isNoOccInfo, strongLoopBreaker, weakLoopBreaker,
InsideLam(..),
OneBranch(..),
BranchCount, oneBranch,
InterestingCxt(..),
TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,
isAlwaysTailCalled,
......@@ -978,7 +978,7 @@ data OccInfo
-- lambda and case-bound variables.
| OneOcc { occ_in_lam :: !InsideLam
, occ_one_br :: !OneBranch
, occ_n_br :: {-# UNPACK #-} !BranchCount
, occ_int_cxt :: !InterestingCxt
, occ_tail :: !TailCallInfo }
-- ^ Occurs exactly once (per branch), not inside a rule
......@@ -992,6 +992,16 @@ data OccInfo
type RulesOnly = Bool
type BranchCount = Int
-- For OneOcc, the BranchCount says how many syntactic occurrences there are
-- At the moment we really only check for 1 or >1, but in principle
-- we could pay attention to how *many* occurences there are
-- (notably in postInlineUnconditionally).
-- But meanwhile, Ints are very efficiently represented.
oneBranch :: BranchCount
oneBranch = 1
{-
Note [LoopBreaker OccInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -1057,14 +1067,6 @@ instance Monoid InsideLam where
mempty = NotInsideLam
mappend = (Semi.<>)
-----------------
data OneBranch
= InOneBranch
-- ^ One syntactic occurrence: Occurs in only one case branch
-- so no code-duplication issue to worry about
| MultipleBranches
deriving (Eq)
-----------------
data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]
| NoTailCallInfo
......@@ -1124,12 +1126,10 @@ instance Outputable OccInfo where
pp_ro | rule_only = char '!'
| otherwise = empty
ppr (OneOcc inside_lam one_branch int_cxt tail_info)
= text "Once" <> pp_lam inside_lam <> pp_br one_branch <> pp_args int_cxt <> pp_tail
= text "Once" <> pp_lam inside_lam <> ppr one_branch <> pp_args int_cxt <> pp_tail
where
pp_lam IsInsideLam = char 'L'
pp_lam NotInsideLam = empty
pp_br MultipleBranches = char '*'
pp_br InOneBranch = empty
pp_args IsInteresting = char '!'
pp_args NotInteresting = empty
pp_tail = pprShortTailCallInfo tail_info
......@@ -1156,7 +1156,7 @@ AlwaysTailCalled.
Note that there is a 'TailCallInfo' on a 'ManyOccs' value. One might expect that
being tail-called would mean that the variable could only appear once per branch
(thus getting a `OneOcc { occ_one_br = True }` occurrence info), but a join
(thus getting a `OneOcc { }` occurrence info), but a join
point can also be invoked from other join points, not just from case branches:
let j1 x = ...
......@@ -1167,7 +1167,7 @@ point can also be invoked from other join points, not just from case branches:
C -> j2 q
Here both 'j1' and 'j2' will get marked AlwaysTailCalled, but j1 will get
ManyOccs and j2 will get `OneOcc { occ_one_br = True }`.
ManyOccs and j2 will get `OneOcc { occ_n_br = 2 }`.
************************************************************************
* *
......
......@@ -1285,14 +1285,14 @@ splitDmdTy ty@(DmdType _ [] res_ty) = (defaultArgDmd res_ty, ty)
deferAfterPreciseException :: DmdType -> DmdType
deferAfterPreciseException = lubDmdType exnDmdType
strictenDmd :: Demand -> CleanDemand
strictenDmd :: Demand -> Demand
strictenDmd (JD { sd = s, ud = u})
= JD { sd = poke_s s, ud = poke_u u }
where
poke_s Lazy = HeadStr
poke_s (Str s) = s
poke_u Abs = UHead
poke_u (Use _ u) = u
poke_s Lazy = Str HeadStr
poke_s s = s
poke_u Abs = useTop
poke_u u = u
-- Deferring and peeling
......
......@@ -58,7 +58,7 @@ module GHC.Types.Id.Info (
isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
occInfo, setOccInfo,
InsideLam(..), OneBranch(..),
InsideLam(..), BranchCount,
TailCallInfo(..),
tailCallInfo, isAlwaysTailCalled,
......
......@@ -82,7 +82,7 @@ plusOne :: Natural -> Natural
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (n [Occ=Once] :: Natural) -> naturalAdd n M.minusOne1}]
Tmpl= \ (n [Occ=Once1] :: Natural) -> naturalAdd n M.minusOne1}]
plusOne = \ (n :: Natural) -> naturalAdd n M.minusOne1
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
......
......@@ -48,7 +48,7 @@ dr :: Double -> Double
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once!] :: Double) ->
Tmpl= \ (x [Occ=Once1!] :: Double) ->
case x of { GHC.Types.D# x1 ->
GHC.Types.D# (GHC.Prim.+## x1 x1)
}}]
......@@ -65,7 +65,7 @@ dl :: Double -> Double
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once!] :: Double) ->
Tmpl= \ (x [Occ=Once1!] :: Double) ->
case x of { GHC.Types.D# y -> GHC.Types.D# (GHC.Prim.+## y y) }}]
dl = dr
......@@ -78,7 +78,7 @@ fr :: Float -> Float
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once!] :: Float) ->
Tmpl= \ (x [Occ=Once1!] :: Float) ->
case x of { GHC.Types.F# x1 ->
GHC.Types.F# (GHC.Prim.plusFloat# x1 x1)
}}]
......@@ -97,7 +97,7 @@ fl :: Float -> Float
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
Tmpl= \ (x [Occ=Once!] :: Float) ->
Tmpl= \ (x [Occ=Once1!] :: Float) ->
case x of { GHC.Types.F# y ->
GHC.Types.F# (GHC.Prim.plusFloat# y y)
}}]
......
-- Exponential with GHC 8.10
module RegBig where
import Prelude
import Control.Applicative
import T10421_Form
import T10421_Y
data Register
= Register String
String
String
String
String
String
String
String
String
String
String
String
registerForm :: a -> IO (FormResult Register)
registerForm _ = do
(a1, _) <- mreq textField "" Nothing
(a2, _) <- mreq textField "" Nothing
(a3, _) <- mreq textField "" Nothing
(a4, _) <- mreq textField "" Nothing
(a5, _) <- mreq textField "" Nothing
(a6, _) <- mreq textField "" Nothing
(a7, _) <- mreq textField "" Nothing
(a8, _) <- mreq textField "" Nothing
(a9, _) <- mreq textField "" Nothing
(a10, _) <- mreq textField "" Nothing
(a11, _) <- mreq textField "" Nothing
(a12, _) <- mreq textField "" Nothing
return (Register <$> a1
<*> a2
<*> a3
<*> a4
<*> a5
<*> a6
<*> a7
<*> a8
<*> a9
<*> a10
<*> a11
<*> a12
)
-- Form.hs
module T10421_Form where
import Control.Applicative
data FormResult a = FormMissing
| FormFailure [String]
| FormSuccess a
instance Functor FormResult where
fmap _ FormMissing = FormMissing
fmap _ (FormFailure errs) = FormFailure errs
fmap f (FormSuccess a) = FormSuccess $ f a
instance Applicative FormResult where
pure = FormSuccess
(FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
(FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
(FormFailure x) <*> _ = FormFailure x
_ <*> (FormFailure y) = FormFailure y
_ <*> _ = FormMissing
-- Y.hs
{-# OPTIONS_GHC -fomit-interface-pragmas #-}
-- Imagine the values defined in this module are complicated
-- and there is no useful inlining/strictness/etc. information
module T10421_Y where
import T10421_Form
mreq :: a -> b -> c -> IO (FormResult d, ())
mreq = undefined
mopt :: a -> b -> c -> IO (FormResult d, ())
mopt = undefined
textField = undefined
checkBoxField = undefined
-- Exponential with GHC 8.10
--
-- This is a smaller version of T10421, but demonstrates the same blow-up
module RegBig where
import Prelude
import Control.Applicative
import T10421a_Form
data Register
= Register String
String
String
String
String
String
String
String
String
String
String
String
registerForm :: FormResult String -- a1
-> FormResult String
-> FormResult String -- a3
-> FormResult String
-> FormResult String
-> FormResult String -- a6
-> FormResult String -- a7
-> FormResult String
-> FormResult String
-> FormResult String
-> FormResult String
-> FormResult String -- a12
-> IO (FormResult Register)
registerForm a1 a2 a3 a4 a5 a6 a7
a8 a9 a10 a11 a12
= return (Register <$> a1
<*> a2
<*> a3
<*> a4
<*> a5
<*> a6
<*> a7
<*> a8
<*> a9
<*> a10
<*> a11
<*> a12
)
-- Form.hs
module T10421a_Form where
import Control.Applicative
data FormResult a = FormMissing
| FormFailure [String]
| FormSuccess a
instance Functor FormResult where
fmap _ FormMissing = FormMissing
fmap _ (FormFailure errs) = FormFailure errs
fmap f (FormSuccess a) = FormSuccess $ f a
instance Applicative FormResult where
pure = FormSuccess
(FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
(FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
(FormFailure x) <*> _ = FormFailure x
_ <*> (FormFailure y) = FormFailure y
_ <*> _ = FormMissing
-- Exponential with GHC 8.10
module T13253 where
f :: Int -> Bool -> Bool
{-# INLINE f #-}
f y x = case x of { True -> y>0 ; False -> y<0 }
foo y x = f (y+1) $
f (y+2) $
f (y+3) $
f (y+4) $
f (y+5) $
f (y+6) $
f (y+7) $
f (y+8) $
f (y+9) $
f (y+10) $
f (y+11) $
f y x
-- Exponential with GHC 8.10
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module T13253 where
import Control.Monad (liftM)
import Control.Monad.Trans.RWS.Lazy -- check how strict behaves
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Class (MonadTrans (..))
import Data.ByteString (ByteString)
import Data.Monoid (Any (..))
import Data.Semigroup (Semigroup (..))
import Data.String (IsString (..))
import System.Environment (getEnv)
type Handler = ReaderT () IO
type MForm = RWST (Maybe ([(String, Text)], ()), (), ()) Any [Int]
type Text = ByteString -- close enough
data HugeStruct = HugeStruct
!Text
!Text
!Text
!Text
!Text
!Text
!Text
!Text
!Text -- 9th
!Text
!Text
data FormResult a = FormMissing
| FormFailure [Text]
| FormSuccess a
deriving Show
instance Functor FormResult where
fmap _ FormMissing = FormMissing
fmap _ (FormFailure errs) = FormFailure errs
fmap f (FormSuccess a) = FormSuccess $ f a
instance Applicative FormResult where
pure = FormSuccess
(FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g
(FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y
(FormFailure x) <*> _ = FormFailure x
_ <*> (FormFailure y) = FormFailure y
_ <*> _ = FormMissing
instance Monoid m => Monoid (FormResult m) where
mempty = pure mempty
mappend = (<>)
instance Semigroup m => Semigroup (FormResult m) where
x <> y = (<>) <$> x <*> y
mreq :: MonadIO m => String -> MForm m (FormResult Text, ())
-- fast
--mreq v = pure (FormFailure [], ())
-- slow
mreq v = mhelper v (\m l -> FormFailure ["fail"]) FormSuccess
askParams :: Monad m => MForm m (Maybe [(String, Text)])
askParams = do
(x, _, _) <- ask
return $ liftM fst x
mhelper
:: MonadIO m
=> String
-> (() -> () -> FormResult b) -- on missing
-> (Text -> FormResult b) -- on success
-> MForm m (FormResult b, ())
mhelper v onMissing onFound = do
-- without tell, also faster
tell (Any True)
-- with different "askParams": faster.
-- mp <- liftIO $ read <$> readFile v
mp <- askParams
(res, x) <- case mp of
Nothing -> return (FormMissing, ())
Just p -> do
return $ case lookup v p of
Nothing -> (onMissing () (), ())
Just t -> (onFound t, ())
return (res, x)
-- not inlining, also faster:
-- {-# NOINLINE mhelper #-}
sampleForm2 :: MForm Handler (FormResult HugeStruct)
sampleForm2 = do
(x01, _) <- mreq "UNUSED"
(x02, _) <- mreq "UNUSED"
(x03, _) <- mreq "UNUSED"
(x04, _) <- mreq "UNUSED"
(x05, _) <- mreq "UNUSED"
(x06, _) <- mreq "UNUSED"
(x07, _) <- mreq "UNUSED"
(x08, _) <- mreq "UNUSED"
(x09, _) <- mreq "UNUSED"
(x10, _) <- mreq "UNUSED"
(x11, _) <- mreq "UNUSED"
let hugeStructRes = HugeStruct
<$> x01
<*> x02
<*> x03
<*> x04
<*> x05
<*> x06
<*> x07
<*> x08
<*> x09
<*> x10
<*> x11
pure hugeStructRes
main :: IO ()
main = pure ()
-- Exponential with GHC 8.10
{-# LANGUAGE BangPatterns #-}
module T18140 where
data D = D
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
!(Maybe Bool)
maMB :: Maybe Bool -> Maybe Bool -> Maybe Bool
maMB Nothing y = y
maMB x Nothing = x
maMB (Just x) (Just y) = Just (maB x y)
maB :: Bool -> Bool -> Bool
maB _ y = y
maD :: D -> D -> D
maD (D x'1 x'2 x'3 x'4 x'5 x'6 x'7 x'8 x'9 x'10 x'11 x'12 x'13 x'14 x'15 x'16 x'17 x'18)
(D y'1 y'2 y'3 y'4 y'5 y'6 y'7 y'8 y'9 y'10 y'11 y'12 y'13 y'14 y'15 y'16 y'17 y'18)
= D
(maMB x'1 y'1)
(maMB x'2 y'2)
(maMB x'3 y'3)
(maMB x'4 y'4)
(maMB x'5 y'5)
(maMB x'6 y'6)
(maMB x'7 y'7)
(maMB x'8 y'8)
(maMB x'9 y'9)
(maMB x'10 y'10)
(maMB x'11 y'11)
(maMB x'12 y'12)
(maMB x'13 y'13)
(maMB x'14 y'14)
(maMB x'15 y'15)
(maMB x'16 y'16)
(maMB x'17 y'17)
(maMB x'18 y'18)
......@@ -388,3 +388,30 @@ test ('T18282',
],
compile,
['-v0 -O'])
test ('T18140',
[ collect_compiler_stats('bytes allocated',2)
],
compile,
['-v0 -O'])
test('T10421',
[ only_ways(['normal']),
collect_compiler_stats('bytes allocated', 1)
],
multimod_compile,
['T10421', '-v0 -O'])
test('T10421a',
[ only_ways(['normal']),
collect_compiler_stats('bytes allocated', 1)
],
multimod_compile,
['T10421a', '-v0 -O'])
test ('T13253',
[ collect_compiler_stats('bytes allocated',2)
],
compile,
['-v0 -O'])
test ('T13253-spj',
[ collect_compiler_stats('bytes allocated',2)
],
compile,
['-v0 -O'])
......@@ -94,11 +94,11 @@ g [InlPrag=NOUSERINLINE[2]] :: Bool -> Bool -> Int -> Int
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
Tmpl= \ (w [Occ=Once] :: Bool)
(w1 [Occ=Once] :: Bool)
(w2 [Occ=Once!] :: Int) ->
case w2 of { GHC.Types.I# ww1 [Occ=Once] ->
case T13143.$wg w w1 ww1 of ww2 [Occ=Once] { __DEFAULT ->
Tmpl= \ (w [Occ=Once1] :: Bool)
(w1 [Occ=Once1] :: Bool)
(w2 [Occ=Once1!] :: Int) ->
case w2 of { GHC.Types.I# ww1 [Occ=Once1] ->
case T13143.$wg w w1 ww1 of ww2 [Occ=Once1] { __DEFAULT ->
GHC.Types.I# ww2
}
}}]
......
......@@ -3,5 +3,5 @@
case GHC.List.reverse1 @a w (GHC.Types.[] @a) of {
[] -> case Foo.f1 @a of { GHC.Types.I# v1 -> GHC.Prim.+# ww2 v1 };
case GHC.List.$wlenAcc
case Foo.$wf @a w of ww [Occ=Once] { __DEFAULT ->
case Foo.$wf @a w of ww [Occ=Once1] { __DEFAULT ->
case Foo.$wf @a w of ww { __DEFAULT -> GHC.Types.I# ww }
(wombat1 [Occ=Once*!] :: T -> t)
(wombat1 [Occ=Once3!] :: T -> t)
A -> wombat1 T17901.A;
B -> wombat1 T17901.B;
C -> wombat1 T17901.C
= \ (@t) (wombat1 :: T -> t) (x :: T) ->
case x of wild { __DEFAULT -> wombat1 wild }
Tmpl= \ (@t) (wombat2 [Occ=Once!] :: S -> t) (x [Occ=Once] :: S) ->
case x of wild [Occ=Once] { __DEFAULT -> wombat2 wild }}]
(wombat2 [Occ=Once1!] :: S -> t)
case x of wild [Occ=Once1] { __DEFAULT -> wombat2 wild }}]
= \ (@t) (wombat2 :: S -> t) (x :: S) ->
case x of wild { __DEFAULT -> wombat2 wild }
Tmpl= \ (@t) (wombat3 [Occ=Once!] :: W -> t) (x [Occ=Once] :: W) ->
case x of wild [Occ=Once] { __DEFAULT -> wombat3 wild }}]
(wombat3 [Occ=Once1!] :: W -> t)
case x of wild [Occ=Once1] { __DEFAULT -> wombat3 wild }}]
= \ (@t) (wombat3 :: W -> t) (x :: W) ->
case x of wild { __DEFAULT -> wombat3 wild }