X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsBinds.lhs;h=697ab480f9c43e96a014f12d1e7da180277fe96a;hb=3932b76369acda843a6c998449bf953a7cb2f5fc;hp=e22cb001cb410e1c9e1177e17d6bbdb11b5a0231;hpb=7a59afcebe45ea87c42006873f77eb4600d7316f;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index e22cb00..697ab48 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -107,7 +107,7 @@ dsHsBind auto_scc rest (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = t
 --	M.f = f_lcl		-- Generated from "exports"
 -- But we don't want that, because if M.f isn't exported,
 -- it'll be inlined unconditionally at every call site (its rhs is 
--- trivial).  That woudl be ok unless it has RULES, which would 
+-- trivial).  That would be ok unless it has RULES, which would 
 -- thereby be completely lost.  Bad, bad, bad.
 --
 -- Instead we want to generate
@@ -323,6 +323,7 @@ simpleSubst subst expr
   = go expr
   where
     go (Var v)	       = lookupVarEnv subst v `orElse` Var v
+    go (Cast e co)     = Cast (go e) co
     go (Type ty)       = Type ty
     go (Lit lit)       = Lit lit
     go (App fun arg)   = App (go fun) (go arg)
@@ -418,19 +419,21 @@ addDictScc var rhs = returnDs rhs
 
 
 \begin{code}
-dsCoercion :: ExprCoFn -> DsM CoreExpr -> DsM CoreExpr
-dsCoercion CoHole 	     thing_inside = thing_inside
-dsCoercion (CoCompose c1 c2) thing_inside = dsCoercion c1 (dsCoercion c2 thing_inside)
-dsCoercion (CoLams ids c)    thing_inside = do { expr <- dsCoercion c thing_inside
-					       ; return (mkLams ids expr) }
-dsCoercion (CoTyLams tvs c)  thing_inside = do { expr <- dsCoercion c thing_inside
-					       ; return (mkLams tvs expr) }
-dsCoercion (CoApps c ids)    thing_inside = do { expr <- dsCoercion c thing_inside
-					       ; return (mkVarApps expr ids) }
-dsCoercion (CoTyApps c tys)  thing_inside = do { expr <- dsCoercion c thing_inside
-					       ; return (mkTyApps expr tys) }
-dsCoercion (CoLet bs c)      thing_inside = do { prs <- dsLHsBinds bs
-					       ; expr <- dsCoercion c thing_inside
+dsCoercion :: HsWrapper -> DsM CoreExpr -> DsM CoreExpr
+dsCoercion WpHole 	     thing_inside = thing_inside
+dsCoercion (WpCompose c1 c2) thing_inside = dsCoercion c1 (dsCoercion c2 thing_inside)
+dsCoercion (WpCo co)     thing_inside = do { expr <- thing_inside
+					       ; return (Cast expr co) }
+dsCoercion (WpLam id)        thing_inside = do { expr <- thing_inside
+					       ; return (Lam id expr) }
+dsCoercion (WpTyLam tv)      thing_inside = do { expr <- thing_inside
+					       ; return (Lam tv expr) }
+dsCoercion (WpApp id)        thing_inside = do { expr <- thing_inside
+					       ; return (App expr (Var id)) }
+dsCoercion (WpTyApp ty)      thing_inside = do { expr <- thing_inside
+					       ; return (App expr (Type ty)) }
+dsCoercion (WpLet bs)        thing_inside = do { prs <- dsLHsBinds bs
+					       ; expr <- thing_inside
 					       ; return (Let (Rec prs) expr) }
 \end{code}