X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Ftypecheck%2FTcRnMonad.lhs;fp=ghc%2Fcompiler%2Ftypecheck%2FTcRnMonad.lhs;h=6ff9043dfb9aaa241d4dd231be6eda2549d96023;hb=872f7e822cb83692afa808509b4f2a6b4343fb2c;hp=616017798c6b1b3b6faad7d47eddb49408387ddd;hpb=7ffe2d8843bee42e9a26103c1e7d7019caba1f78;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs index 6160177..6ff9043 100644 --- a/ghc/compiler/typecheck/TcRnMonad.lhs +++ b/ghc/compiler/typecheck/TcRnMonad.lhs @@ -106,7 +106,6 @@ initTc hsc_env hsc_src mod do_this tcl_ctxt = [], tcl_rdr = emptyLocalRdrEnv, tcl_th_ctxt = topStage, - tcl_arrow_ctxt = topArrowCtxt, tcl_env = emptyNameEnv, tcl_tyvars = tvs_var, tcl_lie = panic "initTc:LIE", -- LIE only valid inside a getLIE @@ -784,33 +783,6 @@ setStage s = updLclEnv (\ env -> env { tcl_th_ctxt = s }) %************************************************************************ %* * - Arrow context -%* * -%************************************************************************ - -\begin{code} -popArrowBinders :: TcM a -> TcM a -- Move to the left of a (-<); see comments in TcRnTypes -popArrowBinders - = updLclEnv (\ env -> env { tcl_arrow_ctxt = pop (tcl_arrow_ctxt env) }) - where - pop (ArrCtxt {proc_level = curr_lvl, proc_banned = banned}) - = ASSERT( not (curr_lvl `elem` banned) ) - ArrCtxt {proc_level = curr_lvl + 1, proc_banned = curr_lvl : banned} - -getBannedProcLevels :: TcM [ProcLevel] -getBannedProcLevels - = do { env <- getLclEnv; return (proc_banned (tcl_arrow_ctxt env)) } - -incProcLevel :: TcM a -> TcM a -incProcLevel - = updLclEnv (\ env -> env { tcl_arrow_ctxt = inc (tcl_arrow_ctxt env) }) - where - inc ctxt = ctxt { proc_level = proc_level ctxt + 1 } -\end{code} - - -%************************************************************************ -%* * Stuff for the renamer's local env %* * %************************************************************************