X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=43232e56b51a43b49ac9147fe9e8ebd807d62ec9;hp=46624c5c0016d2be5693145f839a828741bd4252;hb=HEAD;hpb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252 diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 46624c5..43232e5 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -135,7 +135,8 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this tcl_tyvars = tvs_var, tcl_lie = lie_var, tcl_meta = meta_var, - tcl_untch = initTyVarUnique + tcl_untch = initTyVarUnique, + tcl_hetMetLevel = [] } ; } ; @@ -990,10 +991,10 @@ captureConstraints :: TcM a -> TcM (a, WantedConstraints) -- (captureConstraints m) runs m, and returns the type constraints it generates captureConstraints thing_inside = do { lie_var <- newTcRef emptyWC ; - res <- updLclEnv (\ env -> env { tcl_lie = lie_var }) - thing_inside ; - lie <- readTcRef lie_var ; - return (res, lie) } + res <- updLclEnv (\ env -> env { tcl_lie = lie_var }) + thing_inside ; + lie <- readTcRef lie_var ; + return (res, lie) } captureUntouchables :: TcM a -> TcM (a, Untouchables) captureUntouchables thing_inside @@ -1018,14 +1019,21 @@ setLclTypeEnv lcl_env thing_inside = updLclEnv upd thing_inside where upd env = env { tcl_env = tcl_env lcl_env, - tcl_tyvars = tcl_tyvars lcl_env } + tcl_tyvars = tcl_tyvars lcl_env } + +traceTcConstraints :: String -> TcM () +traceTcConstraints msg + = do { lie_var <- getConstraintVar + ; lie <- readTcRef lie_var + ; traceTc (msg ++ "LIE:") (ppr lie) + } \end{code} %************************************************************************ -%* * - Template Haskell context -%* * +%* * + Template Haskell context +%* * %************************************************************************ \begin{code}