From 85813f652c010eb384853ead39ecd7fa3f1ee8a1 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 6866dec73df3..98f39e1ffa0e 100644 --- a/compiler/rename/RnSplice.lhs +++ b/compiler/rename/RnSplice.lhs @@ -218,8 +218,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 $ @@ -369,6 +368,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 bb31363027bc..b52f3ce79d36 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -325,8 +325,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 @@ -423,7 +422,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) @@ -493,6 +493,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:")