X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsUtils.lhs;h=8b5c0a95bd99b040d0f93da1963d6275e36e0d40;hp=a4a9b80a8f67d457da3c8c3e35bb7be5acb43a5e;hb=7b5b3b0cab463e108a0132435a28ef19d17cb32b;hpb=8612b81134c052247ed15b1243b6e8646c20b759

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index a4a9b80..8b5c0a9 100644
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -53,7 +53,6 @@ import CoreUtils
 import MkCore
 import MkId
 import Id
-import Var
 import Name
 import Literal
 import TyCon
@@ -75,7 +74,6 @@ import StaticFlags
 \end{code}
 
 
-
 %************************************************************************
 %*									*
 		Rebindable syntax
@@ -256,10 +254,9 @@ wrapBinds [] e = e
 wrapBinds ((new,old):prs) e = wrapBind new old (wrapBinds prs e)
 
 wrapBind :: Var -> Var -> CoreExpr -> CoreExpr
-wrapBind new old body	-- Can deal with term variables *or* type variables
-  | new==old    = body
-  | isTyCoVar new = Let (mkTyBind new (mkTyVarTy old)) body
-  | otherwise   = Let (NonRec new (Var old))         body
+wrapBind new old body	-- NB: this function must deal with term
+  | new==old    = body	-- variables, type variables or coercion variables
+  | otherwise   = Let (NonRec new (varToCoreExpr old)) body
 
 seqVar :: Var -> CoreExpr -> CoreExpr
 seqVar var body = Case (Var var) var (exprType body)
@@ -299,10 +296,11 @@ mkCoPrimCaseMatchResult var ty match_alts
                                                   return (LitAlt lit, [], body)
 
 
-mkCoAlgCaseMatchResult :: Id					-- Scrutinee
-                    -> Type                                     -- Type of exp
-		    -> [(DataCon, [CoreBndr], MatchResult)]	-- Alternatives
-		    -> MatchResult
+mkCoAlgCaseMatchResult 
+  :: Id					   -- Scrutinee
+  -> Type                                  -- Type of exp
+  -> [(DataCon, [CoreBndr], MatchResult)]  -- Alternatives (bndrs *include* tyvars, dicts)
+  -> MatchResult
 mkCoAlgCaseMatchResult var ty match_alts 
   | isNewTyCon tycon		-- Newtype case; use a let
   = ASSERT( null (tail match_alts) && null (tail arg_ids1) )
@@ -383,7 +381,7 @@ mkCoAlgCaseMatchResult var ty match_alts
     isPArrFakeAlts [] = panic "DsUtils: unexpectedly found an empty list of PArr fake alternatives"
     --
     mk_parrCase fail = do
-      lengthP <- dsLookupGlobalId lengthPName
+      lengthP <- dsLookupDPHId lengthPName
       alt <- unboxAlt
       return (mkWildCase (len lengthP) intTy ty [alt])
       where
@@ -395,7 +393,7 @@ mkCoAlgCaseMatchResult var ty match_alts
 	--
 	unboxAlt = do
 	  l      <- newSysLocalDs intPrimTy
-	  indexP <- dsLookupGlobalId indexPName
+	  indexP <- dsLookupDPHId indexPName
 	  alts   <- mapM (mkAlt indexP) sorted_alts
 	  return (DataAlt intDataCon, [l], mkWildCase (Var l) intPrimTy ty (dft : alts))
           where
@@ -605,7 +603,7 @@ mkSelectorBinds pat val_expr
         return (bndr_var, rhs_expr)
       where
         error_expr = mkCoerce co (Var err_var)
-        co         = mkUnsafeCoercion (exprType (Var err_var)) (idType bndr_var)
+        co         = mkUnsafeCo (exprType (Var err_var)) (idType bndr_var)
 
     is_simple_lpat p = is_simple_pat (unLoc p)