X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=bd48872c05d4b1dceaac342756d2621b6a57bc54;hb=37a6a52facd1c3999ce4472c50b0030568be1e04;hp=37e11663885c4829e4dd6085859a24ca61b4865f;hpb=27310213397bb89555bb03585e057ba1b017e895;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 37e1166..bd48872 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -114,11 +114,12 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this tcg_warns = NoWarnings, tcg_anns = [], tcg_insts = [], - tcg_fam_insts = [], - tcg_rules = [], - tcg_fords = [], - tcg_dfun_n = dfun_n_var, - tcg_keep = keep_var, + tcg_fam_insts = [], + tcg_rules = [], + tcg_fords = [], + tcg_vects = [], + tcg_dfun_n = dfun_n_var, + tcg_keep = keep_var, tcg_doc_hdr = Nothing, tcg_hpc = False, tcg_main = Nothing @@ -780,11 +781,6 @@ updCtxt :: ([ErrCtxt] -> [ErrCtxt]) -> TcM a -> TcM a updCtxt upd = updLclEnv (\ env@(TcLclEnv { tcl_ctxt = ctxt }) -> env { tcl_ctxt = upd ctxt }) --- Conditionally add an error context -maybeAddErrCtxt :: Maybe Message -> TcM a -> TcM a -maybeAddErrCtxt (Just msg) thing_inside = addErrCtxt msg thing_inside -maybeAddErrCtxt Nothing thing_inside = thing_inside - popErrCtxt :: TcM a -> TcM a popErrCtxt = updCtxt (\ msgs -> case msgs of { [] -> []; (_ : ms) -> ms }) @@ -1151,7 +1147,7 @@ failIfM :: Message -> IfL a failIfM msg = do { env <- getLclEnv ; let full_msg = (if_loc env <> colon) $$ nest 2 msg - ; liftIO (printErrs (full_msg defaultErrStyle)) + ; liftIO (printErrs full_msg defaultErrStyle) ; failM } -------------------- @@ -1186,7 +1182,7 @@ forkM_maybe doc thing_inside ; return Nothing } }} where - print_errs sdoc = liftIO (printErrs (sdoc defaultErrStyle)) + print_errs sdoc = liftIO (printErrs sdoc defaultErrStyle) forkM :: SDoc -> IfL a -> IfL a forkM doc thing_inside