X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSubst.lhs;h=9f1e20db4d20d83d95810bd15c5ffc1cbb6ed6d1;hb=6e9c0431a7cf2bf1a48f01db48c6a1d41fe15a09;hp=b5d7fde99dbad86730de52c44879c7bf7d939983;hpb=c86161c5cf11de77e911fcb9e1e2bd1f8bd80b42;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs
index b5d7fde..9f1e20d 100644
--- a/compiler/coreSyn/CoreSubst.lhs
+++ b/compiler/coreSyn/CoreSubst.lhs
@@ -39,6 +39,7 @@ import OccurAnal( occurAnalyseExpr )
 
 import qualified Type
 import Type     ( Type, TvSubst(..), TvSubstEnv )
+import OptCoercion ( optCoercion )
 import VarSet
 import VarEnv
 import Id
@@ -290,7 +291,10 @@ substExpr subst expr
     go (Lit lit)       = Lit lit
     go (App fun arg)   = App (go fun) (go arg)
     go (Note note e)   = Note (go_note note) (go e)
-    go (Cast e co)     = Cast (go e) (substTy subst co)
+    go (Cast e co)     = Cast (go e) (optCoercion (getTvSubst subst) co)
+	-- Optimise coercions as we go; this is good, for example
+	-- in the RHS of rules, which are only substituted in
+
     go (Lam bndr body) = Lam bndr' (substExpr subst' body)
 		       where
 			 (subst', bndr') = substBndr subst bndr
@@ -463,8 +467,10 @@ substTyVarBndr (Subst in_scope id_env tv_env) tv
 
 -- | See 'Type.substTy'
 substTy :: Subst -> Type -> Type 
-substTy (Subst in_scope _id_env tv_env) ty
-  = Type.substTy (TvSubst in_scope tv_env) ty
+substTy subst ty = Type.substTy (getTvSubst subst) ty
+
+getTvSubst :: Subst -> TvSubst
+getTvSubst (Subst in_scope _id_env tv_env) = TvSubst in_scope tv_env
 \end{code}
 
 
@@ -528,7 +534,8 @@ substUnfoldingSource (Subst in_scope ids _) (InlineWrapper wkr)
   = case wkr_expr of
       Var w1 -> InlineWrapper w1
       _other -> WARN( True, text "Interesting! CoreSubst.substWorker1:" <+> ppr wkr 
-                            <+> equals <+> ppr wkr_expr )   -- Note [Worker inlining]
+                            <+> ifPprDebug (equals <+> ppr wkr_expr) )   
+			      -- Note [Worker inlining]
                 InlineRule    -- It's not a wrapper any more, but still inline it!
 
   | Just w1  <- lookupInScope in_scope wkr = InlineWrapper w1