[commit: ghc] wip/th-new: Clean up error context when checking brackets/splices. (1e6a941)

[git at git.haskell.org]

Repository : ssh://git at git.haskell.org/ghc

On branch  : wip/th-new
Link       : http://ghc.haskell.org/trac/ghc/changeset/1e6a9410911475d5afb57fb4e6b6b29d85a1e13e/ghc

>---------------------------------------------------------------

commit 1e6a9410911475d5afb57fb4e6b6b29d85a1e13e
Author: Geoffrey Mainland <mainland at apeiron.net>
Date:   Thu May 16 15:11:36 2013 +0100

    Clean up error context when checking brackets/splices.


>---------------------------------------------------------------

1e6a9410911475d5afb57fb4e6b6b29d85a1e13e
 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 0d56df1..ee9b256 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 e652a24..df83303 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -326,8 +326,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
@@ -424,7 +423,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)
@@ -494,6 +494,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:")