From cb205eb46927f79850b89b5598989ca86a168c18 Mon Sep 17 00:00:00 2001
From: ross <unknown>
Date: Thu, 5 May 2005 10:52:43 +0000
Subject: [PATCH] [project @ 2005-05-05 10:52:43 by ross] Stop the renamer
 from barfing on arrow notation outside of proc, since this
 will be caught by the typechecker (tcfail120).

---
 ghc/compiler/typecheck/TcRnMonad.lhs |    2 +-
 ghc/compiler/typecheck/TcRnTypes.lhs |   11 ++++++++---
 2 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index 71a20d8..306a71b 100644
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -109,7 +109,7 @@ initTc hsc_env hsc_src mod do_this
 		tcl_ctxt       = [],
 		tcl_rdr	       = emptyLocalRdrEnv,
 		tcl_th_ctxt    = topStage,
-		tcl_arrow_ctxt = panic "initTc:arrow",	-- only used inside proc
+		tcl_arrow_ctxt = NoArrowCtxt,
 		tcl_env        = emptyNameEnv,
 		tcl_tyvars     = tvs_var,
 		tcl_lie	       = panic "initTc:LIE",	-- LIE only valid inside a getLIE
diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs
index ece741f..308a884 100644
--- a/ghc/compiler/typecheck/TcRnTypes.lhs
+++ b/ghc/compiler/typecheck/TcRnTypes.lhs
@@ -27,7 +27,7 @@ module TcRnTypes(
 	ThLevel, impLevel, topLevel,
 
 	-- Arrows
-	newArrowScope, escapeArrowScope,
+	ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope,
 
 	-- Insts
 	Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, 
@@ -394,7 +394,9 @@ and returning to that (using escapeArrowScope) on the left of -< and the
 head of (|..|).
 -}
 
-newtype ArrowCtxt = ArrowCtxt { arr_proc_env :: Env TcGblEnv TcLclEnv }
+data ArrowCtxt
+  = NoArrowCtxt
+  | ArrowCtxt (Env TcGblEnv TcLclEnv)
 
 -- Record the current environment (outside a proc)
 newArrowScope :: TcM a -> TcM a
@@ -404,7 +406,10 @@ newArrowScope
 
 -- Return to the stored environment (from the enclosing proc)
 escapeArrowScope :: TcM a -> TcM a
-escapeArrowScope = updEnv (arr_proc_env . tcl_arrow_ctxt . env_lcl)
+escapeArrowScope
+  = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of
+	NoArrowCtxt -> env
+	ArrowCtxt env' -> env'
 
 ---------------------------
 -- TcTyThing
-- 
1.7.10.4