X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUtils.lhs;h=cb6770e4e0aee8a64efe3609e00ddb18c72a003c;hb=af2db474c2bb80e29924430e3c730bc217e55189;hp=2433eb8ba7cb1229208d0b68533ce0145dd719ac;hpb=b4ef814c34e7007180d0d38a13c19229391aac7f;p=ghc-hetmet.git

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 2433eb8..cb6770e 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -8,7 +8,7 @@ Utility functions on @Core@ syntax
 \begin{code}
 module CoreUtils (
 	-- Construction
-	mkInlineMe, mkSCC, mkCoerce, 
+	mkInlineMe, mkSCC, mkCoerce, mkCoerceI,
 	bindNonRec, needsCaseBinding,
 	mkIfThenElse, mkAltExpr, mkPiType, mkPiTypes,
 
@@ -194,6 +194,10 @@ mkInlineMe e	   = Note InlineMe e
 
 
 \begin{code}
+mkCoerceI :: CoercionI -> CoreExpr -> CoreExpr
+mkCoerceI IdCo e = e
+mkCoerceI (ACo co) e = mkCoerce co e
+
 mkCoerce :: Coercion -> CoreExpr -> CoreExpr
 mkCoerce co (Cast expr co2)
   = ASSERT(let { (from_ty, _to_ty) = coercionKind co; 
@@ -259,7 +263,8 @@ mkAltExpr (DataAlt con) args inst_tys
   = mkConApp con (map Type inst_tys ++ varsToCoreExprs args)
 mkAltExpr (LitAlt lit) [] []
   = Lit lit
-mkAltExpr DEFAULT = panic "mkAltExpr"
+mkAltExpr (LitAlt _) _ _ = panic "mkAltExpr LitAlt"
+mkAltExpr DEFAULT _ _ = panic "mkAltExpr DEFAULT"
 
 mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
 mkIfThenElse guard then_expr else_expr
@@ -733,7 +738,7 @@ dataConInstPat arg_fun fss uniqs con inst_tys
          co_kind  = substTy subst (mkPredTy eq_pred)
 
       -- make value vars, instantiating types
-    mk_id_var uniq fs ty = mkUserLocal (mkVarOccFS fs) uniq (substTy subst ty) noSrcLoc
+    mk_id_var uniq fs ty = mkUserLocal (mkVarOccFS fs) uniq (substTy subst ty) noSrcSpan
     id_bndrs = zipWith3 mk_id_var id_uniqs id_fss arg_tys
 
 exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])
@@ -1158,8 +1163,8 @@ eta_expand n us expr ty
 		--	coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
 
     	case splitNewTypeRepCo_maybe ty of {
- 	  Just(ty1,co) -> 
-              mkCoerce (mkSymCoercion co) (eta_expand n us (mkCoerce co expr) ty1) ;
+ 	  Just(ty1,co) -> mkCoerce (mkSymCoercion co) 
+				   (eta_expand n us (mkCoerce co expr) ty1) ;
  	  Nothing  -> 
 
 	-- We have an expression of arity > 0, but its type isn't a function