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

diff --git a/compiler/typecheck/TcArrows.lhs b/compiler/typecheck/TcArrows.lhs
index 57cb48c..bfb47d8 100644
--- a/compiler/typecheck/TcArrows.lhs
+++ b/compiler/typecheck/TcArrows.lhs
@@ -238,7 +238,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 +251,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 +304,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