Refactor the handling of quasi-quotes
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 10 Feb 2015 14:09:12 +0000 (14:09 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 10 Feb 2015 14:11:39 +0000 (14:11 +0000)
As Trac #10047 points out, a quasi-quotation [n|...blah...|] is supposed
to behave exactly like $(n "...blah...").  But it doesn't!  This was outright
wrong: quasiquotes were being run even inside brackets.

Now that TH supports both typed and untyped splices, a quasi-quote is properly
regarded as a particular syntax for an untyped splice. But apart from that
they should be treated the same.  So this patch refactors the handling of
quasiquotes to do just that.

The changes touch quite a lot of files, but mostly in a routine way.
The biggest changes by far are in RnSplice, and more minor changes in
TcSplice.  These are the places where there was real work to be done.
Everything else is routine knock-on changes.

* No more QuasiQuote forms in declarations, expressions, types, etc.
  So we get rid of these data constructors
    * HsBinds.QuasiQuoteD
    * HsExpr.HsSpliceE
    * HsPat.QuasiQuotePat
    * HsType.HsQuasiQuoteTy

* We get rid of the HsQuasiQuote type altogether

* Instead, we augment the HsExpr.HsSplice type to have three
  consructors, for the three types of splice:
    * HsTypedSplice
    * HsUntypedSplice
    * HsQuasiQuote
  There are some related changes in the data types in HsExpr near HsSplice.
  Specifically: PendingRnSplice, PendingTcSplice, UntypedSpliceFlavour.

* In Hooks, we combine rnQuasiQuoteHook and rnRnSpliceHook into one.
  A smaller, clearer interface.

* We have to update the Haddock submodule, to accommodate the hsSyn changes

55 files changed:
compiler/deSugar/Check.hs
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsMeta.hs
compiler/hsSyn/HsDecls.hs
compiler/hsSyn/HsExpr.hs
compiler/hsSyn/HsExpr.hs-boot
compiler/hsSyn/HsPat.hs
compiler/hsSyn/HsTypes.hs
compiler/hsSyn/HsUtils.hs
compiler/main/Hooks.hs
compiler/parser/Parser.y
compiler/parser/RdrHsSyn.hs
compiler/rename/RnExpr.hs
compiler/rename/RnPat.hs
compiler/rename/RnSource.hs
compiler/rename/RnSplice.hs
compiler/rename/RnTypes.hs
compiler/typecheck/TcEnv.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcPat.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcSplice.hs-boot
testsuite/tests/annotations/should_fail/annfail03.stderr
testsuite/tests/annotations/should_fail/annfail04.stderr
testsuite/tests/annotations/should_fail/annfail06.stderr
testsuite/tests/annotations/should_fail/annfail09.stderr
testsuite/tests/quasiquotation/T3953.stderr
testsuite/tests/quasiquotation/qq001/qq001.stderr
testsuite/tests/quasiquotation/qq002/qq002.stderr
testsuite/tests/quasiquotation/qq003/qq003.stderr
testsuite/tests/quasiquotation/qq004/qq004.stderr
testsuite/tests/th/T10047.hs [new file with mode: 0644]
testsuite/tests/th/T10047.script [new file with mode: 0644]
testsuite/tests/th/T10047.stdout [new file with mode: 0644]
testsuite/tests/th/T2597b.stderr
testsuite/tests/th/T3177a.stderr
testsuite/tests/th/T3395.stderr
testsuite/tests/th/T5358.stderr
testsuite/tests/th/T5795.stderr
testsuite/tests/th/T5971.stderr
testsuite/tests/th/T7276.stderr
testsuite/tests/th/T7276a.stdout
testsuite/tests/th/T7667a.stderr
testsuite/tests/th/T8412.stderr
testsuite/tests/th/TH_1tuple.stderr
testsuite/tests/th/TH_StaticPointers02.stderr
testsuite/tests/th/TH_runIO.stderr
testsuite/tests/th/TH_unresolvedInfix2.stderr
testsuite/tests/th/all.T
utils/haddock

index 6930052..9956def 100644 (file)
@@ -153,7 +153,6 @@ untidy b (L loc p) = L loc (untidy' b p)
     untidy' _ (ConPatOut {})         = panic "Check.untidy: ConPatOut"
     untidy' _ (ViewPat {})           = panic "Check.untidy: ViewPat"
     untidy' _ (SplicePat {})         = panic "Check.untidy: SplicePat"
-    untidy' _ (QuasiQuotePat {})     = panic "Check.untidy: QuasiQuotePat"
     untidy' _ (NPat {})              = panic "Check.untidy: NPat"
     untidy' _ (NPlusKPat {})         = panic "Check.untidy: NPlusKPat"
     untidy' _ (SigPatOut {})         = panic "Check.untidy: SigPatOut"
@@ -732,7 +731,6 @@ tidy_pat (LitPat lit)         = tidy_lit_pat lit
 
 tidy_pat (ConPatIn {})        = panic "Check.tidy_pat: ConPatIn"
 tidy_pat (SplicePat {})       = panic "Check.tidy_pat: SplicePat"
-tidy_pat (QuasiQuotePat {})   = panic "Check.tidy_pat: QuasiQuotePat"
 tidy_pat (SigPatIn {})        = panic "Check.tidy_pat: SigPatIn"
 
 tidy_lit_pat :: HsLit -> Pat Id
index 220ed3c..55cd7d2 100644 (file)
@@ -1150,7 +1150,6 @@ collectl (L _ pat) bndrs
     go (CoPat _ pat _)            = collectl (noLoc pat) bndrs
     go (ViewPat _ pat _)          = collectl pat bndrs
     go p@(SplicePat {})           = pprPanic "collectl/go" (ppr p)
-    go p@(QuasiQuotePat {})       = pprPanic "collectl/go" (ppr p)
 
 collectEvBinders :: TcEvBinds -> [Id]
 collectEvBinders (EvBinds bs)   = foldrBag add_ev_bndr [] bs
index 84fcec0..21fbe94 100644 (file)
@@ -650,7 +650,7 @@ dsExpr (HsTcBracketOut x ps) = dsBracket x ps
 #else
 dsExpr (HsTcBracketOut _ _) = panic "dsExpr HsBracketOut"
 #endif
-dsExpr (HsSpliceE _ s)      = pprPanic "dsExpr:splice" (ppr s)
+dsExpr (HsSpliceE s)  = pprPanic "dsExpr:splice" (ppr s)
 
 -- Arrow notation extension
 dsExpr (HsProc pat cmd) = dsProcExpr pat cmd
@@ -683,7 +683,6 @@ dsExpr (HsTickPragma _ _ expr) = do
 -- HsSyn constructs that just shouldn't be here:
 dsExpr (ExprWithTySig {})  = panic "dsExpr:ExprWithTySig"
 dsExpr (HsBracket     {})  = panic "dsExpr:HsBracket"
-dsExpr (HsQuasiQuoteE {})  = panic "dsExpr:HsQuasiQuoteE"
 dsExpr (HsArrApp      {})  = panic "dsExpr:HsArrApp"
 dsExpr (HsArrForm     {})  = panic "dsExpr:HsArrForm"
 dsExpr (EWildPat      {})  = panic "dsExpr:EWildPat"
index 63b6539..1f7b70f 100644 (file)
@@ -78,7 +78,7 @@ dsBracket :: HsBracket Name -> [PendingTcSplice] -> DsM CoreExpr
 dsBracket brack splices
   = dsExtendMetaEnv new_bit (do_brack brack)
   where
-    new_bit = mkNameEnv [(n, DsSplice (unLoc e)) | PendSplice n e <- splices]
+    new_bit = mkNameEnv [(n, DsSplice (unLoc e)) | PendingTcSplice n e <- splices]
 
     do_brack (VarBr _ n) = do { MkC e1  <- lookupOcc n ; return e1 }
     do_brack (ExpBr e)   = do { MkC e1  <- repLE e     ; return e1 }
@@ -970,12 +970,17 @@ repRole (L _ Nothing)                 = rep2 inferRName []
 repSplice :: HsSplice Name -> DsM (Core a)
 -- See Note [How brackets and nested splices are handled] in TcSplice
 -- We return a CoreExpr of any old type; the context should know
-repSplice (HsSplice n _)
- = do { mb_val <- dsLookupMetaEnv n
+repSplice (HsTypedSplice   n _)  = rep_splice n
+repSplice (HsUntypedSplice n _)  = rep_splice n
+repSplice (HsQuasiQuote n _ _ _) = rep_splice n
+
+rep_splice :: Name -> DsM (Core a)
+rep_splice splice_name
+ = do { mb_val <- dsLookupMetaEnv splice_name
        ; case mb_val of
            Just (DsSplice e) -> do { e' <- dsExpr e
                                    ; return (MkC e') }
-           _ -> pprPanic "HsSplice" (ppr n) }
+           _ -> pprPanic "HsSplice" (ppr splice_name) }
                         -- Should not happen; statically checked
 
 -----------------------------------------------------------------------------
@@ -1094,7 +1099,7 @@ repE (ArithSeq _ _ aseq) =
                              ds3 <- repLE e3
                              repFromThenTo ds1 ds2 ds3
 
-repE (HsSpliceE _ splice)  = repSplice splice
+repE (HsSpliceE splice)    = repSplice splice
 repE (HsStatic e)          = repLE e >>= rep2 staticEName . (:[]) . unC
 repE e@(PArrSeq {})        = notHandled "Parallel arrays" (ppr e)
 repE e@(HsCoreAnn {})      = notHandled "Core annotations" (ppr e)
index 5fb3249..045647c 100644 (file)
@@ -79,7 +79,7 @@ module HsDecls (
     ) where
 
 -- friends:
-import {-# SOURCE #-}   HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr, pprUntypedSplice )
+import {-# SOURCE #-}   HsExpr( LHsExpr, HsExpr, HsSplice, pprExpr, pprSplice )
         -- Because Expr imports Decls via HsBracket
 
 import HsBinds
@@ -139,9 +139,8 @@ data HsDecl id
   | AnnD        (AnnDecl id)
   | RuleD       (RuleDecls id)
   | VectD       (VectDecl id)
-  | SpliceD     (SpliceDecl id)
+  | SpliceD     (SpliceDecl id)   -- Includes quasi-quotes
   | DocD        (DocDecl)
-  | QuasiQuoteD (HsQuasiQuote id)
   | RoleAnnotD  (RoleAnnotDecl id)
   deriving (Typeable)
 deriving instance (DataId id) => Data (HsDecl id)
@@ -265,7 +264,6 @@ instance OutputableBndr name => Outputable (HsDecl name) where
     ppr (AnnD ad)               = ppr ad
     ppr (SpliceD dd)            = ppr dd
     ppr (DocD doc)              = ppr doc
-    ppr (QuasiQuoteD qq)        = ppr qq
     ppr (RoleAnnotD ra)         = ppr ra
 
 instance OutputableBndr name => Outputable (HsGroup name) where
@@ -316,7 +314,7 @@ data SpliceDecl id
 deriving instance (DataId id) => Data (SpliceDecl id)
 
 instance OutputableBndr name => Outputable (SpliceDecl name) where
-   ppr (SpliceDecl (L _ e) _) = pprUntypedSplice e
+   ppr (SpliceDecl (L _ e) _) = pprSplice e
 
 {-
 ************************************************************************
index 9fd90b6..109818d 100644 (file)
@@ -381,11 +381,7 @@ data HsExpr id
   --         'ApiAnnotation.AnnClose'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | HsSpliceE    Bool                   -- True <=> typed splice
-                 (HsSplice id)          -- False <=> untyped
-
-  | HsQuasiQuoteE (HsQuasiQuote id)
-        -- See Note [Quasi-quote overview] in TcSplice
+  | HsSpliceE  (HsSplice id)
 
   -----------------------------------------------------------
   -- Arrow notation extension
@@ -720,13 +716,12 @@ ppr_expr (HsSCC _ lbl expr)
 ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
 ppr_expr (HsType id)      = ppr id
 
-ppr_expr (HsSpliceE t s)       = pprSplice t s
+ppr_expr (HsSpliceE s)         = pprSplice s
 ppr_expr (HsBracket b)         = pprHsBracket b
 ppr_expr (HsRnBracketOut e []) = ppr e
 ppr_expr (HsRnBracketOut e ps) = ppr e $$ ptext (sLit "pending(rn)") <+> ppr ps
 ppr_expr (HsTcBracketOut e []) = ppr e
 ppr_expr (HsTcBracketOut e ps) = ppr e $$ ptext (sLit "pending(tc)") <+> ppr ps
-ppr_expr (HsQuasiQuoteE qq)    = ppr qq
 
 ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
   = hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
@@ -1592,31 +1587,45 @@ pprQuals quals = interpp'SP quals
 -}
 
 data HsSplice id
-   = HsSplice            --  $z  or $(f 4)
+   = HsTypedSplice       --  $z  or $(f 4)
+        id               -- A unique name to identify this splice point
+        (LHsExpr id)     -- See Note [Pending Splices]
+
+   | HsUntypedSplice     --  $z  or $(f 4)
         id               -- A unique name to identify this splice point
         (LHsExpr id)     -- See Note [Pending Splices]
+
+   | HsQuasiQuote        -- See Note [Quasi-quote overview] in TcSplice
+        id               -- Splice point
+        id               -- Quoter
+        SrcSpan          -- The span of the enclosed string
+        FastString       -- The enclosed string
   deriving (Typeable )
 
+deriving instance (DataId id) => Data (HsSplice id)
+
+isTypedSplice :: HsSplice id -> Bool
+isTypedSplice (HsTypedSplice {}) = True
+isTypedSplice _                  = False   -- Quasi-quotes are untyped splices
+
 -- See Note [Pending Splices]
-data PendingSplice id
-  = PendSplice Name (LHsExpr id)
-  deriving( Typeable )
-        -- It'd be convenient to re-use HsSplice, but the splice-name
-        -- really is a Name, never an Id.  Using (PostRn id Name) is
-        -- nearly OK, but annoyingly we can't pretty-print it.
+type SplicePointName = Name
 
 data PendingRnSplice
-  = PendingRnExpSplice        (PendingSplice Name)
-  | PendingRnPatSplice        (PendingSplice Name)
-  | PendingRnTypeSplice       (PendingSplice Name)
-  | PendingRnDeclSplice       (PendingSplice Name)
-  | PendingRnCrossStageSplice Name
+  = PendingRnSplice UntypedSpliceFlavour SplicePointName (LHsExpr Name)
   deriving (Data, Typeable)
 
-type PendingTcSplice = PendingSplice Id
+data UntypedSpliceFlavour
+  = UntypedExpSplice
+  | UntypedPatSplice
+  | UntypedTypeSplice
+  | UntypedDeclSplice
+  deriving( Data, Typeable )
+
+data PendingTcSplice
+  = PendingTcSplice SplicePointName (LHsExpr Id)
+  deriving( Data, Typeable )
 
-deriving instance (DataId id) => Data (HsSplice id)
-deriving instance (DataId id) => Data (PendingSplice id)
 
 {-
 Note [Pending Splices]
@@ -1633,9 +1642,9 @@ looks like
 which the renamer rewrites to
 
     HsRnBracketOut (HsApp (HsVar f) (HsSpliceE sn (g x)))
-                   [PendingRnExpSplice (HsSplice sn (g x))]
+                   [PendingRnSplice UntypedExpSplice sn (g x)]
 
-* The 'sn' is the Name of the splice point.
+* The 'sn' is the Name of the splice point, the SplicePointName
 
 * The PendingRnExpSplice gives the splice that splice-point name maps to;
   and the typechecker can now conveniently find these sub-expressions
@@ -1644,30 +1653,35 @@ which the renamer rewrites to
                                 in the renamed first arg of HsRnBracketOut
   is used only for pretty printing
 
-There are four varieties of pending splices generated by the renamer:
-
- * Pending expression splices (PendingRnExpSplice), e.g.,
+There are four varieties of pending splices generated by the renamer,
+distinguished by their UntypedSpliceFlavour
 
-   [|$(f x) + 2|]
+ * Pending expression splices (UntypedExpSplice), e.g.,
+       [|$(f x) + 2|]
 
- * Pending pattern splices (PendingRnPatSplice), e.g.,
+   UntypedExpSplice is also used for
+     * quasi-quotes, where the pending expression expands to
+          $(quoter "...blah...")
+       (see RnSplice.makePending, HsQuasiQuote case)
 
-   [|\ $(f x) -> x|]
+     * cross-stage lifting, where the pending expression expands to
+          $(lift x)
+       (see RnSplice.checkCrossStageLifting)
 
- * Pending type splices (PendingRnTypeSplice), e.g.,
+ * Pending pattern splices (UntypedPatSplice), e.g.,
+       [| \$(f x) -> x |]
 
-   [|f :: $(g x)|]
+ * Pending type splices (UntypedTypeSplice), e.g.,
+       [| f :: $(g x) |]
 
- * Pending cross-stage splices (PendingRnCrossStageSplice), e.g.,
-
-   \x -> [| x |]
+ * Pending declaration (UntypedDeclSplice), e.g.,
+       [| let $(f x) in ... |]
 
 There is a fifth variety of pending splice, which is generated by the type
 checker:
 
   * Pending *typed* expression splices, (PendingTcSplice), e.g.,
-
-    [||1 + $$(f 2)||]
+        [||1 + $$(f 2)||]
 
 It would be possible to eliminate HsRnBracketOut and use HsBracketOut for the
 output of the renamer. However, when pretty printing the output of the renamer,
@@ -1678,21 +1692,24 @@ sense, although I hate to add another constructor to HsExpr.
 -}
 
 instance OutputableBndr id => Outputable (HsSplice id) where
-  ppr (HsSplice n e) = angleBrackets (ppr n <> comma <+> ppr e)
+  ppr s = pprSplice s
 
-instance OutputableBndr id => Outputable (PendingSplice id) where
-  ppr (PendSplice n e) = angleBrackets (ppr n <> comma <+> ppr e)
+pprPendingSplice :: OutputableBndr id => SplicePointName -> LHsExpr id -> SDoc
+pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr e)
 
-pprUntypedSplice :: OutputableBndr id => HsSplice id -> SDoc
-pprUntypedSplice = pprSplice False
+pprSplice :: OutputableBndr id => HsSplice id -> SDoc
+pprSplice (HsTypedSplice   n e)  = ppr_splice (ptext (sLit "$$")) n e
+pprSplice (HsUntypedSplice n e)  = ppr_splice (ptext (sLit "$"))  n e
+pprSplice (HsQuasiQuote n q _ s) = ppr_quasi n q s
 
-pprTypedSplice :: OutputableBndr id => HsSplice id -> SDoc
-pprTypedSplice = pprSplice True
+ppr_quasi :: OutputableBndr id => id -> id -> FastString -> SDoc
+ppr_quasi n quoter quote = ifPprDebug (brackets (ppr n)) <>
+                           char '[' <> ppr quoter <> ptext (sLit "|") <>
+                           ppr quote <> ptext (sLit "|]")
 
-pprSplice :: OutputableBndr id => Bool -> HsSplice id -> SDoc
-pprSplice is_typed (HsSplice n e)
-    = (if is_typed then ptext (sLit "$$") else char '$')
-      <> ifPprDebug (brackets (ppr n)) <> eDoc
+ppr_splice :: OutputableBndr id => SDoc -> id -> LHsExpr id -> SDoc
+ppr_splice herald n e
+    = herald <> ifPprDebug (brackets (ppr n)) <> eDoc
     where
           -- We use pprLExpr to match pprParendExpr:
           --     Using pprLExpr makes sure that we go 'deeper'
@@ -1740,11 +1757,10 @@ thTyBrackets :: SDoc -> SDoc
 thTyBrackets pp_body = ptext (sLit "[||") <+> pp_body <+> ptext (sLit "||]")
 
 instance Outputable PendingRnSplice where
-  ppr (PendingRnExpSplice s)   = ppr s
-  ppr (PendingRnPatSplice s)   = ppr s
-  ppr (PendingRnTypeSplice s)  = ppr s
-  ppr (PendingRnDeclSplice s)  = ppr s
-  ppr (PendingRnCrossStageSplice name) = ppr name
+  ppr (PendingRnSplice _ n e) = pprPendingSplice n e
+
+instance Outputable PendingTcSplice where
+  ppr (PendingTcSplice n e) = pprPendingSplice n e
 
 {-
 ************************************************************************
index 51cbd29..4b9f968 100644 (file)
@@ -59,8 +59,7 @@ pprLExpr :: (OutputableBndr i) =>
 pprExpr :: (OutputableBndr i) =>
         HsExpr i -> SDoc
 
-pprUntypedSplice :: (OutputableBndr i) =>
-                    HsSplice i -> SDoc
+pprSplice :: (OutputableBndr i) => HsSplice i -> SDoc
 
 pprPatBind :: (OutputableBndr bndr, OutputableBndr id, Outputable body)
            => LPat bndr -> GRHSs id body -> SDoc
index 1d8da13..6cde908 100644 (file)
@@ -29,7 +29,7 @@ module HsPat (
         pprParendLPat, pprConArgs
     ) where
 
-import {-# SOURCE #-} HsExpr            (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprUntypedSplice)
+import {-# SOURCE #-} HsExpr            (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice)
 
 -- friends:
 import HsBinds
@@ -166,11 +166,7 @@ data Pat id
   --        'ApiAnnotation.AnnClose' @')'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | SplicePat       (HsSplice id)
-
-        ------------ Quasiquoted patterns ---------------
-        -- See Note [Quasi-quote overview] in TcSplice
-  | QuasiQuotePat   (HsQuasiQuote id)
+  | SplicePat       (HsSplice id)   -- Includes quasi-quotes
 
         ------------ Literal and n+k patterns ---------------
   | LitPat          HsLit               -- Used for *non-overloaded* literal patterns:
@@ -333,8 +329,7 @@ pprPat (LitPat s)           = ppr s
 pprPat (NPat l Nothing  _)  = ppr l
 pprPat (NPat l (Just _) _)  = char '-' <> ppr l
 pprPat (NPlusKPat n k _ _)  = hcat [ppr n, char '+', ppr k]
-pprPat (SplicePat splice)   = pprUntypedSplice splice
-pprPat (QuasiQuotePat qq)   = ppr qq
+pprPat (SplicePat splice)   = pprSplice splice
 pprPat (CoPat co pat _)     = pprHsWrapper (ppr pat) co
 pprPat (SigPatIn pat ty)    = ppr pat <+> dcolon <+> ppr ty
 pprPat (SigPatOut pat ty)   = ppr pat <+> dcolon <+> ppr ty
@@ -490,14 +485,12 @@ isIrrefutableHsPat pat
     -- Both should be gotten rid of by renamer before
     -- isIrrefutablePat is called
     go1 (SplicePat {})     = urk pat
-    go1 (QuasiQuotePat {}) = urk pat
 
     urk pat = pprPanic "isIrrefutableHsPat:" (ppr pat)
 
 hsPatNeedsParens :: Pat a -> Bool
 hsPatNeedsParens (NPlusKPat {})      = True
 hsPatNeedsParens (SplicePat {})      = False
-hsPatNeedsParens (QuasiQuotePat {})  = True
 hsPatNeedsParens (ConPatIn _ ds)     = conPatNeedsParens ds
 hsPatNeedsParens p@(ConPatOut {})    = conPatNeedsParens (pat_args p)
 hsPatNeedsParens (SigPatIn {})       = True
index d6f3044..5ff0451 100644 (file)
@@ -23,7 +23,6 @@ module HsTypes (
         HsWithBndrs(..),
         HsTupleSort(..), HsExplicitFlag(..),
         HsContext, LHsContext,
-        HsQuasiQuote(..),
         HsTyWrapper(..),
         HsTyLit(..),
         HsIPName(..), hsIPNameFS,
@@ -49,7 +48,7 @@ module HsTypes (
         pprHsContext, pprHsContextNoArrow, pprHsContextMaybe
     ) where
 
-import {-# SOURCE #-} HsExpr ( HsSplice, pprUntypedSplice )
+import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
 
 import PlaceHolder ( PostTc,PostRn,DataId,PlaceHolder(..) )
 
@@ -72,28 +71,6 @@ import Data.Maybe ( fromMaybe )
 {-
 ************************************************************************
 *                                                                      *
-        Quasi quotes; used in types and elsewhere
-*                                                                      *
-************************************************************************
--}
-
-data HsQuasiQuote id = HsQuasiQuote
-                           id           -- The quasi-quoter
-                           SrcSpan      -- The span of the enclosed string
-                           FastString   -- The enclosed string
-  deriving (Data, Typeable)
-
-instance OutputableBndr id => Outputable (HsQuasiQuote id) where
-    ppr = ppr_qq
-
-ppr_qq :: OutputableBndr id => HsQuasiQuote id -> SDoc
-ppr_qq (HsQuasiQuote quoter _ quote) =
-    char '[' <> ppr quoter <> ptext (sLit "|") <>
-    ppr quote <> ptext (sLit "|]")
-
-{-
-************************************************************************
-*                                                                      *
 \subsection{Bang annotations}
 *                                                                      *
 ************************************************************************
@@ -336,12 +313,7 @@ data HsType name
 
       -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | HsQuasiQuoteTy      (HsQuasiQuote name)
-      -- ^ - 'ApiAnnotation.AnnKeywordId' : None
-
-      -- For details on above see note [Api annotations] in ApiAnnotation
-
-  | HsSpliceTy          (HsSplice name)
+  | HsSpliceTy          (HsSplice name)   -- Includes quasi-quotes
                         (PostTc name Kind)
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,
       --         'ApiAnnotation.AnnClose' @')'@
@@ -840,7 +812,6 @@ ppr_mono_ty ctxt_prec (HsForAllTy exp extra tvs ctxt ty)
     sep [pprHsForAllExtra exp extra tvs ctxt, ppr_mono_lty TopPrec ty]
 
 ppr_mono_ty _    (HsBangTy b ty)     = ppr b <> ppr_mono_lty TyConPrec ty
-ppr_mono_ty _    (HsQuasiQuoteTy qq) = ppr qq
 ppr_mono_ty _    (HsRecTy flds)      = pprConDeclFields flds
 ppr_mono_ty _    (HsTyVar name)      = pprPrefixOcc name
 ppr_mono_ty prec (HsFunTy ty1 ty2)   = ppr_fun_ty prec ty1 ty2
@@ -852,7 +823,7 @@ ppr_mono_ty _    (HsKindSig ty kind) = parens (ppr_mono_lty TopPrec ty <+> dcolo
 ppr_mono_ty _    (HsListTy ty)       = brackets (ppr_mono_lty TopPrec ty)
 ppr_mono_ty _    (HsPArrTy ty)       = paBrackets (ppr_mono_lty TopPrec ty)
 ppr_mono_ty prec (HsIParamTy n ty)   = maybeParen prec FunPrec (ppr n <+> dcolon <+> ppr_mono_lty TopPrec ty)
-ppr_mono_ty _    (HsSpliceTy s _)    = pprUntypedSplice s
+ppr_mono_ty _    (HsSpliceTy s _)    = pprSplice s
 ppr_mono_ty _    (HsCoreTy ty)       = ppr ty
 ppr_mono_ty _    (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
 ppr_mono_ty _    (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys)
index 4a80ebd..b1c8036 100644 (file)
@@ -53,7 +53,7 @@ module HsUtils(
   emptyRecStmt, emptyRecStmtName, emptyRecStmtId, mkRecStmt,
 
   -- Template Haskell
-  mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkHsSplice,
+  mkHsSpliceTy, mkHsSpliceE, mkHsSpliceTE, mkUntypedSplice,
   mkHsQuasiQuote, unqualQuasiQuote,
 
   -- Flags
@@ -281,23 +281,23 @@ mkRecStmt stmts  = emptyRecStmt { recS_stmts = stmts }
 mkHsOpApp :: LHsExpr id -> id -> LHsExpr id -> HsExpr id
 mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
 
-mkHsSplice :: LHsExpr RdrName -> HsSplice RdrName
-mkHsSplice e = HsSplice unqualSplice e
-
 unqualSplice :: RdrName
 unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
 
+mkUntypedSplice :: LHsExpr RdrName -> HsSplice RdrName
+mkUntypedSplice e = HsUntypedSplice unqualSplice e
+
 mkHsSpliceE :: LHsExpr RdrName -> HsExpr RdrName
-mkHsSpliceE e = HsSpliceE False (mkHsSplice e)
+mkHsSpliceE e = HsSpliceE (mkUntypedSplice e)
 
 mkHsSpliceTE :: LHsExpr RdrName -> HsExpr RdrName
-mkHsSpliceTE e = HsSpliceE True (mkHsSplice e)
+mkHsSpliceTE e = HsSpliceE (HsTypedSplice unqualSplice e)
 
 mkHsSpliceTy :: LHsExpr RdrName -> HsType RdrName
-mkHsSpliceTy e = HsSpliceTy (mkHsSplice e) placeHolderKind
+mkHsSpliceTy e = HsSpliceTy (HsUntypedSplice unqualSplice e) placeHolderKind
 
-mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsQuasiQuote RdrName
-mkHsQuasiQuote quoter span quote = HsQuasiQuote quoter span quote
+mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice RdrName
+mkHsQuasiQuote quoter span quote = HsQuasiQuote unqualSplice quoter span quote
 
 unqualQuasiQuote :: RdrName
 unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
@@ -705,7 +705,6 @@ collect_lpat (L _ pat) bndrs
     go (SigPatIn pat _)           = collect_lpat pat bndrs
     go (SigPatOut pat _)          = collect_lpat pat bndrs
     go (SplicePat _)              = bndrs
-    go (QuasiQuotePat _)          = bndrs
     go (CoPat _ pat _)            = go pat
 
 {-
index fd25e33..f9339b1 100644 (file)
@@ -20,13 +20,11 @@ module Hooks ( Hooks
              , runPhaseHook
              , runMetaHook
              , linkHook
-             , runQuasiQuoteHook
              , runRnSpliceHook
              , getValueSafelyHook
              ) where
 
 import DynFlags
-import HsTypes
 import Name
 import PipelineMonad
 import HscTypes
@@ -58,7 +56,7 @@ import Data.Maybe
 --   uses the default built-in behaviour
 
 emptyHooks :: Hooks
-emptyHooks = Hooks Nothing Nothing Nothing Nothing Nothing Nothing
+emptyHooks = Hooks Nothing Nothing Nothing Nothing Nothing
                    Nothing Nothing Nothing Nothing Nothing Nothing
                    Nothing
 
@@ -73,8 +71,7 @@ data Hooks = Hooks
   , runPhaseHook           :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
   , runMetaHook            :: Maybe (MetaHook TcM)
   , linkHook               :: Maybe (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
-  , runQuasiQuoteHook      :: Maybe (HsQuasiQuote Name -> RnM (HsQuasiQuote Name))
-  , runRnSpliceHook        :: Maybe (LHsExpr Name -> RnM (LHsExpr Name))
+  , runRnSpliceHook        :: Maybe (HsSplice Name -> RnM (HsSplice Name))
   , getValueSafelyHook     :: Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
   }
 
index 1bffbee..0d6ba25 100644 (file)
@@ -1543,7 +1543,7 @@ atype :: { LHsType RdrName }
         | '(' ctype ')'               {% ams (sLL $1 $> $ HsParTy   $2) [mop $1,mcp $3] }
         | '(' ctype '::' kind ')'     {% ams (sLL $1 $> $ HsKindSig $2 $4)
                                              [mop $1,mj AnnDcolon $3,mcp $5] }
-        | quasiquote                  { sL1 $1 (HsQuasiQuoteTy (unLoc $1)) }
+        | quasiquote                  { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
         | '$(' exp ')'                {% ams (sLL $1 $> $ mkHsSpliceTy $2)
                                              [mo $1,mc $3] }
         | TH_ID_SPLICE                { sLL $1 $> $ mkHsSpliceTy $ sL1 $1 $ HsVar $
@@ -1958,7 +1958,7 @@ explicit_activation :: { ([AddAnn],Activation) }  -- In brackets
 -----------------------------------------------------------------------------
 -- Expressions
 
-quasiquote :: { Located (HsQuasiQuote RdrName) }
+quasiquote :: { Located (HsSplice RdrName) }
         : TH_QUASIQUOTE   { let { loc = getLoc $1
                                 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1
                                 ; quoterId = mkUnqual varName quoter }
@@ -2180,7 +2180,7 @@ aexp2   :: { LHsExpr RdrName }
                                           [mo $1,mc $3] }
         | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
                                       (mo $1:mc $3:fst $2) }
-        | quasiquote          { sL1 $1 (HsQuasiQuoteE (unLoc $1)) }
+        | quasiquote          { sL1 $1 (HsSpliceE (unLoc $1)) }
 
         -- arrow notation extension
         | '(|' aexp2 cmdargs '|)'  {% ams (sLL $1 $> $ HsArrForm $2
index a1d9885..48515aa 100644 (file)
@@ -376,12 +376,10 @@ mkSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName
 --      f x            then behave as if she'd written $(f x)
 --                     ie a SpliceD
 mkSpliceDecl lexpr@(L loc expr)
-  | HsQuasiQuoteE qq <- expr          = QuasiQuoteD qq
-  | HsSpliceE is_typed splice <- expr = ASSERT( not is_typed )
-                                        SpliceD (SpliceDecl (L loc splice) ExplicitSplice)
-  | otherwise                         = SpliceD (SpliceDecl (L loc splice) ImplicitSplice)
+  | HsSpliceE splice <- expr = SpliceD (SpliceDecl (L loc splice) ExplicitSplice)
+  | otherwise                = SpliceD (SpliceDecl (L loc splice) ImplicitSplice)
   where
-    splice = mkHsSplice lexpr
+    splice = mkUntypedSplice lexpr
 
 mkRoleAnnotDecl :: SrcSpan
                 -> Located RdrName                   -- type being annotated
@@ -877,10 +875,9 @@ checkAPat msg loc e0 = do
    RecordCon c _ (HsRecFields fs dd)
                         -> do fs <- mapM (checkPatField msg) fs
                               return (ConPatIn c (RecCon (HsRecFields fs dd)))
-   HsSpliceE is_typed s | not is_typed
-                        -> return (SplicePat s)
-   HsQuasiQuoteE q      -> return (QuasiQuotePat q)
-   _                    -> patFail msg loc e0
+   HsSpliceE s | not (isTypedSplice s)
+               -> return (SplicePat s)
+   _           -> patFail msg loc e0
 
 placeHolderPunRhs :: LHsExpr RdrName
 -- The RHS of a punned record field will be filled in by the renamer
index 4cebafc..90548e7 100644 (file)
@@ -18,8 +18,6 @@ module RnExpr (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} TcSplice( runQuasiQuoteExpr )
-
 import RnBinds   ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
                    rnMatchGroup, rnGRHS, makeMiniFixityEnv)
 import HsSyn
@@ -153,14 +151,7 @@ rnExpr (NegApp e _)
 -- (not with an rnExpr crash) in a stage-1 compiler.
 rnExpr e@(HsBracket br_body) = rnBracket e br_body
 
-rnExpr (HsSpliceE is_typed splice) = rnSpliceExpr is_typed splice
-
-
-rnExpr (HsQuasiQuoteE qq)
-  = do { lexpr' <- runQuasiQuoteExpr qq
-         -- Wrap the result of the quasi-quoter in parens so that we don't
-         -- lose the outermost location set by runQuasiQuote (#7918)
-       ; rnExpr (HsPar lexpr') }
+rnExpr (HsSpliceE splice) = rnSpliceExpr splice
 
 ---------------------------------------------
 --      Sections
index 067be99..c742262 100644 (file)
@@ -36,7 +36,6 @@ module RnPat (-- main entry points
 
 import {-# SOURCE #-} RnExpr ( rnLExpr )
 import {-# SOURCE #-} RnSplice ( rnSplicePat )
-import {-# SOURCE #-} TcSplice ( runQuasiQuotePat )
 
 #include "HsVersions.h"
 
@@ -453,15 +452,9 @@ rnPatAndThen mk (TuplePat pats boxed _)
 rnPatAndThen mk (SplicePat splice)
   = do { eith <- liftCpsFV $ rnSplicePat splice
        ; case eith of   -- See Note [rnSplicePat] in RnSplice
-           Left not_yet_renamed -> rnPatAndThen mk not_yet_renamed
+           Left  not_yet_renamed -> rnPatAndThen mk not_yet_renamed
            Right already_renamed -> return already_renamed }
 
-rnPatAndThen mk (QuasiQuotePat qq)
-  = do { pat <- liftCps $ runQuasiQuotePat qq
-         -- Wrap the result of the quasi-quoter in parens so that we don't
-         -- lose the outermost location set by runQuasiQuote (#7918)
-       ; rnPatAndThen mk (ParPat pat) }
-
 rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
 
 
index ac86fc3..36534ce 100644 (file)
@@ -14,7 +14,6 @@ module RnSource (
 
 import {-# SOURCE #-} RnExpr( rnLExpr )
 import {-# SOURCE #-} RnSplice ( rnSpliceDecl )
-import {-# SOURCE #-} TcSplice ( runQuasiQuoteDecl )
 
 import HsSyn
 import RdrName
@@ -1514,10 +1513,6 @@ add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds
     badImplicitSplice = ptext (sLit "Parse error: naked expression at top level")
                      $$ ptext (sLit "Perhaps you intended to use TemplateHaskell")
 
-add gp _ (QuasiQuoteD qq) ds            -- Expand quasiquotes
-  = do { ds' <- runQuasiQuoteDecl qq
-       ; addl gp (ds' ++ ds) }
-
 -- Class declarations: pull out the fixity signatures to the top
 add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD d) ds
   | isClassDecl d
index e9cf0a5..f6296d1 100644 (file)
@@ -5,8 +5,12 @@ module RnSplice (
         rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
         rnBracket,
         checkThLocalName
+#ifdef GHCI
+        , traceSplice, SpliceInfo(..)
+#endif
   ) where
 
+#include "HsVersions.h"
 
 import Name
 import NameSet
@@ -19,19 +23,23 @@ import Kind
 import ErrUtils         ( dumpIfSet_dyn_printer )
 import Control.Monad    ( unless, when )
 import DynFlags
-import DsMeta           ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName )
+import DsMeta           ( decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, liftName )
 import LoadIface        ( loadInterfaceForName )
 import Module
 import RnEnv
 import RnPat            ( rnPat )
 import RnSource         ( rnSrcDecls, findSplice )
 import RnTypes          ( rnLHsType )
+import PrelNames        ( isUnboundName )
 import SrcLoc
 import TcEnv            ( checkWellStaged, tcMetaTy )
 import Outputable
 import BasicTypes       ( TopLevelFlag, isTopLevel )
 import FastString
 import Hooks
+import Var              ( Id )
+import DsMeta           ( quoteExpName, quotePatName, quoteDecName, quoteTypeName )
+import Util
 
 import {-# SOURCE #-} RnExpr   ( rnLExpr )
 import {-# SOURCE #-} TcExpr   ( tcMonoExpr )
@@ -49,8 +57,8 @@ rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
              -> RnM (HsType Name, FreeVars)
 rnSpliceType e _ = failTH e "Template Haskell type splice"
 
-rnSpliceExpr :: Bool -> HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
-rnSpliceExpr e = failTH e "Template Haskell splice"
+rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
+rnSpliceExpr e = failTH e "Template Haskell splice"
 
 rnSplicePat :: HsSplice RdrName -> RnM (Either (Pat RdrName) (Pat Name), FreeVars)
 rnSplicePat e = failTH e "Template Haskell pattern splice"
@@ -95,14 +103,12 @@ returns a bogus term/type, so that it can report more than one error.
 We don't want the type checker to see these bogus unbound variables.
 -}
 
-rnSpliceGen :: Bool                                     -- Typed splice?
-            -> (HsSplice Name -> RnM (a, FreeVars))     -- Outside brackets, run splice
+rnSpliceGen :: (HsSplice Name -> RnM (a, FreeVars))     -- Outside brackets, run splice
             -> (HsSplice Name -> (PendingRnSplice, a))  -- Inside brackets, make it pending
             -> HsSplice RdrName
             -> RnM (a, FreeVars)
-rnSpliceGen is_typed_splice run_splice pend_splice splice@(HsSplice _ expr)
-  = addErrCtxt (spliceCtxt (HsSpliceE is_typed_splice splice)) $
-    setSrcSpan (getLoc expr) $ do
+rnSpliceGen run_splice pend_splice splice
+  = addErrCtxt (spliceCtxt splice) $ do
     { stage <- getStage
     ; case stage of
         Brack pop_stage RnPendingTyped
@@ -121,34 +127,149 @@ rnSpliceGen is_typed_splice run_splice pend_splice splice@(HsSplice _ expr)
                 ; writeMutVar ps_var (pending_splice : ps)
                 ; return (result, fvs) }
 
-        _ ->  do { (splice', fvs1) <- setStage (Splice is_typed_splice) $
+        _ ->  do { (splice', fvs1) <- checkNoErrs $
+                                      setStage (Splice is_typed_splice) $
                                       rnSplice splice
-
+                   -- checkNoErrs: don't attempt to run the splice if
+                   -- renaming it failed; otherwise we get a cascade of
+                   -- errors from e.g. unbound variables
                  ; (result, fvs2) <- run_splice splice'
                  ; return (result, fvs1 `plusFV` fvs2) } }
+   where
+     is_typed_splice = isTypedSplice splice
+
+------------------
+runRnSplice :: UntypedSpliceFlavour
+            -> (LHsExpr Id -> TcRn res)
+            -> (res -> SDoc)    -- How to pretty-print res
+                                -- Usually just ppr, but not for [Decl]
+            -> HsSplice Name    -- Always untyped
+            -> TcRn res
+runRnSplice flavour run_meta ppr_res splice
+  = do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)
+
+       ; let the_expr = case splice' of
+                  HsUntypedSplice _ e     ->  e
+                  HsQuasiQuote _ q qs str -> mkQuasiQuoteExpr flavour q qs str
+                  HsTypedSplice {}        -> pprPanic "runRnSplice" (ppr splice)
+
+             -- Typecheck the expression
+       ; meta_exp_ty   <- tcMetaTy meta_ty_name
+       ; zonked_q_expr <- tcTopSpliceExpr False $
+                          tcMonoExpr the_expr meta_exp_ty
+
+             -- Run the expression
+       ; result <- run_meta zonked_q_expr
+       ; traceSplice (SpliceInfo { spliceDescription = what
+                                 , spliceIsDecl      = is_decl
+                                 , spliceSource      = Just the_expr
+                                 , spliceGenerated   = ppr_res result })
+
+       ; return result }
+
+  where
+    meta_ty_name = case flavour of
+                       UntypedExpSplice  -> expQTyConName
+                       UntypedPatSplice  -> patQTyConName
+                       UntypedTypeSplice -> typeQTyConName
+                       UntypedDeclSplice -> decsQTyConName
+    what = case flavour of
+                  UntypedExpSplice  -> "expression"
+                  UntypedPatSplice  -> "pattern"
+                  UntypedTypeSplice -> "type"
+                  UntypedDeclSplice -> "declarations"
+    is_decl = case flavour of
+                 UntypedDeclSplice -> True
+                 _                 -> False
+
+------------------
+makePending :: UntypedSpliceFlavour
+            -> HsSplice Name
+            -> PendingRnSplice
+makePending flavour (HsUntypedSplice n e)
+  = PendingRnSplice flavour n e
+makePending flavour (HsQuasiQuote n quoter q_span quote)
+  = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
+makePending _ splice@(HsTypedSplice {})
+  = pprPanic "makePending" (ppr splice)
+
+------------------
+mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -> LHsExpr Name
+-- Return the expression (quoter "...quote...")
+-- which is what we must run in a quasi-quote
+mkQuasiQuoteExpr flavour quoter q_span quote
+  = L q_span $ HsApp (L q_span $
+                      HsApp (L q_span (HsVar quote_selector)) quoterExpr)
+                     quoteExpr
+  where
+    quoterExpr = L q_span $! HsVar $! quoter
+    quoteExpr  = L q_span $! HsLit $! HsString "" quote
+    quote_selector = case flavour of
+                       UntypedExpSplice  -> quoteExpName
+                       UntypedPatSplice  -> quotePatName
+                       UntypedTypeSplice -> quoteTypeName
+                       UntypedDeclSplice -> quoteDecName
 
 ---------------------
 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 -- Not exported...used for all
-rnSplice (HsSplice splice_name expr)
-  = do  { checkTH expr "Template Haskell splice"
+rnSplice (HsTypedSplice splice_name expr)
+  = do  { checkTH expr "Template Haskell typed splice"
+        ; loc  <- getSrcSpanM
+        ; n' <- newLocalBndrRn (L loc splice_name)
+        ; (expr', fvs) <- rnLExpr expr
+        ; return (HsTypedSplice n' expr', fvs) }
+
+rnSplice (HsUntypedSplice splice_name expr)
+  = do  { checkTH expr "Template Haskell untyped splice"
         ; loc  <- getSrcSpanM
         ; n' <- newLocalBndrRn (L loc splice_name)
         ; (expr', fvs) <- rnLExpr expr
-        ; return (HsSplice n' expr', fvs) }
+        ; return (HsUntypedSplice n' expr', fvs) }
+
+rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
+  = do  { checkTH quoter "Template Haskell quasi-quote"
+        ; loc  <- getSrcSpanM
+        ; splice_name' <- newLocalBndrRn (L loc splice_name)
+
+          -- Drop the leading "$" from the quoter name, if present
+          -- This is old-style syntax, now deprecated
+          -- NB: when removing this backward-compat, remove
+          --     the matching code in Lexer.x (around line 310)
+        ; let occ_str = occNameString (rdrNameOcc quoter)
+        ; quoter <- if ASSERT( not (null occ_str) )  -- Lexer ensures this
+                       head occ_str /= '$'
+                    then return quoter
+                    else do { addWarn (deprecatedDollar quoter)
+                            ; return (mkRdrUnqual (mkVarOcc (tail occ_str))) }
+
+          -- Rename the quoter; akin to the HsVar case of rnExpr
+        ; quoter' <- lookupOccRn quoter
+        ; this_mod <- getModule
+        ; when (nameIsLocalOrFrom this_mod quoter') $
+          checkThLocalName quoter'
+
+        ; return (HsQuasiQuote splice_name' quoter' q_loc quote, unitFV quoter') }
+
+deprecatedDollar :: RdrName -> SDoc
+deprecatedDollar quoter
+  = hang (ptext (sLit "Deprecated syntax:"))
+       2 (ptext (sLit "quasiquotes no longer need a dollar sign:")
+          <+> ppr quoter)
+
 
 ---------------------
-rnSpliceExpr :: Bool -> HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
-rnSpliceExpr is_typed splice
-  = rnSpliceGen is_typed run_expr_splice pend_expr_splice splice
+rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
+rnSpliceExpr splice
+  = rnSpliceGen run_expr_splice pend_expr_splice splice
   where
     pend_expr_splice :: HsSplice Name -> (PendingRnSplice, HsExpr Name)
-    pend_expr_splice rn_splice@(HsSplice n e)
-        = (PendingRnExpSplice (PendSplice n e), HsSpliceE is_typed rn_splice)
+    pend_expr_splice rn_splice
+        = (makePending UntypedExpSplice rn_splice, HsSpliceE rn_splice)
 
     run_expr_splice :: HsSplice Name -> RnM (HsExpr Name, FreeVars)
-    run_expr_splice rn_splice@(HsSplice _ expr')
-      | is_typed   -- Run it later, in the type checker
+    run_expr_splice rn_splice
+      | isTypedSplice rn_splice   -- Run it later, in the type checker
       = do {  -- Ugh!  See Note [Splices] above
              lcl_rdr <- getLocalRdrEnv
            ; gbl_rdr <- getGlobalRdrEnv
@@ -156,53 +277,67 @@ rnSpliceExpr is_typed splice
                                                      , isLocalGRE gre]
                  lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
 
-           ; return (HsSpliceE is_typed rn_splice, lcl_names `plusFV` gbl_names) }
+           ; return (HsSpliceE rn_splice, lcl_names `plusFV` gbl_names) }
 
       | otherwise  -- Run it here
-      = do { expr <- getHooked runRnSpliceHook return >>= ($ expr')
-
-             -- The splice must have type ExpQ
-           ; meta_exp_ty <- tcMetaTy expQTyConName
-
-             -- Typecheck the expression
-           ; zonked_q_expr <- tcTopSpliceExpr False $
-                              tcMonoExpr expr meta_exp_ty
-
-             -- Run the expression
-           ; expr2 <- runMetaE zonked_q_expr
-           ; showSplice "expression" expr (ppr expr2)
-
-           ; (lexpr3, fvs) <- checkNoErrs $
-                              rnLExpr expr2
-           ; return (unLoc lexpr3, fvs)  }
+      = do { rn_expr <- runRnSplice UntypedExpSplice runMetaE ppr rn_splice
+           ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
+           ; return (HsPar lexpr3, fvs)  }
 
 ----------------------
 rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
              -> RnM (HsType Name, FreeVars)
 rnSpliceType splice k
-  = rnSpliceGen False run_type_splice pend_type_splice splice
+  = rnSpliceGen run_type_splice pend_type_splice splice
   where
-    pend_type_splice rn_splice@(HsSplice n e)
-       = (PendingRnTypeSplice (PendSplice n e), HsSpliceTy rn_splice k)
+    pend_type_splice rn_splice
+       = (makePending UntypedTypeSplice rn_splice, HsSpliceTy rn_splice k)
 
-    run_type_splice (HsSplice _ expr')
-       = do { expr <- getHooked runRnSpliceHook return >>= ($ expr')
+    run_type_splice rn_splice
+      = do { hs_ty2 <- runRnSplice UntypedTypeSplice runMetaT ppr rn_splice
+           ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
+                                 ; checkNoErrs $ rnLHsType doc hs_ty2 }
+                                    -- checkNoErrs: see Note [Renamer errors]
+           ; return (HsParTy hs_ty3, fvs) }
+              -- Wrap the result of the splice in parens so that we don't
+              -- lose the outermost location set by runQuasiQuote (#7918)
 
-            ; meta_exp_ty <- tcMetaTy typeQTyConName
+----------------------
+-- | Rename a splice pattern. See Note [rnSplicePat]
+rnSplicePat :: HsSplice RdrName -> RnM ( Either (Pat RdrName) (Pat Name)
+                                       , FreeVars)
+rnSplicePat splice
+  = rnSpliceGen run_pat_splice pend_pat_splice splice
+  where
+    pend_pat_splice rn_splice
+      = (makePending UntypedPatSplice rn_splice, Right (SplicePat rn_splice))
 
-              -- Typecheck the expression
-            ; zonked_q_expr <- tcTopSpliceExpr False $
-                               tcMonoExpr expr meta_exp_ty
+    run_pat_splice rn_splice
+      = do { pat <- runRnSplice UntypedPatSplice runMetaP ppr rn_splice
+           ; return (Left (ParPat pat), emptyFVs) }
+              -- Wrap the result of the quasi-quoter in parens so that we don't
+              -- lose the outermost location set by runQuasiQuote (#7918)
 
-              -- Run the expression
-            ; hs_ty2 <- runMetaT zonked_q_expr
-            ; showSplice "type" expr (ppr hs_ty2)
+----------------------
+rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
+rnSpliceDecl (SpliceDecl (L loc splice) flg)
+  = rnSpliceGen run_decl_splice pend_decl_splice splice
+  where
+    pend_decl_splice rn_splice
+       = (makePending UntypedDeclSplice rn_splice, SpliceDecl (L loc rn_splice) flg)
 
-            ; (hs_ty3, fvs) <- do { let doc = SpliceTypeCtx hs_ty2
-                                  ; checkNoErrs $ rnLHsType doc hs_ty2
-                                    -- checkNoErrs: see Note [Renamer errors]
-                                  }
-            ; return (unLoc hs_ty3, fvs) }
+    run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
+
+rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
+-- Declaration splice at the very top level of the module
+rnTopSpliceDecls splice
+   = do  { (rn_splice, fvs) <- setStage (Splice False) $
+                               rnSplice splice
+         ; decls <- runRnSplice UntypedDeclSplice runMetaD ppr_decls rn_splice
+         ; return (decls,fvs) }
+   where
+     ppr_decls :: [LHsDecl RdrName] -> SDoc
+     ppr_decls ds = vcat (map ppr ds)
 
 {-
 Note [rnSplicePat]
@@ -228,61 +363,6 @@ Pat RdrName (the result of running a top-level splice) or a Pat Name
 rnSplicePat.
 -}
 
--- | Rename a splice pattern. See Note [rnSplicePat]
-rnSplicePat :: HsSplice RdrName -> RnM ( Either (Pat RdrName) (Pat Name)
-                                       , FreeVars)
-rnSplicePat splice
-  = rnSpliceGen False run_pat_splice pend_pat_splice splice
-  where
-    pend_pat_splice rn_splice@(HsSplice n e)
-      = (PendingRnPatSplice (PendSplice n e), Right $ SplicePat rn_splice)
-
-    run_pat_splice (HsSplice _ expr')
-      = do { expr <- getHooked runRnSpliceHook return >>= ($ expr')
-
-           ; meta_exp_ty <- tcMetaTy patQTyConName
-
-             -- Typecheck the expression
-           ; zonked_q_expr <- tcTopSpliceExpr False $
-                              tcMonoExpr expr meta_exp_ty
-
-             -- Run the expression
-           ; pat <- runMetaP zonked_q_expr
-           ; showSplice "pattern" expr (ppr pat)
-
-           ; return (Left $ unLoc pat, emptyFVs) }
-
-----------------------
-rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
-rnSpliceDecl (SpliceDecl (L loc splice) flg)
-  = rnSpliceGen False run_decl_splice pend_decl_splice splice
-  where
-    pend_decl_splice rn_splice@(HsSplice n e)
-       = (PendingRnDeclSplice (PendSplice n e), SpliceDecl(L loc rn_splice) flg)
-
-    run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
-
-rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
--- Declaration splice at the very top level of the module
-rnTopSpliceDecls (HsSplice _ expr'')
-   = do  { (expr, fvs) <- setStage (Splice False) $
-                           rnLExpr expr''
-
-         ; expr' <- getHooked runRnSpliceHook return >>= ($ expr)
-
-         ; list_q <- tcMetaTy decsQTyConName     -- Q [Dec]
-         ; zonked_q_expr <- tcTopSpliceExpr False (tcMonoExpr expr' list_q)
-
-                -- Run the expression
-         ; decls <- runMetaD zonked_q_expr
-         ; traceSplice $ SpliceInfo True
-                                    "declarations"
-                                    (Just (getLoc expr))
-                                    (Just $ ppr expr')
-                                    (vcat (map ppr decls))
-
-         ; return (decls,fvs) }
-
 {-
 ************************************************************************
 *                                                                      *
@@ -399,64 +479,61 @@ rn_bracket _ (DecBrG _) = panic "rn_bracket: unexpected DecBrG"
 rn_bracket _ (TExpBr e) = do { (e', fvs) <- rnLExpr e
                              ; return (TExpBr e', fvs) }
 
-spliceCtxt :: HsExpr RdrName -> SDoc
-spliceCtxt expr= hang (ptext (sLit "In the splice:")) 2 (ppr expr)
-
-showSplice :: String -> LHsExpr Name -> SDoc -> TcM ()
--- Note that 'before' is *renamed* but not *typechecked*
--- Reason (a) less typechecking crap
---        (b) data constructors after type checking have been
---            changed to their *wrappers*, and that makes them
---            print always fully qualified
-showSplice what before after =
-    traceSplice $ SpliceInfo False what Nothing (Just $ ppr before) after
+spliceCtxt :: HsSplice RdrName -> SDoc
+spliceCtxt splice
+  = hang (ptext (sLit "In the") <+> what) 2 (ppr splice)
+  where
+    what = case splice of
+             HsUntypedSplice {} -> ptext (sLit "untyped splice:")
+             HsTypedSplice   {} -> ptext (sLit "typed splice:")
+             HsQuasiQuote    {} -> ptext (sLit "quasi-quotation:")
 
 -- | The splice data to be logged
---
--- duplicates code in TcSplice.hs
 data SpliceInfo
   = SpliceInfo
-    { spliceIsDeclaration :: Bool
-    , spliceDescription   :: String
-    , spliceLocation      :: Maybe SrcSpan
-    , spliceSource        :: Maybe SDoc
+    { spliceDescription   :: String
+    , spliceSource        :: Maybe (LHsExpr Name)  -- Nothing <=> top-level decls
+                                                   --        added by addTopDecls
+    , spliceIsDecl        :: Bool    -- True <=> put the generate code in a file
+                                     --          when -dth-dec-file is on
     , spliceGenerated     :: SDoc
     }
+        -- Note that 'spliceSource' is *renamed* but not *typechecked*
+        -- Reason (a) less typechecking crap
+        --        (b) data constructors after type checking have been
+        --            changed to their *wrappers*, and that makes them
+        --            print always fully qualified
 
 -- | outputs splice information for 2 flags which have different output formats:
 -- `-ddump-splices` and `-dth-dec-file`
---
--- This duplicates code in TcSplice.hs
 traceSplice :: SpliceInfo -> TcM ()
-traceSplice sd = do
-    loc <- case sd of
-        SpliceInfo { spliceLocation = Nothing }  -> getSrcSpanM
-        SpliceInfo { spliceLocation = Just loc } -> return loc
-    traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc sd)
-    when (spliceIsDeclaration sd) $ do
-        dflags <- getDynFlags
-        liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file
-                                       (spliceCodeDoc loc sd)
+traceSplice (SpliceInfo { spliceDescription = sd, spliceSource = mb_src
+                        , spliceGenerated = gen, spliceIsDecl = is_decl })
+  = do { loc <- case mb_src of
+                   Nothing        -> getSrcSpanM
+                   Just (L loc _) -> return loc
+       ; traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc)
+
+       ; when is_decl $  -- Raw material for -dth-dec-file
+         do { dflags <- getDynFlags
+            ; liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file
+                                             (spliceCodeDoc loc) } }
   where
     -- `-ddump-splices`
-    spliceDebugDoc :: SrcSpan -> SpliceInfo -> SDoc
-    spliceDebugDoc loc sd
-      = let code = case spliceSource sd of
-                Nothing -> ending
-                Just b  -> nest 2 b : ending
-            ending = [ text "======>", nest 2 (spliceGenerated sd) ]
-        in  (vcat [   ppr loc <> colon
-                  <+> text "Splicing" <+> text (spliceDescription sd)
-                  , nest 2 (sep code)
-                  ])
+    spliceDebugDoc :: SrcSpan -> SDoc
+    spliceDebugDoc loc
+      = let code = case mb_src of
+                     Nothing -> ending
+                     Just e  -> nest 2 (ppr e) : ending
+            ending = [ text "======>", nest 2 gen ]
+        in  hang (ppr loc <> colon <+> text "Splicing" <+> text sd)
+               2 (sep code)
 
     -- `-dth-dec-file`
-    spliceCodeDoc :: SrcSpan -> SpliceInfo -> SDoc
-    spliceCodeDoc loc sd
-      = (vcat [    text "--" <+> ppr loc <> colon
-               <+> text "Splicing" <+> text (spliceDescription sd)
-              , sep [spliceGenerated sd]
-              ])
+    spliceCodeDoc :: SrcSpan -> SDoc
+    spliceCodeDoc loc
+      = vcat [ text "--" <+> ppr loc <> colon <+> text "Splicing" <+> text sd
+             , gen ]
 
 illegalBracket :: SDoc
 illegalBracket = ptext (sLit "Template Haskell brackets cannot be nested (without intervening splices)")
@@ -499,6 +576,10 @@ checkThLocalName _name
 
 #else         /* GHCI and TH is on */
 checkThLocalName name
+  | isUnboundName name   -- Do not report two errors for
+  = return ()            --   $(not_in_scope args)
+
+  | otherwise
   = do  { traceRn (text "checkThLocalName" <+> ppr name)
         ; mb_local_use <- getStageAndBindLevel name
         ; case mb_local_use of {
@@ -534,15 +615,20 @@ checkCrossStageLifting top_lvl name (Brack _ (RnPendingUntyped ps_var))
         -- E.g. \x -> [| h x |]
         -- We must behave as if the reference to x was
         --      h $(lift x)
-        -- We use 'x' itself as the splice proxy, used by
+        -- We use 'x' itself as the SplicePointName, used by
         -- the desugarer to stitch it all back together.
         -- If 'x' occurs many times we may get many identical
-        -- bindings of the same splice proxy, but that doesn't
+        -- bindings of the same SplicePointName, but that doesn't
         -- matter, although it's a mite untidy.
     do  { traceRn (text "checkCrossStageLifting" <+> ppr name)
-        ; -- Update the pending splices
+
+          -- Construct the (lift x) expression
+        ; let lift_expr   = nlHsApp (nlHsVar liftName) (nlHsVar name)
+              pend_splice = PendingRnSplice UntypedExpSplice name lift_expr
+
+          -- Update the pending splices
         ; ps <- readMutVar ps_var
-        ; writeMutVar ps_var (PendingRnCrossStageSplice name : ps) }
+        ; writeMutVar ps_var (pend_splice : ps) }
 
 checkCrossStageLifting _ _ _ = return ()
 #endif /* GHCI */
index 8d3b797..7040b41 100644 (file)
@@ -25,7 +25,6 @@ module RnTypes (
         extractWildcards, filterInScope
   ) where
 
-import {-# SOURCE #-} TcSplice( runQuasiQuoteType )
 import {-# SOURCE #-} RnSplice( rnSpliceType )
 
 import DynFlags
@@ -295,13 +294,6 @@ rnHsTyKi isType doc (HsDocTy ty haddock_doc)
        ; haddock_doc' <- rnLHsDoc haddock_doc
        ; return (HsDocTy ty' haddock_doc', fvs) }
 
-rnHsTyKi isType doc (HsQuasiQuoteTy qq)
-  = ASSERT( isType )
-    do { ty <- runQuasiQuoteType qq
-         -- Wrap the result of the quasi-quoter in parens so that we don't
-         -- lose the outermost location set by runQuasiQuote (#7918)
-       ; rnHsType doc (HsParTy ty) }
-
 rnHsTyKi isType _ (HsCoreTy ty)
   = ASSERT( isType )
     return (HsCoreTy ty, emptyFVs)
@@ -984,7 +976,6 @@ extract_lty (L _ ty) acc
       HsOpTy ty1 (_, (L _ tv)) ty2 -> extract_tv tv (extract_lty ty1 (extract_lty ty2 acc))
       HsParTy ty                -> extract_lty ty acc
       HsCoreTy {}               -> acc  -- The type is closed
-      HsQuasiQuoteTy {}         -> acc  -- Quasi quotes mention no type variables
       HsSpliceTy {}             -> acc  -- Type splices mention no type variables
       HsDocTy ty _              -> extract_lty ty acc
       HsExplicitListTy _ tys    -> extract_ltys tys acc
index cd28352..564b1f3 100644 (file)
@@ -626,7 +626,7 @@ stageRestrictionError :: SDoc -> TcM a
 stageRestrictionError pp_thing
   = failWithTc $
     sep [ ptext (sLit "GHC stage restriction:")
-        , nest 2 (vcat [ pp_thing <+> ptext (sLit "is used in a top-level splice or annotation,")
+        , nest 2 (vcat [ pp_thing <+> ptext (sLit "is used in a top-level splice, quasi-quote, or annotation,")
                        , ptext (sLit "and must be imported, not defined locally")])]
 
 topIdLvl :: Id -> ThLevel
index 7f7b6a1..b8ab372 100644 (file)
@@ -822,10 +822,7 @@ tcExpr (PArrSeq _ _) _
 ************************************************************************
 -}
 
-tcExpr (HsSpliceE is_ty splice)  res_ty
-  = ASSERT( is_ty )   -- Untyped splices are expanded by the renamer
-   tcSpliceExpr splice res_ty
-
+tcExpr (HsSpliceE splice)        res_ty = tcSpliceExpr splice res_ty
 tcExpr (HsBracket brack)         res_ty = tcTypedBracket   brack res_ty
 tcExpr (HsRnBracketOut brack ps) res_ty = tcUntypedBracket brack ps res_ty
 
@@ -1293,7 +1290,7 @@ checkCrossStageLifting id (Brack _ (TcPending ps_var lie_var))
 
                    -- Update the pending splices
         ; ps <- readMutVar ps_var
-        ; let pending_splice = PendSplice (idName id) (nlHsApp (noLoc lift) (nlHsVar id))
+        ; let pending_splice = PendingTcSplice (idName id) (nlHsApp (noLoc lift) (nlHsVar id))
         ; writeMutVar ps_var (pending_splice : ps)
 
         ; return () }
index 1f6974c..b46212e 100644 (file)
@@ -614,11 +614,11 @@ zonkExpr env (HsTcBracketOut body bs)
   = do bs' <- mapM zonk_b bs
        return (HsTcBracketOut body bs')
   where
-    zonk_b (PendSplice n e) = do e' <- zonkLExpr env e
-                                 return (PendSplice n e')
+    zonk_b (PendingTcSplice n e) = do e' <- zonkLExpr env e
+                                      return (PendingTcSplice n e')
 
-zonkExpr _ (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
-                             return (HsSpliceE t s)
+zonkExpr _ (HsSpliceE s) = WARN( True, ppr s ) -- Should not happen
+                           return (HsSpliceE s)
 
 zonkExpr env (OpApp e1 op fixity e2)
   = do new_e1 <- zonkLExpr env e1
index 937b5e8..0cb128e 100644 (file)
@@ -343,7 +343,6 @@ tc_fun_type ty ty1 ty2 exp_kind@(EK _ ctxt)
 tc_hs_type :: HsType Name -> ExpKind -> TcM TcType
 tc_hs_type (HsParTy ty)        exp_kind = tc_lhs_type ty exp_kind
 tc_hs_type (HsDocTy ty _)      exp_kind = tc_lhs_type ty exp_kind
-tc_hs_type (HsQuasiQuoteTy {}) _ = panic "tc_hs_type: qq"       -- Eliminated by renamer
 tc_hs_type ty@(HsBangTy {})    _
     -- While top-level bangs at this point are eliminated (eg !(Maybe Int)),
     -- other kinds of bangs are not (eg ((!Maybe) Int)). These kinds of
index 14c5dbf..daf0fbd 100644 (file)
@@ -474,9 +474,6 @@ tc_pat penv lpat@(LazyPat pat) pat_ty thing_inside
 
         ; return (LazyPat pat', res) }
 
-tc_pat _ p@(QuasiQuotePat _) _ _
-  = pprPanic "Should never see QuasiQuotePat in type checker" (ppr p)
-
 tc_pat _ (WildPat _) pat_ty thing_inside
   = do  { res <- thing_inside
         ; return (WildPat pat_ty, res) }
index 9cc8222..e7220db 100644 (file)
@@ -492,7 +492,6 @@ tcCheckPatSynPat = go
     go1   (SigPatIn pat _)    = go pat
     go1   (ViewPat _ pat _)   = go pat
     go1 p@SplicePat{}         = thInPatSynErr p
-    go1 p@QuasiQuotePat{}     = thInPatSynErr p
     go1 p@NPlusKPat{}         = nPlusKPatInPatSynErr p
     go1   ConPatOut{}         = panic "ConPatOut in output of renamer"
     go1   SigPatOut{}         = panic "SigPatOut in output of renamer"
@@ -575,7 +574,6 @@ tcCollectEx = return . go
     go1 (TuplePat ps _ _)   = mconcat . map go $ ps
     go1 (PArrPat ps _)      = mconcat . map go $ ps
     go1 (ViewPat _ p _)     = go p
-    go1 (QuasiQuotePat qq)  = pprPanic "TODO: tcInstPatSyn QuasiQuotePat" $ ppr qq
     go1 con@ConPatOut{}     = mappend (mkVarSet (pat_tvs con), pat_dicts con) $
                                  goConDetails $ pat_args con
     go1 (SigPatOut p _)     = go p
index 16d0ef6..8f94d6c 100644 (file)
@@ -24,8 +24,8 @@ module TcRnDriver (
     ) where
 
 #ifdef GHCI
-import {-# SOURCE #-} TcSplice ( runQuasi, traceSplice, SpliceInfo(..) )
-import RnSplice ( rnTopSpliceDecls )
+import {-# SOURCE #-} TcSplice ( runQuasi )
+import RnSplice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) )
 #endif
 
 import DynFlags
@@ -568,11 +568,10 @@ tc_rn_src_decls boot_details ds
 
                     -- Dump generated top-level declarations
                     ; let msg = "top-level declarations added with addTopDecls"
-                    ; traceSplice $ SpliceInfo True
-                                               msg
-                                               Nothing
-                                               Nothing
-                                               (ppr th_rn_decls)
+                    ; traceSplice $ SpliceInfo { spliceDescription = msg
+                                               , spliceIsDecl    = True
+                                               , spliceSource    = Nothing
+                                               , spliceGenerated = ppr th_rn_decls }
 
                     ; return (tcg_env, appendGroups rn_decls th_rn_decls)
                     }
index fa777b3..1611a99 100644 (file)
@@ -13,15 +13,15 @@ module TcSplice(
      -- These functions are defined in stage1 and stage2
      -- The raise civilised errors in stage1
      tcSpliceExpr, tcTypedBracket, tcUntypedBracket,
-     runQuasiQuoteExpr, runQuasiQuotePat,
-     runQuasiQuoteDecl, runQuasiQuoteType,
+--     runQuasiQuoteExpr, runQuasiQuotePat,
+--     runQuasiQuoteDecl, runQuasiQuoteType,
      runAnnotation,
 
 #ifdef GHCI
      -- These ones are defined only in stage2, and are
      -- called only in stage2 (ie GHCI is on)
      runMetaE, runMetaP, runMetaT, runMetaD, runQuasi,
-     tcTopSpliceExpr, lookupThName_maybe, traceSplice, SpliceInfo(..),
+     tcTopSpliceExpr, lookupThName_maybe,
      defaultRunMeta, runMeta'
 #endif
       ) where
@@ -32,14 +32,14 @@ import HsSyn
 import Annotations
 import Name
 import TcRnMonad
-import RdrName
 import TcType
 
 #ifdef GHCI
 import HscMain
         -- These imports are the reason that TcSplice
         -- is very high up the module hierarchy
-
+import RnSplice( traceSplice, SpliceInfo(..) )
+import RdrName
 import HscTypes
 import Convert
 import RnExpr
@@ -94,7 +94,6 @@ import Panic
 import Lexeme
 import FastString
 import Outputable
-import Control.Monad    ( when )
 
 import DsMeta
 import qualified Language.Haskell.TH as TH
@@ -124,10 +123,10 @@ tcUntypedBracket :: HsBracket Name -> [PendingRnSplice] -> TcRhoType -> TcM (HsE
 tcSpliceExpr     :: HsSplice Name  -> TcRhoType -> TcM (HsExpr TcId)
         -- None of these functions add constraints to the LIE
 
-runQuasiQuoteExpr :: HsQuasiQuote RdrName -> RnM (LHsExpr RdrName)
-runQuasiQuotePat  :: HsQuasiQuote RdrName -> RnM (LPat RdrName)
-runQuasiQuoteType :: HsQuasiQuote RdrName -> RnM (LHsType RdrName)
-runQuasiQuoteDecl :: HsQuasiQuote RdrName -> RnM [LHsDecl RdrName]
+-- runQuasiQuoteExpr :: HsQuasiQuote RdrName -> RnM (LHsExpr RdrName)
+-- runQuasiQuotePat  :: HsQuasiQuote RdrName -> RnM (LPat RdrName)
+-- runQuasiQuoteType :: HsQuasiQuote RdrName -> RnM (LHsType RdrName)
+-- runQuasiQuoteDecl :: HsQuasiQuote RdrName -> RnM [LHsDecl RdrName]
 
 runAnnotation     :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
 
@@ -136,10 +135,10 @@ tcTypedBracket   x _   = failTH x "Template Haskell bracket"
 tcUntypedBracket x _ _ = failTH x "Template Haskell bracket"
 tcSpliceExpr  e _      = failTH e "Template Haskell splice"
 
-runQuasiQuoteExpr q = failTH q "quasiquote"
-runQuasiQuotePat  q = failTH q "pattern quasiquote"
-runQuasiQuoteType q = failTH q "type quasiquote"
-runQuasiQuoteDecl q = failTH q "declaration quasiquote"
+-- runQuasiQuoteExpr q = failTH q "quasiquote"
+-- runQuasiQuotePat  q = failTH q "pattern quasiquote"
+-- runQuasiQuoteType q = failTH q "type quasiquote"
+-- runQuasiQuoteDecl q = failTH q "declaration quasiquote"
 runAnnotation   _ q = failTH q "annotation"
 
 #else
@@ -381,37 +380,24 @@ tcBrackTy (TExpBr _)  = panic "tcUntypedBracket: Unexpected TExpBr"
 
 ---------------
 tcPendingSplice :: PendingRnSplice -> TcM PendingTcSplice
-tcPendingSplice (PendingRnExpSplice (PendSplice n expr))
-  = do { res_ty <- tcMetaTy expQTyConName
-       ; tc_pending_splice n expr res_ty }
-tcPendingSplice (PendingRnPatSplice (PendSplice n expr))
-  = do { res_ty <- tcMetaTy patQTyConName
-       ; tc_pending_splice n expr res_ty }
-tcPendingSplice (PendingRnTypeSplice (PendSplice n expr))
-  = do { res_ty <- tcMetaTy typeQTyConName
-       ; tc_pending_splice n expr res_ty }
-tcPendingSplice (PendingRnDeclSplice (PendSplice n expr))
-  = do { res_ty <- tcMetaTy decsQTyConName
-       ; tc_pending_splice n expr res_ty }
-
-tcPendingSplice (PendingRnCrossStageSplice n)
-  -- Behave like $(lift x); not very pretty
-  = do { res_ty <- tcMetaTy expQTyConName
-       ; tc_pending_splice n (nlHsApp (nlHsVar liftName) (nlHsVar n)) res_ty }
-
----------------
-tc_pending_splice :: Name -> LHsExpr Name -> TcRhoType -> TcM PendingTcSplice
-tc_pending_splice splice_name expr res_ty
-  = do { expr' <- tcMonoExpr expr res_ty
-       ; return (PendSplice splice_name expr') }
+tcPendingSplice (PendingRnSplice flavour splice_name expr)
+  = do { res_ty <- tcMetaTy meta_ty_name
+       ; expr' <- tcMonoExpr expr res_ty
+       ; return (PendingTcSplice splice_name expr') }
+  where
+     meta_ty_name = case flavour of
+                       UntypedExpSplice  -> expQTyConName
+                       UntypedPatSplice  -> patQTyConName
+                       UntypedTypeSplice -> typeQTyConName
+                       UntypedDeclSplice -> decsQTyConName
 
 ---------------
 -- Takes a type tau and returns the type Q (TExp tau)
 tcTExpTy :: TcType -> TcM TcType
-tcTExpTy tau = do
-    q <- tcLookupTyCon qTyConName
-    texp <- tcLookupTyCon tExpTyConName
-    return (mkTyConApp q [mkTyConApp texp [tau]])
+tcTExpTy tau
+  = do { q    <- tcLookupTyCon qTyConName
+       ; texp <- tcLookupTyCon tExpTyConName
+       ; return (mkTyConApp q [mkTyConApp texp [tau]]) }
 
 {-
 ************************************************************************
@@ -421,7 +407,7 @@ tcTExpTy tau = do
 ************************************************************************
 -}
 
-tcSpliceExpr splice@(HsSplice name expr) res_ty
+tcSpliceExpr splice@(HsTypedSplice name expr) res_ty
   = addErrCtxt (spliceCtxtDoc splice) $
     setSrcSpan (getLoc expr)    $ do
     { stage <- getStage
@@ -429,6 +415,8 @@ tcSpliceExpr splice@(HsSplice name expr) res_ty
         Splice {}            -> tcTopSplice expr res_ty
         Comp                 -> tcTopSplice expr res_ty
         Brack pop_stage pend -> tcNestedSplice pop_stage pend name expr res_ty }
+tcSpliceExpr splice _
+  = pprPanic "tcSpliceExpr" (ppr splice)
 
 tcNestedSplice :: ThStage -> PendingStuff -> Name
                 -> LHsExpr Name -> TcRhoType -> TcM (HsExpr Id)
@@ -442,7 +430,7 @@ tcNestedSplice pop_stage (TcPending ps_var lie_var) splice_name expr res_ty
        ; untypeq <- tcLookupId unTypeQName
        ; let expr'' = mkHsApp (nlHsTyApp untypeq [res_ty]) expr'
        ; ps <- readMutVar ps_var
-       ; writeMutVar ps_var (PendSplice splice_name expr'' : ps)
+       ; writeMutVar ps_var (PendingTcSplice splice_name expr'' : ps)
 
        -- The returned expression is ignored; it's in the pending splices
        ; return (panic "tcSpliceExpr") }
@@ -460,7 +448,10 @@ tcTopSplice expr res_ty
 
          -- Run the expression
        ; expr2 <- runMetaE zonked_q_expr
-       ; showSplice False "expression" expr (ppr expr2)
+       ; traceSplice (SpliceInfo { spliceDescription = "expression"
+                                 , spliceIsDecl      = False
+                                 , spliceSource      = Just expr
+                                 , spliceGenerated   = ppr expr2 })
 
          -- Rename and typecheck the spliced-in expression,
          -- making sure it has type res_ty
@@ -486,7 +477,7 @@ quotationCtxtDoc br_body
 spliceCtxtDoc :: HsSplice Name -> SDoc
 spliceCtxtDoc splice
   = hang (ptext (sLit "In the Template Haskell splice"))
-         2 (pprTypedSplice splice)
+         2 (pprSplice splice)
 
 spliceResultDoc :: LHsExpr Name -> SDoc
 spliceResultDoc expr
@@ -575,114 +566,6 @@ convertAnnotationWrapper  annotation_wrapper = Right $
                 seqSerialized serialized `seq` serialized
 
 
-{-
-************************************************************************
-*                                                                      *
-        Quasi-quoting
-*                                                                      *
-************************************************************************
-
-Note [Quasi-quote overview]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The GHC "quasi-quote" extension is described by Geoff Mainland's paper
-"Why it's nice to be quoted: quasiquoting for Haskell" (Haskell
-Workshop 2007).
-
-Briefly, one writes
-        [p| stuff |]
-and the arbitrary string "stuff" gets parsed by the parser 'p', whose
-type should be Language.Haskell.TH.Quote.QuasiQuoter.  'p' must be
-defined in another module, because we are going to run it here.  It's
-a bit like a TH splice:
-        $(p "stuff")
-
-However, you can do this in patterns as well as terms.  Because of this,
-the splice is run by the *renamer* rather than the type checker.
-
-************************************************************************
-*                                                                      *
-\subsubsection{Quasiquotation}
-*                                                                      *
-************************************************************************
-
-See Note [Quasi-quote overview] in TcSplice.
--}
-
-runQuasiQuote :: Outputable hs_syn
-              => HsQuasiQuote RdrName   -- Contains term of type QuasiQuoter, and the String
-              -> Name                   -- Of type QuasiQuoter -> String -> Q th_syn
-              -> Name                   -- Name of th_syn type
-              -> String                 -- Description of splice type
-              -> (MetaHook RnM -> LHsExpr Id -> RnM hs_syn)
-              -> RnM hs_syn
-runQuasiQuote (HsQuasiQuote quoter q_span quote) quote_selector meta_ty descr meta_req
-  = do  {     -- Drop the leading "$" from the quoter name, if present
-              -- This is old-style syntax, now deprecated
-              -- NB: when removing this backward-compat, remove
-              --     the matching code in Lexer.x (around line 310)
-          let occ_str = occNameString (rdrNameOcc quoter)
-        ; quoter <- ASSERT( not (null occ_str) )  -- Lexer ensures this
-                    if head occ_str /= '$' then return quoter
-                    else do { addWarn (deprecatedDollar quoter)
-                            ; return (mkRdrUnqual (mkVarOcc (tail occ_str))) }
-
-        ; quoter' <- lookupOccRn quoter
-                -- We use lookupOcc rather than lookupGlobalOcc because in the
-                -- erroneous case of \x -> [x| ...|] we get a better error message
-                -- (stage restriction rather than out of scope).
-
-        ; when (isUnboundName quoter') failM
-                -- If 'quoter' is not in scope, proceed no further
-                -- The error message was generated by lookupOccRn, but it then
-                -- succeeds with an "unbound name", which makes the subsequent
-                -- attempt to run the quote fail in a confusing way
-
-          -- Check that the quoter is not locally defined, otherwise the TH
-          -- machinery will not be able to run the quasiquote.
-        ; this_mod <- getModule
-        ; let is_local = nameIsLocalOrFrom this_mod quoter'
-        ; checkTc (not is_local) (quoteStageError quoter')
-
-        ; traceTc "runQQ" (ppr quoter <+> ppr is_local)
-        ; HsQuasiQuote quoter'' _ quote' <- getHooked runQuasiQuoteHook return >>=
-             ($ HsQuasiQuote quoter' q_span quote)
-
-          -- Build the expression
-        ; let quoterExpr = L q_span $! HsVar $! quoter''
-        ; let quoteExpr = L q_span $! HsLit $! HsString "" quote'
-        ; let expr = L q_span $
-                     HsApp (L q_span $
-                            HsApp (L q_span (HsVar quote_selector)) quoterExpr) quoteExpr
-        ; meta_exp_ty <- tcMetaTy meta_ty
-
-        -- Typecheck the expression
-        ; zonked_q_expr <- tcTopSpliceExpr False (tcMonoExpr expr meta_exp_ty)
-
-        -- Run the expression
-        ; result <- runMeta meta_req zonked_q_expr
-        ; showSplice (descr == "declarations") descr quoteExpr (ppr result)
-
-        ; return result }
-
-runQuasiQuoteExpr qq
-  = runQuasiQuote qq quoteExpName  expQTyConName  "expression"   metaRequestE
-runQuasiQuotePat  qq
-  = runQuasiQuote qq quotePatName  patQTyConName  "pattern"      metaRequestP
-runQuasiQuoteType qq
-  = runQuasiQuote qq quoteTypeName typeQTyConName "type"         metaRequestT
-runQuasiQuoteDecl qq
-  = runQuasiQuote qq quoteDecName  decsQTyConName "declarations" metaRequestD
-
-quoteStageError :: Name -> SDoc
-quoteStageError quoter
-  = sep [ptext (sLit "GHC stage restriction:") <+> ppr quoter,
-         nest 2 (ptext (sLit "is used in a quasiquote, and must be imported, not defined locally"))]
-
-deprecatedDollar :: RdrName -> SDoc
-deprecatedDollar quoter
-  = hang (ptext (sLit "Deprecated syntax:"))
-       2 (ptext (sLit "quasiquotes no longer need a dollar sign:")
-          <+> ppr quoter)
 
 {-
 ************************************************************************
@@ -959,69 +842,6 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
       th_state_var <- fmap tcg_th_state getGblEnv
       updTcRef th_state_var (\m -> Map.insert (typeOf x) (toDyn x) m)
 
-{-
-************************************************************************
-*                                                                      *
-\subsection{Errors and contexts}
-*                                                                      *
-************************************************************************
--}
-
--- Note that 'before' is *renamed* but not *typechecked*
--- Reason (a) less typechecking crap
---        (b) data constructors after type checking have been
---            changed to their *wrappers*, and that makes them
---            print always fully qualified
-showSplice :: Bool -> String -> LHsExpr Name -> SDoc -> TcM ()
-showSplice isDec what before after =
-    traceSplice $ SpliceInfo isDec what Nothing (Just $ ppr before) after
-
--- | The splice data to be logged
---
--- duplicates code in RnSplice.hs
-data SpliceInfo
-  = SpliceInfo
-    { spliceIsDeclaration :: Bool
-    , spliceDescription   :: String
-    , spliceLocation      :: Maybe SrcSpan
-    , spliceSource        :: Maybe SDoc
-    , spliceGenerated     :: SDoc
-    }
-
--- | outputs splice information for 2 flags which have different output formats:
--- `-ddump-splices` and `-dth-dec-file`
---
--- This duplicates code in RnSplice.hs
-traceSplice :: SpliceInfo -> TcM ()
-traceSplice sd = do
-    loc <- case sd of
-        SpliceInfo { spliceLocation = Nothing }  -> getSrcSpanM
-        SpliceInfo { spliceLocation = Just loc } -> return loc
-    traceOptTcRn Opt_D_dump_splices (spliceDebugDoc loc sd)
-    when (spliceIsDeclaration sd) $ do
-        dflags <- getDynFlags
-        liftIO $ dumpIfSet_dyn_printer alwaysQualify dflags Opt_D_th_dec_file
-                                       (spliceCodeDoc loc sd)
-  where
-    -- `-ddump-splices`
-    spliceDebugDoc :: SrcSpan -> SpliceInfo -> SDoc
-    spliceDebugDoc loc sd
-      = let code = case spliceSource sd of
-                Nothing -> ending
-                Just b  -> nest 2 b : ending
-            ending = [ text "======>", nest 2 (spliceGenerated sd) ]
-        in  (vcat [   ppr loc <> colon
-                  <+> text "Splicing" <+> text (spliceDescription sd)
-                  , nest 2 (sep code)
-                  ])
-
-    -- `-dth-dec-file`
-    spliceCodeDoc :: SrcSpan -> SpliceInfo -> SDoc
-    spliceCodeDoc loc sd
-      = (vcat [    text "--" <+> ppr loc <> colon
-               <+> text "Splicing" <+> text (spliceDescription sd)
-              , sep [spliceGenerated sd]
-              ])
 
 {-
 ************************************************************************
index f039bde..b683fe6 100644 (file)
@@ -1,20 +1,17 @@
 {-# LANGUAGE CPP #-}
 
 module TcSplice where
-import HsSyn    ( HsSplice, HsBracket, HsQuasiQuote,
-                  HsExpr, LHsType, LHsExpr, LPat, LHsDecl )
+import HsSyn    ( HsSplice, HsBracket, HsExpr, LHsExpr )
 import HsExpr   ( PendingRnSplice )
 import Name     ( Name )
-import RdrName  ( RdrName )
 import TcRnTypes( TcM, TcId )
 import TcType   ( TcRhoType )
 import Annotations ( Annotation, CoreAnnTarget )
 
 #ifdef GHCI
-import Id         ( Id )
+import HsSyn      ( LHsType, LPat, LHsDecl )
+import RdrName    ( RdrName )
 import qualified Language.Haskell.TH as TH
-import Outputable (SDoc)
-import SrcLoc     (SrcSpan)
 #endif
 
 tcSpliceExpr :: HsSplice Name
@@ -29,30 +26,16 @@ tcTypedBracket :: HsBracket Name
                -> TcRhoType
                -> TcM (HsExpr TcId)
 
-runQuasiQuoteDecl :: HsQuasiQuote RdrName -> TcM [LHsDecl RdrName]
-runQuasiQuoteExpr :: HsQuasiQuote RdrName -> TcM (LHsExpr RdrName)
-runQuasiQuoteType :: HsQuasiQuote RdrName -> TcM (LHsType RdrName)
-runQuasiQuotePat  :: HsQuasiQuote RdrName -> TcM (LPat RdrName)
 runAnnotation     :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
 
 #ifdef GHCI
-tcTopSpliceExpr :: Bool -> TcM (LHsExpr Id) -> TcM (LHsExpr Id)
+tcTopSpliceExpr :: Bool -> TcM (LHsExpr TcId) -> TcM (LHsExpr TcId)
 
-runMetaE :: LHsExpr Id -> TcM (LHsExpr RdrName)
-runMetaP :: LHsExpr Id -> TcM (LPat RdrName)
-runMetaT :: LHsExpr Id  -> TcM (LHsType RdrName)
-runMetaD :: LHsExpr Id -> TcM [LHsDecl RdrName]
+runMetaE :: LHsExpr TcId -> TcM (LHsExpr RdrName)
+runMetaP :: LHsExpr TcId -> TcM (LPat RdrName)
+runMetaT :: LHsExpr TcId  -> TcM (LHsType RdrName)
+runMetaD :: LHsExpr TcId -> TcM [LHsDecl RdrName]
 
 lookupThName_maybe :: TH.Name -> TcM (Maybe Name)
 runQuasi :: TH.Q a -> TcM a
-
-data SpliceInfo
-  = SpliceInfo
-    { spliceIsDeclaration :: Bool
-    , spliceDescription   :: String
-    , spliceLocation      :: Maybe SrcSpan
-    , spliceSource        :: Maybe SDoc
-    , spliceGenerated     :: SDoc
-    }
-traceSplice :: SpliceInfo -> TcM ()
 #endif
index 05e05a6..625b5d1 100644 (file)
@@ -1,6 +1,6 @@
 
 annfail03.hs:17:11:
     GHC stage restriction:
-      ‘InModule’ is used in a top-level splice or annotation,
+      ‘InModule’ is used in a top-level splice, quasi-quote, or annotation,
       and must be imported, not defined locally
     In the annotation: {-# ANN f InModule #-}
index bb638bc..0226a40 100644 (file)
@@ -2,6 +2,6 @@
 annfail04.hs:14:12:
     GHC stage restriction:
       instance for ‘Thing
-                      Int’ is used in a top-level splice or annotation,
+                      Int’ is used in a top-level splice, quasi-quote, or annotation,
       and must be imported, not defined locally
     In the annotation: {-# ANN f (thing :: Int) #-}
index 6bae2c1..7a7f715 100644 (file)
@@ -2,6 +2,6 @@
 annfail06.hs:22:1:
     GHC stage restriction:
       instance for ‘Data
-                      InstancesInWrongModule’ is used in a top-level splice or annotation,
+                      InstancesInWrongModule’ is used in a top-level splice, quasi-quote, or annotation,
       and must be imported, not defined locally
     In the annotation: {-# ANN f InstancesInWrongModule #-}
index f0a03ae..35bdaf7 100644 (file)
@@ -1,6 +1,6 @@
 
 annfail09.hs:11:11:
     GHC stage restriction:
-      ‘g’ is used in a top-level splice or annotation,
+      ‘g’ is used in a top-level splice, quasi-quote, or annotation,
       and must be imported, not defined locally
     In the annotation: {-# ANN f g #-}
index 0a067dd..99c63b1 100644 (file)
@@ -1,2 +1,4 @@
 
-T3953.hs:5:7: Not in scope: ‘notDefinedHere’
+T3953.hs:5:7:
+    Not in scope: ‘notDefinedHere’
+    In the quasi-quotation: [notDefinedHere| |]
index aa748e6..350dd41 100644 (file)
@@ -1,4 +1,6 @@
 
 qq001.hs:7:16:
-    GHC stage restriction: parse
-      is used in a quasiquote, and must be imported, not defined locally
+    GHC stage restriction:
+      ‘parse’ is used in a top-level splice, quasi-quote, or annotation,
+      and must be imported, not defined locally
+    In the quasi-quotation: [parse||]
index b32b5ac..12ab375 100644 (file)
@@ -1,4 +1,6 @@
 
 qq002.hs:8:10:
-    GHC stage restriction: parse
-      is used in a quasiquote, and must be imported, not defined locally
+    GHC stage restriction:
+      ‘parse’ is used in a top-level splice, quasi-quote, or annotation,
+      and must be imported, not defined locally
+    In the quasi-quotation: [parse||]
index a1f490f..dd7fa8c 100644 (file)
@@ -1,4 +1,6 @@
 
 qq003.hs:5:26:
-    GHC stage restriction: parse
-      is used in a quasiquote, and must be imported, not defined locally
+    GHC stage restriction:
+      ‘parse’ is used in a top-level splice, quasi-quote, or annotation,
+      and must be imported, not defined locally
+    In the quasi-quotation: [parse||]
index be61788..7cd33e1 100644 (file)
@@ -1,4 +1,6 @@
 
 qq004.hs:8:21:
-    GHC stage restriction: parse
-      is used in a quasiquote, and must be imported, not defined locally
+    GHC stage restriction:
+      ‘parse’ is used in a top-level splice, quasi-quote, or annotation,
+      and must be imported, not defined locally
+    In the quasi-quotation: [parse||]
diff --git a/testsuite/tests/th/T10047.hs b/testsuite/tests/th/T10047.hs
new file mode 100644 (file)
index 0000000..7916abb
--- /dev/null
@@ -0,0 +1,6 @@
+module T10047 where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+
+n = QuasiQuoter { quoteExp = dyn }
diff --git a/testsuite/tests/th/T10047.script b/testsuite/tests/th/T10047.script
new file mode 100644 (file)
index 0000000..ee6d046
--- /dev/null
@@ -0,0 +1,4 @@
+:set -XTemplateHaskell -XQuasiQuotes
+:l T10047
+:t [| $(dyn "foo") |]
+:t [| [n|foo|] |]
diff --git a/testsuite/tests/th/T10047.stdout b/testsuite/tests/th/T10047.stdout
new file mode 100644 (file)
index 0000000..ea22d78
--- /dev/null
@@ -0,0 +1,2 @@
+[| $(dyn "foo") |] :: ExpQ
+[| [n|foo|] |] :: ExpQ
index 99ff754..0e897cc 100644 (file)
@@ -2,4 +2,4 @@
 T2597b.hs:8:8:
     Empty stmt list in do-block
     When splicing a TH expression: do
-    In the splice: $mkBug2
+    In the untyped splice: $mkBug2
index 88614ff..d034e29 100644 (file)
@@ -1,5 +1,5 @@
 
-T3177a.hs:8:6:
+T3177a.hs:8:8:
     ‘Int’ is applied to too many type arguments
     In the type signature for ‘f’: f :: Int Int
 
index b3d9874..3c51176 100644 (file)
@@ -4,7 +4,7 @@ T3395.hs:6:9:
       r1 <- undefined
     (It should be an expression.)
     When splicing a TH expression: [r1 <- undefined | undefined]
-    In the splice:
+    In the untyped splice:
       $(return
         $ CompE
             [NoBindS (VarE $ mkName "undefined"),
index 395510e..f47a9fd 100644 (file)
@@ -1,9 +1,9 @@
 
-T5358.hs:14:15:
+T5358.hs:14:12:
     Exception when trying to run compile-time code:
       runTest called error: forall (t_0 :: *) . t_0 -> GHC.Types.Bool
     Code: do { VarI _ t _ _ <- reify (mkName "prop_x1");
                ($) error ((++) "runTest called error: " pprint t) }
-    In the splice:
+    In the untyped splice:
       $(do { VarI _ t _ _ <- reify (mkName "prop_x1");
              error $ ("runTest called error: " ++ pprint t) })
index bdc218c..79e9f92 100644 (file)
@@ -1,6 +1,6 @@
 
 T5795.hs:9:6:
     GHC stage restriction:
-      ‘ty’ is used in a top-level splice or annotation,
+      ‘ty’ is used in a top-level splice, quasi-quote, or annotation,
       and must be imported, not defined locally
-    In the splice: $ty
+    In the untyped splice: $ty
index 07bae41..d48c225 100644 (file)
@@ -4,4 +4,4 @@ T5971.hs:6:7:
       Probable cause: you used a unique Template Haskell name (NameU), 
       perhaps via newName, but did not bind it
       If that's it, then -ddump-splices might be useful
-    In the splice: $(newName "x" >>= varE)
+    In the untyped splice: $(newName "x" >>= varE)
index 8d6f545..157d731 100644 (file)
@@ -1,8 +1,8 @@
 
 T7276.hs:6:8:
     Couldn't match type ‘[Language.Haskell.TH.Syntax.Dec]’
-                  with ‘Language.Haskell.TH.Syntax.Exp’
+                   with ‘Language.Haskell.TH.Syntax.Exp’
     Expected type: Language.Haskell.TH.Lib.ExpQ
       Actual type: Language.Haskell.TH.Lib.DecsQ
     In the expression: [d| y = 3 |]
-    In the splice: $([d| y = 3 |])
+    In the untyped splice: $([d| y = 3 |])
index 6ad7f98..6aad44f 100644 (file)
@@ -16,4 +16,4 @@
     In an equation for ‘x’: x = [d| a = () |] :: Q Exp
 (deferred type error)
     Code: x
-    In the splice: $x
+    In the untyped splice: $x
index 1b54ed3..ca8b8f2 100644 (file)
@@ -2,4 +2,4 @@
 T7667a.hs:8:12:
     Illegal variable name: ‘False’
     When splicing a TH expression: False
-    In the splice: $(return $ VarE (mkName "False"))
+    In the untyped splice: $(return $ VarE (mkName "False"))
index 64e2d41..82b6116 100644 (file)
@@ -1,4 +1,4 @@
 
 T8412.hs:5:12:
     Illegal literal in type (type literals must not be negative): -1
-    In the splice: $(return $ LitT $ NumTyLit (- 1))
+    In the untyped splice: $(return $ LitT $ NumTyLit (- 1))
index 4e1d38b..5e9d6c7 100644 (file)
@@ -2,4 +2,4 @@
 TH_1tuple.hs:11:7:
     Illegal 1-tuple type constructor
     When splicing a TH expression: 1 :: ()
-    In the splice: $(sigE [| 1 |] (tupleT 1))
+    In the untyped splice: $(sigE [| 1 |] (tupleT 1))
index 88da9d1..e6f6963 100644 (file)
@@ -1,10 +1,12 @@
 
 TH_StaticPointers02.hs:11:34:
     static forms cannot be used in splices: static 'a'
-    In the splice:
+    In the untyped splice:
       $(case staticKey (static 'a') of {
           Fingerprint w0 w1
-            -> let ...
+            -> let
+                 w0i = ...
+                 ....
                in
                  [| fmap (\ p -> ...) $ unsafeLookupStaticPtr
                     $ Fingerprint (fromIntegral w0i) (fromIntegral w1i) |] })
index 8173e83..5d5a4f2 100644 (file)
@@ -1,6 +1,6 @@
 
-TH_runIO.hs:12:9:
+TH_runIO.hs:12:7:
     Exception when trying to run compile-time code:
       user error (hi)
     Code: runIO (fail "hi")
-    In the splice: $(runIO (fail "hi"))
+    In the untyped splice: $(runIO (fail "hi"))
index 57d93dc..6e17ef4 100644 (file)
@@ -4,8 +4,8 @@ TH_unresolvedInfix2.hs:14:11:
         must have lower precedence than that of the operand,
           namely ‘:+’ [infixl 6]
         in the section: ‘:+ N :+ N’
-    In the splice:
+    In the untyped splice:
       $(let
-          plus = conE ...
-          n = conE ...
+          plus = conE ':+
+          n = conE 'N
         in infixE Nothing plus (Just $ uInfixE n plus n))
index 2b4c37a..e38c54a 100644 (file)
@@ -356,3 +356,4 @@ test('T9824', normal, compile, ['-v0'])
 test('T8031', normal, compile, ['-v0'])
 test('T8624', normal, run_command, ['$MAKE -s --no-print-directory T8624'])
 test('TH_Lift', normal, compile, ['-v0'])
+test('T10047', normal, ghci_script, ['T10047.script'])
index d61bbc7..4bb685b 160000 (submodule)
@@ -1 +1 @@
-Subproject commit d61bbc75890e4eb0ad508b9c2a27b91f691213e6
+Subproject commit 4bb685bd0f5774584c6bef3f8786daffeac13b56