X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcArrows.lhs;h=c575808a97ff019905fc3c63e805cbbd026f0455;hb=25f84fa7e4b84c3db5ba745a7881c009b778e0b1;hp=57cb48c9e24b71b9be141d7de113a2b9f7ab4b7e;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcArrows.lhs b/compiler/typecheck/TcArrows.lhs
index 57cb48c..c575808 100644
--- a/compiler/typecheck/TcArrows.lhs
+++ b/compiler/typecheck/TcArrows.lhs
@@ -5,6 +5,13 @@
 Typecheck arrow notation
 
 \begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module TcArrows ( tcProc ) where
 
 #include "HsVersions.h"
@@ -238,7 +245,7 @@ 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]     <- tcInstSkolTyVars (ArrowSkol span) [alphaTyVar]
+	; [w_tv]     <- tcInstSkolTyVars ArrowSkol [alphaTyVar]
 	; let w_ty = mkTyVarTy w_tv 	-- Just a convenient starting point
 
 		--  a ((w,t1) .. tn) t
@@ -251,7 +258,8 @@ tc_cmd env cmd@(HsArrForm expr fixity cmd_args) (cmd_stk, res_ty)
 
 		-- Check expr
 	; (expr', lie) <- escapeArrowScope (getLIE (tcMonoExpr expr e_ty))
-	; inst_binds <- tcSimplifyCheck sig_msg [w_tv] [] lie
+	; loc <- getInstLoc (SigOrigin ArrowSkol)
+	; inst_binds <- tcSimplifyCheck loc [w_tv] [] lie
 
 		-- Check that the polymorphic variable hasn't been unified with anything
 		-- and is not free in res_ty or the cmd_stk  (i.e.  t, t1..tn)
@@ -303,8 +311,6 @@ tc_cmd env cmd@(HsArrForm expr fixity cmd_args) (cmd_stk, res_ty)
 				    
 	    other -> (ty, [])
 
-    sig_msg  = ptext SLIT("expected type of a command form")
-
 -----------------------------------------------------------------
 --		Base case for illegal commands
 -- This is where expressions that aren't commands get rejected