import CoreArity ( exprArity )
import Rules ( lookupRule, getRules )
import BasicTypes ( isMarkedStrict, Arity )
-import CostCentre ( currentCCS )
+import CostCentre ( currentCCS, pushCCisNop )
import TysPrim ( realWorldStatePrimTy )
import PrelInfo ( realWorldPrimId )
import BasicTypes ( TopLevelFlag(..), isTopLevel,
seqType new_ty `seq` return new_ty
where
new_ty = substTy env ty
+
+---------------------------------
+simplCoercion :: SimplEnv -> InType -> SimplM OutType
+simplCoercion env co
+ = do { co' <- simplType env co
+ ; return (optCoercion co') }
\end{code}
simplCast :: SimplEnv -> InExpr -> Coercion -> SimplCont
-> SimplM (SimplEnv, OutExpr)
simplCast env body co0 cont0
- = do { co1 <- simplType env co0
+ = do { co1 <- simplCoercion env co0
; simplExprF env body (addCoerce co1 cont0) }
where
addCoerce co cont = add_coerce co (coercionKind co) cont
| (_l1, t1) <- coercionKind co2
-- e |> (g1 :: S1~L) |> (g2 :: L~T1)
-- ==>
- -- e, if T1=T2
- -- e |> (g1 . g2 :: T1~T2) otherwise
+ -- e, if S1=T1
+ -- e |> (g1 . g2 :: S1~T1) otherwise
--
-- For example, in the initial form of a worker
-- we may find (coerce T (coerce S (\x.e))) y
simplNote :: SimplEnv -> Note -> CoreExpr -> SimplCont
-> SimplM (SimplEnv, OutExpr)
simplNote env (SCC cc) e cont
+ | pushCCisNop cc (getEnclosingCC env) -- scc "f" (...(scc "f" e)...)
+ = simplExprF env e cont -- ==> scc "f" (...e...)
+ | otherwise
= do { e' <- simplExpr (setEnclosingCC env currentCCS) e
; rebuild env (mkSCC cc e') cont }