diff options
author | Reid Barton <rwbarton@gmail.com> | 2017-03-01 08:23:51 -0500 |
---|---|---|
committer | Reid Barton <rwbarton@gmail.com> | 2017-03-01 08:26:45 -0500 |
commit | 85c486a16bff96281c53baf8b385a39f259d39be (patch) | |
tree | 61a5382a878dfc9a909bdd2146effd41167d96b3 | |
parent | 701256df88c61a2eee4cf00a59e61ef76a57b4b4 (diff) | |
download | haskell-wip/rwbarton-D1259.tar.gz |
D1259wip/rwbarton-D1259
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']) |