summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorReid Barton <rwbarton@gmail.com>2017-03-01 08:23:51 -0500
committerReid Barton <rwbarton@gmail.com>2017-03-01 08:26:45 -0500
commit85c486a16bff96281c53baf8b385a39f259d39be (patch)
tree61a5382a878dfc9a909bdd2146effd41167d96b3
parent701256df88c61a2eee4cf00a59e61ef76a57b4b4 (diff)
downloadhaskell-wip/rwbarton-D1259.tar.gz
-rw-r--r--compiler/deSugar/Desugar.hs7
-rw-r--r--compiler/deSugar/DsBinds.hs24
-rw-r--r--compiler/deSugar/DsExpr.hs2
-rw-r--r--compiler/deSugar/DsListComp.hs2
-rw-r--r--compiler/deSugar/DsMonad.hs22
-rw-r--r--compiler/deSugar/DsUtils.hs39
-rw-r--r--compiler/deSugar/MatchLit.hs6
-rw-r--r--compiler/simplCore/CSE.hs9
-rw-r--r--compiler/simplCore/SimplUtils.hs8
-rw-r--r--compiler/typecheck/TcRnTypes.hs44
-rw-r--r--libraries/base/Data/OldList.hs4
-rw-r--r--testsuite/tests/codeGen/should_run/cgrun057.stderr2
-rw-r--r--testsuite/tests/deSugar/should_compile/Makefile8
-rw-r--r--testsuite/tests/deSugar/should_compile/T10844.hs13
-rw-r--r--testsuite/tests/deSugar/should_compile/T10844.stdout1
-rw-r--r--testsuite/tests/deSugar/should_compile/T10844a.hs8
-rw-r--r--testsuite/tests/deSugar/should_compile/all.T3
-rw-r--r--testsuite/tests/numeric/should_compile/T7116.stdout88
-rw-r--r--testsuite/tests/profiling/should_run/scc001.prof.sample45
-rw-r--r--testsuite/tests/roles/should_compile/Roles13.stderr90
-rw-r--r--testsuite/tests/simplCore/should_compile/T13143.stderr111
-rw-r--r--testsuite/tests/simplCore/should_compile/T3234.stderr16
-rw-r--r--testsuite/tests/simplCore/should_compile/T3717.stderr84
-rw-r--r--testsuite/tests/simplCore/should_compile/T3772.stdout4
-rw-r--r--testsuite/tests/simplCore/should_compile/T4908.stderr127
-rw-r--r--testsuite/tests/simplCore/should_compile/T4930.stderr84
-rw-r--r--testsuite/tests/simplCore/should_compile/T7360.stderr72
-rw-r--r--testsuite/tests/simplCore/should_compile/T8274.stdout12
-rw-r--r--testsuite/tests/simplCore/should_compile/T9400.stderr54
-rw-r--r--testsuite/tests/simplCore/should_compile/noinline01.stderr16
-rw-r--r--testsuite/tests/simplCore/should_compile/par01.stderr24
-rw-r--r--testsuite/tests/simplCore/should_compile/rule2.stderr2
-rw-r--r--testsuite/tests/simplCore/should_compile/spec-inline.stderr230
-rw-r--r--testsuite/tests/th/TH_Roles2.stderr4
-rw-r--r--testsuite/tests/th/all.T2
35 files changed, 702 insertions, 565 deletions
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index d5931d16e5..a02b1625a9 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -127,6 +127,7 @@ deSugar hsc_env
; (msgs, mb_res)
<- initDs hsc_env mod rdr_env type_env
fam_inst_env complete_matches $
+ withTopBinds $
do { ds_ev_binds <- dsEvBinds ev_binds
; core_prs <- dsTopLHsBinds binds_cvr
; (spec_prs, spec_rules) <- dsImpSpecs imp_specs
@@ -143,15 +144,15 @@ deSugar hsc_env
; case mb_res of {
Nothing -> return (msgs, Nothing) ;
- Just (ds_ev_binds, all_prs, all_rules, vects0, ds_fords) ->
+ Just ((ds_ev_binds, all_prs, all_rules, vects0, ds_fords), ds_top_binds) ->
do { -- Add export flags to bindings
keep_alive <- readIORef keep_var
; let (rules_for_locals, rules_for_imps) = partition isLocalRule all_rules
final_prs = addExportFlagsAndRules target export_set keep_alive
rules_for_locals (fromOL all_prs)
-
- final_pgm = combineEvBinds ds_ev_binds final_prs
+ final_binds = ds_ev_binds ++ ds_top_binds
+ final_pgm = combineEvBinds final_binds final_prs
-- Notice that we put the whole lot in a big Rec, even the foreign binds
-- When compiling PrelFloat, which defines data Float = F# Float#
-- we want F# to be in scope in the foreign marshalling code!
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 0b115cb902..3414d55b63 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -41,6 +41,7 @@ import PrelNames
import TyCon
import TcEvidence
import TcType
+import TcRnMonad
import Type
import Coercion
import TysWiredIn ( typeNatKind, typeSymbolKind )
@@ -61,7 +62,6 @@ import BasicTypes
import DynFlags
import FastString
import Util
-import MonadUtils
import qualified GHC.LanguageExtensions as LangExt
import Control.Monad
@@ -1151,7 +1151,7 @@ dsEvTerm (EvId v) = return (Var v)
dsEvTerm (EvCallStack cs) = dsEvCallStack cs
dsEvTerm (EvTypeable ty ev) = dsEvTypeable ty ev
dsEvTerm (EvLit (EvNum n)) = mkNaturalExpr n
-dsEvTerm (EvLit (EvStr s)) = mkStringExprFS s
+dsEvTerm (EvLit (EvStr s)) = mkStringExprFSAtTopLevel s
dsEvTerm (EvCast tm co)
= do { tm' <- dsEvTerm tm
@@ -1174,14 +1174,15 @@ dsEvTerm (EvSelector sel_id tys tms)
= do { tms' <- mapM dsEvTerm tms
; return $ Var sel_id `mkTyApps` tys `mkApps` tms' }
-dsEvTerm (EvDelayedError ty msg) = return $ dsEvDelayedError ty msg
+dsEvTerm (EvDelayedError ty msg) = dsEvDelayedError ty msg
-dsEvDelayedError :: Type -> FastString -> CoreExpr
+dsEvDelayedError :: Type -> FastString -> DsM CoreExpr
dsEvDelayedError ty msg
- = Var errorId `mkTyApps` [getRuntimeRep "dsEvTerm" ty, ty] `mkApps` [litMsg]
+ = do { litMsg <- bindExprAtTopLevel (Lit (MachStr (fastStringToByteString msg)))
+ ; return $ Var errorId `mkTyApps` [getRuntimeRep "dsEvTerm" ty, ty]
+ `mkApps` [litMsg] }
where
errorId = tYPE_ERROR_ID
- litMsg = Lit (MachStr (fastStringToByteString msg))
{-**********************************************************************
* *
@@ -1321,11 +1322,11 @@ dsEvCallStack cs = do
df <- getDynFlags
m <- getModule
srcLocDataCon <- dsLookupDataCon srcLocDataConName
- let mkSrcLoc l =
+ let mkSrcLoc l = bindExprAtTopLevel =<<
liftM (mkCoreConApps srcLocDataCon)
- (sequence [ mkStringExprFS (unitIdFS $ moduleUnitId m)
- , mkStringExprFS (moduleNameFS $ moduleName m)
- , mkStringExprFS (srcSpanFile l)
+ (sequence [ mkStringExprFSAtTopLevel (unitIdFS $ moduleUnitId m)
+ , mkStringExprFSAtTopLevel (moduleNameFS $ moduleName m)
+ , mkStringExprFSAtTopLevel (srcSpanFile l)
, return $ mkIntExprInt df (srcSpanStartLine l)
, return $ mkIntExprInt df (srcSpanStartCol l)
, return $ mkIntExprInt df (srcSpanEndLine l)
@@ -1339,7 +1340,7 @@ dsEvCallStack cs = do
mkCoreApps (Var pushCSVar) [mkCoreTup [name, loc], rest]
let mkPush name loc tm = do
- nameExpr <- mkStringExprFS name
+ nameExpr <- mkStringExprFSAtTopLevel name
locExpr <- mkSrcLoc loc
case tm of
EvCallStack EvCsEmpty -> return (pushCS nameExpr locExpr emptyCS)
@@ -1350,6 +1351,7 @@ dsEvCallStack cs = do
-- See Note [Overview of implicit CallStacks]
let ip_co = unwrapIP (exprType tmExpr)
return (pushCS nameExpr locExpr (mkCastDs tmExpr ip_co))
+
case cs of
EvCsPushCall name loc tm -> mkPush (occNameFS $ getOccName name) loc tm
EvCsEmpty -> return emptyCS
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 28254c93b4..6502c781f5 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -979,7 +979,7 @@ handle_failure :: LPat Id -> MatchResult -> SyntaxExpr Id -> DsM CoreExpr
handle_failure pat match fail_op
| matchCanFail match
= do { dflags <- getDynFlags
- ; fail_msg <- mkStringExpr (mk_fail_msg dflags pat)
+ ; fail_msg <- mkStringExprAtTopLevel (mk_fail_msg dflags pat)
; fail_expr <- dsSyntaxExpr fail_op [fail_msg]
; extractMatchResult match fail_expr }
| otherwise
diff --git a/compiler/deSugar/DsListComp.hs b/compiler/deSugar/DsListComp.hs
index 2bb303ec98..ba8085c6a2 100644
--- a/compiler/deSugar/DsListComp.hs
+++ b/compiler/deSugar/DsListComp.hs
@@ -824,7 +824,7 @@ dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts
handle_failure pat match fail_op
| matchCanFail match
= do { dflags <- getDynFlags
- ; fail_msg <- mkStringExpr (mk_fail_msg dflags pat)
+ ; fail_msg <- mkStringExprAtTopLevel (mk_fail_msg dflags pat)
; fail_expr <- dsSyntaxExpr fail_op [fail_msg]
; extractMatchResult match fail_expr }
| otherwise
diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs
index 4f68100111..7242937ee6 100644
--- a/compiler/deSugar/DsMonad.hs
+++ b/compiler/deSugar/DsMonad.hs
@@ -6,7 +6,7 @@
@DsMonad@: monadery used in desugaring
-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance MonadThings is necessarily an orphan
module DsMonad (
@@ -24,6 +24,7 @@ module DsMonad (
UniqSupply, newUniqueSupply,
getGhcModeDs, dsGetFamInstEnvs,
dsLookupGlobal, dsLookupGlobalId, dsDPHBuiltin, dsLookupTyCon, dsLookupDataCon,
+ withTopBinds,
PArrBuiltin(..),
dsLookupDPHRdrEnv, dsLookupDPHRdrEnv_maybe,
@@ -161,7 +162,7 @@ initDs :: HscEnv
initDs hsc_env mod rdr_env type_env fam_inst_env complete_matches thing_inside
= do { msg_var <- newIORef (emptyBag, emptyBag)
; let all_matches = (hptCompleteSigs hsc_env) ++ complete_matches
- ; pm_iter_var <- newIORef 0
+ ; pm_iter_var <- newIORef 0
; let dflags = hsc_dflags hsc_env
(ds_gbl_env, ds_lcl_env) = mkDsEnvs dflags mod rdr_env type_env
fam_inst_env msg_var
@@ -291,6 +292,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var pmvar complete_matches
, ds_dph_env = emptyGlobalRdrEnv
, ds_parr_bi = panic "DsMonad: uninitialised ds_parr_bi"
, ds_complete_matches = completeMatchMap
+ , ds_top_binds = Nothing
}
lcl_env = DsLclEnv { dsl_meta = emptyNameEnv
, dsl_loc = real_span
@@ -318,6 +320,22 @@ loadModule doc mod
is_dloc = wiredInSrcSpan, is_as = name }
name = moduleName mod
+-- | Run the provided action and gather any additional top-level
+-- binders generated by it.
+withTopBinds :: DsM a -> DsM (a, [CoreBind])
+-- see Note [Adding Top-Level Binders in the Desugarer]
+withTopBinds thing_inside = do
+ dflags <- getDynFlags
+ if optLevel dflags < 1
+ -- don't actually bind things at the top at -O0.
+ -- See Note [Adding Top-Level Bindings in the Desugarer]
+ then (,[]) <$> thing_inside
+ else do
+ ref <- liftIO (newIORef [])
+ a <- updGblEnv (\env -> env { ds_top_binds = Just ref }) thing_inside
+ top_binds <- liftIO (readIORef ref)
+ return (a, top_binds)
+
{-
************************************************************************
* *
diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs
index 165130aa94..331b42d922 100644
--- a/compiler/deSugar/DsUtils.hs
+++ b/compiler/deSugar/DsUtils.hs
@@ -25,6 +25,8 @@ module DsUtils (
wrapBind, wrapBinds,
mkErrorAppDs, mkCoreAppDs, mkCoreAppsDs, mkCastDs,
+ mkStringExprAtTopLevel, mkStringExprFSAtTopLevel,
+ bindExprAtTopLevel,
seqVar,
@@ -73,6 +75,8 @@ import SrcLoc
import Util
import DynFlags
import FastString
+import Data.IORef
+import TcRnMonad
import qualified GHC.LanguageExtensions as LangExt
import TcEvidence
@@ -466,10 +470,9 @@ mkErrorAppDs :: Id -- The error function
mkErrorAppDs err_id ty msg = do
src_loc <- getSrcSpanDs
dflags <- getDynFlags
- let
- full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg])
- core_msg = Lit (mkMachString full_msg)
- -- mkMachString returns a result of type String#
+ let full_msg = showSDoc dflags (hcat [ppr src_loc, vbar, msg])
+ -- mkMachString returns a result of type String#
+ core_msg <- bindExprAtTopLevel (Lit (mkMachString full_msg))
return (mkApps (Var err_id) [Type (getRuntimeRep "mkErrorAppDs" ty), Type ty, core_msg])
{-
@@ -567,6 +570,34 @@ mkCastDs :: CoreExpr -> Coercion -> CoreExpr
mkCastDs e co | isReflCo co = e
| otherwise = Cast e co
+-- | Like 'mkStringExpr' except it makes the string a new top-level binder.
+mkStringExprAtTopLevel :: String -> DsM CoreExpr
+mkStringExprAtTopLevel = mkStringExprFSAtTopLevel . fsLit
+
+-- | Like 'mkStringExprFS' except it makes the string a new top-level binder.
+mkStringExprFSAtTopLevel :: FastString -> DsM CoreExpr
+mkStringExprFSAtTopLevel str = do
+ str_expr <- mkStringExprFS str
+ bindExprAtTopLevel str_expr
+
+-- | Attempt to bind an expression at the top level.
+--
+-- @bindExprAtTopLevel e@ returns a @Var v@ where @v@ is bound to @e@
+-- if we are compiling a whole module.
+-- If we are compiling an individual expression, e.g. in GHCi,
+-- it returns @e@ unmodified.
+bindExprAtTopLevel :: CoreExpr -> DsM CoreExpr
+-- see Note [Adding Top-Level Binders in the Desguarer]
+bindExprAtTopLevel expr = do
+ top_binds_var_maybe <- ds_top_binds <$> getGblEnv
+ case top_binds_var_maybe of
+ Nothing -> return expr
+ Just var -> do
+ id <- newSysLocalDs (exprType expr)
+ liftIO $ modifyIORef var ((NonRec id expr) :)
+ return (Var id)
+
+
{-
************************************************************************
* *
diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs
index 2e9a5235bf..e955a4f556 100644
--- a/compiler/deSugar/MatchLit.hs
+++ b/compiler/deSugar/MatchLit.hs
@@ -73,7 +73,7 @@ See also below where we look for @DictApps@ for \tr{plusInt}, etc.
-}
dsLit :: HsLit -> DsM CoreExpr
-dsLit (HsStringPrim _ s) = return (Lit (MachStr s))
+dsLit (HsStringPrim _ s) = bindExprAtTopLevel (Lit (MachStr s))
dsLit (HsCharPrim _ c) = return (Lit (MachChar c))
dsLit (HsIntPrim _ i) = return (Lit (MachInt i))
dsLit (HsWordPrim _ w) = return (Lit (MachWord w))
@@ -83,7 +83,7 @@ dsLit (HsFloatPrim f) = return (Lit (MachFloat (fl_value f)))
dsLit (HsDoublePrim d) = return (Lit (MachDouble (fl_value d)))
dsLit (HsChar _ c) = return (mkCharExpr c)
-dsLit (HsString _ str) = mkStringExprFS str
+dsLit (HsString _ str) = mkStringExprFSAtTopLevel str
dsLit (HsInteger _ i _) = mkIntegerExpr i
dsLit (HsInt _ i) = do dflags <- getDynFlags
return (mkIntExpr dflags i)
@@ -366,7 +366,7 @@ matchLiterals (var:vars) ty sub_groups
= do { -- We now have to convert back to FastString. Perhaps there
-- should be separate MachBytes and MachStr constructors?
let s' = mkFastStringByteString s
- ; lit <- mkStringExprFS s'
+ ; lit <- mkStringExprFSAtTopLevel s'
; let pred = mkApps (Var eq_str) [Var var, lit]
; return (mkGuardedMatchResult pred mr) }
wrap_str_guard _ (l, _) = pprPanic "matchLiterals/wrap_str_guard" (ppr l)
diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs
index b8e26b593e..6603abf14a 100644
--- a/compiler/simplCore/CSE.hs
+++ b/compiler/simplCore/CSE.hs
@@ -294,11 +294,14 @@ cseProgram binds = snd (mapAccumL (cseBind True) emptyCSEnv binds)
cseBind :: Bool -> CSEnv -> CoreBind -> (CSEnv, CoreBind)
cseBind toplevel env (NonRec b e)
- = (env2, NonRec b2 e1)
+ = (env2, NonRec b2 e2)
where
e1 = tryForCSE toplevel env e
(env1, b1) = addBinder env b
(env2, b2) = addBinding env1 b b1 e1
+ e2 -- See Note [Take care with literal strings]
+ | toplevel && exprIsLiteralString e = e
+ | otherwise = e1
cseBind _ env (Rec [(in_id, rhs)])
| noCSE in_id
@@ -402,9 +405,7 @@ the original RHS unmodified. This produces:
-}
tryForCSE :: Bool -> CSEnv -> InExpr -> OutExpr
-tryForCSE toplevel env expr
- | toplevel && exprIsLiteralString expr = expr
- -- See Note [Take care with literal strings]
+tryForCSE _toplevel env expr
| Just e <- lookupCSEnv env expr'' = mkTicks ticks e
| otherwise = expr'
-- The varToCoreExpr is needed if we have
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index 0fe262b2c7..6941f16e15 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -1030,6 +1030,12 @@ Note [Do not inline CoVars unconditionally]
Coercion variables appear inside coercions, and the RHS of a let-binding
is a term (not a coercion) so we can't necessarily inline the latter in
the former.
+
+Note [Do not inline string literals]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We float out string literals and then common them up. So we must ensure
+that preInlineUnconditionally doesn't undo the work of FloatOut by inlining
+them right back.
-}
preInlineUnconditionally :: DynFlags -> SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
@@ -1055,6 +1061,8 @@ preInlineUnconditionally dflags env top_lvl bndr rhs
-- See Note [pre/postInlineUnconditionally in gentle mode]
act = idInlineActivation bndr
try_once in_lam int_cxt -- There's one textual occurrence
+ -- See Note [Do not inline string literals]
+ | exprIsLiteralString rhs = False
| not in_lam = isNotTopLevel top_lvl || early_phase
| otherwise = int_cxt && canInlineInLam rhs
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 67eb982b91..a7c9f57a32 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -381,6 +381,9 @@ data DsGblEnv
, ds_parr_bi :: PArrBuiltin -- desugarar names for '-XParallelArrays'
, ds_complete_matches :: CompleteMatchMap
-- Additional complete pattern matches
+ , ds_top_binds :: Maybe (IORef [CoreBind])
+ -- extra top-level bindings added by the desugarer, e.g. string literals and callstacks
+ -- see Note [Adding Top-Level Bindings in the Desugarer]
}
type CompleteMatchMap = UniqFM [CompleteMatch]
@@ -391,6 +394,47 @@ mkCompleteMatchMap cms = foldl' insertMatch emptyUFM cms
insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap
insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c]
+-- Note [Adding Top-Level Bindings in the Desugarer]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Inlining can cause wasteful duplication of constant values like
+-- String literals or CallStacks. For example, if we have a function
+-- that adds a common prefix to an error message
+--
+-- myError msg = error ("some header: " ++ msg)
+--
+-- each time GHC inlines myError we will get a duplicate copy of the
+-- "some header: " literal, which can lead to a sizeable increase in
+-- binary size.
+--
+-- But why is this not already solved by FloatOut (which does indeed
+-- float such constants to the top)? The issue is that by the time
+-- FloatOut runs, myError has already been assigned a StableUnfolding
+-- that captures the string. FloatOut won't rewrite the unfolding
+-- because GHC promises to inline exactly the code the user wrote. Thus,
+-- even though we *have* floated the constant out, we are still forced
+-- to duplicate it when myError is inlined into another module, ugh!
+--
+-- Rather than changing FloatOut, we give the desugarer the ability to
+-- add new top-level bindings (stored in the new ds_top_binds field of
+-- the DsGblEnv), and pre-emptively float string literals before the
+-- unfoldings are produced.
+--
+-- We call the desugarer in two contexts: compiling an entire module, and
+-- compiling and individual expression (e.g. for ghci). In the context of
+-- an individual expression it makes no sense to add top-level bindings,
+-- so the ds_top_binds field is a Maybe.
+--
+-- The function DsUtils.bindExprAtTopLevel takes care of determining
+-- whether we can actually create a new binding, and returns a Var if
+-- able, and the original Expr otherwise.
+--
+-- The function DsMonad.withTopBinds initializes the ds_top_binds field
+-- to a fresh IORef for the duration of the wrapped action, and returns
+-- a pair of the action's result and any added top-level binders. But it
+-- only does so if we're compiling with optimizations, otherwise we don't
+-- gain anything by pre-emptively floating things and just slow down GHC.
+-- (see T1969 for an extreme example)
+
instance ContainsModule DsGblEnv where
extractModule = ds_mod
diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs
index 428d3bded9..b97ae2ab58 100644
--- a/libraries/base/Data/OldList.hs
+++ b/libraries/base/Data/OldList.hs
@@ -1135,9 +1135,9 @@ unwords (w:ws) = w ++ go ws
-- the words are on the short side.
{-# RULES
"unwords" [~1] forall ws .
- unwords ws = tailUnwords (foldr unwordsFB "" ws)
+ unwords ws = tailUnwords (foldr unwordsFB [] ws)
"unwordsList" [1] forall ws .
- tailUnwords (foldr unwordsFB "" ws) = unwords ws
+ tailUnwords (foldr unwordsFB [] ws) = unwords ws
#-}
{-# INLINE [0] tailUnwords #-}
diff --git a/testsuite/tests/codeGen/should_run/cgrun057.stderr b/testsuite/tests/codeGen/should_run/cgrun057.stderr
index 5d1656d25d..262d74912d 100644
--- a/testsuite/tests/codeGen/should_run/cgrun057.stderr
+++ b/testsuite/tests/codeGen/should_run/cgrun057.stderr
@@ -1,4 +1,4 @@
-*** Exception (reporting due to +RTS -xc): (THUNK_STATIC), stack trace:
+*** Exception (reporting due to +RTS -xc): (THUNK_2_0), stack trace:
Main.g,
called from Main.f,
called from Main.main,
diff --git a/testsuite/tests/deSugar/should_compile/Makefile b/testsuite/tests/deSugar/should_compile/Makefile
index 792d4e7bc9..40e614d4d6 100644
--- a/testsuite/tests/deSugar/should_compile/Makefile
+++ b/testsuite/tests/deSugar/should_compile/Makefile
@@ -14,3 +14,11 @@ T5252Take2:
$(RM) -f T5252Take2a.hi T5252Take2a.o
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5252Take2a.hs
'$(TEST_HC)' $(TEST_HC_OPTS) -c T5252Take2.hs
+
+T10844:
+ $(RM) -f T10844.hi T10844.o
+ $(RM) -f T10844a.hi T10844a.o
+ # check that the string "foo" appears in the simplified core
+ # of T10844a, but *not* in T10844
+ '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T10844a.hs -ddump-simpl | grep '"foo"' || true
+ '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T10844.hs -ddump-simpl | grep '"foo"' || true
diff --git a/testsuite/tests/deSugar/should_compile/T10844.hs b/testsuite/tests/deSugar/should_compile/T10844.hs
new file mode 100644
index 0000000000..fdfba8439a
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T10844.hs
@@ -0,0 +1,13 @@
+module T10844 where
+
+import T10844a
+
+-- String literals should not be inlined, the point of this test is to
+-- check that the string "foo" from T10844a does not appear in the
+-- simplified core of T10844.
+
+n :: Int
+n = 0
+{-# NOINLINE n #-}
+
+main = print (foo n)
diff --git a/testsuite/tests/deSugar/should_compile/T10844.stdout b/testsuite/tests/deSugar/should_compile/T10844.stdout
new file mode 100644
index 0000000000..26d50feff8
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T10844.stdout
@@ -0,0 +1 @@
+T10844a.$fFooInt2 = "foo"#
diff --git a/testsuite/tests/deSugar/should_compile/T10844a.hs b/testsuite/tests/deSugar/should_compile/T10844a.hs
new file mode 100644
index 0000000000..8d640d72a8
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T10844a.hs
@@ -0,0 +1,8 @@
+module T10844a where
+
+class Foo a where foo :: a -> a
+
+instance Foo Int where
+ foo 0 = error "foo"
+ foo n = n
+ {-# INLINE foo #-}
diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T
index 24b95a0112..413f71092a 100644
--- a/testsuite/tests/deSugar/should_compile/all.T
+++ b/testsuite/tests/deSugar/should_compile/all.T
@@ -96,3 +96,6 @@ test('T12944', normal, compile, [''])
test('T12950', normal, compile, [''])
test('T13043', normal, compile, [''])
test('T13215', normal, compile, [''])
+test('T10844',
+ [extra_clean(['T10844a.hi', 'T10844a.o'])],
+ run_command, ['$MAKE -s --no-print-directory T10844'])
diff --git a/testsuite/tests/numeric/should_compile/T7116.stdout b/testsuite/tests/numeric/should_compile/T7116.stdout
index 681d171350..a62569aede 100644
--- a/testsuite/tests/numeric/should_compile/T7116.stdout
+++ b/testsuite/tests/numeric/should_compile/T7116.stdout
@@ -3,50 +3,6 @@
Result size of Tidy Core
= {terms: 36, types: 19, coercions: 0, joins: 0/0}
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T7116.$trModule4 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-T7116.$trModule4 = "main"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T7116.$trModule3 :: GHC.Types.TrName
-[GblId,
- Caf=NoCafRefs,
- Str=m1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
-T7116.$trModule3 = GHC.Types.TrNameS T7116.$trModule4
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T7116.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T7116.$trModule2 = "T7116"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T7116.$trModule1 :: GHC.Types.TrName
-[GblId,
- Caf=NoCafRefs,
- Str=m1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
-T7116.$trModule1 = GHC.Types.TrNameS T7116.$trModule2
-
--- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T7116.$trModule :: GHC.Types.Module
-[GblId,
- Caf=NoCafRefs,
- Str=m,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
-T7116.$trModule
- = GHC.Types.Module T7116.$trModule3 T7116.$trModule1
-
-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
dr :: Double -> Double
[GblId,
@@ -111,5 +67,49 @@ fl :: Float -> Float
}}]
fl = fr
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T7116.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T7116.$trModule2 = "T7116"#
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T7116.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+T7116.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T7116.$trModule3 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+T7116.$trModule3 = GHC.Types.TrNameS T7116.$trModule4
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T7116.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+T7116.$trModule1 = GHC.Types.TrNameS T7116.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T7116.$trModule :: GHC.Types.Module
+[GblId,
+ Caf=NoCafRefs,
+ Str=m,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+T7116.$trModule
+ = GHC.Types.Module T7116.$trModule3 T7116.$trModule1
+
diff --git a/testsuite/tests/profiling/should_run/scc001.prof.sample b/testsuite/tests/profiling/should_run/scc001.prof.sample
index 1144774100..544f4c01f7 100644
--- a/testsuite/tests/profiling/should_run/scc001.prof.sample
+++ b/testsuite/tests/profiling/should_run/scc001.prof.sample
@@ -1,33 +1,34 @@
- Sat Jun 4 11:59 2016 Time and Allocation Profiling Report (Final)
+ Fri Feb 24 15:04 2017 Time and Allocation Profiling Report (Final)
scc001 +RTS -hc -p -RTS
total time = 0.00 secs (0 ticks @ 1000 us, 1 processor)
- total alloc = 50,888 bytes (excludes profiling overheads)
+ total alloc = 51,400 bytes (excludes profiling overheads)
COST CENTRE MODULE SRC %time %alloc
-MAIN MAIN <built-in> 0.0 1.7
+MAIN MAIN <built-in> 0.0 1.6
+CAF GHC.Show <entire-module> 0.0 1.1
+CAF GHC.IO.Handle.FD <entire-module> 0.0 67.6
CAF GHC.IO.Encoding <entire-module> 0.0 5.4
-CAF GHC.Conc.Signal <entire-module> 0.0 1.3
-CAF GHC.IO.Handle.FD <entire-module> 0.0 67.8
-main Main scc001.hs:(5,1)-(7,23) 0.0 22.5
+CAF GHC.Conc.Signal <entire-module> 0.0 1.2
+main Main scc001.hs:(5,1)-(7,23) 0.0 22.4
- individual inherited
-COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc
+ individual inherited
+COST CENTRE MODULE SRC no. entries %time %alloc %time %alloc
-MAIN MAIN <built-in> 46 0 0.0 1.7 0.0 100.0
- CAF Main <entire-module> 91 0 0.0 0.1 0.0 0.1
- (...) Main scc001.hs:16:1-16 97 1 0.0 0.0 0.0 0.0
- h Main scc001.hs:16:1-16 96 1 0.0 0.0 0.0 0.0
- main Main scc001.hs:(5,1)-(7,23) 92 1 0.0 0.0 0.0 0.0
- CAF GHC.Show <entire-module> 88 0 0.0 0.6 0.0 0.6
- CAF GHC.IO.Handle.FD <entire-module> 85 0 0.0 67.8 0.0 67.8
- CAF GHC.IO.Handle.Text <entire-module> 84 0 0.0 0.2 0.0 0.2
- CAF GHC.Conc.Signal <entire-module> 82 0 0.0 1.3 0.0 1.3
- CAF GHC.IO.Encoding <entire-module> 79 0 0.0 5.4 0.0 5.4
- CAF GHC.IO.Encoding.Iconv <entire-module> 65 0 0.0 0.5 0.0 0.5
- main Main scc001.hs:(5,1)-(7,23) 93 0 0.0 22.5 0.0 22.5
- f Main scc001.hs:10:1-7 94 1 0.0 0.0 0.0 0.0
- g Main scc001.hs:13:1-7 95 1 0.0 0.0 0.0 0.0
+MAIN MAIN <built-in> 110 0 0.0 1.6 0.0 100.0
+ CAF Main <entire-module> 219 0 0.0 0.1 0.0 0.9
+ (...) Main scc001.hs:16:1-16 225 1 0.0 0.0 0.0 0.0
+ main Main scc001.hs:(5,1)-(7,23) 220 1 0.0 0.9 0.0 0.9
+ f Main scc001.hs:10:1-7 222 1 0.0 0.0 0.0 0.0
+ g Main scc001.hs:13:1-7 223 1 0.0 0.0 0.0 0.0
+ h Main scc001.hs:16:1-16 224 1 0.0 0.0 0.0 0.0
+ CAF GHC.Conc.Signal <entire-module> 214 0 0.0 1.2 0.0 1.2
+ CAF GHC.IO.Encoding <entire-module> 204 0 0.0 5.4 0.0 5.4
+ CAF GHC.IO.Encoding.Iconv <entire-module> 202 0 0.0 0.4 0.0 0.4
+ CAF GHC.IO.Handle.FD <entire-module> 194 0 0.0 67.6 0.0 67.6
+ CAF GHC.IO.Handle.Text <entire-module> 192 0 0.0 0.2 0.0 0.2
+ CAF GHC.Show <entire-module> 177 0 0.0 1.1 0.0 1.1
+ main Main scc001.hs:(5,1)-(7,23) 221 0 0.0 21.6 0.0 21.6
diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr
index f336a69be1..c364feaa75 100644
--- a/testsuite/tests/roles/should_compile/Roles13.stderr
+++ b/testsuite/tests/roles/should_compile/Roles13.stderr
@@ -11,10 +11,10 @@ convert1 = \ (ds :: Wrap Age) -> ds
-- RHS size: {terms: 1, types: 0, coercions: 5, joins: 0/0}
convert :: Wrap Age -> Int
[GblId, Arity=1, Caf=NoCafRefs]
-convert =
- convert1
- `cast` (<Wrap Age>_R -> Roles13.N:Wrap[0] Roles13.N:Age[0]
- :: ((Wrap Age -> Wrap Age) :: *) ~R# ((Wrap Age -> Int) :: *))
+convert
+ = convert1
+ `cast` (<Wrap Age>_R -> Roles13.N:Wrap[0] Roles13.N:Age[0]
+ :: ((Wrap Age -> Wrap Age) :: *) ~R# ((Wrap Age -> Int) :: *))
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule1 :: GHC.Prim.Addr#
@@ -59,28 +59,28 @@ $tcAge2 = GHC.Types.TrNameS $tcAge1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
Roles13.$tcAge :: GHC.Types.TyCon
[GblId, Caf=NoCafRefs]
-Roles13.$tcAge =
- GHC.Types.TyCon
- 3456257068627873222##
- 14056710845110756026##
- Roles13.$trModule
- $tcAge2
- 0#
- krep
+Roles13.$tcAge
+ = GHC.Types.TyCon
+ 3456257068627873222##
+ 14056710845110756026##
+ Roles13.$trModule
+ $tcAge2
+ 0#
+ krep
-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
krep1 :: GHC.Types.KindRep
[GblId]
-krep1 =
- GHC.Types.KindRepTyConApp
- GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep)
+krep1
+ = GHC.Types.KindRepTyConApp
+ GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep)
-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
krep2 :: GHC.Types.KindRep
[GblId, Caf=NoCafRefs]
-krep2 =
- GHC.Types.KindRepTyConApp
- Roles13.$tcAge (GHC.Types.[] @ GHC.Types.KindRep)
+krep2
+ = GHC.Types.KindRepTyConApp
+ Roles13.$tcAge (GHC.Types.[] @ GHC.Types.KindRep)
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
krep3 :: GHC.Types.KindRep
@@ -100,14 +100,14 @@ $tc'MkAge2 = GHC.Types.TrNameS $tc'MkAge1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
Roles13.$tc'MkAge :: GHC.Types.TyCon
[GblId]
-Roles13.$tc'MkAge =
- GHC.Types.TyCon
- 18264039750958872441##
- 1870189534242358050##
- Roles13.$trModule
- $tc'MkAge2
- 0#
- krep3
+Roles13.$tc'MkAge
+ = GHC.Types.TyCon
+ 18264039750958872441##
+ 1870189534242358050##
+ Roles13.$trModule
+ $tc'MkAge2
+ 0#
+ krep3
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
krep4 :: GHC.Types.KindRep
@@ -137,14 +137,14 @@ $tcWrap2 = GHC.Types.TrNameS $tcWrap1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
Roles13.$tcWrap :: GHC.Types.TyCon
[GblId, Caf=NoCafRefs]
-Roles13.$tcWrap =
- GHC.Types.TyCon
- 13773534096961634492##
- 15591525585626702988##
- Roles13.$trModule
- $tcWrap2
- 0#
- krep6
+Roles13.$tcWrap
+ = GHC.Types.TyCon
+ 13773534096961634492##
+ 15591525585626702988##
+ Roles13.$trModule
+ $tcWrap2
+ 0#
+ krep6
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
krep7 :: GHC.Types.KindRep
@@ -159,9 +159,9 @@ krep8 = GHC.Types.KindRepVar 0#
-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
krep9 :: [GHC.Types.KindRep]
[GblId, Caf=NoCafRefs]
-krep9 =
- GHC.Types.:
- @ GHC.Types.KindRep krep8 (GHC.Types.[] @ GHC.Types.KindRep)
+krep9
+ = GHC.Types.:
+ @ GHC.Types.KindRep krep8 (GHC.Types.[] @ GHC.Types.KindRep)
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
krep10 :: GHC.Types.KindRep
@@ -186,14 +186,14 @@ $tc'MkWrap2 = GHC.Types.TrNameS $tc'MkWrap1
-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0}
Roles13.$tc'MkWrap :: GHC.Types.TyCon
[GblId, Caf=NoCafRefs]
-Roles13.$tc'MkWrap =
- GHC.Types.TyCon
- 15580677875333883466##
- 808508687714473149##
- Roles13.$trModule
- $tc'MkWrap2
- 1#
- krep11
+Roles13.$tc'MkWrap
+ = GHC.Types.TyCon
+ 15580677875333883466##
+ 808508687714473149##
+ Roles13.$trModule
+ $tc'MkWrap2
+ 1#
+ krep11
diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr
index c576f56152..2660673512 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13143.stderr
@@ -27,6 +27,59 @@ f [InlPrag=INLINE[0]] :: forall a. Int -> a
Tmpl= \ (@ a) _ [Occ=Dead] -> T13143.$wf @ a GHC.Prim.void#}]
f = \ (@ a) _ [Occ=Dead] -> lvl @ a
+-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
+lvl1 :: Int
+[GblId, Str=b]
+lvl1 = T13143.$wf @ Int GHC.Prim.void#
+
+Rec {
+-- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0}
+T13143.$wg [InlPrag=[0], Occ=LoopBreaker]
+ :: Bool -> Bool -> GHC.Prim.Int# -> GHC.Prim.Int#
+[GblId, Arity=3, Str=<S,1*U><S,1*U><S,U>]
+T13143.$wg
+ = \ (w :: Bool) (w1 :: Bool) (ww :: GHC.Prim.Int#) ->
+ case w of {
+ False ->
+ case w1 of {
+ False -> T13143.$wg GHC.Types.False GHC.Types.True ww;
+ True -> GHC.Prim.+# ww 1#
+ };
+ True ->
+ case w1 of {
+ False -> T13143.$wg GHC.Types.True GHC.Types.True ww;
+ True -> case lvl1 of wild2 { }
+ }
+ }
+end Rec }
+
+-- RHS size: {terms: 14, types: 6, coercions: 0, joins: 0/0}
+g [InlPrag=INLINE[0]] :: Bool -> Bool -> Int -> Int
+[GblId,
+ Arity=3,
+ Str=<S,1*U><S,1*U><S(S),1*U(U)>m,
+ 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 { __DEFAULT -> GHC.Types.I# ww2 }
+ }}]
+g = \ (w :: Bool) (w1 :: Bool) (w2 :: Int) ->
+ case w2 of { GHC.Types.I# ww1 ->
+ case T13143.$wg w w1 ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
+ }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T13143.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T13143.$trModule2 = "T13143"#
+
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
T13143.$trModule4 :: GHC.Prim.Addr#
[GblId,
@@ -44,14 +97,6 @@ T13143.$trModule3 :: GHC.Types.TrName
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
T13143.$trModule3 = GHC.Types.TrNameS T13143.$trModule4
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T13143.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T13143.$trModule2 = "T13143"#
-
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T13143.$trModule1 :: GHC.Types.TrName
[GblId,
@@ -68,54 +113,8 @@ T13143.$trModule :: GHC.Types.Module
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
-T13143.$trModule =
- GHC.Types.Module T13143.$trModule3 T13143.$trModule1
-
--- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
-lvl1 :: Int
-[GblId, Str=b]
-lvl1 = T13143.$wf @ Int GHC.Prim.void#
-
-Rec {
--- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0}
-T13143.$wg [InlPrag=[0], Occ=LoopBreaker]
- :: Bool -> Bool -> GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=3, Str=<S,1*U><S,1*U><S,U>]
-T13143.$wg =
- \ (w :: Bool) (w1 :: Bool) (ww :: GHC.Prim.Int#) ->
- case w of {
- False ->
- case w1 of {
- False -> T13143.$wg GHC.Types.False GHC.Types.True ww;
- True -> GHC.Prim.+# ww 1#
- };
- True ->
- case w1 of {
- False -> T13143.$wg GHC.Types.True GHC.Types.True ww;
- True -> case lvl1 of wild2 { }
- }
- }
-end Rec }
-
--- RHS size: {terms: 14, types: 6, coercions: 0, joins: 0/0}
-g [InlPrag=INLINE[0]] :: Bool -> Bool -> Int -> Int
-[GblId,
- Arity=3,
- Str=<S,1*U><S,1*U><S(S),1*U(U)>m,
- 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 { __DEFAULT -> GHC.Types.I# ww2 }
- }}]
-g =
- \ (w :: Bool) (w1 :: Bool) (w2 :: Int) ->
- case w2 of { GHC.Types.I# ww1 ->
- case T13143.$wg w w1 ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
- }
+T13143.$trModule
+ = GHC.Types.Module T13143.$trModule3 T13143.$trModule1
diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr
index e79bfbbc92..3af1f3bdf0 100644
--- a/testsuite/tests/simplCore/should_compile/T3234.stderr
+++ b/testsuite/tests/simplCore/should_compile/T3234.stderr
@@ -10,13 +10,11 @@
==================== Grand total simplifier statistics ====================
-Total ticks: 55
+Total ticks: 51
-18 PreInlineUnconditionally
- 1 c
+13 PreInlineUnconditionally
1 n
1 g
- 1 a
1 xs
1 ys
1 c
@@ -30,8 +28,12 @@ Total ticks: 55
1 a
1 lvl
1 lvl
- 1 lvl
-1 PostInlineUnconditionally 1 c
+5 PostInlineUnconditionally
+ 1 c
+ 1 n
+ 1 a
+ 1 c
+ 1 c
1 UnfoldingDone 1 GHC.Base.build
5 RuleFired
1 ++
@@ -39,7 +41,7 @@ Total ticks: 55
1 fold/build
1 unpack
1 unpack-list
-5 LetFloatFromLet 5
+2 LetFloatFromLet 2
25 BetaReduction
1 a
1 c
diff --git a/testsuite/tests/simplCore/should_compile/T3717.stderr b/testsuite/tests/simplCore/should_compile/T3717.stderr
index 9bcc4f31ac..e2947b7543 100644
--- a/testsuite/tests/simplCore/should_compile/T3717.stderr
+++ b/testsuite/tests/simplCore/should_compile/T3717.stderr
@@ -3,6 +3,46 @@
Result size of Tidy Core
= {terms: 36, types: 15, coercions: 0, joins: 0/0}
+Rec {
+-- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0}
+T3717.$wfoo [InlPrag=[0], Occ=LoopBreaker]
+ :: GHC.Prim.Int# -> GHC.Prim.Int#
+[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>]
+T3717.$wfoo
+ = \ (ww :: GHC.Prim.Int#) ->
+ case ww of ds {
+ __DEFAULT -> T3717.$wfoo (GHC.Prim.-# ds 1#);
+ 0# -> 0#
+ }
+end Rec }
+
+-- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0}
+foo [InlPrag=INLINE[0]] :: Int -> Int
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=<S(S),1*U(1*U)>m,
+ 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= \ (w [Occ=Once!] :: Int) ->
+ case w of { GHC.Types.I# ww1 [Occ=Once] ->
+ case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
+ }}]
+foo
+ = \ (w :: Int) ->
+ case w of { GHC.Types.I# ww1 ->
+ case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
+ }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T3717.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T3717.$trModule2 = "T3717"#
+
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
T3717.$trModule4 :: GHC.Prim.Addr#
[GblId,
@@ -20,14 +60,6 @@ T3717.$trModule3 :: GHC.Types.TrName
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
T3717.$trModule3 = GHC.Types.TrNameS T3717.$trModule4
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T3717.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T3717.$trModule2 = "T3717"#
-
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T3717.$trModule1 :: GHC.Types.TrName
[GblId,
@@ -44,40 +76,8 @@ T3717.$trModule :: GHC.Types.Module
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
-T3717.$trModule =
- GHC.Types.Module T3717.$trModule3 T3717.$trModule1
-
-Rec {
--- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0}
-T3717.$wfoo [InlPrag=[0], Occ=LoopBreaker]
- :: GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>]
-T3717.$wfoo =
- \ (ww :: GHC.Prim.Int#) ->
- case ww of ds {
- __DEFAULT -> T3717.$wfoo (GHC.Prim.-# ds 1#);
- 0# -> 0#
- }
-end Rec }
-
--- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0}
-foo [InlPrag=INLINE[0]] :: Int -> Int
-[GblId,
- Arity=1,
- Caf=NoCafRefs,
- Str=<S(S),1*U(1*U)>m,
- 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= \ (w [Occ=Once!] :: Int) ->
- case w of { GHC.Types.I# ww1 [Occ=Once] ->
- case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
- }}]
-foo =
- \ (w :: Int) ->
- case w of { GHC.Types.I# ww1 ->
- case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
- }
+T3717.$trModule
+ = GHC.Types.Module T3717.$trModule3 T3717.$trModule1
diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout
index 44aee7b69e..d834c55b76 100644
--- a/testsuite/tests/simplCore/should_compile/T3772.stdout
+++ b/testsuite/tests/simplCore/should_compile/T3772.stdout
@@ -53,8 +53,8 @@ $wxs :: GHC.Prim.Int# -> ()
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>]
$wxs
= \ (ww :: GHC.Prim.Int#) ->
- case ww of ds1 {
- __DEFAULT -> $wxs (GHC.Prim.-# ds1 1#);
+ case ww of ds14 {
+ __DEFAULT -> $wxs (GHC.Prim.-# ds14 1#);
1# -> GHC.Tuple.()
}
end Rec }
diff --git a/testsuite/tests/simplCore/should_compile/T4908.stderr b/testsuite/tests/simplCore/should_compile/T4908.stderr
index 185b9b3529..bca3b65266 100644
--- a/testsuite/tests/simplCore/should_compile/T4908.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4908.stderr
@@ -3,6 +3,67 @@
Result size of Tidy Core
= {terms: 68, types: 43, coercions: 0, joins: 0/0}
+Rec {
+-- RHS size: {terms: 19, types: 5, coercions: 0, joins: 0/0}
+T4908.f_$s$wf [Occ=LoopBreaker] :: Int -> Int# -> Int# -> Bool
+[GblId, Arity=3, Caf=NoCafRefs, Str=<L,A><L,1*U><S,1*U>]
+T4908.f_$s$wf
+ = \ (sc :: Int) (sc1 :: Int#) (sc2 :: Int#) ->
+ case sc2 of ds {
+ __DEFAULT ->
+ case sc1 of ds1 {
+ __DEFAULT -> T4908.f_$s$wf sc ds1 (-# ds 1#);
+ 0# -> GHC.Types.True
+ };
+ 0# -> GHC.Types.True
+ }
+end Rec }
+
+-- RHS size: {terms: 24, types: 13, coercions: 0, joins: 0/0}
+T4908.$wf [InlPrag=[0]] :: Int# -> (Int, Int) -> Bool
+[GblId,
+ Arity=2,
+ Caf=NoCafRefs,
+ Str=<S,1*U><L,1*U(A,1*U(1*U))>,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 20] 101 20}]
+T4908.$wf
+ = \ (ww :: Int#) (w :: (Int, Int)) ->
+ case ww of ds {
+ __DEFAULT ->
+ case w of { (a, b) ->
+ case b of { I# ds1 ->
+ case ds1 of ds2 {
+ __DEFAULT -> T4908.f_$s$wf a ds2 (-# ds 1#);
+ 0# -> GHC.Types.True
+ }
+ }
+ };
+ 0# -> GHC.Types.True
+ }
+
+-- RHS size: {terms: 8, types: 6, coercions: 0, joins: 0/0}
+f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool
+[GblId,
+ Arity=2,
+ Caf=NoCafRefs,
+ Str=<S(S),1*U(1*U)><L,1*U(A,1*U(1*U))>,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True,
+ Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
+ Tmpl= \ (w [Occ=Once!] :: Int) (w1 [Occ=Once] :: (Int, Int)) ->
+ case w of { I# ww1 [Occ=Once] -> T4908.$wf ww1 w1 }}]
+f = \ (w :: Int) (w1 :: (Int, Int)) ->
+ case w of { I# ww1 -> T4908.$wf ww1 w1 }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T4908.$trModule2 :: Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T4908.$trModule2 = "T4908"#
+
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
T4908.$trModule4 :: Addr#
[GblId,
@@ -20,14 +81,6 @@ T4908.$trModule3 :: TrName
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
T4908.$trModule3 = GHC.Types.TrNameS T4908.$trModule4
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T4908.$trModule2 :: Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T4908.$trModule2 = "T4908"#
-
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T4908.$trModule1 :: TrName
[GblId,
@@ -44,62 +97,8 @@ T4908.$trModule :: Module
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
-T4908.$trModule =
- GHC.Types.Module T4908.$trModule3 T4908.$trModule1
-
-Rec {
--- RHS size: {terms: 19, types: 5, coercions: 0, joins: 0/0}
-T4908.f_$s$wf [Occ=LoopBreaker] :: Int -> Int# -> Int# -> Bool
-[GblId, Arity=3, Caf=NoCafRefs, Str=<L,A><L,1*U><S,1*U>]
-T4908.f_$s$wf =
- \ (sc :: Int) (sc1 :: Int#) (sc2 :: Int#) ->
- case sc2 of ds {
- __DEFAULT ->
- case sc1 of ds1 {
- __DEFAULT -> T4908.f_$s$wf sc ds1 (-# ds 1#);
- 0# -> GHC.Types.True
- };
- 0# -> GHC.Types.True
- }
-end Rec }
-
--- RHS size: {terms: 24, types: 13, coercions: 0, joins: 0/0}
-T4908.$wf [InlPrag=[0]] :: Int# -> (Int, Int) -> Bool
-[GblId,
- Arity=2,
- Caf=NoCafRefs,
- Str=<S,1*U><L,1*U(A,1*U(1*U))>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 20] 101 20}]
-T4908.$wf =
- \ (ww :: Int#) (w :: (Int, Int)) ->
- case ww of ds {
- __DEFAULT ->
- case w of { (a, b) ->
- case b of { I# ds1 ->
- case ds1 of ds2 {
- __DEFAULT -> T4908.f_$s$wf a ds2 (-# ds 1#);
- 0# -> GHC.Types.True
- }
- }
- };
- 0# -> GHC.Types.True
- }
-
--- RHS size: {terms: 8, types: 6, coercions: 0, joins: 0/0}
-f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool
-[GblId,
- Arity=2,
- Caf=NoCafRefs,
- Str=<S(S),1*U(1*U)><L,1*U(A,1*U(1*U))>,
- Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True,
- Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
- Tmpl= \ (w [Occ=Once!] :: Int) (w1 [Occ=Once] :: (Int, Int)) ->
- case w of { I# ww1 [Occ=Once] -> T4908.$wf ww1 w1 }}]
-f =
- \ (w :: Int) (w1 :: (Int, Int)) ->
- case w of { I# ww1 -> T4908.$wf ww1 w1 }
+T4908.$trModule
+ = GHC.Types.Module T4908.$trModule3 T4908.$trModule1
------ Local rules for imported ids --------
diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr
index 9db97a5e1f..bbfb9a65e8 100644
--- a/testsuite/tests/simplCore/should_compile/T4930.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4930.stderr
@@ -3,6 +3,46 @@
Result size of Tidy Core
= {terms: 44, types: 17, coercions: 0, joins: 0/0}
+Rec {
+-- RHS size: {terms: 18, types: 4, coercions: 0, joins: 0/0}
+T4930.$wfoo [InlPrag=[0], Occ=LoopBreaker]
+ :: GHC.Prim.Int# -> GHC.Prim.Int#
+[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>]
+T4930.$wfoo
+ = \ (ww :: GHC.Prim.Int#) ->
+ case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# ww 5#) of {
+ False -> GHC.Prim.+# ww 5#;
+ True -> case T4930.$wfoo ww of { __DEFAULT -> GHC.Prim.+# ww 5# }
+ }
+end Rec }
+
+-- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0}
+foo [InlPrag=INLINE[0]] :: Int -> Int
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=<S(S),1*U(U)>m,
+ 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= \ (w [Occ=Once!] :: Int) ->
+ case w of { GHC.Types.I# ww1 [Occ=Once] ->
+ case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
+ }}]
+foo
+ = \ (w :: Int) ->
+ case w of { GHC.Types.I# ww1 ->
+ case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
+ }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T4930.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T4930.$trModule2 = "T4930"#
+
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
T4930.$trModule4 :: GHC.Prim.Addr#
[GblId,
@@ -20,14 +60,6 @@ T4930.$trModule3 :: GHC.Types.TrName
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
T4930.$trModule3 = GHC.Types.TrNameS T4930.$trModule4
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T4930.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T4930.$trModule2 = "T4930"#
-
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T4930.$trModule1 :: GHC.Types.TrName
[GblId,
@@ -44,40 +76,8 @@ T4930.$trModule :: GHC.Types.Module
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
-T4930.$trModule =
- GHC.Types.Module T4930.$trModule3 T4930.$trModule1
-
-Rec {
--- RHS size: {terms: 18, types: 4, coercions: 0, joins: 0/0}
-T4930.$wfoo [InlPrag=[0], Occ=LoopBreaker]
- :: GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>]
-T4930.$wfoo =
- \ (ww :: GHC.Prim.Int#) ->
- case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# ww 5#) of {
- False -> GHC.Prim.+# ww 5#;
- True -> case T4930.$wfoo ww of { __DEFAULT -> GHC.Prim.+# ww 5# }
- }
-end Rec }
-
--- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0}
-foo [InlPrag=INLINE[0]] :: Int -> Int
-[GblId,
- Arity=1,
- Caf=NoCafRefs,
- Str=<S(S),1*U(U)>m,
- 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= \ (w [Occ=Once!] :: Int) ->
- case w of { GHC.Types.I# ww1 [Occ=Once] ->
- case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
- }}]
-foo =
- \ (w :: Int) ->
- case w of { GHC.Types.I# ww1 ->
- case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
- }
+T4930.$trModule
+ = GHC.Types.Module T4930.$trModule3 T4930.$trModule1
diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr
index 260cbd2c13..818a86d54b 100644
--- a/testsuite/tests/simplCore/should_compile/T7360.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7360.stderr
@@ -75,6 +75,19 @@ fun2
}
})
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T7360.$tcFoo1 [InlPrag=[~]] :: GHC.Types.KindRep
+[GblId, Caf=NoCafRefs, Str=m5]
+T7360.$tcFoo1 = GHC.Types.KindRepTYPE GHC.Types.LiftedRep
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T7360.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T7360.$trModule2 = "T7360"#
+
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
T7360.$trModule4 :: GHC.Prim.Addr#
[GblId,
@@ -92,14 +105,6 @@ T7360.$trModule3 :: GHC.Types.TrName
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
T7360.$trModule3 = GHC.Types.TrNameS T7360.$trModule4
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T7360.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T7360.$trModule2 = "T7360"#
-
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T7360.$trModule1 :: GHC.Types.TrName
[GblId,
@@ -119,10 +124,29 @@ T7360.$trModule :: GHC.Types.Module
T7360.$trModule
= GHC.Types.Module T7360.$trModule3 T7360.$trModule1
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T7360.$tcFoo1 [InlPrag=[~]] :: GHC.Types.KindRep
-[GblId, Caf=NoCafRefs, Str=m5]
-T7360.$tcFoo1 = GHC.Types.KindRepTYPE GHC.Types.LiftedRep
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T7360.$tc'Foo12 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T7360.$tc'Foo12 = "'Foo3"#
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T7360.$tc'Foo9 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T7360.$tc'Foo9 = "'Foo2"#
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T7360.$tc'Foo6 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T7360.$tc'Foo6 = "'Foo1"#
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
T7360.$tcFoo3 :: GHC.Prim.Addr#
@@ -164,14 +188,6 @@ T7360.$tc'Foo4
= GHC.Types.KindRepTyConApp
T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep)
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T7360.$tc'Foo6 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T7360.$tc'Foo6 = "'Foo1"#
-
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T7360.$tc'Foo5 :: GHC.Types.TrName
[GblId,
@@ -204,14 +220,6 @@ T7360.$tc'Foo7
= GHC.Types.KindRepTyConApp
T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep)
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T7360.$tc'Foo9 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T7360.$tc'Foo9 = "'Foo2"#
-
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T7360.$tc'Foo8 :: GHC.Types.TrName
[GblId,
@@ -256,14 +264,6 @@ T7360.$tc'Foo10 [InlPrag=[~]] :: GHC.Types.KindRep
[GblId, Str=m4]
T7360.$tc'Foo10 = GHC.Types.KindRepFun krep krep1
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T7360.$tc'Foo12 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T7360.$tc'Foo12 = "'Foo3"#
-
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T7360.$tc'Foo11 :: GHC.Types.TrName
[GblId,
diff --git a/testsuite/tests/simplCore/should_compile/T8274.stdout b/testsuite/tests/simplCore/should_compile/T8274.stdout
index 90d5cebefb..db6afacc1f 100644
--- a/testsuite/tests/simplCore/should_compile/T8274.stdout
+++ b/testsuite/tests/simplCore/should_compile/T8274.stdout
@@ -1,9 +1,11 @@
p = T8274.Positives 42# 4.23# 4.23## '4'# 4##
n = T8274.Negatives -4# -4.0# -4.0##
-T8274.$trModule4 :: Addr#
-T8274.$trModule4 = "main"#
T8274.$trModule2 :: Addr#
T8274.$trModule2 = "T8274"#
+T8274.$trModule4 :: Addr#
+T8274.$trModule4 = "main"#
+T8274.$tc'Positives3 :: Addr#
+T8274.$tc'Positives3 = "'Positives"#
T8274.$tcP3 :: Addr#
T8274.$tcP3 = "P"#
T8274.$tcP = GHC.Types.TyCon 7483823267324216774## 12197132127820124256## T8274.$trModule T8274.$tcP2 0# T8274.$tcP1
@@ -12,12 +14,10 @@ krep1 = GHC.Types.KindRepTyConApp GHC.Types.$tcFloat# (GHC.Types.[] @ GHC.Types.
krep2 = GHC.Types.KindRepTyConApp GHC.Types.$tcDouble# (GHC.Types.[] @ GHC.Types.KindRep)
krep3 = GHC.Types.KindRepTyConApp GHC.Types.$tcChar# (GHC.Types.[] @ GHC.Types.KindRep)
krep4 = GHC.Types.KindRepTyConApp GHC.Types.$tcWord# (GHC.Types.[] @ GHC.Types.KindRep)
-T8274.$tc'Positives3 :: Addr#
-T8274.$tc'Positives3 = "'Positives"#
= GHC.Types.TyCon 14886798270706315033## 15735393004803600911## T8274.$trModule T8274.$tc'Positives2 0# T8274.$tc'Positives1
+T8274.$tc'Negatives3 :: Addr#
+T8274.$tc'Negatives3 = "'Negatives"#
T8274.$tcN3 :: Addr#
T8274.$tcN3 = "N"#
T8274.$tcN = GHC.Types.TyCon 17387464673997143412## 16681536026493340311## T8274.$trModule T8274.$tcN2 0# T8274.$tcN1
-T8274.$tc'Negatives3 :: Addr#
-T8274.$tc'Negatives3 = "'Negatives"#
= GHC.Types.TyCon 14330047746189143983## 12207513731214201811## T8274.$trModule T8274.$tc'Negatives2 0# T8274.$tc'Negatives1
diff --git a/testsuite/tests/simplCore/should_compile/T9400.stderr b/testsuite/tests/simplCore/should_compile/T9400.stderr
index a8004dce8b..a68cbbf601 100644
--- a/testsuite/tests/simplCore/should_compile/T9400.stderr
+++ b/testsuite/tests/simplCore/should_compile/T9400.stderr
@@ -31,33 +31,33 @@ T9400.$trModule = GHC.Types.Module $trModule2 $trModule4
-- RHS size: {terms: 22, types: 15, coercions: 0, joins: 0/0}
main :: IO ()
[GblId]
-main =
- >>
- @ IO
- GHC.Base.$fMonadIO
- @ ()
- @ ()
- (putStrLn (unpackCString# "c"#))
- (>>
- @ IO
- GHC.Base.$fMonadIO
- @ ()
- @ ()
- (putStrLn (unpackCString# "x"#))
- (>>
- @ IO
- GHC.Base.$fMonadIO
- @ ()
- @ ()
- (putStrLn (unpackCString# "z"#))
- (>>
- @ IO
- GHC.Base.$fMonadIO
- @ ()
- @ ()
- (putStrLn (unpackCString# "efg"#))
- (Control.Exception.Base.patError
- @ 'LiftedRep @ (IO ()) "T9400.hs:(17,5)-(18,29)|case"#))))
+main
+ = >>
+ @ IO
+ GHC.Base.$fMonadIO
+ @ ()
+ @ ()
+ (putStrLn (unpackCString# "c"#))
+ (>>
+ @ IO
+ GHC.Base.$fMonadIO
+ @ ()
+ @ ()
+ (putStrLn (unpackCString# "x"#))
+ (>>
+ @ IO
+ GHC.Base.$fMonadIO
+ @ ()
+ @ ()
+ (putStrLn (unpackCString# "z"#))
+ (>>
+ @ IO
+ GHC.Base.$fMonadIO
+ @ ()
+ @ ()
+ (putStrLn (unpackCString# "efg"#))
+ (Control.Exception.Base.patError
+ @ 'LiftedRep @ (IO ()) "T9400.hs:(17,5)-(18,29)|case"#))))
diff --git a/testsuite/tests/simplCore/should_compile/noinline01.stderr b/testsuite/tests/simplCore/should_compile/noinline01.stderr
index 1bb98e57b4..22d799a2da 100644
--- a/testsuite/tests/simplCore/should_compile/noinline01.stderr
+++ b/testsuite/tests/simplCore/should_compile/noinline01.stderr
@@ -9,6 +9,10 @@ Noinline01.g :: GHC.Types.Bool
[GblId] =
\u [] Noinline01.f GHC.Types.False;
+Noinline01.$trModule2 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+ "Noinline01"#;
+
Noinline01.$trModule4 :: GHC.Prim.Addr#
[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
"main"#;
@@ -17,10 +21,6 @@ Noinline01.$trModule3 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
NO_CCS GHC.Types.TrNameS! [Noinline01.$trModule4];
-Noinline01.$trModule2 :: GHC.Prim.Addr#
-[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
- "Noinline01"#;
-
Noinline01.$trModule1 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
NO_CCS GHC.Types.TrNameS! [Noinline01.$trModule2];
@@ -42,6 +42,10 @@ Noinline01.g :: GHC.Types.Bool
[GblId] =
\u [] Noinline01.f GHC.Types.False;
+Noinline01.$trModule2 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+ "Noinline01"#;
+
Noinline01.$trModule4 :: GHC.Prim.Addr#
[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
"main"#;
@@ -50,10 +54,6 @@ Noinline01.$trModule3 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
NO_CCS GHC.Types.TrNameS! [Noinline01.$trModule4];
-Noinline01.$trModule2 :: GHC.Prim.Addr#
-[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
- "Noinline01"#;
-
Noinline01.$trModule1 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
NO_CCS GHC.Types.TrNameS! [Noinline01.$trModule2];
diff --git a/testsuite/tests/simplCore/should_compile/par01.stderr b/testsuite/tests/simplCore/should_compile/par01.stderr
index bbcb9ef4fd..67f29515d2 100644
--- a/testsuite/tests/simplCore/should_compile/par01.stderr
+++ b/testsuite/tests/simplCore/should_compile/par01.stderr
@@ -7,14 +7,19 @@ Rec {
-- RHS size: {terms: 7, types: 3, coercions: 0, joins: 0/0}
Par01.depth [Occ=LoopBreaker] :: GHC.Types.Int -> GHC.Types.Int
[GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>, Unf=OtherCon []]
-Par01.depth =
- \ (d :: GHC.Types.Int) ->
- case GHC.Prim.par# @ GHC.Types.Int d of { __DEFAULT ->
- Par01.depth d
- }
+Par01.depth
+ = \ (d :: GHC.Types.Int) ->
+ case GHC.Prim.par# @ GHC.Types.Int d of { __DEFAULT ->
+ Par01.depth d
+ }
end Rec }
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+Par01.$trModule2 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []]
+Par01.$trModule2 = "Par01"#
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
Par01.$trModule4 :: GHC.Prim.Addr#
[GblId, Caf=NoCafRefs, Unf=OtherCon []]
Par01.$trModule4 = "main"#
@@ -24,11 +29,6 @@ Par01.$trModule3 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []]
Par01.$trModule3 = GHC.Types.TrNameS Par01.$trModule4
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-Par01.$trModule2 :: GHC.Prim.Addr#
-[GblId, Caf=NoCafRefs, Unf=OtherCon []]
-Par01.$trModule2 = "Par01"#
-
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Par01.$trModule1 :: GHC.Types.TrName
[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []]
@@ -37,8 +37,8 @@ Par01.$trModule1 = GHC.Types.TrNameS Par01.$trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
Par01.$trModule :: GHC.Types.Module
[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []]
-Par01.$trModule =
- GHC.Types.Module Par01.$trModule3 Par01.$trModule1
+Par01.$trModule
+ = GHC.Types.Module Par01.$trModule3 Par01.$trModule1
diff --git a/testsuite/tests/simplCore/should_compile/rule2.stderr b/testsuite/tests/simplCore/should_compile/rule2.stderr
index 7444cc90a4..867d38d2ee 100644
--- a/testsuite/tests/simplCore/should_compile/rule2.stderr
+++ b/testsuite/tests/simplCore/should_compile/rule2.stderr
@@ -15,7 +15,7 @@ Total ticks: 13
1 PreInlineUnconditionally 1 f
1 UnfoldingDone 1 Roman.bar
1 RuleFired 1 foo/bar
-3 LetFloatFromLet 3
+1 LetFloatFromLet 1
1 EtaReduction 1 ds
6 BetaReduction
1 f
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index dda28c8926..b9a8f1edb2 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -4,89 +4,44 @@ Result size of Tidy Core
= {terms: 178, types: 68, coercions: 0, joins: 0/2}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-Roman.$trModule4 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- 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,
- Caf=NoCafRefs,
- Str=m1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
-Roman.$trModule3 = GHC.Types.TrNameS Roman.$trModule4
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-Roman.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Caf=NoCafRefs,
- 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,
- Caf=NoCafRefs,
- Str=m1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
-Roman.$trModule1 = GHC.Types.TrNameS Roman.$trModule2
-
--- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-Roman.$trModule :: GHC.Types.Module
-[GblId,
- Caf=NoCafRefs,
- Str=m,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
-Roman.$trModule =
- GHC.Types.Module Roman.$trModule3 Roman.$trModule1
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-lvl :: GHC.Prim.Addr#
+ds :: GHC.Prim.Addr#
[GblId, Caf=NoCafRefs]
-lvl = "spec-inline.hs:(19,5)-(29,25)|function go"#
+ds = "spec-inline.hs:(19,5)-(29,25)|function go"#
-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0}
Roman.foo3 :: Int
[GblId, Str=x]
-Roman.foo3 =
- Control.Exception.Base.patError @ 'GHC.Types.LiftedRep @ Int lvl
+Roman.foo3
+ = Control.Exception.Base.patError @ 'GHC.Types.LiftedRep @ Int ds
Rec {
-- RHS size: {terms: 55, types: 9, coercions: 0, joins: 0/1}
Roman.foo_$s$wgo [Occ=LoopBreaker]
:: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
[GblId, Arity=2, Caf=NoCafRefs, Str=<S,U><S,U>]
-Roman.foo_$s$wgo =
- \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) ->
- let {
- m :: GHC.Prim.Int#
- [LclId]
- m =
- GHC.Prim.+#
- (GHC.Prim.+#
- (GHC.Prim.+#
- (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# sc sc) sc) sc) sc)
- sc)
- sc } in
- case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# sc1 0#) of {
- False ->
- case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 100#) of {
- False ->
- case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 500#) of {
- False -> Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# sc1 1#);
- True -> Roman.foo_$s$wgo m (GHC.Prim.-# sc1 3#)
- };
- True -> Roman.foo_$s$wgo sc (GHC.Prim.-# sc1 2#)
- };
- True -> 0#
- }
+Roman.foo_$s$wgo
+ = \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) ->
+ let {
+ m :: GHC.Prim.Int#
+ [LclId]
+ m = GHC.Prim.+#
+ (GHC.Prim.+#
+ (GHC.Prim.+#
+ (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# sc sc) sc) sc) sc)
+ sc)
+ sc } in
+ case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# sc1 0#) of {
+ False ->
+ case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 100#) of {
+ False ->
+ case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# sc1 500#) of {
+ False -> Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# sc1 1#);
+ True -> Roman.foo_$s$wgo m (GHC.Prim.-# sc1 3#)
+ };
+ True -> Roman.foo_$s$wgo sc (GHC.Prim.-# sc1 2#)
+ };
+ True -> 0#
+ }
end Rec }
-- RHS size: {terms: 74, types: 22, coercions: 0, joins: 0/1}
@@ -96,42 +51,41 @@ Roman.$wgo [InlPrag=[0]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
Str=<S,1*U><S,1*U>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 30] 256 0}]
-Roman.$wgo =
- \ (w :: Maybe Int) (w1 :: Maybe Int) ->
- case w1 of {
- Nothing -> case Roman.foo3 of wild1 { };
- Just x ->
- case x of { GHC.Types.I# ipv ->
- let {
- m :: GHC.Prim.Int#
- [LclId]
- m =
- GHC.Prim.+#
- (GHC.Prim.+#
- (GHC.Prim.+#
- (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# ipv ipv) ipv) ipv) ipv)
- ipv)
- ipv } in
- case w of {
- Nothing -> Roman.foo_$s$wgo m 10#;
- Just n ->
- case n of { GHC.Types.I# x2 ->
- case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# x2 0#) of {
- False ->
- case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 100#) of {
- False ->
- case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 500#) of {
- False -> Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# x2 1#);
- True -> Roman.foo_$s$wgo m (GHC.Prim.-# x2 3#)
- };
- True -> Roman.foo_$s$wgo ipv (GHC.Prim.-# x2 2#)
- };
- True -> 0#
- }
- }
- }
- }
- }
+Roman.$wgo
+ = \ (w :: Maybe Int) (w1 :: Maybe Int) ->
+ case w1 of {
+ Nothing -> case Roman.foo3 of wild1 { };
+ Just x ->
+ case x of { GHC.Types.I# ipv ->
+ let {
+ m :: GHC.Prim.Int#
+ [LclId]
+ m = GHC.Prim.+#
+ (GHC.Prim.+#
+ (GHC.Prim.+#
+ (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# ipv ipv) ipv) ipv) ipv)
+ ipv)
+ ipv } in
+ case w of {
+ Nothing -> Roman.foo_$s$wgo m 10#;
+ Just n ->
+ case n of { GHC.Types.I# x2 ->
+ case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# x2 0#) of {
+ False ->
+ case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 100#) of {
+ False ->
+ case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<# x2 500#) of {
+ False -> Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# x2 1#);
+ True -> Roman.foo_$s$wgo m (GHC.Prim.-# x2 3#)
+ };
+ True -> Roman.foo_$s$wgo ipv (GHC.Prim.-# x2 2#)
+ };
+ True -> 0#
+ }
+ }
+ }
+ }
+ }
-- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0}
Roman.foo_go [InlPrag=INLINE[0]] :: Maybe Int -> Maybe Int -> Int
@@ -143,9 +97,9 @@ Roman.foo_go [InlPrag=INLINE[0]] :: Maybe Int -> Maybe Int -> Int
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
Tmpl= \ (w [Occ=Once] :: Maybe Int) (w1 [Occ=Once] :: Maybe Int) ->
case Roman.$wgo w w1 of ww { __DEFAULT -> GHC.Types.I# ww }}]
-Roman.foo_go =
- \ (w :: Maybe Int) (w1 :: Maybe Int) ->
- case Roman.$wgo w w1 of ww { __DEFAULT -> GHC.Types.I# ww }
+Roman.foo_go
+ = \ (w :: Maybe Int) (w1 :: Maybe Int) ->
+ case Roman.$wgo w w1 of ww { __DEFAULT -> GHC.Types.I# ww }
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Roman.foo2 :: Int
@@ -178,11 +132,55 @@ foo :: Int -> Int
case n of n1 { GHC.Types.I# _ [Occ=Dead] ->
Roman.foo_go (GHC.Base.Just @ Int n1) Roman.foo1
}}]
-foo =
- \ (n :: Int) ->
- case n of { GHC.Types.I# ipv ->
- case Roman.foo_$s$wgo 6# ipv of ww { __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 }
+ }
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+Roman.$trModule2 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ 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: 1, types: 0, coercions: 0, joins: 0/0}
+Roman.$trModule4 :: GHC.Prim.Addr#
+[GblId,
+ Caf=NoCafRefs,
+ 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,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+Roman.$trModule3 = GHC.Types.TrNameS Roman.$trModule4
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+Roman.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+Roman.$trModule1 = GHC.Types.TrNameS Roman.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+Roman.$trModule :: GHC.Types.Module
+[GblId,
+ Caf=NoCafRefs,
+ Str=m,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+Roman.$trModule
+ = GHC.Types.Module Roman.$trModule3 Roman.$trModule1
------ Local rules for imported ids --------
diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr
index d2c6316c51..d3974d5fe6 100644
--- a/testsuite/tests/th/TH_Roles2.stderr
+++ b/testsuite/tests/th/TH_Roles2.stderr
@@ -16,8 +16,8 @@ TH_Roles2.$tcT
TH_Roles2.$trModule
(GHC.Types.TrNameS "T"#)
1
- krep_a40L
-krep_a40L [InlPrag=[~]]
+ krep
+krep [InlPrag=[~]]
= GHC.Types.KindRepFun
(GHC.Types.KindRepVar 0)
(GHC.Types.KindRepTYPE GHC.Types.LiftedRep)
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 47da8df34d..d73ad8600c 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -252,7 +252,7 @@ test('TH_Roles2', normalise_version('array', 'base', 'deepseq', 'ghc-prim',
'ghc-boot', 'ghc-boot-th',
'integer-gmp', 'pretty', 'template-haskell',
'binary', 'bytestring', 'containers'
- ), compile, ['-v0 -ddump-tc'])
+ ), compile, ['-v0 -ddump-tc -dsuppress-uniques'])
test('TH_Roles3', normal, compile, ['-v0 -dsuppress-uniques'])
test('TH_Roles4', normal, compile, ['-v0'])