From 1dfb756e01201c62ddde93010b3384d4d9644ad6 Mon Sep 17 00:00:00 2001
From: ross <unknown>
Date: Tue, 15 Mar 2005 11:59:36 +0000
Subject: [PATCH] [project @ 2005-03-15 11:59:32 by ross] Fix (and test) for
 SourceForge bug 1161624: erroneous rejection of

	foo = proc x -> arr (\y -> y-1) -< x

Now open a new level for the left side of -<, so that variables bound
in the proc are illegal, but variables bound in the expression are OK.

Note that the levels gimmick doesn't really implement holes in the
scope: it rules out nasty obfuscations like

	foo x = proc x -> arr (\y -> x-1) -< x

Also added the same treatment to the head of a `form', where it was
missing.

(for STABLE)
---
 ghc/compiler/typecheck/TcArrows.lhs  |    6 +++---
 ghc/compiler/typecheck/TcRnMonad.lhs |    2 +-
 ghc/compiler/typecheck/TcRnTypes.lhs |    8 +++++---
 3 files changed, 9 insertions(+), 7 deletions(-)

diff --git a/ghc/compiler/typecheck/TcArrows.lhs b/ghc/compiler/typecheck/TcArrows.lhs
index d45c7f3..794fa09 100644
--- a/ghc/compiler/typecheck/TcArrows.lhs
+++ b/ghc/compiler/typecheck/TcArrows.lhs
@@ -231,14 +231,14 @@ 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)	$
@@ -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
diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index f4fbc06..374c9cc 100644
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -794,7 +794,7 @@ popArrowBinders
   where
     pop (ArrCtxt {proc_level = curr_lvl, proc_banned = banned})
 	= ASSERT( not (curr_lvl `elem` banned) )
-	  ArrCtxt {proc_level = curr_lvl, proc_banned = curr_lvl : banned}
+	  ArrCtxt {proc_level = curr_lvl + 1, proc_banned = curr_lvl : banned}
 
 getBannedProcLevels :: TcM [ProcLevel]
   = do { env <- getLclEnv; return (proc_banned (tcl_arrow_ctxt env)) }
diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs
index 33190e7..50258cc 100644
--- a/ghc/compiler/typecheck/TcRnTypes.lhs
+++ b/ghc/compiler/typecheck/TcRnTypes.lhs
@@ -361,7 +361,8 @@ topSpliceStage = Splice (topLevel - 1)	-- Stage for the body of a top-level spli
 ---------------------------
 
 -- In arrow notation, a variable bound by a proc (or enclosed let/kappa)
--- is not in scope to the left of an arrow tail (-<).  For example
+-- is not in scope to the left of an arrow tail (-<) or the head of (|..|).
+-- For example
 --
 --	proc x -> (e1 -< e2)
 --
@@ -369,7 +370,7 @@ topSpliceStage = Splice (topLevel - 1)	-- Stage for the body of a top-level spli
 -- a bit complicated:
 --
 --	let x = 3 in
---	prox y -> (proc z -> e1) -< e2
+--	proc y -> (proc z -> e1) -< e2
 --
 -- Here, x and z are in scope in e1, but y is not.  Here's how we track this:
 --	a) Assign an "proc level" to each proc, being the number of
@@ -378,7 +379,8 @@ topSpliceStage = Splice (topLevel - 1)	-- Stage for the body of a top-level spli
 --	   enclosing proc.
 --	c) Keep a list of out-of-scope procs.  When moving to the left of
 --	   an arrow-tail, add the proc-level of the immediately enclosing
---	   proc to the list.
+--	   proc to the list, and increment the proc-level so that variables
+--	   bound inside the expression are in scope.
 --	d) When looking up a variable, complain if its proc-level is in
 --	   the banned list
 
-- 
1.7.10.4