X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsBinds.lhs;h=58e42fd1ac7123cce9430bee7070683f64dadc5e;hb=15cb792d18b1094e98c035dca6ecec5dad516056;hp=64306af0e0f30195d4a79ca44b4a37ea1ff38709;hpb=4fbd341bca17fbe4af6dbe23ba414abc45729224;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index 64306af..58e42fd 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -236,7 +236,7 @@ dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
 	      mb_lhs  	    = decomposeRuleLhs (bndrs ++ const_dicts) body
 
 	; case mb_lhs of
-	    Nothing -> do { dsWarn msg; return Nothing }
+	    Nothing -> do { warnDs msg; return Nothing }
 
 	    Just (bndrs', var, args) -> return (Just (addInlineInfo inl spec_id spec_rhs, rule))
 		where
@@ -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)
@@ -421,16 +422,18 @@ addDictScc var rhs = returnDs rhs
 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 (ExprCoFn co)     thing_inside = do { expr <- thing_inside
+					       ; return (Cast expr co) }
+dsCoercion (CoLam id)        thing_inside = do { expr <- thing_inside
+					       ; return (Lam id expr) }
+dsCoercion (CoTyLam tv)      thing_inside = do { expr <- thing_inside
+					       ; return (Lam tv expr) }
+dsCoercion (CoApp id)        thing_inside = do { expr <- thing_inside
+					       ; return (App expr (Var id)) }
+dsCoercion (CoTyApp ty)      thing_inside = do { expr <- thing_inside
+					       ; return (App expr (Type ty)) }
+dsCoercion (CoLet bs)        thing_inside = do { prs <- dsLHsBinds bs
+					       ; expr <- thing_inside
 					       ; return (Let (Rec prs) expr) }
 \end{code}