Move error-ids to MkCore (from PrelRules)

[ghc-hetmet.git] / compiler / deSugar / Match.lhs

diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs
index d90f904..d64a649 100644 (file)
--- a/compiler/deSugar/Match.lhs
+++ b/compiler/deSugar/Match.lhs
@@ -35,7 +35,6 @@ import Id
 import DataCon
 import MatchCon
 import MatchLit
-import PrelInfo
 import Type
 import TysWiredIn
 import ListSetOps
@@ -344,10 +343,11 @@ matchCoercion :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 -- Apply the coercion to the match variable and then match that
 matchCoercion (var:vars) ty (eqns@(eqn1:_))
   = do { let CoPat co pat _ = firstPat eqn1
-       ; var' <- newUniqueId (idName var) (hsPatType pat)
+       ; var' <- newUniqueId var (hsPatType pat)
        ; match_result <- match (var':vars) ty (map decomposeFirst_Coercion eqns)
-       ; rhs <- dsCoercion co (return (Var var))
-       ; return (mkCoLetMatchResult (NonRec var' rhs) match_result) }
+       ; co' <- dsHsWrapper co
+        ; let rhs' = co' (Var var)
+       ; return (mkCoLetMatchResult (NonRec var' rhs') match_result) }
 
 matchView :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
 -- Apply the view function to the match variable and then match that
@@ -357,7 +357,7 @@ matchView (var:vars) ty (eqns@(eqn1:_))
          -- to figure out the type of the fresh variable
          let ViewPat viewExpr (L _ pat) _ = firstPat eqn1
          -- do the rest of the compilation 
-       ; var' <- newUniqueId (idName var) (hsPatType pat)
+       ; var' <- newUniqueId var (hsPatType pat)
        ; match_result <- match (var':vars) ty (map decomposeFirst_View eqns)
          -- compile the view expressions
        ; viewExpr' <- dsLExpr viewExpr
@@ -463,8 +463,8 @@ tidy1 v (VarPat var)
   = return (wrapBind var v, WildPat (idType var)) 
 
 tidy1 v (VarPatOut var binds)
-  = do { prs <- dsLHsBinds binds
-       ; return (wrapBind var v . mkCoreLet (Rec prs),
+  = do { ds_ev_binds <- dsTcEvBinds binds
+       ; return (wrapBind var v . wrapDsEvBinds ds_ev_binds,
                  WildPat (idType var)) }
 
        -- case v of { x@p -> mr[] }
@@ -874,7 +874,7 @@ viewLExprEq (e1,_) (e2,_) =
         wrap WpHole WpHole = True
         wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2'
         wrap (WpCast c)  (WpCast c')  = tcEqType c c'
-        wrap (WpApp d)   (WpApp d')   = d == d'
+        wrap (WpEvApp _) (WpEvApp _) = panic "ToDo: Match.viewLExprEq"
         wrap (WpTyApp t) (WpTyApp t') = tcEqType t t'
         -- Enhancement: could implement equality for more wrappers
         --   if it seems useful (lams and lets)