rnBracket (ExpBr e) = do { (e', fvs) <- rnLExpr e
; return (ExpBr e', fvs) }
-rnBracket (PatBr _) = do { addErr (ptext (sLit "Tempate Haskell pattern brackets are not supported yet"));
- failM }
-
+rnBracket (PatBr _) = failWith (ptext (sLit "Tempate Haskell pattern brackets are not supported yet"))
rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t
; return (TypBr t', fvs) }
where
fv_pat)]
rn_rec_stmt_lhs _ (L _ (LetStmt binds@(HsIPBinds _)))
- = do { addErr (badIpBinds (ptext (sLit "an mdo expression")) binds)
- ; failM }
+ = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
rn_rec_stmt_lhs fix_env (L loc (LetStmt (HsValBinds binds)))
= do binds' <- rnValBindsLHS fix_env binds
L loc (BindStmt pat' expr' bind_op fail_op))]
rn_rec_stmt _ (L _ (LetStmt binds@(HsIPBinds _))) _
- = do { addErr (badIpBinds (ptext (sLit "an mdo expression")) binds)
- ; failM }
+ = failWith (badIpBinds (ptext (sLit "an mdo expression")) binds)
rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds'))) _ = do
(binds', du_binds) <-
pred' <- rnPred doc pred
return (HsPredTy pred')
-rnHsType _ (HsSpliceTy _) = do
- addErr (ptext (sLit "Type splices are not yet implemented"))
- failM
+rnHsType _ (HsSpliceTy _) =
+ failWith (ptext (sLit "Type splices are not yet implemented"))
rnHsType doc (HsDocTy ty haddock_doc) = do
ty' <- rnLHsType doc ty
setErrsVar :: TcRef Messages -> TcRn a -> TcRn a
setErrsVar v = updLclEnv (\ env -> env { tcl_errs = v })
-addErr :: Message -> TcRn ()
+addErr :: Message -> TcRn () -- Ignores the context stack
addErr msg = do { loc <- getSrcSpanM ; addErrAt loc msg }
+failWith :: Message -> TcRn a
+failWith msg = addErr msg >> failM
+
addLocErr :: Located e -> (e -> Message) -> TcRn ()
addLocErr (L loc e) fn = addErrAt loc (fn e)