[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).

diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index 71a20d8..306a71b 100644 (file)
--- 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 (file)
--- 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