From a2ee35c45d0e4883d53273fd1102666d2bbdd78a Mon Sep 17 00:00:00 2001 From: Geoffrey Mainland Date: Thu, 16 May 2013 15:11:36 +0100 Subject: [PATCH] Clean up error context when checking brackets/splices. --- compiler/rename/RnSplice.lhs | 8 ++++++-- compiler/typecheck/TcSplice.lhs | 16 +++++++++++++--- 2 files changed, 19 insertions(+), 5 deletions(-) diff --git a/compiler/rename/RnSplice.lhs b/compiler/rename/RnSplice.lhs index 2e8133501591..14c77d156ebe 100644 --- a/compiler/rename/RnSplice.lhs +++ b/compiler/rename/RnSplice.lhs @@ -217,8 +217,7 @@ rnSpliceExpr splice@(HsSplice isTypedSplice _ expr) \begin{code} rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars) rnBracket e br_body - = addErrCtxt (hang (ptext (sLit "In the Template Haskell quotation")) - 2 (ppr br_body)) $ + = addErrCtxt (quotationCtxtDoc br_body) $ do { -- Check that Template Haskell is enabled and available thEnabled <- xoptM Opt_TemplateHaskell ; unless thEnabled $ @@ -368,6 +367,11 @@ quotedNameStageErr br = sep [ ptext (sLit "Stage error: the non-top-level quoted name") <+> ppr br , ptext (sLit "must be used at the same stage at which is is bound")] +quotationCtxtDoc :: HsBracket RdrName -> SDoc +quotationCtxtDoc br_body + = hang (ptext (sLit "In the Template Haskell quotation")) + 2 (ppr br_body) + spliceResultDoc :: OutputableBndr id => LHsExpr id -> SDoc spliceResultDoc expr = sep [ ptext (sLit "In the result of the splice:") diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 2e5070a8add0..2b52b6d01fcd 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -324,8 +324,7 @@ runAnnotation _ q = pprPanic "Cant do runAnnotation without GHCi" (ppr q) \begin{code} -- See Note [How brackets and nested splices are handled] tcBracket brack ps res_ty - = addErrCtxt (hang (ptext (sLit "In the Template Haskell quotation")) - 2 (ppr brack)) $ + = addErrCtxt (quotationCtxtDoc brack) $ do { cur_stage <- getStage -- Check for nested brackets ; case cur_stage of @@ -422,7 +421,8 @@ tcTExpTy tau = do \begin{code} tcSpliceExpr splice@(HsSplice isTypedSplice name expr) res_ty - = setSrcSpan (getLoc expr) $ do + = addErrCtxt (spliceCtxtDoc splice) $ + setSrcSpan (getLoc expr) $ do { stage <- getStage ; case stage of { Splice {} | not isTypedSplice -> pprPanic "tcSpliceExpr: encountered unexpanded top-level untyped splice" (ppr splice) @@ -492,6 +492,16 @@ tcTopSplice expr res_ty ; exp4 <- tcMonoExpr exp3 res_ty ; return (unLoc exp4) } } +quotationCtxtDoc :: HsBracket Name -> SDoc +quotationCtxtDoc br_body + = hang (ptext (sLit "In the Template Haskell quotation")) + 2 (ppr br_body) + +spliceCtxtDoc :: HsSplice Name -> SDoc +spliceCtxtDoc splice + = hang (ptext (sLit "In the Template Haskell splice")) + 2 (ppr splice) + spliceResultDoc :: LHsExpr Name -> SDoc spliceResultDoc expr = sep [ ptext (sLit "In the result of the splice:")