X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=5d8e0a2da0b4890490176a72d82cfbe6965b71e8;hp=0a1fdd2d8719f26eee68a9a636cf9768f7d08d68;hb=a51fe79ebcdcb8285573a18f12cade2101533419;hpb=0ccc12b6d176efe4a6d605864412deda75b62459 diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 0a1fdd2..5d8e0a2 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -28,8 +28,9 @@ import CoreMonad ( SimplifierSwitch(..), Tick(..) ) import CoreSyn import Demand ( isStrictDmd, splitStrictSig ) import PprCore ( pprParendExpr, pprCoreExpr ) -import CoreUnfold ( mkUnfolding, mkCoreUnfolding, mkInlineRule, - exprIsConApp_maybe, callSiteInline, CallCtxt(..) ) +import CoreUnfold ( mkUnfolding, mkCoreUnfolding + , mkInlineUnfolding, mkSimpleUnfolding + , exprIsConApp_maybe, callSiteInline, CallCtxt(..) ) import CoreUtils import qualified CoreSubst import CoreArity ( exprArity ) @@ -713,7 +714,7 @@ simplUnfolding env _ _ _ _ (DFunUnfolding ar con ops) simplUnfolding env top_lvl id _ _ (CoreUnfolding { uf_tmpl = expr, uf_arity = arity , uf_src = src, uf_guidance = guide }) - | isInlineRuleSource src + | isStableSource src = do { expr' <- simplExpr rule_env expr ; let src' = CoreSubst.substUnfoldingSource (mkCoreSubst (text "inline-unf") env) src ; return (mkCoreUnfolding (isTopLevel top_lvl) src' expr' arity guide) } @@ -724,7 +725,7 @@ simplUnfolding env top_lvl id _ _ -- See Note [Simplifying gently inside InlineRules] in SimplUtils simplUnfolding _ top_lvl id _occ_info new_rhs _ - = return (mkUnfolding (isTopLevel top_lvl) (isBottomingId id) new_rhs) + = return (mkUnfolding InlineRhs (isTopLevel top_lvl) (isBottomingId id) new_rhs) -- We make an unfolding *even for loop-breakers*. -- Reason: (a) It might be useful to know that they are WHNF -- (b) In TidyPgm we currently assume that, if we want to @@ -1789,7 +1790,7 @@ simplAlt env _ case_bndr' cont' (DataAlt con, vs, rhs) addBinderUnfolding :: SimplEnv -> Id -> CoreExpr -> SimplEnv addBinderUnfolding env bndr rhs - = modifyInScope env (bndr `setIdUnfolding` mkUnfolding False False rhs) + = modifyInScope env (bndr `setIdUnfolding` mkSimpleUnfolding rhs) addBinderOtherCon :: SimplEnv -> Id -> [AltCon] -> SimplEnv addBinderOtherCon env bndr cons @@ -2016,7 +2017,7 @@ mkDupableAlt env case_bndr (con, bndrs', rhs') DataAlt dc -> setIdUnfolding case_bndr unf where -- See Note [Case binders and join points] - unf = mkInlineRule rhs Nothing + unf = mkInlineUnfolding Nothing rhs rhs = mkConApp dc (map Type (tyConAppArgs scrut_ty) ++ varsToCoreExprs bndrs')