X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplify.lhs;h=18b3fc66b2e28f0b018b263915662608e8a9bbdb;hb=6582768fd0065b9aa4abdd93fdfa6ac1d047482b;hp=d90c5db170cd83447a3e9c4059704c646bc8eeec;hpb=fe204a040a0381a1c18be10b9870cb3d20b0486b;p=ghc-hetmet.git

diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs
index d90c5db..18b3fc6 100644
--- a/compiler/simplCore/Simplify.lhs
+++ b/compiler/simplCore/Simplify.lhs
@@ -29,7 +29,7 @@ import CoreUtils
 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,
@@ -822,6 +822,12 @@ simplType env ty
     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}
 
 
@@ -859,7 +865,7 @@ rebuild env expr cont0
 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
@@ -1004,6 +1010,9 @@ simplNonRecE env bndr (rhs, rhs_se) (bndrs, body) cont
 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 }