This BIG PATCH contains most of the work for the New Coercion Representation
[ghc-hetmet.git] / compiler / typecheck / TcMatches.lhs
index 46b67da..f912039 100644 (file)
@@ -28,7 +28,7 @@ import TysWiredIn
 import Id
 import TyCon
 import TysPrim
-import Coercion                ( mkSymCoI )
+import Coercion         ( mkSymCo )
 import Outputable
 import BasicTypes      ( Arity )
 import Util
@@ -73,7 +73,7 @@ tcMatchesFun fun_name inf matches exp_ty
        ; checkArgs fun_name matches
 
        ; (wrap_gen, (wrap_fun, group)) 
-            <- tcGen (SigSkol (FunSigCtxt fun_name)) exp_ty $ \ _ exp_rho ->
+            <- tcGen (FunSigCtxt fun_name) exp_ty $ \ _ exp_rho ->
                  -- Note [Polymorphic expected type for tcMatchesFun]
                matchFunTys herald arity exp_rho $ \ pat_tys rhs_ty -> 
               tcMatches match_ctxt pat_tys rhs_ty matches 
@@ -104,15 +104,15 @@ tcMatchesCase ctxt scrut_ty matches res_ty
 
 tcMatchLambda :: MatchGroup Name -> TcRhoType -> TcM (HsWrapper, MatchGroup TcId)
 tcMatchLambda match res_ty 
-  = matchFunTys doc n_pats res_ty  $ \ pat_tys rhs_ty ->
+  = matchFunTys herald n_pats res_ty  $ \ pat_tys rhs_ty ->
     tcMatches match_ctxt pat_tys rhs_ty match
   where
     n_pats = matchGroupArity match
-    doc = sep [ ptext (sLit "The lambda expression")
-                <+> quotes (pprSetDepth (PartWay 1) $ 
+    herald = sep [ ptext (sLit "The lambda expression")
+                        <+> quotes (pprSetDepth (PartWay 1) $ 
                              pprMatches (LambdaExpr :: HsMatchContext Name) match),
                        -- The pprSetDepth makes the abstraction print briefly
-               ptext (sLit "has") <+> speakNOf n_pats (ptext (sLit "argument"))]
+               ptext (sLit "has")]
     match_ctxt = MC { mc_what = LambdaExpr,
                      mc_body = tcBody }
 \end{code}
@@ -143,7 +143,7 @@ matchFunTys
 matchFunTys herald arity res_ty thing_inside
   = do { (coi, pat_tys, res_ty) <- matchExpectedFunTys herald arity res_ty
        ; res <- thing_inside pat_tys res_ty
-        ; return (coiToHsWrapper (mkSymCoI coi), res) }
+        ; return (coToHsWrapper (mkSymCo coi), res) }
 \end{code}
 
 %************************************************************************
@@ -246,7 +246,7 @@ tcDoStmts ListComp stmts body res_ty
        ; (stmts', body') <- tcStmts ListComp (tcLcStmt listTyCon) stmts 
                                     elt_ty $
                             tcBody body
-       ; return $ mkHsWrapCoI coi 
+       ; return $ mkHsWrapCo coi 
                      (HsDo ListComp stmts' body' (mkListTy elt_ty)) }
 
 tcDoStmts PArrComp stmts body res_ty
@@ -254,7 +254,7 @@ tcDoStmts PArrComp stmts body res_ty
        ; (stmts', body') <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts 
                                     elt_ty $
                             tcBody body
-       ; return $ mkHsWrapCoI coi 
+       ; return $ mkHsWrapCo coi 
                      (HsDo PArrComp stmts' body' (mkPArrTy elt_ty)) }
 
 tcDoStmts DoExpr stmts body res_ty