[project @ 2005-03-15 11:59:32 by ross]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcArrows.lhs

diff --git a/ghc/compiler/typecheck/TcArrows.lhs b/ghc/compiler/typecheck/TcArrows.lhs
index 2ddab4e..794fa09 100644 (file)
--- a/ghc/compiler/typecheck/TcArrows.lhs
+++ b/ghc/compiler/typecheck/TcArrows.lhs
@@ -19,7 +19,7 @@ import TcMatches ( TcStmtCtxt(..), tcMatchPats, matchCtxt, tcStmts,
 import TcType  ( TcType, TcTauType, TcRhoType, mkFunTys, mkTyConApp,
                  mkTyVarTy, mkAppTys, tcSplitTyConApp_maybe, tcEqType, 
                  SkolemInfo(..) )
-import TcMType ( newTyFlexiVarTy, newTyFlexiVarTys, tcSkolTyVar, zonkTcType )
+import TcMType ( newTyFlexiVarTy, newTyFlexiVarTys, tcSkolTyVars, zonkTcType )
 import TcBinds ( tcBindsAndThen )
 import TcSimplify ( tcSimplifyCheck )
 import TcUnify ( Expected(..), checkSigTyVarsWrt, zapExpectedTo )
@@ -231,20 +231,20 @@ tc_cmd env cmd@(HsDo do_or_lc stmts _ ty) (cmd_stk, res_ty)
 
 
 -----------------------------------------------------------------
---     Arrow ``forms''       (| e |) c1 .. cn
+--     Arrow ``forms''       (| e c1 .. cn |)
 --
 --     G      |-b  c : [s1 .. sm] s
 --     pop(G) |-   e : forall w. b ((w,s1) .. sm) s
 --                             -> a ((w,t1) .. tn) t
 --     e \not\in (s, s1..sm, t, t1..tn)
 --     ----------------------------------------------
---     G |-a  (| e |) c  :  [t1 .. tn] t
+--     G |-a  (| e c |)  :  [t1 .. tn] t
 
 tc_cmd env cmd@(HsArrForm expr fixity cmd_args) (cmd_stk, res_ty)      
   = addErrCtxt (cmdCtxt cmd)   $
     do { cmds_w_tys <- zipWithM new_cmd_ty cmd_args [1..]
        ; span       <- getSrcSpanM
-       ; w_tv       <- tcSkolTyVar (ArrowSkol span) alphaTyVar
+       ; [w_tv]     <- tcSkolTyVars (ArrowSkol span) [alphaTyVar]
        ; let w_ty = mkTyVarTy w_tv     -- Just a convenient starting point
 
                --  a ((w,t1) .. tn) t
@@ -256,7 +256,7 @@ tc_cmd env cmd@(HsArrForm expr fixity cmd_args) (cmd_stk, res_ty)
                              e_res_ty
 
                -- Check expr
-       ; (expr', lie) <- getLIE (tcCheckRho expr e_ty)
+       ; (expr', lie) <- popArrowBinders (getLIE (tcCheckRho expr e_ty))
        ; inst_binds <- tcSimplifyCheck sig_msg [w_tv] [] lie
 
                -- Check that the polymorphic variable hasn't been unified with anything