import Type hiding ( substTy, extendTvSubst )
import SimplEnv
import SimplUtils
-import Literal ( mkStringLit )
import MkId ( rUNTIME_ERROR_ID )
import Id
import Var
import PprCore ( pprParendExpr, pprCoreExpr )
import CoreUnfold ( mkUnfolding, callSiteInline, CallCtxt(..) )
import CoreUtils
-import Rules ( lookupRule )
+import Rules ( lookupRule, getRules )
import BasicTypes ( isMarkedStrict )
import CostCentre ( currentCCS )
import TysPrim ( realWorldStatePrimTy )
; env1 <- go (zapFloats env_with_info) triples
; return (env0 `addRecFloats` env1) }
-- addFloats adds the floats from env1,
- -- *and* updates env0 with the in-scope set from env1
+ -- _and_ updates env0 with the in-scope set from env1
where
add_rules :: SimplEnv -> (InBndr,InExpr) -> (SimplEnv, (InBndr, OutBndr, InExpr))
-- Add the (substituted) rules to the binder
old_info = idInfo old_bndr
occ_info = occInfo old_info
wkr = substWorker env (workerInfo old_info)
- omit_unfolding = isNonRuleLoopBreaker occ_info || not (activeInline env old_bndr)
+ omit_unfolding = isNonRuleLoopBreaker occ_info
+ -- or not (activeInline env old_bndr)
+ -- Do *not* trim the unfolding in SimplGently, else
+ -- the specialiser can't see it!
-----------------
addPolyBind :: TopLevelFlag -> SimplEnv -> OutBind -> SimplEnv
-- is recursive, and hence a loop breaker:
-- foldr k z (build g) = g k z
-- So it's up to the programmer: rules can cause divergence
- ; rules <- getRules
+ ; rule_base <- getSimplRules
; let in_scope = getInScope env
+ rules = getRules rule_base var
maybe_rule = case activeRule dflags env of
Nothing -> Nothing -- No rules apply
Just act_fn -> lookupRule act_fn in_scope
- rules var args
+ var args rules
; case maybe_rule of {
Just (rule, rule_rhs) -> do
tick (RuleFired (ru_name rule))
-- inaccessible. So we simply put an error case here instead.
pprTrace "mkCase: null alts" (ppr case_bndr <+> ppr scrut) $
let res_ty' = contResultType env' (substTy env' (coreAltsType alts)) dup_cont
- lit = Lit (mkStringLit "Impossible alternative")
+ lit = mkStringLit "Impossible alternative"
in return (env', mkApps (Var rUNTIME_ERROR_ID) [Type res_ty', lit])
else do