X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=f2609b7d8e3363a6b03a959bab0468e49a2c788e;hb=0db3e625ff0717f36495b375e6008995d6ffb0a3;hp=62328bc7a1ab2dfc799e6449e221bde4c47f151b;hpb=724deead8ae0150c7424d8d78765aa3e2584244c;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 62328bc..f2609b7 100644
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -46,6 +46,7 @@ import {-# SOURCE #-}	DsExpr( dsExpr )
 
 import HsSyn
 import TcHsSyn
+import TcType( tcSplitTyConApp )
 import CoreSyn
 import DsMonad
 
@@ -287,7 +288,8 @@ mkCoAlgCaseMatchResult var ty match_alts
     (con1, arg_ids1, match_result1) = ASSERT( notNull match_alts ) head match_alts
     arg_id1 	= ASSERT( notNull arg_ids1 ) head arg_ids1
     var_ty      = idType var
-    (tc, ty_args) = splitNewTyConApp var_ty
+    (tc, ty_args) = tcSplitTyConApp var_ty	-- Don't look through newtypes
+    	 	    		    		-- (not that splitTyConApp does, these days)
     newtype_rhs = unwrapNewTypeBody tc ty_args (Var var)
 		
 	-- Stuff for data types
@@ -299,11 +301,10 @@ mkCoAlgCaseMatchResult var ty match_alts
 	      | otherwise
 	      = CanFail
 
-    wild_var = mkWildId (idType var)
     sorted_alts  = sortWith get_tag match_alts
     get_tag (con, _, _) = dataConTag con
     mk_case fail = do alts <- mapM (mk_alt fail) sorted_alts
-                      return (Case (Var var) wild_var ty (mk_default fail ++ alts))
+                      return (mkWildCase (Var var) (idType var) ty (mk_default fail ++ alts))
 
     mk_alt fail (con, args, MatchResult _ body_fn) = do
           body <- body_fn fail
@@ -350,7 +351,7 @@ mkCoAlgCaseMatchResult var ty match_alts
     mk_parrCase fail = do
       lengthP <- dsLookupGlobalId lengthPName
       alt <- unboxAlt
-      return (Case (len lengthP) (mkWildId intTy) ty [alt])
+      return (mkWildCase (len lengthP) intTy ty [alt])
       where
 	elemTy      = case splitTyConApp (idType var) of
 		        (_, [elemTy]) -> elemTy
@@ -362,9 +363,8 @@ mkCoAlgCaseMatchResult var ty match_alts
 	  l      <- newSysLocalDs intPrimTy
 	  indexP <- dsLookupGlobalId indexPName
 	  alts   <- mapM (mkAlt indexP) sorted_alts
-	  return (DataAlt intDataCon, [l], (Case (Var l) wild ty (dft : alts)))
+	  return (DataAlt intDataCon, [l], mkWildCase (Var l) intPrimTy ty (dft : alts))
           where
-	    wild = mkWildId intPrimTy
 	    dft  = (DEFAULT, [], fail)
 	--
 	-- each alternative matches one array length (corresponding to one