Skip to content

Commit

Permalink
Clean up error context when checking brackets/splices.
Browse files Browse the repository at this point in the history
  • Loading branch information
mainland committed Jun 6, 2013
1 parent 0b867a0 commit a2ee35c
Show file tree
Hide file tree
Showing 2 changed files with 19 additions and 5 deletions.
8 changes: 6 additions & 2 deletions compiler/rename/RnSplice.lhs
Expand Up @@ -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 $
Expand Down Expand Up @@ -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:")
Expand Down
16 changes: 13 additions & 3 deletions compiler/typecheck/TcSplice.lhs
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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:")
Expand Down

0 comments on commit a2ee35c

Please sign in to comment.