diff options
| author | romes <rodrigo.m.mesquita@gmail.com> | 2022-03-19 17:42:46 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-06-01 07:44:44 -0400 |
| commit | 7975202ba9010c581918413808ee06fbab9ac85f (patch) | |
| tree | ffebdbd9d9fcef2300b1a6d3950bb5dd3f8435c4 | |
| parent | 392ce3fca5d33688add52309a05914efa163e6f6 (diff) | |
| download | haskell-7975202ba9010c581918413808ee06fbab9ac85f.tar.gz | |
TTG: Rework and improve splices
This commit redefines the structure of Splices in the AST.
We get rid of `HsSplice` which used to represent typed and untyped
splices, quasi quotes, and the result of splicing either an expression,
a type or a pattern.
Instead we have `HsUntypedSplice` which models an untyped splice or a
quasi quoter, which works in practice just like untyped splices.
The `HsExpr` constructor `HsSpliceE` which used to be constructed with
an `HsSplice` is split into `HsTypedSplice` and `HsUntypedSplice`. The
former is directly constructed with an `HsExpr` and the latter now takes
an `HsUntypedSplice`.
Both `HsType` and `Pat` constructors `HsSpliceTy` and `SplicePat` now
take an `HsUntypedSplice` instead of a `HsSplice` (remember only
/untyped splices/ can be spliced as types or patterns).
The result of splicing an expression, type, or pattern is now
comfortably stored in the extension fields `XSpliceTy`, `XSplicePat`,
`XUntypedSplice` as, respectively, `HsUntypedSpliceResult (HsType
GhcRn)`, `HsUntypedSpliceResult (Pat GhcRn)`, and `HsUntypedSpliceResult
(HsExpr GhcRn)`
Overall the TTG extension points are now better used to
make invalid states unrepresentable and model the progression between
stages better.
See Note [Lifecycle of an untyped splice, and PendingRnSplice]
and Note [Lifecycle of an typed splice, and PendingTcSplice] for more
details.
Updates haddock submodule
Fixes #21263
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
49 files changed, 1145 insertions, 1050 deletions
diff --git a/compiler/GHC/Driver/Hooks.hs b/compiler/GHC/Driver/Hooks.hs index 7978a5049d..a6458d7738 100644 --- a/compiler/GHC/Driver/Hooks.hs +++ b/compiler/GHC/Driver/Hooks.hs @@ -141,7 +141,7 @@ data Hooks = Hooks , runMetaHook :: !(Maybe (MetaHook TcM)) , linkHook :: !(Maybe (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)) - , runRnSpliceHook :: !(Maybe (HsSplice GhcRn -> RnM (HsSplice GhcRn))) + , runRnSpliceHook :: !(Maybe (HsUntypedSplice GhcRn -> RnM (HsUntypedSplice GhcRn))) , getValueSafelyHook :: !(Maybe (HscEnv -> Name -> Type -> IO (Either Type (HValue, [Linkable], PkgsLoaded)))) , createIservProcessHook :: !(Maybe (CreateProcess -> IO ProcessHandle)) diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index c83a05256a..d2b1b6a117 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -69,7 +69,7 @@ module GHC.Hs.Decls ( -- ** @default@ declarations DefaultDecl(..), LDefaultDecl, -- ** Template haskell declaration splice - SpliceExplicitFlag(..), + SpliceDecoration(..), SpliceDecl(..), LSpliceDecl, -- ** Foreign function interface declarations ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..), @@ -104,7 +104,7 @@ import GHC.Prelude import Language.Haskell.Syntax.Decls -import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprSpliceDecl ) +import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprUntypedSplice ) -- Because Expr imports Decls via HsBracket import GHC.Hs.Binds @@ -313,7 +313,8 @@ type instance XXSpliceDecl (GhcPass _) = DataConCantHappen instance OutputableBndrId p => Outputable (SpliceDecl (GhcPass p)) where - ppr (SpliceDecl _ (L _ e) f) = pprSpliceDecl e f + ppr (SpliceDecl _ (L _ e) DollarSplice) = pprUntypedSplice True Nothing e + ppr (SpliceDecl _ (L _ e) BareSplice) = pprUntypedSplice False Nothing e {- ************************************************************************ diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index 274b5dfcb3..d664456654 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -33,7 +33,7 @@ import Language.Haskell.Syntax.Expr -- friends: import GHC.Prelude -import GHC.Hs.Decls +import GHC.Hs.Decls() -- import instances import GHC.Hs.Pat import GHC.Hs.Lit import Language.Haskell.Syntax.Extension @@ -44,7 +44,6 @@ import GHC.Parser.Annotation -- others: import GHC.Tc.Types.Evidence -import GHC.Core.DataCon (FieldLabelString) import GHC.Types.Name import GHC.Types.Name.Set import GHC.Types.Basic @@ -64,6 +63,9 @@ import GHC.Builtin.Types (mkTupleStr) import GHC.Tc.Utils.TcType (TcType, TcTyVar) import {-# SOURCE #-} GHC.Tc.Types (TcLclEnv) +import GHCi.RemoteTypes ( ForeignRef ) +import qualified Language.Haskell.TH as TH (Q) + -- libraries: import Data.Data hiding (Fixity(..)) import qualified Data.Data as Data (Fixity(..)) @@ -171,80 +173,14 @@ deriving instance (Data (hs_syn GhcTc), Typeable hs_syn) => Data (HsWrap hs_syn) -- --------------------------------------------------------------------- -{- -Note [The life cycle of a TH quotation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When desugaring a bracket (aka quotation), we want to produce Core -code that, when run, will produce the TH syntax tree for the quotation. -To that end, we want to desugar /renamed/ but not /typechecked/ code; -the latter is cluttered with the typechecker's elaboration that should -not appear in the TH syntax tree. So in (HsExpr GhcTc) tree, we must -have a (HsExpr GhcRn) for the quotation itself. - -As such, when typechecking both typed and untyped brackets, -we keep a /renamed/ bracket in the extension field. - -The HsBracketTc, the GhcTc ext field for both brackets, contains: - - The renamed quote :: HsQuote GhcRn -- for the desugarer - - [PendingTcSplice] - - The type of the quote - - Maybe QuoteWrapper - -Note that (HsBracketTc) stores the untyped (HsQuote GhcRn) for both typed and -untyped brackets. They are treated uniformly by the desugarer, and we can -easily construct untyped brackets from typed ones (with ExpBr). - -Typed quotes -~~~~~~~~~~~~ -Here is the life cycle of a /typed/ quote [|| e ||], whose datacon is - HsTypedBracket (XTypedBracket p) (LHsExpr p) - - In pass p (XTypedBracket p) (LHsExpr p) - ------------------------------------------- - GhcPs Annotations only LHsExpr GhcPs - GhcRn Annotations only LHsExpr GhcRn - GhcTc HsBracketTc LHsExpr GhcTc: unused! - -Note that in the GhcTc tree, the second field (HsExpr GhcTc) -is entirely unused; the desugarer uses the (HsExpr GhcRn) from the -first field. - -Untyped quotes -~~~~~~~~~~~~~~ -Here is the life cycle of an /untyped/ quote, whose datacon is - HsUntypedBracket (XUntypedBracket p) (HsQuote p) - -Here HsQuote is a sum-type of expressions [| e |], patterns [| p |], -types [| t |] etc. - - In pass p (XUntypedBracket p) (HsQuote p) - ------------------------------------------------------- - GhcPs Annotations only HsQuote GhcPs - GhcRn Annotations, [PendingRnSplice] HsQuote GhcRn - GhcTc HsBracketTc HsQuote GhcTc: unused! - -The difficulty is: the typechecker does not typecheck the body of an -untyped quote, so how do we make a (HsQuote GhcTc) to put in the -second field? - -Answer: we use the extension constructor of HsQuote, XQuote, and make -all the other constructors into DataConCantHappen. That is, the only -non-bottom value of type (HsQuote GhcTc) is (XQuote noExtField). Hence -the instances - type instance XExpBr GhcTc = DataConCantHappen - ...etc... - -See the related Note [How brackets and nested splices are handled] in GHC.Tc.Gen.Splice --} - data HsBracketTc = HsBracketTc - { brack_renamed_quote :: (HsQuote GhcRn) -- See Note [The life cycle of a TH quotation] - , brack_ty :: Type - , brack_quote_wrapper :: (Maybe QuoteWrapper) -- The wrapper to apply type and dictionary argument to the quote. - , brack_pending_splices :: [PendingTcSplice] -- Output of the type checker is the *original* - -- renamed expression, plus - -- _typechecked_ splices to be - -- pasted back in by the desugarer + { hsb_quote :: HsQuote GhcRn -- See Note [The life cycle of a TH quotation] + , hsb_ty :: Type + , hsb_wrap :: Maybe QuoteWrapper -- The wrapper to apply type and dictionary argument to the quote. + , hsb_splices :: [PendingTcSplice] -- Output of the type checker is the *original* + -- renamed expression, plus + -- _typechecked_ splices to be + -- pasted back in by the desugarer } type instance XTypedBracket GhcPs = EpAnn [AddEpAnn] @@ -407,7 +343,6 @@ type instance XArithSeq GhcPs = EpAnn [AddEpAnn] type instance XArithSeq GhcRn = NoExtField type instance XArithSeq GhcTc = PostTcExpr -type instance XSpliceE (GhcPass _) = EpAnnCO type instance XProc (GhcPass _) = EpAnn [AddEpAnn] type instance XStatic GhcPs = EpAnn [AddEpAnn] @@ -701,7 +636,17 @@ ppr_expr (ExprWithTySig _ expr sig) ppr_expr (ArithSeq _ _ info) = brackets (ppr info) -ppr_expr (HsSpliceE _ s) = pprSplice s +ppr_expr (HsTypedSplice ext e) = + case ghcPass @p of + GhcPs -> pprTypedSplice Nothing e + GhcRn -> pprTypedSplice (Just ext) e + GhcTc -> pprTypedSplice Nothing e +ppr_expr (HsUntypedSplice ext s) = + case ghcPass @p of + GhcPs -> pprUntypedSplice True Nothing s + GhcRn | HsUntypedSpliceNested n <- ext -> pprUntypedSplice True (Just n) s + GhcRn | HsUntypedSpliceTop _ e <- ext -> ppr e + GhcTc -> dataConCantHappen ext ppr_expr (HsTypedBracket b e) = case ghcPass @p of @@ -855,7 +800,8 @@ hsExprNeedsParens prec = go go (ExprWithTySig{}) = prec >= sigPrec go (ArithSeq{}) = False go (HsPragE{}) = prec >= appPrec - go (HsSpliceE{}) = False + go (HsTypedSplice{}) = False + go (HsUntypedSplice{}) = False go (HsTypedBracket{}) = False go (HsUntypedBracket{}) = False go (HsProc{}) = prec > topPrec @@ -1693,15 +1639,46 @@ pprQuals quals = interpp'SP quals ************************************************************************ -} -newtype HsSplicedT = HsSplicedT DelayedSplice deriving (Data) +-- | Finalizers produced by a splice with +-- 'Language.Haskell.TH.Syntax.addModFinalizer' +-- +-- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. For how +-- this is used. +-- +newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())] + +-- A Data instance which ignores the argument of 'ThModFinalizers'. +instance Data ThModFinalizers where + gunfold _ z _ = z $ ThModFinalizers [] + toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix + dataTypeOf a = mkDataType "HsExpr.ThModFinalizers" [toConstr a] + +-- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. +-- This is the result of splicing a splice. It is produced by +-- the renamer and consumed by the typechecker. It lives only between the two. +data HsUntypedSpliceResult thing -- 'thing' can be HsExpr or HsType + = HsUntypedSpliceTop + { utsplice_result_finalizers :: ThModFinalizers -- ^ TH finalizers produced by the splice. + , utsplice_result :: thing -- ^ The result of splicing; See Note [Lifecycle of a splice] + } + | HsUntypedSpliceNested SplicePointName -- A unique name to identify this splice point + +type instance XTypedSplice GhcPs = (EpAnnCO, EpAnn [AddEpAnn]) +type instance XTypedSplice GhcRn = SplicePointName +type instance XTypedSplice GhcTc = DelayedSplice -type instance XTypedSplice (GhcPass _) = EpAnn [AddEpAnn] -type instance XUntypedSplice (GhcPass _) = EpAnn [AddEpAnn] -type instance XQuasiQuote (GhcPass _) = NoExtField -type instance XSpliced (GhcPass _) = NoExtField -type instance XXSplice GhcPs = DataConCantHappen -type instance XXSplice GhcRn = DataConCantHappen -type instance XXSplice GhcTc = HsSplicedT +type instance XUntypedSplice GhcPs = EpAnnCO +type instance XUntypedSplice GhcRn = HsUntypedSpliceResult (HsExpr GhcRn) +type instance XUntypedSplice GhcTc = DataConCantHappen + +-- HsUntypedSplice +type instance XUntypedSpliceExpr GhcPs = EpAnn [AddEpAnn] +type instance XUntypedSpliceExpr GhcRn = EpAnn [AddEpAnn] +type instance XUntypedSpliceExpr GhcTc = DataConCantHappen + +type instance XQuasiQuote p = NoExtField + +type instance XXUntypedSplice p = DataConCantHappen -- See Note [Running typed splices in the zonker] -- These are the arguments that are passed to `GHC.Tc.Gen.Splice.runTopSplice` @@ -1736,116 +1713,38 @@ data PendingRnSplice data PendingTcSplice = PendingTcSplice SplicePointName (LHsExpr GhcTc) -{- -Note [Pending Splices] -~~~~~~~~~~~~~~~~~~~~~~ -When we rename an untyped bracket, we name and lift out all the nested -splices, so that when the typechecker hits the bracket, it can -typecheck those nested splices without having to walk over the untyped -bracket code. So for example - [| f $(g x) |] -looks like - - HsUntypedBracket _ (HsApp (HsVar "f") (HsSpliceE _ (HsUntypedSplice sn (g x))) - -which the renamer rewrites to - - HsUntypedBracket - [PendingRnSplice UntypedExpSplice sn (g x)] - (HsApp (HsVar f) (HsSpliceE _ (HsUntypedSplice sn (g x))) - -* 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 - -* Note that a nested splice, such as the `$(g x)` now appears twice: - - In the PendingRnSplice: this is the version that will later be typechecked - - In the HsSpliceE in the body of the bracket. This copy is used only for pretty printing. - -There are four varieties of pending splices generated by the renamer, -distinguished by their UntypedSpliceFlavour - - * Pending expression splices (UntypedExpSplice), e.g., - [|$(f x) + 2|] - - UntypedExpSplice is also used for - * quasi-quotes, where the pending expression expands to - $(quoter "...blah...") - (see GHC.Rename.Splice.makePending, HsQuasiQuote case) - - * cross-stage lifting, where the pending expression expands to - $(lift x) - (see GHC.Rename.Splice.checkCrossStageLifting) - - * Pending pattern splices (UntypedPatSplice), e.g., - [| \$(f x) -> x |] - - * Pending type splices (UntypedTypeSplice), e.g., - [| f :: $(g 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)||] --} - -instance OutputableBndrId p - => Outputable (HsSplicedThing (GhcPass p)) where - ppr (HsSplicedExpr e) = ppr_expr e - ppr (HsSplicedTy t) = ppr t - ppr (HsSplicedPat p) = ppr p - -instance (OutputableBndrId p) => Outputable (HsSplice (GhcPass p)) where - ppr s = pprSplice s pprPendingSplice :: (OutputableBndrId p) => SplicePointName -> LHsExpr (GhcPass p) -> SDoc pprPendingSplice n e = angleBrackets (ppr n <> comma <+> ppr (stripParensLHsExpr e)) -pprSpliceDecl :: (OutputableBndrId p) - => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc -pprSpliceDecl e@HsQuasiQuote{} _ = pprSplice e -pprSpliceDecl e ExplicitSplice = text "$" <> ppr_splice_decl e -pprSpliceDecl e ImplicitSplice = ppr_splice_decl e - -ppr_splice_decl :: (OutputableBndrId p) - => HsSplice (GhcPass p) -> SDoc -ppr_splice_decl (HsUntypedSplice _ _ n e) = ppr_splice empty n e empty -ppr_splice_decl e = pprSplice e - -pprSplice :: forall p. (OutputableBndrId p) => HsSplice (GhcPass p) -> SDoc -pprSplice (HsTypedSplice _ DollarSplice n e) - = ppr_splice (text "$$") n e empty -pprSplice (HsTypedSplice _ BareSplice _ _ ) - = panic "Bare typed splice" -- impossible -pprSplice (HsUntypedSplice _ DollarSplice n e) - = ppr_splice (text "$") n e empty -pprSplice (HsUntypedSplice _ BareSplice n e) - = ppr_splice empty n e empty -pprSplice (HsQuasiQuote _ n q _ s) = ppr_quasi n q s -pprSplice (HsSpliced _ _ thing) = ppr thing -pprSplice (XSplice x) = case ghcPass @p of -#if __GLASGOW_HASKELL__ < 811 - GhcPs -> dataConCantHappen x - GhcRn -> dataConCantHappen x -#endif - GhcTc -> case x of - HsSplicedT _ -> text "Unevaluated typed splice" +pprTypedSplice :: (OutputableBndrId p) => Maybe SplicePointName -> LHsExpr (GhcPass p) -> SDoc +pprTypedSplice n e = ppr_splice (text "$$") n e -ppr_quasi :: OutputableBndr p => p -> p -> FastString -> SDoc -ppr_quasi n quoter quote = whenPprDebug (brackets (ppr n)) <> - char '[' <> ppr quoter <> vbar <> +pprUntypedSplice :: forall p. (OutputableBndrId p) + => Bool -- Whether to preceed the splice with "$" + -> Maybe SplicePointName -- Used for pretty printing when exists + -> HsUntypedSplice (GhcPass p) + -> SDoc +pprUntypedSplice True n (HsUntypedSpliceExpr _ e) = ppr_splice (text "$") n e +pprUntypedSplice False n (HsUntypedSpliceExpr _ e) = ppr_splice empty n e +pprUntypedSplice _ _ (HsQuasiQuote _ q s) = ppr_quasi q (unLoc s) + +ppr_quasi :: OutputableBndr p => p -> FastString -> SDoc +ppr_quasi quoter quote = char '[' <> ppr quoter <> vbar <> ppr quote <> text "|]" ppr_splice :: (OutputableBndrId p) - => SDoc -> (IdP (GhcPass p)) -> LHsExpr (GhcPass p) -> SDoc -> SDoc -ppr_splice herald n e trail - = herald <> whenPprDebug (brackets (ppr n)) <> ppr e <> trail + => SDoc + -> Maybe SplicePointName + -> LHsExpr (GhcPass p) + -> SDoc +ppr_splice herald mn e + = herald + <> (case mn of + Nothing -> empty + Just splice_name -> whenPprDebug (brackets (ppr splice_name))) + <> ppr e type instance XExpBr GhcPs = NoExtField @@ -2059,14 +1958,16 @@ type instance Anno (GRHS (GhcPass p) (LocatedA (HsCmd (GhcPass p)))) = SrcAnn N type instance Anno (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsExpr (GhcPass pr)))) = SrcSpanAnnA type instance Anno (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr)))) = SrcSpanAnnA -type instance Anno (HsSplice (GhcPass p)) = SrcSpanAnnA +type instance Anno (HsUntypedSplice (GhcPass p)) = SrcSpanAnnA type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsExpr (GhcPass pr))))] = SrcSpanAnnL type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))] = SrcSpanAnnL type instance Anno (FieldLabelStrings (GhcPass p)) = SrcAnn NoEpAnns -type instance Anno (FieldLabelString) = SrcAnn NoEpAnns -type instance Anno (DotFieldOcc (GhcPass p)) = SrcAnn NoEpAnns +type instance Anno FastString = SrcAnn NoEpAnns + -- NB: type FieldLabelString = FastString + +type instance Anno (DotFieldOcc (GhcPass p)) = SrcAnn NoEpAnns instance (Anno a ~ SrcSpanAnn' (EpAnn an)) => WrapXRec (GhcPass p) a where diff --git a/compiler/GHC/Hs/Expr.hs-boot b/compiler/GHC/Hs/Expr.hs-boot index 204af54681..6f1744096d 100644 --- a/compiler/GHC/Hs/Expr.hs-boot +++ b/compiler/GHC/Hs/Expr.hs-boot @@ -1,3 +1,5 @@ +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] @@ -10,15 +12,19 @@ module GHC.Hs.Expr where import GHC.Utils.Outputable ( SDoc, Outputable ) import Language.Haskell.Syntax.Pat ( LPat ) import {-# SOURCE #-} GHC.Hs.Pat () -- for Outputable -import GHC.Types.Basic ( SpliceExplicitFlag(..)) import Language.Haskell.Syntax.Expr ( HsExpr, LHsExpr , HsCmd , MatchGroup , GRHSs - , HsSplice + , HsUntypedSplice ) import GHC.Hs.Extension ( OutputableBndrId, GhcPass ) +import GHC.Types.Name ( Name ) +import Data.Bool ( Bool ) +import Data.Maybe ( Maybe ) + +type SplicePointName = Name instance (OutputableBndrId p) => Outputable (HsExpr (GhcPass p)) instance (OutputableBndrId p) => Outputable (HsCmd (GhcPass p)) @@ -27,10 +33,8 @@ pprLExpr :: (OutputableBndrId p) => LHsExpr (GhcPass p) -> SDoc pprExpr :: (OutputableBndrId p) => HsExpr (GhcPass p) -> SDoc -pprSplice :: (OutputableBndrId p) => HsSplice (GhcPass p) -> SDoc - -pprSpliceDecl :: (OutputableBndrId p) - => HsSplice (GhcPass p) -> SpliceExplicitFlag -> SDoc +pprTypedSplice :: (OutputableBndrId p) => Maybe SplicePointName -> LHsExpr (GhcPass p) -> SDoc +pprUntypedSplice :: (OutputableBndrId p) => Bool -> Maybe SplicePointName -> HsUntypedSplice (GhcPass p) -> SDoc pprPatBind :: forall bndr p . (OutputableBndrId bndr, OutputableBndrId p) @@ -38,3 +42,12 @@ pprPatBind :: forall bndr p . (OutputableBndrId bndr, pprFunBind :: (OutputableBndrId idR) => MatchGroup (GhcPass idR) (LHsExpr (GhcPass idR)) -> SDoc + +data ThModFinalizers +type role HsUntypedSpliceResult representational +data HsUntypedSpliceResult thing + = HsUntypedSpliceTop + { utsplice_result_finalizers :: ThModFinalizers + , utsplice_result :: thing + } + | HsUntypedSpliceNested SplicePointName diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs index 1904de63d4..3f4c0b16bd 100644 --- a/compiler/GHC/Hs/Instances.hs +++ b/compiler/GHC/Hs/Instances.hs @@ -373,15 +373,16 @@ deriving instance Data (HsMatchContext GhcPs) deriving instance Data (HsMatchContext GhcRn) deriving instance Data (HsMatchContext GhcTc) --- deriving instance (DataIdLR p p) => Data (HsSplice p) -deriving instance Data (HsSplice GhcPs) -deriving instance Data (HsSplice GhcRn) -deriving instance Data (HsSplice GhcTc) - --- deriving instance (DataIdLR p p) => Data (HsSplicedThing p) -deriving instance Data (HsSplicedThing GhcPs) -deriving instance Data (HsSplicedThing GhcRn) -deriving instance Data (HsSplicedThing GhcTc) +-- deriving instance (DataIdLR p p) => Data (HsUntypedSplice p) +deriving instance Data (HsUntypedSplice GhcPs) +deriving instance Data (HsUntypedSplice GhcRn) +deriving instance Data (HsUntypedSplice GhcTc) + +deriving instance Data (HsUntypedSpliceResult (HsExpr GhcRn)) + +deriving instance Data (HsUntypedSpliceResult (Pat GhcRn)) + +deriving instance Data (HsUntypedSpliceResult (HsType GhcRn)) -- deriving instance (DataIdLR p p) => Data (HsQuote p) deriving instance Data (HsQuote GhcPs) diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs index 9ca56e3290..f3e4fbe9c4 100644 --- a/compiler/GHC/Hs/Pat.hs +++ b/compiler/GHC/Hs/Pat.hs @@ -53,7 +53,7 @@ import GHC.Prelude import Language.Haskell.Syntax.Pat import Language.Haskell.Syntax.Expr ( HsExpr ) -import {-# SOURCE #-} GHC.Hs.Expr (pprLExpr, pprSplice) +import {-# SOURCE #-} GHC.Hs.Expr (pprLExpr, pprUntypedSplice, HsUntypedSpliceResult(..)) -- friends: import GHC.Hs.Binds @@ -137,7 +137,7 @@ type instance XViewPat GhcTc = Type -- (= the argument type of the view function), for hsPatType. type instance XSplicePat GhcPs = NoExtField -type instance XSplicePat GhcRn = NoExtField +type instance XSplicePat GhcRn = HsUntypedSpliceResult (Pat GhcRn) -- See Note [Lifecycle of a splice] in GHC.Hs.Expr type instance XSplicePat GhcTc = DataConCantHappen type instance XLitPat (GhcPass _) = NoExtField @@ -319,7 +319,12 @@ pprPat (NPlusKPat _ n k _ _ _) = hcat [ppr_n, char '+', ppr k] GhcPs -> ppr n GhcRn -> ppr n GhcTc -> ppr n -pprPat (SplicePat _ splice) = pprSplice splice +pprPat (SplicePat ext splice) = + case ghcPass @p of + GhcPs -> pprUntypedSplice True Nothing splice + GhcRn | HsUntypedSpliceNested n <- ext -> pprUntypedSplice True (Just n) splice + GhcRn | HsUntypedSpliceTop _ p <- ext -> ppr p + GhcTc -> dataConCantHappen ext pprPat (SigPat _ pat ty) = ppr pat <+> dcolon <+> ppr ty pprPat (ListPat _ pats) = brackets (interpp'SP pats) pprPat (TuplePat _ pats bx) diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs index 30009ef400..63b568df4a 100644 --- a/compiler/GHC/Hs/Syn/Type.hs +++ b/compiler/GHC/Hs/Syn/Type.hs @@ -125,13 +125,14 @@ hsExprType (ArithSeq _ mb_overloaded_op asi) = case mb_overloaded_op of Nothing -> asi_ty where asi_ty = arithSeqInfoType asi -hsExprType (HsTypedBracket (HsBracketTc _ ty _wrap _pending) _) = ty -hsExprType (HsUntypedBracket (HsBracketTc _ ty _wrap _pending) _) = ty -hsExprType e@(HsSpliceE{}) = pprPanic "hsExprType: Unexpected HsSpliceE" - (ppr e) +hsExprType (HsTypedBracket (HsBracketTc { hsb_ty = ty }) _) = ty +hsExprType (HsUntypedBracket (HsBracketTc { hsb_ty = ty }) _) = ty +hsExprType e@(HsTypedSplice{}) = pprPanic "hsExprType: Unexpected HsTypedSplice" + (ppr e) -- Typed splices should have been eliminated during zonking, but we -- can't use `dataConCantHappen` since they are still present before -- than in the typechecked AST. +hsExprType (HsUntypedSplice ext _) = dataConCantHappen ext hsExprType (HsProc _ _ lcmd_top) = lhsCmdTopType lcmd_top hsExprType (HsStatic (_, ty) _s) = ty hsExprType (HsPragE _ _ e) = lhsExprType e diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index 5cb4200ecd..fe9aad3475 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -91,7 +91,7 @@ import GHC.Prelude import Language.Haskell.Syntax.Type -import {-# SOURCE #-} GHC.Hs.Expr ( pprSplice ) +import {-# SOURCE #-} GHC.Hs.Expr ( pprUntypedSplice, HsUntypedSpliceResult(..) ) import Language.Haskell.Syntax.Extension import GHC.Hs.Extension @@ -303,7 +303,7 @@ type instance XKindSig (GhcPass _) = EpAnn [AddEpAnn] type instance XAppKindTy (GhcPass _) = SrcSpan -- Where the `@` lives type instance XSpliceTy GhcPs = NoExtField -type instance XSpliceTy GhcRn = NoExtField +type instance XSpliceTy GhcRn = HsUntypedSpliceResult (HsType GhcRn) type instance XSpliceTy GhcTc = Kind type instance XDocTy (GhcPass _) = EpAnn [AddEpAnn] @@ -1008,7 +1008,7 @@ ppr_mono_lty :: OutputableBndrId p => LHsType (GhcPass p) -> SDoc ppr_mono_lty ty = ppr_mono_ty (unLoc ty) -ppr_mono_ty :: (OutputableBndrId p) => HsType (GhcPass p) -> SDoc +ppr_mono_ty :: forall p. (OutputableBndrId p) => HsType (GhcPass p) -> SDoc ppr_mono_ty (HsForAllTy { hst_tele = tele, hst_body = ty }) = sep [pprHsForAll tele Nothing, ppr_mono_lty ty] @@ -1036,7 +1036,12 @@ ppr_mono_ty (HsKindSig _ ty kind) = ppr_mono_lty ty <+> dcolon <+> ppr kind ppr_mono_ty (HsListTy _ ty) = brackets (ppr_mono_lty ty) ppr_mono_ty (HsIParamTy _ n ty) = (ppr n <+> dcolon <+> ppr_mono_lty ty) -ppr_mono_ty (HsSpliceTy _ s) = pprSplice s +ppr_mono_ty (HsSpliceTy ext s) = + case ghcPass @p of + GhcPs -> pprUntypedSplice True Nothing s + GhcRn | HsUntypedSpliceNested n <- ext -> pprUntypedSplice True (Just n) s + GhcRn | HsUntypedSpliceTop _ t <- ext -> ppr t + GhcTc -> pprUntypedSplice True Nothing s ppr_mono_ty (HsExplicitListTy _ prom tys) | isPromoted prom = quote $ brackets (maybeAddSpace tys $ interpp'SP tys) | otherwise = brackets (interpp'SP tys) diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 9d4e733375..4dd0aab928 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -89,10 +89,6 @@ module GHC.Hs.Utils( unitRecStmtTc, mkLetStmt, - -- * Template Haskell - mkUntypedSplice, mkTypedSplice, - mkHsQuasiQuote, - -- * Collecting binders isUnliftedHsBind, isBangedHsBind, @@ -451,19 +447,6 @@ mkLetStmt anns binds = LetStmt anns binds mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs mkHsOpApp e1 op e2 = OpApp noAnn e1 (noLocA (HsVar noExtField (noLocA op))) e2 -unqualSplice :: RdrName -unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice")) - -mkUntypedSplice :: EpAnn [AddEpAnn] -> SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs -mkUntypedSplice ann hasParen e = HsUntypedSplice ann hasParen unqualSplice e - -mkTypedSplice :: EpAnn [AddEpAnn] -> SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs -mkTypedSplice ann hasParen e = HsTypedSplice ann hasParen unqualSplice e - -mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs -mkHsQuasiQuote quoter span quote - = HsQuasiQuote noExtField unqualSplice quoter span quote - mkHsString :: String -> HsLit (GhcPass p) mkHsString s = HsString NoSourceText (mkFastString s) @@ -1216,9 +1199,7 @@ collect_pat flag pat bndrs = case pat of NPlusKPat _ n _ _ _ _ -> unXRec @p n : bndrs SigPat _ pat _ -> collect_lpat flag pat bndrs XPat ext -> collectXXPat @p flag ext bndrs - SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)) - -> collect_pat flag pat bndrs - SplicePat _ _ -> bndrs + SplicePat ext _ -> collectXSplicePat @p flag ext bndrs -- See Note [Dictionary binders in ConPatOut] ConPat {pat_args=ps} -> case flag of CollNoDictBinders -> foldr (collect_lpat flag) bndrs (hsConPatArgs ps) @@ -1244,6 +1225,7 @@ add_ev_bndr (EvBind { eb_lhs = b }) bs | isId b = b:bs class UnXRec p => CollectPass p where collectXXPat :: CollectFlag p -> XXPat p -> [IdP p] -> [IdP p] collectXXHsBindsLR :: forall pR. XXHsBindsLR p pR -> [IdP p] -> [IdP p] + collectXSplicePat :: CollectFlag p -> XSplicePat p -> [IdP p] -> [IdP p] instance IsPass p => CollectPass (GhcPass p) where collectXXPat flag ext = @@ -1265,6 +1247,13 @@ instance IsPass p => CollectPass (GhcPass p) where -- binding (hence see AbsBinds) is in zonking in GHC.Tc.Utils.Zonk + collectXSplicePat flag ext = + case ghcPass @p of + GhcPs -> id + GhcRn | (HsUntypedSpliceTop _ pat) <- ext -> collect_pat flag pat + GhcRn | (HsUntypedSpliceNested _) <- ext -> id + GhcTc -> dataConCantHappen ext + {- Note [Dictionary binders in ConPatOut] diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs index 09cd86f952..eec4ba9de3 100644 --- a/compiler/GHC/HsToCore/Coverage.hs +++ b/compiler/GHC/HsToCore/Coverage.hs @@ -640,7 +640,8 @@ addTickHsExpr (HsPragE x p e) = liftM (HsPragE x p) (addTickLHsExpr e) addTickHsExpr e@(HsTypedBracket {}) = return e addTickHsExpr e@(HsUntypedBracket{}) = return e -addTickHsExpr e@(HsSpliceE {}) = return e +addTickHsExpr e@(HsTypedSplice{}) = return e +addTickHsExpr e@(HsUntypedSplice{}) = return e addTickHsExpr e@(HsGetField {}) = return e addTickHsExpr e@(HsProjection {}) = return e addTickHsExpr (HsProc x pat cmdtop) = diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs index 84dd992037..5feee52901 100644 --- a/compiler/GHC/HsToCore/Expr.hs +++ b/compiler/GHC/HsToCore/Expr.hs @@ -487,9 +487,10 @@ dsExpr (RecordUpd x _ _) = dataConCantHappen x -- Template Haskell stuff -- See Note [The life cycle of a TH quotation] -dsExpr (HsTypedBracket (HsBracketTc q _ hs_wrapper ps) _) = dsBracket hs_wrapper q ps -dsExpr (HsUntypedBracket (HsBracketTc q _ hs_wrapper ps) _) = dsBracket hs_wrapper q ps -dsExpr (HsSpliceE _ s) = pprPanic "dsExpr:splice" (ppr s) +dsExpr (HsTypedBracket bracket_tc _) = dsBracket bracket_tc +dsExpr (HsUntypedBracket bracket_tc _) = dsBracket bracket_tc +dsExpr (HsTypedSplice _ s) = pprPanic "dsExpr:typed splice" (pprTypedSplice Nothing s) +dsExpr (HsUntypedSplice ext _) = dataConCantHappen ext -- Arrow notation extension dsExpr (HsProc _ pat cmd) = dsProcExpr pat cmd diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index 6718169bc3..5f08571bf2 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -157,36 +157,32 @@ getPlatform :: MetaM Platform getPlatform = targetPlatform <$> getDynFlags ----------------------------------------------------------------------------- -dsBracket :: Maybe QuoteWrapper -- ^ This is Nothing only when we are dealing with a VarBr - -> HsQuote GhcRn -- See Note [The life cycle of a TH quotation] - -> [PendingTcSplice] - -> DsM CoreExpr +dsBracket :: HsBracketTc -> DsM CoreExpr -- See Note [Desugaring Brackets] -- Returns a CoreExpr of type (M TH.Exp) -- The quoted thing is parameterised over Name, even though it has -- been type checked. We don't want all those type decorations! -dsBracket wrap brack splices - = do_brack brack +dsBracket (HsBracketTc { hsb_wrap = mb_wrap, hsb_splices = splices, hsb_quote = quote }) + = case quote of + VarBr _ _ n -> do { MkC e1 <- lookupOccDsM (unLoc n) ; return e1 } + ExpBr _ e -> runOverloaded $ do { MkC e1 <- repLE e ; return e1 } + PatBr _ p -> runOverloaded $ do { MkC p1 <- repTopP p ; return p1 } + TypBr _ t -> runOverloaded $ do { MkC t1 <- repLTy t ; return t1 } + DecBrG _ gp -> runOverloaded $ do { MkC ds1 <- repTopDs gp ; return ds1 } + DecBrL {} -> panic "dsUntypedBracket: unexpected DecBrL" where - runOverloaded act = do + Just wrap = mb_wrap -- Not used in VarBr case -- In the overloaded case we have to get given a wrapper, it is just - -- for variable quotations that there is no wrapper, because they + -- the VarBr case that there is no wrapper, because they -- have a simple type. - mw <- mkMetaWrappers (expectJust "runOverloaded" wrap) - runReaderT (mapReaderT (dsExtendMetaEnv new_bit) act) mw + + runOverloaded act = do { mw <- mkMetaWrappers wrap + ; runReaderT (mapReaderT (dsExtendMetaEnv new_bit) act) mw } new_bit = mkNameEnv [(n, DsSplice (unLoc e)) | PendingTcSplice n e <- splices] - do_brack (VarBr _ _ n) = do { MkC e1 <- lookupOccDsM (unLoc n) ; return e1 } - do_brack (ExpBr _ e) = runOverloaded $ do { MkC e1 <- repLE e ; return e1 } - do_brack (PatBr _ p) = runOverloaded $ do { MkC p1 <- repTopP p ; return p1 } - do_brack (TypBr _ t) = runOverloaded $ do { MkC t1 <- repLTy t ; return t1 } - do_brack (DecBrG _ gp) = runOverloaded $ do { MkC ds1 <- repTopDs gp ; return ds1 } - do_brack (DecBrL {}) = panic "dsUntypedBracket: unexpected DecBrL" - - {- Note [Desugaring Brackets] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1413,7 +1409,8 @@ repTy (HsKindSig _ t k) = do t1 <- repLTy t k1 <- repLTy k repTSig t1 k1 -repTy (HsSpliceTy _ splice) = repSplice splice +repTy (HsSpliceTy (HsUntypedSpliceNested n) _) = rep_splice n +repTy t@(HsSpliceTy (HsUntypedSpliceTop _ _) _) = pprPanic "repTy: top level splice" (ppr t) repTy (HsExplicitListTy _ _ tys) = do tys1 <- repLTys tys repTPromotedList tys1 @@ -1460,13 +1457,8 @@ repRole (L _ Nothing) = rep2_nw inferRName [] -- Splices ----------------------------------------------------------------------------- -repSplice :: HsSplice GhcRn -> MetaM (Core a) -- See Note [How brackets and nested splices are handled] in GHC.Tc.Gen.Splice -- We return a CoreExpr of any old type; the context should know -repSplice (HsTypedSplice _ _ n _) = rep_splice n -repSplice (HsUntypedSplice _ _ n _) = rep_splice n -repSplice (HsQuasiQuote _ n _ _ _) = rep_splice n -repSplice e@(HsSpliced {}) = pprPanic "repSplice" (ppr e) rep_splice :: Name -> MetaM (Core a) rep_splice splice_name @@ -1634,7 +1626,9 @@ repE (ArithSeq _ _ aseq) = ds3 <- repLE e3 repFromThenTo ds1 ds2 ds3 -repE (HsSpliceE _ splice) = repSplice splice +repE (HsTypedSplice n _) = rep_splice n +repE (HsUntypedSplice (HsUntypedSpliceNested n) _) = rep_splice n +repE e@(HsUntypedSplice (HsUntypedSpliceTop _ _) _) = pprPanic "repE: top level splice" (ppr e) repE (HsStatic _ e) = repLE e >>= rep2 staticEName . (:[]) . unC repE (HsUnboundVar _ uv) = do occ <- occNameLit uv @@ -2101,7 +2095,8 @@ repP p@(NPat _ (L _ l) (Just _) _) repP (SigPat _ p t) = do { p' <- repLP p ; t' <- repLTy (hsPatSigType t) ; repPsig p' t' } -repP (SplicePat _ splice) = repSplice splice +repP (SplicePat (HsUntypedSpliceNested n) _) = rep_splice n +repP p@(SplicePat (HsUntypedSpliceTop _ _) _) = pprPanic "repP: top level splice" (ppr p) repP other = notHandled (ThExoticPattern other) ---------------------------------------------------------- diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index b6604a9d76..e92327f6d7 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -377,8 +377,9 @@ enrichHie ts (hsGrp, imports, exports, docs) ev_bs insts tcs = let asts = HieASTs $ resolveTyVarScopes asts' return asts - where - processGrp grp = concatM + +processGrp :: HsGroup GhcRn -> HieM [HieAST Type] +processGrp grp = concatM [ toHie $ fmap (RS ModuleScope ) hs_valds grp , toHie $ hs_splcds grp , toHie $ hs_tyclds grp @@ -798,7 +799,7 @@ class ( HiePass (NoGhcTcPass p) , Data (AmbiguousFieldOcc (GhcPass p)) , Data (HsCmdTop (GhcPass p)) , Data (GRHS (GhcPass p) (LocatedA (HsCmd (GhcPass p)))) - , Data (HsSplice (GhcPass p)) + , Data (HsUntypedSplice (GhcPass p)) , Data (HsLocalBinds (GhcPass p)) , Data (FieldOcc (GhcPass p)) , Data (HsTupArg (GhcPass p)) @@ -1202,11 +1203,14 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where [ toHie b , toHie xbracket ] - HieTc | HsBracketTc _ _ _ p <- xbracket -> - [ toHie b + HieTc | HsBracketTc q _ _ p <- xbracket -> + [ toHie q , toHie p ] - HsSpliceE _ x -> + HsTypedSplice _ x -> + [ toHie x + ] + HsUntypedSplice _ x -> [ toHie $ L mspan x ] HsGetField {} -> [] @@ -1871,14 +1875,19 @@ instance ToHie (LocatedA (SpliceDecl GhcRn)) where [ toHie splice ] -instance ToHie (HsQuote a) where - toHie _ = pure [] +instance ToHie (HsQuote GhcRn) where + toHie (ExpBr _ e) = toHie e + toHie (PatBr _ b) = toHie (PS Nothing NoScope NoScope b) + toHie (DecBrL {} ) = pure [] + toHie (DecBrG _ decls) = processGrp decls + toHie (TypBr _ ty) = toHie ty + toHie (VarBr {} ) = pure [] instance ToHie PendingRnSplice where - toHie _ = pure [] + toHie (PendingRnSplice _ _ e) = toHie e instance ToHie PendingTcSplice where - toHie _ = pure [] + toHie (PendingTcSplice _ e) = toHie e instance ToHie (LBooleanFormula (LocatedN Name)) where toHie (L span form) = concatM $ makeNode form (locA span) : case form of @@ -1898,25 +1907,14 @@ instance ToHie (LBooleanFormula (LocatedN Name)) where instance ToHie (LocatedAn NoEpAnns HsIPName) where toHie (L span e) = makeNodeA e span -instance HiePass p => ToHie (LocatedA (HsSplice (GhcPass p))) where +instance HiePass p => ToHie (LocatedA (HsUntypedSplice (GhcPass p))) where toHie (L span sp) = concatM $ makeNodeA sp span : case sp of - HsTypedSplice _ _ _ expr -> - [ toHie expr - ] - HsUntypedSplice _ _ _ expr -> + HsUntypedSpliceExpr _ expr -> [ toHie expr ] - HsQuasiQuote _ _ _ ispan _ -> - [ locOnly ispan + HsQuasiQuote _ _ ispanFs -> + [ locOnly (getLocA ispanFs) ] - HsSpliced _ _ _ -> - [] - XSplice x -> case hiePass @p of -#if __GLASGOW_HASKELL__ < 811 - HieRn -> dataConCantHappen x -#endif - HieTc -> case x of - HsSplicedT _ -> [] instance ToHie (LocatedA (RoleAnnotDecl GhcRn)) where toHie (L span annot) = concatM $ makeNodeA annot span : case annot of diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index bb57f39d7b..a238dac301 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -2625,15 +2625,15 @@ explicit_activation :: { ([AddEpAnn],Activation) } -- In brackets ----------------------------------------------------------------------------- -- Expressions -quasiquote :: { Located (HsSplice GhcPs) } +quasiquote :: { Located (HsUntypedSplice GhcPs) } : TH_QUASIQUOTE { let { loc = getLoc $1 ; ITquasiQuote (quoter, quote, quoteSpan) = unLoc $1 ; quoterId = mkUnqual varName quoter } - in sL1 $1 (mkHsQuasiQuote quoterId (mkSrcSpanPs quoteSpan) quote) } + in sL1 $1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) } | TH_QQUASIQUOTE { let { loc = getLoc $1 ; ITqQuasiQuote (qual, quoter, quote, quoteSpan) = unLoc $1 ; quoterId = mkQual varName (qual, quoter) } - in sL1 $1 (mkHsQuasiQuote quoterId (mkSrcSpanPs quoteSpan) quote) } + in sL1 $1 (HsQuasiQuote noExtField quoterId (L (noAnnSrcSpan (mkSrcSpanPs quoteSpan)) quote)) } exp :: { ECP } : infixexp '::' ctype @@ -2926,7 +2926,7 @@ aexp2 :: { ECP } -- Template Haskell Extension | splice_untyped { ECP $ pvA $ mkHsSplicePV $1 } - | splice_typed { ecpFromExp $ mapLoc (HsSpliceE noAnn) (reLocA $1) } + | splice_typed { ecpFromExp $ mapLoc (uncurry HsTypedSplice) (reLocA $1) } | SIMPLEQUOTE qvar {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } | SIMPLEQUOTE qcon {% fmap ecpFromExp $ acsA (\cs -> sLL $1 (reLocN $>) $ HsUntypedBracket (EpAnn (glR $1) [mj AnnSimpleQuote $1] cs) (VarBr noExtField True $2)) } @@ -2964,19 +2964,19 @@ projection | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel (Just $ glAA $1)) cs) (reLocA $2)) :| [])) } splice_exp :: { LHsExpr GhcPs } - : splice_untyped { mapLoc (HsSpliceE noAnn) (reLocA $1) } - | splice_typed { mapLoc (HsSpliceE noAnn) (reLocA $1) } + : splice_untyped { mapLoc (HsUntypedSplice noAnn) (reLocA $1) } + | splice_typed { mapLoc (uncurry HsTypedSplice) (reLocA $1) } -splice_untyped :: { Located (HsSplice GhcPs) } +splice_untyped :: { Located (HsUntypedSplice GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ mkUntypedSplice (EpAnn (glR $1) [mj AnnDollar $1] cs) DollarSplice $2) } + acs (\cs -> sLLlA $1 $> $ HsUntypedSpliceExpr (EpAnn (glR $1) [mj AnnDollar $1] cs) $2) } -splice_typed :: { Located (HsSplice GhcPs) } +splice_typed :: { Located ((EpAnnCO, EpAnn [AddEpAnn]), LHsExpr GhcPs) } -- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer : PREFIX_DOLLAR_DOLLAR aexp2 {% runPV (unECP $2) >>= \ $2 -> - acs (\cs -> sLLlA $1 $> $ mkTypedSplice (EpAnn (glR $1) [mj AnnDollarDollar $1] cs) DollarSplice $2) } + acs (\cs -> sLLlA $1 $> $ ((noAnn, EpAnn (glR $1) [mj AnnDollarDollar $1] cs), $2)) } cmdargs :: { [LHsCmdTop GhcPs] } : cmdargs acmd { $2 : $1 } diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 5d0d111fcb..902e23e08c 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -399,19 +399,19 @@ mkSpliceDecl :: LHsExpr GhcPs -> P (LHsDecl GhcPs) -- Typed splices are not allowed at the top level, thus we do not represent them -- as spliced declaration. See #10945 mkSpliceDecl lexpr@(L loc expr) - | HsSpliceE _ splice@(HsUntypedSplice {}) <- expr = do + | HsUntypedSplice _ splice@(HsUntypedSpliceExpr {}) <- expr = do cs <- getCommentsFor (locA loc) - return $ L (addCommentsToSrcAnn loc cs) $ SpliceD noExtField (SpliceDecl noExtField (L loc splice) ExplicitSplice) + return $ L (addCommentsToSrcAnn loc cs) $ SpliceD noExtField (SpliceDecl noExtField (L loc splice) DollarSplice) - | HsSpliceE _ splice@(HsQuasiQuote {}) <- expr = do + | HsUntypedSplice _ splice@(HsQuasiQuote {}) <- expr = do cs <- getCommentsFor (locA loc) - return $ L (addCommentsToSrcAnn loc cs) $ SpliceD noExtField (SpliceDecl noExtField (L loc splice) ExplicitSplice) + return $ L (addCommentsToSrcAnn loc cs) $ SpliceD noExtField (SpliceDecl noExtField (L loc splice) DollarSplice) | otherwise = do cs <- getCommentsFor (locA loc) return $ L (addCommentsToSrcAnn loc cs) $ SpliceD noExtField (SpliceDecl noExtField - (L loc (mkUntypedSplice noAnn BareSplice lexpr)) - ImplicitSplice) + (L loc (HsUntypedSpliceExpr noAnn lexpr)) + BareSplice) mkRoleAnnotDecl :: SrcSpan -> LocatedN RdrName -- type being annotated @@ -1563,7 +1563,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where -- | Disambiguate "[a,b,c]" (list syntax) mkHsExplicitListPV :: SrcSpan -> [LocatedA b] -> AnnList -> PV (LocatedA b) -- | Disambiguate "$(...)" and "[quasi|...|]" (TH splices) - mkHsSplicePV :: Located (HsSplice GhcPs) -> PV (Located b) + mkHsSplicePV :: Located (HsUntypedSplice GhcPs) -> PV (Located b) -- | Disambiguate "f { a = b, ... }" syntax (record construction and record updates) mkHsRecordPV :: Bool -> -- Is OverloadedRecordUpdate in effect? @@ -1690,7 +1690,7 @@ instance DisambECP (HsCmd GhcPs) where mkHsTySigPV l a sig _ = cmdFail (locA l) (ppr a <+> text "::" <+> ppr sig) mkHsExplicitListPV l xs _ = cmdFail l $ brackets (fsep (punctuate comma (map ppr xs))) - mkHsSplicePV (L l sp) = cmdFail l (ppr sp) + mkHsSplicePV (L l sp) = cmdFail l (pprUntypedSplice True Nothing sp) mkHsRecordPV _ l _ a (fbinds, ddLoc) _ = do let (fs, ps) = partitionEithers fbinds if not (null ps) @@ -1786,7 +1786,7 @@ instance DisambECP (HsExpr GhcPs) where return $ L (noAnnSrcSpan l) (ExplicitList (EpAnn (spanAsAnchor l) anns cs) xs) mkHsSplicePV sp@(L l _) = do cs <- getCommentsFor l - return $ mapLoc (HsSpliceE (EpAnn (spanAsAnchor l) NoEpAnns cs)) sp + return $ mapLoc (HsUntypedSplice (EpAnn (spanAsAnchor l) NoEpAnns cs)) sp mkHsRecordPV opts l lrec a (fbinds, ddLoc) anns = do cs <- getCommentsFor l r <- mkRecConstrOrUpdate opts a lrec (fbinds, ddLoc) (EpAnn (spanAsAnchor l) anns cs) diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs index 3b22e3ea73..eab8711c8f 100644 --- a/compiler/GHC/Rename/Expr.hs +++ b/compiler/GHC/Rename/Expr.hs @@ -47,7 +47,7 @@ import GHC.Rename.Utils ( bindLocalNamesFV, checkDupNames , genHsVar, genLHsVar, genHsApp, genHsApps , genAppType ) import GHC.Rename.Unbound ( reportUnboundName ) -import GHC.Rename.Splice ( rnTypedBracket, rnUntypedBracket, rnSpliceExpr, checkThLocalName ) +import GHC.Rename.Splice ( rnTypedBracket, rnUntypedBracket, rnTypedSplice, rnUntypedSpliceExpr, checkThLocalName ) import GHC.Rename.HsType import GHC.Rename.Pat import GHC.Driver.Session @@ -375,7 +375,8 @@ rnExpr (HsProjection _ fs) rnExpr e@(HsTypedBracket _ br_body) = rnTypedBracket e br_body rnExpr e@(HsUntypedBracket _ br_body) = rnUntypedBracket e br_body -rnExpr (HsSpliceE _ splice) = rnSpliceExpr splice +rnExpr (HsTypedSplice _ splice) = rnTypedSplice splice +rnExpr (HsUntypedSplice _ splice) = rnUntypedSpliceExpr splice --------------------------------------------- -- Sections diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs index bc701e87bf..1755b6a1ef 100644 --- a/compiler/GHC/Rename/Module.hs +++ b/compiler/GHC/Rename/Module.hs @@ -2545,8 +2545,8 @@ add gp loc (SpliceD _ splice@(SpliceDecl _ _ flag)) ds = do { -- We've found a top-level splice. If it is an *implicit* one -- (i.e. a naked top level expression) case flag of - ExplicitSplice -> return () - ImplicitSplice -> do { th_on <- xoptM LangExt.TemplateHaskell + DollarSplice -> return () + BareSplice -> do { th_on <- xoptM LangExt.TemplateHaskell ; unless th_on $ setSrcSpan (locA loc) $ failWith badImplicitSplice } diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs index 9eeaff6783..b64d1141e7 100644 --- a/compiler/GHC/Rename/Pat.hs +++ b/compiler/GHC/Rename/Pat.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} @@ -22,7 +22,7 @@ general, all of these functions return a renamed thing, and a set of free variables. -} module GHC.Rename.Pat (-- main entry points - rnPat, rnPats, rnBindPat, rnPatAndThen, + rnPat, rnPats, rnBindPat, NameMaker, applyNameMaker, -- a utility for making names: localRecNameMaker, topRecNameMaker, -- sometimes we want to make local names, @@ -609,15 +609,13 @@ rnPatAndThen mk (SumPat _ pat alt arity) ; return (SumPat noExtField pat alt arity) } --- If a splice has been run already, just rename the result. -rnPatAndThen mk (SplicePat x (HsSpliced x2 mfs (HsSplicedPat pat))) - = SplicePat x . HsSpliced x2 mfs . HsSplicedPat <$> rnPatAndThen mk pat - rnPatAndThen mk (SplicePat _ splice) = do { eith <- liftCpsFV $ rnSplicePat splice ; case eith of -- See Note [rnSplicePat] in GHC.Rename.Splice - Left not_yet_renamed -> rnPatAndThen mk not_yet_renamed - Right already_renamed -> return already_renamed } + (rn_splice, HsUntypedSpliceTop mfs pat) -> -- Splice was top-level and thus run, creating Pat GhcPs + gParPat . (fmap (flip SplicePat rn_splice . HsUntypedSpliceTop mfs)) <$> rnLPatAndThen mk pat + (rn_splice, HsUntypedSpliceNested splice_name) -> return (SplicePat (HsUntypedSpliceNested splice_name) rn_splice) -- Splice was nested and thus already renamed + } -------------------- rnConPatAndThen :: NameMaker diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs index e67e480d78..db032bbc23 100644 --- a/compiler/GHC/Rename/Splice.hs +++ b/compiler/GHC/Rename/Splice.hs @@ -1,14 +1,20 @@ - +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} module GHC.Rename.Splice ( rnTopSpliceDecls, - rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl, + + -- Typed splices + rnTypedSplice, + -- Untyped splices + rnSpliceType, rnUntypedSpliceExpr, rnSplicePat, rnSpliceDecl, + + -- Brackets rnTypedBracket, rnUntypedBracket, - checkThLocalName - , traceSplice, SpliceInfo(..) + + checkThLocalName, traceSplice, SpliceInfo(..) ) where import GHC.Prelude @@ -284,51 +290,43 @@ 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 :: (HsSplice GhcRn -> RnM (a, FreeVars)) - -- Outside brackets, run splice - -> (HsSplice GhcRn -> (PendingRnSplice, a)) - -- Inside brackets, make it pending - -> HsSplice GhcPs - -> RnM (a, FreeVars) -rnSpliceGen run_splice pend_splice splice +rnUntypedSpliceGen :: (HsUntypedSplice GhcRn -> RnM (a, FreeVars)) + -- Outside brackets, run splice + -> (Name -> HsUntypedSplice GhcRn -> (PendingRnSplice, a)) + -- Inside brackets, make it pending + -> HsUntypedSplice GhcPs + -> RnM (a, FreeVars) +rnUntypedSpliceGen run_splice pend_splice splice = addErrCtxt (spliceCtxt splice) $ do { stage <- getStage ; case stage of - Brack pop_stage RnPendingTyped - -> do { checkTc is_typed_splice illegalUntypedSplice - ; (splice', fvs) <- setStage pop_stage $ - rnSplice splice - ; let (_pending_splice, result) = pend_splice splice' - ; return (result, fvs) } + Brack _ RnPendingTyped + -> failWithTc illegalUntypedSplice Brack pop_stage (RnPendingUntyped ps_var) - -> do { checkTc (not is_typed_splice) illegalTypedSplice - ; (splice', fvs) <- setStage pop_stage $ - rnSplice splice - ; let (pending_splice, result) = pend_splice splice' + -> do { (splice', fvs) <- setStage pop_stage $ + rnUntypedSplice splice + ; loc <- getSrcSpanM + ; splice_name <- newLocalBndrRn (L (noAnnSrcSpan loc) unqualSplice) + ; let (pending_splice, result) = pend_splice splice_name splice' ; ps <- readMutVar ps_var ; writeMutVar ps_var (pending_splice : ps) ; return (result, fvs) } _ -> do { checkTopSpliceAllowed splice ; (splice', fvs1) <- checkNoErrs $ - setStage (Splice splice_type) $ - rnSplice splice + setStage (Splice Untyped) $ + rnUntypedSplice 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 - splice_type = if is_typed_splice - then Typed - else Untyped -- Nested splices are fine without TemplateHaskell because they -- are not executed until the top-level splice is run. -checkTopSpliceAllowed :: HsSplice GhcPs -> RnM () +checkTopSpliceAllowed :: HsUntypedSplice GhcPs -> RnM () checkTopSpliceAllowed splice = do let (herald, ext) = spliceExtension splice extEnabled <- xoptM ext @@ -336,11 +334,9 @@ checkTopSpliceAllowed splice = do (failWith $ TcRnUnknownMessage $ mkPlainError noHints $ text herald <+> text "are not permitted without" <+> ppr ext) where - spliceExtension :: HsSplice GhcPs -> (String, LangExt.Extension) + spliceExtension :: HsUntypedSplice GhcPs -> (String, LangExt.Extension) spliceExtension (HsQuasiQuote {}) = ("Quasi-quotes", LangExt.QuasiQuotes) - spliceExtension (HsTypedSplice {}) = ("Top-level splices", LangExt.TemplateHaskell) - spliceExtension (HsUntypedSplice {}) = ("Top-level splices", LangExt.TemplateHaskell) - spliceExtension s@(HsSpliced {}) = pprPanic "spliceExtension" (ppr s) + spliceExtension (HsUntypedSpliceExpr {}) = ("Top-level splices", LangExt.TemplateHaskell) ------------------ @@ -352,7 +348,7 @@ runRnSplice :: UntypedSpliceFlavour -> (LHsExpr GhcTc -> TcRn res) -> (res -> SDoc) -- How to pretty-print res -- Usually just ppr, but not for [Decl] - -> HsSplice GhcRn -- Always untyped + -> HsUntypedSplice GhcRn -> TcRn (res, [ForeignRef (TH.Q ())]) runRnSplice flavour run_meta ppr_res splice = do { hooks <- hsc_hooks <$> getTopEnv @@ -361,10 +357,8 @@ runRnSplice flavour run_meta ppr_res splice Just h -> h splice ; let the_expr = case splice' of - HsUntypedSplice _ _ _ e -> e - HsQuasiQuote _ _ q qs str -> mkQuasiQuoteExpr flavour q qs str - HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice) - HsSpliced {} -> pprPanic "runRnSplice" (ppr splice) + HsUntypedSpliceExpr _ e -> e + HsQuasiQuote _ q str -> mkQuasiQuoteExpr flavour q str -- Typecheck the expression ; meta_exp_ty <- tcMetaTy meta_ty_name @@ -401,30 +395,28 @@ runRnSplice flavour run_meta ppr_res splice ------------------ makePending :: UntypedSpliceFlavour - -> HsSplice GhcRn + -> Name + -> HsUntypedSplice GhcRn -> PendingRnSplice -makePending flavour (HsUntypedSplice _ _ n e) +makePending flavour n (HsUntypedSpliceExpr _ 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) -makePending _ splice@(HsSpliced {}) - = pprPanic "makePending" (ppr splice) +makePending flavour n (HsQuasiQuote _ quoter quote) + = PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter quote) ------------------ -mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString +mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name + -> XRec GhcPs FastString -> LHsExpr GhcRn -- Return the expression (quoter "...quote...") -- which is what we must run in a quasi-quote -mkQuasiQuoteExpr flavour quoter q_span' quote +mkQuasiQuoteExpr flavour quoter (L q_span' quote) = L q_span $ HsApp noComments (L q_span $ HsApp noComments (L q_span (HsVar noExtField (L (la2na q_span) quote_selector))) quoterExpr) quoteExpr where - q_span = noAnnSrcSpan q_span' + q_span = noAnnSrcSpan (locA q_span') quoterExpr = L q_span $! HsVar noExtField $! (L (la2na q_span) quoter) quoteExpr = L q_span $! HsLit noComments $! HsString NoSourceText quote quote_selector = case flavour of @@ -434,66 +426,90 @@ mkQuasiQuoteExpr flavour quoter q_span' quote UntypedDeclSplice -> quoteDecName --------------------- -rnSplice :: HsSplice GhcPs -> RnM (HsSplice GhcRn, FreeVars) +unqualSplice :: RdrName +-- The RdrName for a SplicePointName. See GHC.Hs.Expr +-- Note [Lifecycle of an untyped splice, and PendingRnSplice] +-- We use "spn" (which is arbitrary) because it is brief but greppable-for. +unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "spn")) + +rnUntypedSplice :: HsUntypedSplice GhcPs -> RnM (HsUntypedSplice GhcRn, FreeVars) -- Not exported...used for all -rnSplice (HsTypedSplice x hasParen splice_name expr) - = do { loc <- getSrcSpanM - ; n' <- newLocalBndrRn (L (noAnnSrcSpan loc) splice_name) - ; (expr', fvs) <- rnLExpr expr - ; return (HsTypedSplice x hasParen n' expr', fvs) } - -rnSplice (HsUntypedSplice x hasParen splice_name expr) - = do { loc <- getSrcSpanM - ; n' <- newLocalBndrRn (L (noAnnSrcSpan loc) splice_name) - ; (expr', fvs) <- rnLExpr expr - ; return (HsUntypedSplice x hasParen n' expr', fvs) } - -rnSplice (HsQuasiQuote x splice_name quoter q_loc quote) - = do { loc <- getSrcSpanM - ; splice_name' <- newLocalBndrRn (L (noAnnSrcSpan loc) splice_name) - - -- Rename the quoter; akin to the HsVar case of rnExpr +rnUntypedSplice (HsUntypedSpliceExpr annCo expr) + = do { (expr', fvs) <- rnLExpr expr + ; return (HsUntypedSpliceExpr annCo expr', fvs) } + +rnUntypedSplice (HsQuasiQuote ext quoter quote) + = do { -- 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 x splice_name' quoter' q_loc quote - , unitFV quoter') } - -rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice) + ; return (HsQuasiQuote ext quoter' quote, unitFV quoter') } --------------------- -rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars) -rnSpliceExpr splice - = rnSpliceGen run_expr_splice pend_expr_splice splice +rnTypedSplice :: LHsExpr GhcPs -- Typed splice expression + -> RnM (HsExpr GhcRn, FreeVars) +rnTypedSplice expr + = addErrCtxt (hang (text "In the typed splice:") 2 (pprTypedSplice Nothing expr)) $ do + { stage <- getStage + ; case stage of + Brack pop_stage RnPendingTyped + -> setStage pop_stage rn_splice + + Brack _ (RnPendingUntyped _) + -> failWithTc illegalTypedSplice + + _ -> do { extEnabled <- xoptM LangExt.TemplateHaskell + ; unless extEnabled + (failWith $ TcRnUnknownMessage $ mkPlainError noHints $ + text "Top-level splices are not permitted without" + <+> ppr LangExt.TemplateHaskell) + + ; (result, fvs1) <- checkNoErrs $ setStage (Splice Typed) rn_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 + + -- Run typed splice later, in the type checker + -- Ugh! See Note [Free variables of typed splices] above + ; traceRn "rnTypedSplice: typed expression splice" empty + ; lcl_rdr <- getLocalRdrEnv + ; gbl_rdr <- getGlobalRdrEnv + ; let gbl_names = mkNameSet [greMangledName gre | gre <- globalRdrEnvElts gbl_rdr + , isLocalGRE gre] + lcl_names = mkNameSet (localRdrEnvElts lcl_rdr) + fvs2 = lcl_names `plusFV` gbl_names + + ; return (result, fvs1 `plusFV` fvs2) } } + where + rn_splice :: RnM (HsExpr GhcRn, FreeVars) + rn_splice = + do { loc <- getSrcSpanM + -- The renamer allocates a splice-point name to every typed splice + -- (incl the top level ones for which it will not ultimately be used) + ; n' <- newLocalBndrRn (L (noAnnSrcSpan loc) unqualSplice) + ; (expr', fvs) <- rnLExpr expr + ; return (HsTypedSplice n' expr', fvs) } + +rnUntypedSpliceExpr :: HsUntypedSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars) +rnUntypedSpliceExpr splice + = rnUntypedSpliceGen run_expr_splice pend_expr_splice splice where - pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn) - pend_expr_splice rn_splice - = (makePending UntypedExpSplice rn_splice, HsSpliceE noAnn rn_splice) + pend_expr_splice :: Name -> HsUntypedSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn) + pend_expr_splice name rn_splice + = (makePending UntypedExpSplice name rn_splice, HsUntypedSplice (HsUntypedSpliceNested name) rn_splice) - run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars) + run_expr_splice :: HsUntypedSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars) run_expr_splice rn_splice - | isTypedSplice rn_splice -- Run it later, in the type checker - = do { -- Ugh! See Note [Free variables of typed splices] above - traceRn "rnSpliceExpr: typed expression splice" empty - ; lcl_rdr <- getLocalRdrEnv - ; gbl_rdr <- getGlobalRdrEnv - ; let gbl_names = mkNameSet [greMangledName gre | gre <- globalRdrEnvElts gbl_rdr - , isLocalGRE gre] - lcl_names = mkNameSet (localRdrEnvElts lcl_rdr) - - ; return (HsSpliceE noAnn rn_splice, lcl_names `plusFV` gbl_names) } - - | otherwise -- Run it here, see Note [Running splices in the Renamer] - = do { traceRn "rnSpliceExpr: untyped expression splice" empty + = do { traceRn "rnUntypedSpliceExpr: untyped expression splice" empty + -- Run it here, see Note [Running splices in the Renamer] ; (rn_expr, mod_finalizers) <- runRnSplice UntypedExpSplice runMetaE ppr rn_splice ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr) -- See Note [Delaying modFinalizers in untyped splices]. - ; let e = HsSpliceE noAnn - . HsSpliced noExtField (ThModFinalizers mod_finalizers) - . HsSplicedExpr + ; let e = flip HsUntypedSplice rn_splice + . HsUntypedSpliceTop (ThModFinalizers mod_finalizers) <$> lexpr3 ; return (gHsPar e, fvs) } @@ -649,13 +665,13 @@ References: -} ---------------------- -rnSpliceType :: HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars) +rnSpliceType :: HsUntypedSplice GhcPs -> RnM (HsType GhcRn, FreeVars) rnSpliceType splice - = rnSpliceGen run_type_splice pend_type_splice splice + = rnUntypedSpliceGen run_type_splice pend_type_splice splice where - pend_type_splice rn_splice - = ( makePending UntypedTypeSplice rn_splice - , HsSpliceTy noExtField rn_splice) + pend_type_splice name rn_splice + = ( makePending UntypedTypeSplice name rn_splice + , HsSpliceTy (HsUntypedSpliceNested name) rn_splice) run_type_splice rn_splice = do { traceRn "rnSpliceType: untyped type splice" empty @@ -666,10 +682,9 @@ rnSpliceType splice -- checkNoErrs: see Note [Renamer errors] -- See Note [Delaying modFinalizers in untyped splices]. ; return ( HsParTy noAnn - $ HsSpliceTy noExtField - . HsSpliced noExtField (ThModFinalizers mod_finalizers) - . HsSplicedTy <$> - hs_ty3 + $ flip HsSpliceTy rn_splice + . HsUntypedSpliceTop (ThModFinalizers mod_finalizers) + <$> hs_ty3 , fvs ) } -- Wrap the result of the splice in parens so that we don't @@ -717,50 +732,43 @@ whole signature, instead of as an arbitrary type. ---------------------- -- | Rename a splice pattern. See Note [rnSplicePat] -rnSplicePat :: HsSplice GhcPs -> RnM ( Either (Pat GhcPs) (Pat GhcRn) - , FreeVars) +rnSplicePat :: HsUntypedSplice GhcPs -> RnM ( (HsUntypedSplice GhcRn, HsUntypedSpliceResult (LPat GhcPs)) + , FreeVars) rnSplicePat splice - = rnSpliceGen run_pat_splice pend_pat_splice splice + = rnUntypedSpliceGen run_pat_splice pend_pat_splice splice where - pend_pat_splice :: HsSplice GhcRn -> - (PendingRnSplice, Either b (Pat GhcRn)) - pend_pat_splice rn_splice - = (makePending UntypedPatSplice rn_splice - , Right (SplicePat noExtField rn_splice)) - - run_pat_splice :: HsSplice GhcRn -> - RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars) + pend_pat_splice name rn_splice + = (makePending UntypedPatSplice name rn_splice + , (rn_splice, HsUntypedSpliceNested name)) -- Pat splice is nested and thus simply renamed + run_pat_splice rn_splice = do { traceRn "rnSplicePat: untyped pattern splice" empty ; (pat, mod_finalizers) <- runRnSplice UntypedPatSplice runMetaP ppr rn_splice -- See Note [Delaying modFinalizers in untyped splices]. - ; let p = SplicePat noExtField - . HsSpliced noExtField (ThModFinalizers mod_finalizers) - . HsSplicedPat - <$> pat - ; return (Left $ gParPat p, emptyFVs) } + ; let p = HsUntypedSpliceTop (ThModFinalizers mod_finalizers) pat + ; return ((rn_splice, p), emptyFVs) } -- Wrap the result of the quasi-quoter in parens so that we don't -- lose the outermost location set by runQuasiQuote (#7918) ---------------------- rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars) rnSpliceDecl (SpliceDecl _ (L loc splice) flg) - = rnSpliceGen run_decl_splice pend_decl_splice splice + = rnUntypedSpliceGen run_decl_splice pend_decl_splice splice where - pend_decl_splice rn_splice - = ( makePending UntypedDeclSplice rn_splice + pend_decl_splice name rn_splice + = ( makePending UntypedDeclSplice name rn_splice , SpliceDecl noExtField (L loc rn_splice) flg) - run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice) + run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (pprUntypedSplice True Nothing rn_splice) -rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars) +rnTopSpliceDecls :: HsUntypedSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars) -- Declaration splice at the very top level of the module rnTopSpliceDecls splice = do { checkTopSpliceAllowed splice ; (rn_splice, fvs) <- checkNoErrs $ setStage (Splice Untyped) $ - rnSplice splice + rnUntypedSplice splice -- As always, be sure to checkNoErrs above lest we end up with -- holes making it to typechecking, hence #12584. -- @@ -803,33 +811,33 @@ bound in the pattern to be in scope in the RHS of the pattern. This scope management is effectively done by using continuation-passing style in GHC.Rename.Pat, through the CpsRn monad. We don't wish to be in that monad here (it would create import cycles and generally conflict with renaming other -splices), so we really want to return a (Pat RdrName) -- the result of +splices), so we really want to return a (Pat GhcPs) -- the result of running the splice -- which can then be further renamed in GHC.Rename.Pat, in the CpsRn monad. The problem is that if we're renaming a splice within a bracket, we *don't* want to run the splice now. We really do just want to rename -it to an HsSplice Name. Of course, then we can't know what variables +it to an HsUntypedSplice Name. Of course, then we can't know what variables are bound within the splice. So we accept any unbound variables and rename them again when the bracket is spliced in. If a variable is brought into scope by a pattern splice all is fine. If it is not then an error is reported. -In any case, when we're done in rnSplicePat, we'll either have a -Pat RdrName (the result of running a top-level splice) or a Pat Name -(the renamed nested splice). Thus, the awkward return type of -rnSplicePat. +In any case, when we're done in rnSplicePat, we'll have both the renamed +splice, and either a Pat RdrName and ThModFinalizers (the result of running a +top-level splice) or a splice point name. Thus, rnSplicePat returns both +HsUntypedSplice GhcRn, and HsUntypedSpliceResult (Pat GhcPs) -- which models +the existence of either the result of running the splice (HsUntypedSpliceTop), +or its splice point name if nested (HsUntypedSpliceNested) -} -spliceCtxt :: HsSplice GhcPs -> SDoc +spliceCtxt :: HsUntypedSplice GhcPs -> SDoc spliceCtxt splice - = hang (text "In the" <+> what) 2 (ppr splice) + = hang (text "In the" <+> what) 2 (pprUntypedSplice True Nothing splice) where what = case splice of - HsUntypedSplice {} -> text "untyped splice:" - HsTypedSplice {} -> text "typed splice:" - HsQuasiQuote {} -> text "quasi-quotation:" - HsSpliced {} -> text "spliced expression:" + HsUntypedSpliceExpr {} -> text "untyped splice:" + HsQuasiQuote {} -> text "quasi-quotation:" -- | The splice data to be logged data SpliceInfo diff --git a/compiler/GHC/Rename/Splice.hs-boot b/compiler/GHC/Rename/Splice.hs-boot index 06b8dc6c92..7a67c41d19 100644 --- a/compiler/GHC/Rename/Splice.hs-boot +++ b/compiler/GHC/Rename/Splice.hs-boot @@ -1,14 +1,13 @@ module GHC.Rename.Splice where -import GHC.Prelude import GHC.Hs import GHC.Tc.Utils.Monad import GHC.Types.Name.Set -rnSpliceType :: HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars) -rnSplicePat :: HsSplice GhcPs -> RnM ( Either (Pat GhcPs) (Pat GhcRn) - , FreeVars ) +rnSpliceType :: HsUntypedSplice GhcPs -> RnM (HsType GhcRn, FreeVars) +rnSplicePat :: HsUntypedSplice GhcPs -> RnM ( (HsUntypedSplice GhcRn, HsUntypedSpliceResult (LPat GhcPs)) + , FreeVars) rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars) -rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars) +rnTopSpliceDecls :: HsUntypedSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars) diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs index dc4fa5d46b..ad30052579 100644 --- a/compiler/GHC/Tc/Deriv/Generate.hs +++ b/compiler/GHC/Tc/Deriv/Generate.hs @@ -1661,8 +1661,8 @@ gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon mk_untyped_bracket = HsUntypedBracket noAnn . ExpBr noExtField mk_typed_bracket = HsTypedBracket noAnn - mk_usplice = HsUntypedSplice EpAnnNotUsed DollarSplice - mk_tsplice = HsTypedSplice EpAnnNotUsed DollarSplice + mk_tsplice = HsTypedSplice (EpAnnNotUsed, noAnn) + mk_usplice = HsUntypedSplice EpAnnNotUsed . HsUntypedSpliceExpr noAnn data_cons = getPossibleDataCons tycon tycon_args pats_etc mk_bracket mk_splice lift_name data_con @@ -1677,7 +1677,7 @@ gen_Lift_binds loc (DerivInstTys{ dit_rep_tc = tycon (map lift_var as_needed) lift_var :: RdrName -> LHsExpr (GhcPass 'Parsed) - lift_var x = noLocA (HsSpliceE EpAnnNotUsed (mk_splice x (nlHsPar (mk_lift_expr x)))) + lift_var x = noLocA (mk_splice (nlHsPar (mk_lift_expr x))) mk_lift_expr :: RdrName -> LHsExpr (GhcPass 'Parsed) mk_lift_expr x = nlHsApps (Exact lift_name) [nlHsVar x] diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs index 45c3dabbe5..e26fee1f98 100644 --- a/compiler/GHC/Tc/Gen/Expr.hs +++ b/compiler/GHC/Tc/Gen/Expr.hs @@ -27,7 +27,7 @@ module GHC.Tc.Gen.Expr import GHC.Prelude -import {-# SOURCE #-} GHC.Tc.Gen.Splice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket ) +import {-# SOURCE #-} GHC.Tc.Gen.Splice( tcTypedSplice, tcTypedBracket, tcUntypedBracket ) import GHC.Hs import GHC.Hs.Syn.Type @@ -565,17 +565,18 @@ tcExpr (HsProjection _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsProjection: Not ************************************************************************ -} --- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSpliceExpr'. -- Here we get rid of it and add the finalizers to the global environment. --- -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. -tcExpr (HsSpliceE _ (HsSpliced _ mod_finalizers (HsSplicedExpr expr))) - res_ty - = do addModFinalizersWithLclEnv mod_finalizers - tcExpr expr res_ty -tcExpr (HsSpliceE _ splice) res_ty = tcSpliceExpr splice res_ty -tcExpr e@(HsTypedBracket _ body) res_ty = tcTypedBracket e body res_ty +tcExpr (HsTypedSplice ext splice) res_ty = tcTypedSplice ext splice res_ty +tcExpr e@(HsTypedBracket _ body) res_ty = tcTypedBracket e body res_ty + tcExpr e@(HsUntypedBracket ps body) res_ty = tcUntypedBracket e body ps res_ty +tcExpr (HsUntypedSplice splice _) res_ty + = case splice of + HsUntypedSpliceTop mod_finalizers expr + -> do { addModFinalizersWithLclEnv mod_finalizers + ; tcExpr expr res_ty } + HsUntypedSpliceNested {} -> panic "tcExpr: invalid nested splice" {- ************************************************************************ diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs index 17b1299ab1..f663aab407 100644 --- a/compiler/GHC/Tc/Gen/Head.hs +++ b/compiler/GHC/Tc/Gen/Head.hs @@ -482,7 +482,7 @@ tcInferAppHead_maybe fun args HsRecSel _ f -> Just <$> tcInferRecSelId f ExprWithTySig _ e hs_ty -> Just <$> tcExprWithSig e hs_ty HsOverLit _ lit -> Just <$> tcInferOverLit lit - HsSpliceE _ (HsSpliced _ _ (HsSplicedExpr e)) + HsUntypedSplice (HsUntypedSpliceTop _ e) _ -> tcInferAppHead_maybe e args _ -> return Nothing diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs index f2e5c92d11..54a38a70b4 100644 --- a/compiler/GHC/Tc/Gen/HsType.hs +++ b/compiler/GHC/Tc/Gen/HsType.hs @@ -1042,9 +1042,11 @@ tc_infer_hs_type mode (HsKindSig _ ty sig) -- splices or not. -- -- See Note [Delaying modFinalizers in untyped splices]. -tc_infer_hs_type mode (HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty))) +tc_infer_hs_type mode (HsSpliceTy (HsUntypedSpliceTop _ ty) _) = tc_infer_hs_type mode ty +tc_infer_hs_type _ (HsSpliceTy (HsUntypedSpliceNested n) s) = pprPanic "tc_infer_hs_type: invalid nested splice" (pprUntypedSplice True (Just n) s) + tc_infer_hs_type mode (HsDocTy _ ty _) = tc_infer_lhs_type mode ty -- See Note [Typechecking HsCoreTys] @@ -1142,14 +1144,12 @@ tc_hs_type _ ty@(HsRecTy {}) _ -- while capturing the local environment. -- -- See Note [Delaying modFinalizers in untyped splices]. -tc_hs_type mode (HsSpliceTy _ (HsSpliced _ mod_finalizers (HsSplicedTy ty))) +tc_hs_type mode (HsSpliceTy (HsUntypedSpliceTop mod_finalizers ty) _) exp_kind = do addModFinalizersWithLclEnv mod_finalizers tc_hs_type mode ty exp_kind --- This should never happen; type splices are expanded by the renamer -tc_hs_type _ ty@(HsSpliceTy {}) _exp_kind - = failWithTc $ TcRnUnexpectedTypeSplice ty +tc_hs_type _ (HsSpliceTy (HsUntypedSpliceNested n) s) _ = pprPanic "tc_hs_type: invalid nested splice" (pprUntypedSplice True (Just n) s) ---------- Functions and applications tc_hs_type mode (HsFunTy _ mult ty1 ty2) exp_kind diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs index 45cedcbc8d..cd429f0cc5 100644 --- a/compiler/GHC/Tc/Gen/Pat.hs +++ b/compiler/GHC/Tc/Gen/Pat.hs @@ -685,15 +685,13 @@ AST is used for the subtraction operation. ge' minus'' ; return (mkHsWrapPat mult_wrap pat' pat_ty, res) } --- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSplicePat'. -- Here we get rid of it and add the finalizers to the global environment. --- -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. - SplicePat _ splice -> case splice of - (HsSpliced _ mod_finalizers (HsSplicedPat pat)) -> do + SplicePat (HsUntypedSpliceTop mod_finalizers pat) _ -> do { addModFinalizersWithLclEnv mod_finalizers ; tc_pat pat_ty penv pat thing_inside } - _ -> panic "invalid splice in splice pat" + + SplicePat (HsUntypedSpliceNested _) _ -> panic "tc_pat: nested splice in splice pat" XPat (HsPatExpanded lpat rpat) -> do { (rpat', res) <- tc_pat pat_ty penv rpat thing_inside diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs index 95cb2f467f..16a46f4454 100644 --- a/compiler/GHC/Tc/Gen/Sig.hs +++ b/compiler/GHC/Tc/Gen/Sig.hs @@ -315,8 +315,8 @@ no_anon_wc_ty lty = go lty && go ty HsQualTy { hst_ctxt = ctxt , hst_body = ty } -> gos (unLoc ctxt) && go ty - HsSpliceTy _ (HsSpliced _ _ (HsSplicedTy ty)) -> go $ L noSrcSpanA ty - HsSpliceTy{} -> True + HsSpliceTy (HsUntypedSpliceTop _ ty) _ -> go $ L noSrcSpanA ty + HsSpliceTy (HsUntypedSpliceNested _) _ -> True HsTyLit{} -> True HsTyVar{} -> True HsStarTy{} -> True diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index 1f2c9b66eb..4c6279a6d9 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -20,9 +20,7 @@ -- | Template Haskell splices module GHC.Tc.Gen.Splice( - tcSpliceExpr, tcTypedBracket, tcUntypedBracket, --- runQuasiQuoteExpr, runQuasiQuotePat, --- runQuasiQuoteDecl, runQuasiQuoteType, + tcTypedSplice, tcTypedBracket, tcUntypedBracket, runAnnotation, runMetaE, runMetaP, runMetaT, runMetaD, runQuasi, @@ -120,6 +118,7 @@ import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Utils.Misc +import GHC.Utils.Trace import GHC.Utils.Panic as Panic import GHC.Utils.Panic.Plain import GHC.Utils.Lexeme @@ -160,6 +159,479 @@ import GHC.Parser.HaddockLex (lexHsDoc) import GHC.Parser (parseIdentifier) import GHC.Rename.Doc (rnHsDoc) + + +{- +Note [Template Haskell state diagram] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Here are the ThStages, s, their corresponding level numbers +(the result of (thLevel s)), and their state transitions. +The top level of the program is stage Comp: + + Start here + | + V + ----------- $ ------------ $ + | Comp | ---------> | Splice | -----| + | 1 | | 0 | <----| + ----------- ------------ + ^ | ^ | + $ | | [||] $ | | [||] + | v | v + -------------- ---------------- + | Brack Comp | | Brack Splice | + | 2 | | 1 | + -------------- ---------------- + +* Normal top-level declarations start in state Comp + (which has level 1). + Annotations start in state Splice, since they are + treated very like a splice (only without a '$') + +* Code compiled in state Splice (and only such code) + will be *run at compile time*, with the result replacing + the splice + +* The original paper used level -1 instead of 0, etc. + +* The original paper did not allow a splice within a + splice, but there is no reason not to. This is the + $ transition in the top right. + +Note [Template Haskell levels] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +* Imported things are impLevel (= 0) + +* However things at level 0 are not *necessarily* imported. + eg $( \b -> ... ) here b is bound at level 0 + +* In GHCi, variables bound by a previous command are treated + as impLevel, because we have bytecode for them. + +* Variables are bound at the "current level" + +* The current level starts off at outerLevel (= 1) + +* The level is decremented by splicing $(..) + incremented by brackets [| |] + incremented by name-quoting 'f + +* When a variable is used, checkWellStaged compares + bind: binding level, and + use: current level at usage site + + Generally + bind > use Always error (bound later than used) + [| \x -> $(f x) |] + + bind = use Always OK (bound same stage as used) + [| \x -> $(f [| x |]) |] + + bind < use Inside brackets, it depends + Inside splice, OK + Inside neither, OK + + For (bind < use) inside brackets, there are three cases: + - Imported things OK f = [| map |] + - Top-level things OK g = [| f |] + - Non-top-level Only if there is a liftable instance + h = \(x:Int) -> [| x |] + + To track top-level-ness we use the ThBindEnv in TcLclEnv + + For example: + f = ... + g1 = $(map ...) is OK + g2 = $(f ...) is not OK; because we haven't compiled f yet + + +Note [How top-level splices are handled] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Top-level splices (those not inside a [| .. |] quotation bracket) are handled +very straightforwardly: + + 1. tcTopSpliceExpr: typecheck the body e of the splice $(e) + + 2. runMetaT: desugar, compile, run it, and convert result back to + GHC.Hs syntax RdrName (of the appropriate flavour, eg HsType RdrName, + HsExpr RdrName etc) + + 3. treat the result as if that's what you saw in the first place + e.g for HsType, rename and kind-check + for HsExpr, rename and type-check + + (The last step is different for decls, because they can *only* be + top-level: we return the result of step 2.) + +Note [Warnings for TH splices] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We only produce warnings for TH splices when the user requests so +(-fenable-th-splice-warnings). There are multiple reasons: + + * It's not clear that the user that compiles a splice is the author of the code + that produces the warning. Think of the situation where they just splice in + code from a third-party library that produces incomplete pattern matches. + In this scenario, the user isn't even able to fix that warning. + * Gathering information for producing the warnings (pattern-match check + warnings in particular) is costly. There's no point in doing so if the user + is not interested in those warnings. + +That's why we store Origin flags in the Haskell AST. The functions from ThToHs +take such a flag and depending on whether TH splice warnings were enabled or +not, we pass FromSource (if the user requests warnings) or Generated +(otherwise). This is implemented in getThSpliceOrigin. + +For correct pattern-match warnings it's crucial that we annotate the Origin +consistently (#17270). In the future we could offer the Origin as part of the +TH AST. That would enable us to give quotes from the current module get +FromSource origin, and/or third library authors to tag certain parts of +generated code as FromSource to enable warnings. +That effort is tracked in #14838. + +Note [The life cycle of a TH quotation] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When desugaring a bracket (aka quotation), we want to produce Core +code that, when run, will produce the TH syntax tree for the quotation. +To that end, we want to desugar /renamed/ but not /typechecked/ code; +the latter is cluttered with the typechecker's elaboration that should +not appear in the TH syntax tree. So in (HsExpr GhcTc) tree, we must +have a (HsExpr GhcRn) for the quotation itself. + +As such, when typechecking both typed and untyped brackets, +we keep a /renamed/ bracket in the extension field. + +The HsBracketTc, the GhcTc ext field for both typed and untyped +brackets, contains: + - The renamed quote :: HsQuote GhcRn -- for the desugarer + - [PendingTcSplice] + - The type of the quote + - Maybe QuoteWrapper + +Note that HsBracketTc stores the untyped (HsQuote GhcRn) for both typed and +untyped brackets. They are treated uniformly by the desugarer, and we can +easily construct untyped brackets from typed ones (with ExpBr). + +See Note [Desugaring of brackets]. + +------------ +Typed quotes +------------ +Here is the life cycle of a /typed/ quote [|| e ||], whose datacon is + HsTypedBracket (XTypedBracket p) (LHsExpr p) + + In pass p (XTypedBracket p) (LHsExpr p) + ------------------------------------------- + GhcPs Annotations only LHsExpr GhcPs + GhcRn Annotations only LHsExpr GhcRn + GhcTc HsBracketTc LHsExpr GhcTc: unused! + +Note that in the GhcTc tree, the second field (HsExpr GhcTc) +is entirely unused; the desugarer uses the (HsExpr GhcRn) from the +first field. + +-------------- +Untyped quotes +-------------- +Here is the life cycle of an /untyped/ quote, whose datacon is + HsUntypedBracket (XUntypedBracket p) (HsQuote p) + +Here HsQuote is a sum-type of expressions [| e |], patterns [| p |], +types [| t |] etc. + + In pass p (XUntypedBracket p) (HsQuote p) + ------------------------------------------------------- + GhcPs Annotations only HsQuote GhcPs + GhcRn Annotations, [PendingRnSplice] HsQuote GhcRn + GhcTc HsBracketTc HsQuote GhcTc: unused! + +The difficulty is: the typechecker does not typecheck the body of an +untyped quote, so how do we make a (HsQuote GhcTc) to put in the +second field? + +Answer: we use the extension constructor of HsQuote, namely XQuote, +and make all the other constructors into DataConCantHappen. That is, +the only non-bottom value of type (HsQuote GhcTc) is (XQuote noExtField). +Hence the instances + + type instance XExpBr GhcTc = DataConCantHappen + ...etc... + +See the related Note [How brackets and nested splices are handled] + +Note [Typechecking Overloaded Quotes] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The main function for typechecking untyped quotations is `tcUntypedBracket`. + +Consider an expression quote, `[| e |]`, its type is `forall m . Quote m => m Exp`. +Note carefully that this is overloaded: its type is not `Q Exp` for some fixed Q. + +When we typecheck it we therefore create a template of a metavariable +`m` applied to `Exp` and emit a constraint `Quote m`. All this is done +in the `brackTy` function. `brackTy` also selects the correct +contents type for the quotation (Exp, Type, Decs etc). + +The meta variable and the constraint evidence variable are +returned together in a `QuoteWrapper` and then passed along to two further places +during compilation: + +1. Typechecking nested splices (immediately in tcPendingSplice) +2. Desugaring quotations (see GHC.HsToCore.Quote) + +`tcPendingSplice` takes the `m` type variable as an argument and +checks each nested splice against this variable `m`. During this +process the variable `m` can either be fixed to a specific value or +further constrained by the nested splices. + +Once we have checked all the nested splices, the quote type is checked against +the expected return type. + +The process is very simple and like typechecking a list where the quotation is +like the container and the splices are the elements of the list which must have +a specific type. + +After the typechecking process is completed, the evidence variable for `Quote m` +and the type `m` is stored in a `QuoteWrapper` which is passed through the pipeline +and used when desugaring quotations. + +Typechecking typed quotations is a similar idea but the `QuoteWrapper` is stored +in the `PendingStuff` as the nested splices are gathered up in a different way +to untyped splices. Untyped splices are found in the renamer but typed splices are +not typechecked and extracted until during typechecking. + +Note [Lifecycle of an untyped splice, and PendingRnSplice] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Untyped splices $(f x) and quasiquotes [p| stuff |] have the following +life cycle. Remember, quasi-quotes are very like splices; see Note [Quasi-quote overview]). + +The type structure is + + data HsExpr p = ... + | HsUntypedSplice (XUntypedSplice p) (HsUntypedSplice p) + + data HsUntypedSplice p + = HsUntypedSpliceExpr (XUntypedSpliceExpr p) (LHsExpr p) + | HsQuasiQuote (XQuasiQuote p) (IdP id) (XRec p FastString) + +Remember that untyped splices can occur in expressions, patterns, +types, and declarations. So we have a HsUntypedSplice data +constructor in all four of these types. + +Untyped splices never occur in (HsExpr GhcTc), and similarly +patterns etc. So we have + + type instance XUntypedSplice GhcTc = DataConCantHappen + +Top-level and nested splices are handled differently. + +------------------------------------- +Nested untyped splices/quasiquotes +---------------------------------- +When we rename an /untyped/ bracket, such as + [| f $(g x) |] +we name and lift out all the nested splices, so that when the +typechecker hits the bracket, it can typecheck those nested splices +without having to walk over the untyped bracket code. Our example +[| f $(g x) |] parses as + + HsUntypedBracket _ + (HsApp (HsVar "f") + (HsUntypedSplice _ (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcPs))) + +RENAMER (rnUntypedBracket): + +* Set the ThStage to (Brack s (RnPendingUntyped ps_var)) + +* Rename the body + +* Nested splices (which must be untyped) are renamed (rnUntypedSplice), + and the results accumulated in ps_var. Each gets a fresh + SplicePointName, 'spn' + +* The SplicePointName connects the `PendingRnSplice` with the particular point + in the syntax tree where that expresion should be spliced in. That point + in the tree is identified by `(HsUntypedSpliceNested spn)`. It is used by + the desugarer, so that we ultimately generate something like + let spn = g x + in App (Var "f") spn + +The result is + HsUntypedBracket + [PendingRnSplice UntypedExpSplice spn (g x :: LHsExpr GHcRn)] + (HsApp (HsVar f) (HsUntypedSplice (HsUntypedSpliceNested spn) + (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcRn)))) + +Note that a nested splice, such as the `$(g x)` now appears twice: + - In the PendingRnSplice: this is the version that will later be typechecked + - In the HsUntypedSpliceExpr in the body of the bracket. This copy is used + only for pretty printing. + +NB: a single untyped bracket can contain many splices, each of a different +`UntypedSpliceFlavour`. For example + + [| let $e0 in (f :: $e1) $e2 (\ $e -> body ) |] + 1 + +Here $e0 is a declaration splice, $e1 is a type splice, $e2 is an +expression splice, and $e3 is a pattern splice. The `PendingRnSplice` +keeps track of which is which through its `UntypedSpliceFlavour` +field. + +TYPECHECKER (tcUntypedBracket): see also Note [Typechecking Overloaded Quotes] + +* Typecheck the [PendingRnSplice] individually, to give [PendingTcSplice] + So PendingTcSplice is used for both typed and untyped splices. + +* Ignore the body of the bracket; just check that the context + expects a bracket of that type (e.g. a [p| pat |] bracket should + be in a context needing a (m Pat) + +* Stash the whole lot inside a HsBracketTc + +Result is: + HsUntypedBracket + (HsBracketTc { hsb_splices = [PendingTcSplice spn (g x :: LHsExpr GHcTc)] + , hsb_quote = HsApp (HsVar f) + (HsUntypedSplice (HsUntypedSpliceNested spn) + (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcRn))) + }) + (XQuote noExtField) + +NB in the typechecker output, the original payload (which would now +have type (HsQuote GhcTc) is stubbed off with (XQuote noExtField). The payload +is now in the hsb_quote field of the HsBracketTc. + + +------------------------------------- +Top-level untyped splices/quasiquotes +------------------------------------- +A top-level splice (not inside a bracket) does not need a SpliceName, +nor does a top-level splice ever end up inside a PendingRnSplice; +hence HsUntypedSpliceTop does not have a SplicePointName field. + +Example $(g x). This is parsed as + + HsUntypedSplice _ (HsUntypedSpliceExpr _ ((g x) :: LHsExpr GhcPs)) + +Renamer: the renamer runs the splice, so the output of the renamer looks like + + HsUntypedSplice (HsUntypedSpliceTop fins (e2 :: LHsExpr GhcRn)) + (HsUntypedSpliceExpr ((g x) :: LHsExpr GhcRn)) + +where 'e2' is the result of running (g x) to + produce the syntax tree for 'e2' + 'fins' is a bunch of TH finalisers, to be run later. + +Typechecker: the typechecker simply adds the finalisers, and +typechecks e2, discarding the HsUntypedSplice altogether. + + +Note [Lifecycle of an typed splice, and PendingTcSplice] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +---------------------- +Nested, typed splices +---------------------- +When we typecheck a /typed/ bracket, we lift nested splices out as +`PendingTcSplice`, very similar to Note [PendingRnSplice]. Again, the +splice needs a SplicePointName, for the desguarer to use to connect +the splice expression with the point in the syntax tree where it is +used. Example: + [|| f $$(g 2)||] + +Parser: this is parsed as + + HsTypedBracket _ (HsApp (HsVar "f") + (HsTypedSplice _ (g 2 :: LHsExpr GhcPs))) + +RENAMER (rnTypedSplice): the renamer adds a SplicePointName, spn: + + HsTypedBracket _ (HsApp (HsVar "f") + (HsTypedSplice spn (g x :: LHsExpr GhcRn))) + +TYPECHECKER (tcTypedBracket): + +* Set the ThStage to (Brack s (TcPending ps_var lie_var)) + +* Typecheck the body, and keep the elaborated result (despite never using it!) + +* Nested splices (which must be typed) are typechecked by tcNestedSplice, and + the results accumulated in ps_var; their constraints accumulate in lie_var + +* Result is a HsTypedBracket (HsBracketTc rn_brack ty quote_wrapper pending_splices) tc_brack + where rn_brack is the untyped renamed exp quote constructed from the typed renamed expression :: HsQuote GhcRn + +Just like untyped brackets, dump the output into a HsBracketTc. + + HsTypedBracket + (HsBracketTc { hsb_splices = [PendingTcSplice spn (g x :: LHsExpr GHcTc)] + , hsb_quote = HsApp (HsVar f) + (HsUntypedSplice (HsUntypedSpliceNested spn) + (HsUntypedSpliceExpr _ (g x :: LHsExpr GhcRn))) + }) + (panic "should never be looked at") + +NB: we never need to represent typed /nested/ splices in phase GhcTc. + +There are only typed expression splices so `PendingTcSplice` doesn't have a +flavour field. + + +-------------------------------- +Top-level, typed splices $$(f x) +-------------------------------- +Typed splices are renamed and typechecked, but only actually run in +the zonker, after typechecking. See Note [Running typed splices in the zonker] + +* Output of parser: + HsTypedSplice _ (e :: HsExpr GhcPs) + +* Output of renamer: + HsTypedSplice (n :: SplicePointName) (e :: HsExpr GhcRn) + +* Output of typechecker: (top-level splices only) + HsTypedSplice (del_splice :: DelayedSplice) (e :: HsExpr GhcTc) + where 'del_splice' is something the zonker can run to produce + the syntax tree to splice in. + See Note [Running typed splices in the zonker] + +Note [Desugaring of brackets] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In both cases, desugaring happens like this: + * Hs*Bracket is desugared by GHC.HsToCore.Quote.dsBracket using the renamed + expression held in `HsBracketTc` (`type instance X*Bracket GhcTc = HsBracketTc`). It + + a) Extends the ds_meta environment with the PendingSplices + attached to the bracket + + b) Converts the quoted (HsExpr Name) to a CoreExpr that, when + run, will produce a suitable TH expression/type/decl. This + is why we leave the *renamed* expression attached to the bracket: + the quoted expression should not be decorated with all the goop + added by the type checker + + * Each splice carries a unique Name, called a "splice point", thus + ${n}(e). The name is initialised to an (Unqual "splice") when the + splice is created; the renamer gives it a unique. + + * When GHC.HsToCore.Quote (used to desugar the body of the bracket) comes across + a splice, it looks up the splice's Name, n, in the ds_meta envt, + to find an (HsExpr Id) that should be substituted for the splice; + it just desugars it to get a CoreExpr (GHC.HsToCore.Quote.repSplice). + +Example: + Source: f = [| Just $(g 3) |] + The [| |] part is a HsUntypedBracket GhcPs + + Typechecked: f = [| Just ${s7}(g 3) |]{s7 = g Int 3} + The [| |] part is a HsUntypedBracket GhcTc, containing *renamed* + (not typechecked) expression (see Note [The life cycle of a TH quotation]) + The "s7" is the "splice point"; the (g Int 3) part + is a typechecked expression + + Desugared: f = do { s7 <- g Int 3 + ; return (ConE "Data.Maybe.Just" s7) } + +-} + {- ************************************************************************ * * @@ -168,17 +640,12 @@ import GHC.Rename.Doc (rnHsDoc) ************************************************************************ -} -tcTypedBracket :: HsExpr GhcRn -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -tcUntypedBracket :: HsExpr GhcRn -> HsQuote GhcRn -> [PendingRnSplice] -> ExpRhoType - -> TcM (HsExpr GhcTc) -tcSpliceExpr :: HsSplice GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) +tcTypedBracket :: HsExpr GhcRn -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) +tcUntypedBracket :: HsExpr GhcRn -> HsQuote GhcRn -> [PendingRnSplice] -> ExpRhoType + -> TcM (HsExpr GhcTc) +tcTypedSplice :: Name -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -- 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] - runAnnotation :: CoreAnnTarget -> LHsExpr GhcRn -> TcM Annotation {- ************************************************************************ @@ -205,31 +672,34 @@ tcTypedBracket rn_expr expr res_ty -- brackets. ; let wrapper = QuoteWrapper ev_var m_var -- Typecheck expr to make sure it is valid. - -- The typechecked expression won't be used, but we return it with its type. + -- The typechecked expression won't be used, so we just discard it -- (See Note [The life cycle of a TH quotation] in GHC.Hs.Expr) -- We'll typecheck it again when we splice it in somewhere ; (tc_expr, expr_ty) <- setStage (Brack cur_stage (TcPending ps_ref lie_var wrapper)) $ - tcScalingUsage Many $ - -- Scale by Many, TH lifting is currently nonlinear (#18465) - tcInferRhoNC expr - -- NC for no context; tcBracket does that + tcScalingUsage Many $ + -- Scale by Many, TH lifting is currently nonlinear (#18465) + tcInferRhoNC expr + -- NC for no context; tcBracket does that ; let rep = getRuntimeRep expr_ty ; meta_ty <- tcTExpTy m_var expr_ty ; ps' <- readMutVar ps_ref ; codeco <- tcLookupId unsafeCodeCoerceName ; bracket_ty <- mkAppTy m_var <$> tcMetaTy expTyConName + ; let brack_tc = HsBracketTc { hsb_quote = ExpBr noExtField expr, hsb_ty = bracket_ty + , hsb_wrap = Just wrapper, hsb_splices = ps' } + -- The tc_expr is stored here so that the expression can be used in HIE files. + brack_expr = HsTypedBracket brack_tc tc_expr ; tcWrapResultO (Shouldn'tHappenOrigin "TH typed bracket expression") rn_expr (unLoc (mkHsApp (mkLHsWrap (applyQuoteWrapper wrapper) (nlHsTyApp codeco [rep, expr_ty])) - (noLocA (HsTypedBracket (HsBracketTc (ExpBr noExtField expr) bracket_ty (Just wrapper) ps') tc_expr)))) + (noLocA brack_expr))) meta_ty res_ty } -- See Note [Typechecking Overloaded Quotes] tcUntypedBracket rn_expr brack ps res_ty = do { traceTc "tc_bracket untyped" (ppr brack $$ ppr ps) - -- Create the type m Exp for expression bracket, m Type for a type -- bracket and so on. The brack_info is a Maybe because the -- VarBracket ('a) isn't overloaded, but also shouldn't contain any @@ -243,12 +713,15 @@ tcUntypedBracket rn_expr brack ps res_ty Just m_var -> mapM (tcPendingSplice m_var) ps Nothing -> assert (null ps) $ return [] + -- Notice that we don't attempt to typecheck the body + -- of the bracket, which is in brack. ; traceTc "tc_bracket done untyped" (ppr expected_type) - -- Unify the overall type of the bracket with the expected result - -- type + -- Unify the overall type of the bracket with the expected result type ; tcWrapResultO BracketOrigin rn_expr - (HsUntypedBracket (HsBracketTc brack expected_type brack_info ps') (XQuote noExtField)) + (HsUntypedBracket (HsBracketTc { hsb_quote = brack, hsb_ty = expected_type + , hsb_wrap = brack_info, hsb_splices = ps' }) + (XQuote noExtField)) -- (XQuote noExtField): see Note [The life cycle of a TH quotation] in GHC.Hs.Expr expected_type res_ty @@ -339,262 +812,6 @@ quotationCtxtDoc br_body -- The whole of the rest of the file is the else-branch (ie stage2 only) -{- -Note [How top-level splices are handled] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Top-level splices (those not inside a [| .. |] quotation bracket) are handled -very straightforwardly: - - 1. tcTopSpliceExpr: typecheck the body e of the splice $(e) - - 2. runMetaT: desugar, compile, run it, and convert result back to - GHC.Hs syntax RdrName (of the appropriate flavour, eg HsType RdrName, - HsExpr RdrName etc) - - 3. treat the result as if that's what you saw in the first place - e.g for HsType, rename and kind-check - for HsExpr, rename and type-check - - (The last step is different for decls, because they can *only* be - top-level: we return the result of step 2.) - -Note [How brackets and nested splices are handled] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Nested splices (those inside a [| .. |] quotation bracket), -are treated quite differently. - -Remember, there are two forms of bracket - typed [|| e ||] - and untyped [| e |] - -The life cycle of a typed bracket: - * Starts as HsTypedBracket - - * When renaming: - * Set the ThStage to (Brack s RnPendingTyped) - * Rename the body - * Result is a HsTypedBracket - - * When typechecking: - * Set the ThStage to (Brack s (TcPending ps_var lie_var)) - * Typecheck the body, and keep the elaborated result (despite never using it!) - * Nested splices (which must be typed) are typechecked, and - the results accumulated in ps_var; their constraints - accumulate in lie_var - * Result is a HsTypedBracket (HsBracketTc rn_brack ty quote_wrapper pending_splices) tc_brack - where rn_brack is the untyped renamed exp quote constructed from the typed renamed expression :: HsQuote GhcRn - -The life cycle of a un-typed bracket: - * Starts as HsUntypedBracket - - * When renaming: - * Set the ThStage to (Brack s (RnPendingUntyped ps_var)) - * Rename the body - * Nested splices (which must be untyped) are renamed, and the - results accumulated in ps_var - * Result is a HsUntypedBracket pending_splices rn_body - - * When typechecking: - * Typecheck the pending_splices individually - * Ignore the body of the bracket; just check that the context - expects a bracket of that type (e.g. a [p| pat |] bracket should - be in a context needing a (Q Pat) - * Result is a HsUntypedBracket (HsBracketTc rn_brack ty quote_wrapper pending_splices) (XQuote noExtField) - where rn_brack is the incoming renamed bracket :: HsQuote GhcRn - and (XQuote noExtField) stands for the removal of the `HsQuote GhcTc` field (since `HsQuote GhcTc` isn't possible) - -See the related Note [The life cycle of a TH quotation] - -In both cases, desugaring happens like this: - * Hs*Bracket is desugared by GHC.HsToCore.Quote.dsBracket using the renamed - expression held in `HsBracketTc` (`type instance X*Bracket GhcTc = HsBracketTc`). It - - a) Extends the ds_meta environment with the PendingSplices - attached to the bracket - - b) Converts the quoted (HsExpr Name) to a CoreExpr that, when - run, will produce a suitable TH expression/type/decl. This - is why we leave the *renamed* expression attached to the bracket: - the quoted expression should not be decorated with all the goop - added by the type checker - - * Each splice carries a unique Name, called a "splice point", thus - ${n}(e). The name is initialised to an (Unqual "splice") when the - splice is created; the renamer gives it a unique. - - * When GHC.HsToCore.Quote (used to desugar the body of the bracket) comes across - a splice, it looks up the splice's Name, n, in the ds_meta envt, - to find an (HsExpr Id) that should be substituted for the splice; - it just desugars it to get a CoreExpr (GHC.HsToCore.Quote.repSplice). - -Example: - Source: f = [| Just $(g 3) |] - The [| |] part is a HsUntypedBracket GhcPs - - Typechecked: f = [| Just ${s7}(g 3) |]{s7 = g Int 3} - The [| |] part is a HsUntypedBracket GhcTc, containing *renamed* - (not typechecked) expression (see Note [The life cycle of a TH quotation]) - The "s7" is the "splice point"; the (g Int 3) part - is a typechecked expression - - Desugared: f = do { s7 <- g Int 3 - ; return (ConE "Data.Maybe.Just" s7) } - - -Note [Template Haskell state diagram] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Here are the ThStages, s, their corresponding level numbers -(the result of (thLevel s)), and their state transitions. -The top level of the program is stage Comp: - - Start here - | - V - ----------- $ ------------ $ - | Comp | ---------> | Splice | -----| - | 1 | | 0 | <----| - ----------- ------------ - ^ | ^ | - $ | | [||] $ | | [||] - | v | v - -------------- ---------------- - | Brack Comp | | Brack Splice | - | 2 | | 1 | - -------------- ---------------- - -* Normal top-level declarations start in state Comp - (which has level 1). - Annotations start in state Splice, since they are - treated very like a splice (only without a '$') - -* Code compiled in state Splice (and only such code) - will be *run at compile time*, with the result replacing - the splice - -* The original paper used level -1 instead of 0, etc. - -* The original paper did not allow a splice within a - splice, but there is no reason not to. This is the - $ transition in the top right. - -Note [Template Haskell levels] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -* Imported things are impLevel (= 0) - -* However things at level 0 are not *necessarily* imported. - eg $( \b -> ... ) here b is bound at level 0 - -* In GHCi, variables bound by a previous command are treated - as impLevel, because we have bytecode for them. - -* Variables are bound at the "current level" - -* The current level starts off at outerLevel (= 1) - -* The level is decremented by splicing $(..) - incremented by brackets [| |] - incremented by name-quoting 'f - -* When a variable is used, checkWellStaged compares - bind: binding level, and - use: current level at usage site - - Generally - bind > use Always error (bound later than used) - [| \x -> $(f x) |] - - bind = use Always OK (bound same stage as used) - [| \x -> $(f [| x |]) |] - - bind < use Inside brackets, it depends - Inside splice, OK - Inside neither, OK - - For (bind < use) inside brackets, there are three cases: - - Imported things OK f = [| map |] - - Top-level things OK g = [| f |] - - Non-top-level Only if there is a liftable instance - h = \(x:Int) -> [| x |] - - To track top-level-ness we use the ThBindEnv in TcLclEnv - - For example: - f = ... - g1 = $(map ...) is OK - g2 = $(f ...) is not OK; because we haven't compiled f yet - -Note [Typechecking Overloaded Quotes] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -The main function for typechecking untyped quotations is `tcUntypedBracket`. - -Consider an expression quote, `[| e |]`, its type is `forall m . Quote m => m Exp`. -When we typecheck it we therefore create a template of a metavariable `m` applied to `Exp` and -emit a constraint `Quote m`. All this is done in the `brackTy` function. -`brackTy` also selects the correct contents type for the quotation (Exp, Type, Decs etc). - -The meta variable and the constraint evidence variable are -returned together in a `QuoteWrapper` and then passed along to two further places -during compilation: - -1. Typechecking nested splices (immediately in tcPendingSplice) -2. Desugaring quotations (see GHC.HsToCore.Quote) - -`tcPendingSplice` takes the `m` type variable as an argument and checks -each nested splice against this variable `m`. During this -process the variable `m` can either be fixed to a specific value or further constrained by the -nested splices. - -Once we have checked all the nested splices, the quote type is checked against -the expected return type. - -The process is very simple and like typechecking a list where the quotation is -like the container and the splices are the elements of the list which must have -a specific type. - -After the typechecking process is completed, the evidence variable for `Quote m` -and the type `m` is stored in a `QuoteWrapper` which is passed through the pipeline -and used when desugaring quotations. - -Typechecking typed quotations is a similar idea but the `QuoteWrapper` is stored -in the `PendingStuff` as the nested splices are gathered up in a different way -to untyped splices. Untyped splices are found in the renamer but typed splices are -not typechecked and extracted until during typechecking. - --} - --- | We only want to produce warnings for TH-splices if the user requests so. --- See Note [Warnings for TH splices]. -getThSpliceOrigin :: TcM Origin -getThSpliceOrigin = do - warn <- goptM Opt_EnableThSpliceWarnings - if warn then return FromSource else return Generated - -{- Note [Warnings for TH splices] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We only produce warnings for TH splices when the user requests so -(-fenable-th-splice-warnings). There are multiple reasons: - - * It's not clear that the user that compiles a splice is the author of the code - that produces the warning. Think of the situation where they just splice in - code from a third-party library that produces incomplete pattern matches. - In this scenario, the user isn't even able to fix that warning. - * Gathering information for producing the warnings (pattern-match check - warnings in particular) is costly. There's no point in doing so if the user - is not interested in those warnings. - -That's why we store Origin flags in the Haskell AST. The functions from ThToHs -take such a flag and depending on whether TH splice warnings were enabled or -not, we pass FromSource (if the user requests warnings) or Generated -(otherwise). This is implemented in getThSpliceOrigin. - -For correct pattern-match warnings it's crucial that we annotate the Origin -consistently (#17270). In the future we could offer the Origin as part of the -TH AST. That would enable us to give quotes from the current module get -FromSource origin, and/or third library authors to tag certain parts of -generated code as FromSource to enable warnings. -That effort is tracked in #14838. --} {- ************************************************************************ @@ -604,21 +821,19 @@ That effort is tracked in #14838. ************************************************************************ -} -tcSpliceExpr splice@(HsTypedSplice _ _ name expr) res_ty - = addErrCtxt (spliceCtxtDoc splice) $ +tcTypedSplice splice_name expr res_ty + = addErrCtxt (typedSpliceCtxtDoc splice_name expr) $ setSrcSpan (getLocA expr) $ do { stage <- getStage ; case stage of Splice {} -> tcTopSplice expr res_ty - Brack pop_stage pend -> tcNestedSplice pop_stage pend name expr res_ty + Brack pop_stage pend -> tcNestedSplice pop_stage pend splice_name expr res_ty RunSplice _ -> -- See Note [RunSplice ThLevel] in "GHC.Tc.Types". pprPanic ("tcSpliceExpr: attempted to typecheck a splice when " ++ - "running another splice") (ppr splice) + "running another splice") (pprTypedSplice (Just splice_name) expr) Comp -> tcTopSplice expr res_ty } -tcSpliceExpr splice _ - = pprPanic "tcSpliceExpr" (ppr splice) {- Note [Collecting modFinalizers in typed splices] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -630,6 +845,59 @@ environment (with 'addModFinalizersWithLclEnv'). -} +------------------ +tcTopSplice :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) +tcTopSplice expr res_ty + = do { -- Typecheck the expression, + -- making sure it has type Q (T res_ty) + res_ty <- expTypeToType res_ty + ; q_type <- tcMetaTy qTyConName + -- Top level splices must still be of type Q (TExp a) + ; meta_exp_ty <- tcTExpTy q_type res_ty + ; q_expr <- tcTopSpliceExpr Typed $ + tcCheckMonoExpr expr meta_exp_ty + ; lcl_env <- getLclEnv + ; let delayed_splice + = DelayedSplice lcl_env expr res_ty q_expr + ; return (HsTypedSplice delayed_splice q_expr) + + } + +------------------- +tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc) +-- Note [How top-level splices are handled] +-- Type check an expression that is the body of a top-level splice +-- (the caller will compile and run it) +-- Note that set the level to Splice, regardless of the original level, +-- before typechecking the expression. For example: +-- f x = $( ...$(g 3) ... ) +-- The recursive call to tcCheckPolyExpr will simply expand the +-- inner escape before dealing with the outer one + +tcTopSpliceExpr isTypedSplice tc_action + = checkNoErrs $ -- checkNoErrs: must not try to run the thing + -- if the type checker fails! + unsetGOptM Opt_DeferTypeErrors $ + -- Don't defer type errors. Not only are we + -- going to run this code, but we do an unsafe + -- coerce, so we get a seg-fault if, say we + -- splice a type into a place where an expression + -- is expected (#7276) + setStage (Splice isTypedSplice) $ + do { -- Typecheck the expression + (mb_expr', wanted) <- tryCaptureConstraints tc_action + -- If tc_action fails (perhaps because of insoluble constraints) + -- we want to capture and report those constraints, else we may + -- just get a silent failure (#20179). Hence the 'try' part. + + ; const_binds <- simplifyTop wanted + + ; case mb_expr' of + Nothing -> failM -- In this case simplifyTop should have + -- reported some errors + Just expr' -> return $ mkHsDictLet (EvBinds const_binds) expr' } + +------------------ tcNestedSplice :: ThStage -> PendingStuff -> Name -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -- See Note [How brackets and nested splices are handled] @@ -649,35 +917,13 @@ tcNestedSplice pop_stage (TcPending ps_var lie_var q@(QuoteWrapper _ m_var)) spl ; writeMutVar ps_var (PendingTcSplice splice_name expr'' : ps) -- The returned expression is ignored; it's in the pending splices - -- But we still return a plausible expression - -- (a) in case we print it in debug messages, and - -- (b) because we test whether it is tagToEnum in Tc.Gen.Expr.tcApp - ; return (HsSpliceE noAnn $ - HsSpliced noExtField (ThModFinalizers []) $ - HsSplicedExpr (unLoc expr'')) } - + ; return stubNestedSplice } tcNestedSplice _ _ splice_name _ _ = pprPanic "tcNestedSplice: rename stage found" (ppr splice_name) -tcTopSplice :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) -tcTopSplice expr res_ty - = do { -- Typecheck the expression, - -- making sure it has type Q (T res_ty) - res_ty <- expTypeToType res_ty - ; q_type <- tcMetaTy qTyConName - -- Top level splices must still be of type Q (TExp a) - ; meta_exp_ty <- tcTExpTy q_type res_ty - ; q_expr <- tcTopSpliceExpr Typed $ - tcCheckMonoExpr expr meta_exp_ty - ; lcl_env <- getLclEnv - ; let delayed_splice - = DelayedSplice lcl_env expr res_ty q_expr - ; return (HsSpliceE noAnn (XSplice (HsSplicedT delayed_splice))) - - } - +------------------ -- This is called in the zonker -- See Note [Running typed splices in the zonker] runTopSplice :: DelayedSplice -> TcM (HsExpr GhcTc) @@ -715,15 +961,15 @@ runTopSplice (DelayedSplice lcl_env orig_expr res_ty q_expr) {- ************************************************************************ * * -\subsection{Error messages} + * * ************************************************************************ -} -spliceCtxtDoc :: HsSplice GhcRn -> SDoc -spliceCtxtDoc splice +typedSpliceCtxtDoc :: SplicePointName -> LHsExpr GhcRn -> SDoc +typedSpliceCtxtDoc n splice = hang (text "In the Template Haskell splice") - 2 (pprSplice splice) + 2 (pprTypedSplice (Just n) splice) spliceResultDoc :: LHsExpr GhcTc -> SDoc spliceResultDoc expr @@ -731,39 +977,14 @@ spliceResultDoc expr , nest 2 (char '$' <> ppr expr) , text "To see what the splice expanded to, use -ddump-splices"] -------------------- -tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc) --- Note [How top-level splices are handled] --- Type check an expression that is the body of a top-level splice --- (the caller will compile and run it) --- Note that set the level to Splice, regardless of the original level, --- before typechecking the expression. For example: --- f x = $( ...$(g 3) ... ) --- The recursive call to tcCheckPolyExpr will simply expand the --- inner escape before dealing with the outer one - -tcTopSpliceExpr isTypedSplice tc_action - = checkNoErrs $ -- checkNoErrs: must not try to run the thing - -- if the type checker fails! - unsetGOptM Opt_DeferTypeErrors $ - -- Don't defer type errors. Not only are we - -- going to run this code, but we do an unsafe - -- coerce, so we get a seg-fault if, say we - -- splice a type into a place where an expression - -- is expected (#7276) - setStage (Splice isTypedSplice) $ - do { -- Typecheck the expression - (mb_expr', wanted) <- tryCaptureConstraints tc_action - -- If tc_action fails (perhaps because of insoluble constraints) - -- we want to capture and report those constraints, else we may - -- just get a silent failure (#20179). Hence the 'try' part. - - ; const_binds <- simplifyTop wanted +stubNestedSplice :: HsExpr GhcTc +-- Used when we need a (LHsExpr GhcTc) that we are never going +-- to look at. We could use "panic" but that's confusing if we ever +-- do a debug-print. The warning is because this should never happen +-- /except/ when doing debug prints. +stubNestedSplice = warnPprTrace True "stubNestedSplice" empty $ + HsLit noComments (mkHsString "stubNestedSplice") - ; case mb_expr' of - Nothing -> failM -- In this case simplifyTop should have - -- reported some errors - Just expr' -> return $ mkHsDictLet (EvBinds const_binds) expr' } {- ************************************************************************ @@ -1774,6 +1995,14 @@ lookupName is_type_name s Nothing -> mkRdrUnqual occ Just mod -> mkRdrQual (mkModuleName mod) occ +-- | We only want to produce warnings for TH-splices if the user requests so. +-- See Note [Warnings for TH splices]. +getThSpliceOrigin :: TcM Origin +getThSpliceOrigin = do + warn <- goptM Opt_EnableThSpliceWarnings + if warn then return FromSource else return Generated + + getThing :: TH.Name -> TcM TcTyThing getThing th_name = do { name <- lookupThName th_name diff --git a/compiler/GHC/Tc/Gen/Splice.hs-boot b/compiler/GHC/Tc/Gen/Splice.hs-boot index c4cd5f70df..d3aca85c6f 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs-boot +++ b/compiler/GHC/Tc/Gen/Splice.hs-boot @@ -10,13 +10,13 @@ import GHC.Tc.Utils.TcType ( ExpRhoType ) import GHC.Types.Annotations ( Annotation, CoreAnnTarget ) import GHC.Hs.Extension ( GhcRn, GhcPs, GhcTc ) -import GHC.Hs ( HsSplice, HsQuote, HsExpr, LHsExpr, LHsType, - LPat, LHsDecl, ThModFinalizers ) +import GHC.Hs ( HsQuote, HsExpr, LHsExpr, LHsType, LPat, LHsDecl, ThModFinalizers ) import qualified Language.Haskell.TH as TH -tcSpliceExpr :: HsSplice GhcRn - -> ExpRhoType - -> TcM (HsExpr GhcTc) +tcTypedSplice :: Name + -> LHsExpr GhcRn + -> ExpRhoType + -> TcM (HsExpr GhcTc) tcTypedBracket :: HsExpr GhcRn -> LHsExpr GhcRn diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs index 7a3ca9e42a..eb31cec392 100644 --- a/compiler/GHC/Tc/TyCl/PatSyn.hs +++ b/compiler/GHC/Tc/TyCl/PatSyn.hs @@ -1088,9 +1088,8 @@ tcPatToExpr name args pat = go pat = return $ unLoc $ foldl' nlHsApp (noLocA neg) [noLocA (HsOverLit noAnn n)] | otherwise = return $ HsOverLit noAnn n - go1 (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat))) - = go1 pat - go1 (SplicePat _ (HsSpliced{})) = panic "Invalid splice variety" + go1 (SplicePat (HsUntypedSpliceTop _ pat) _) = go1 pat + go1 (SplicePat (HsUntypedSpliceNested _) _) = panic "tcPatToExpr: invalid nested splice" go1 (XPat (HsPatExpanded _ pat))= go1 pat -- See Note [Invertible view patterns] @@ -1107,9 +1106,6 @@ tcPatToExpr name args pat = go pat go1 p@(WildPat {}) = notInvertible p go1 p@(AsPat {}) = notInvertible p go1 p@(NPlusKPat {}) = notInvertible p - go1 p@(SplicePat _ (HsTypedSplice {})) = notInvertible p - go1 p@(SplicePat _ (HsUntypedSplice {})) = notInvertible p - go1 p@(SplicePat _ (HsQuasiQuote {})) = notInvertible p notInvertible p = Left (not_invertible_msg p) diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs index caee214db9..2d4505b67d 100644 --- a/compiler/GHC/Tc/Types/Origin.hs +++ b/compiler/GHC/Tc/Types/Origin.hs @@ -705,7 +705,8 @@ exprCtOrigin (ArithSeq {}) = Shouldn'tHappenOrigin "arithmetic sequence" exprCtOrigin (HsPragE _ _ e) = lexprCtOrigin e exprCtOrigin (HsTypedBracket {}) = Shouldn'tHappenOrigin "TH typed bracket" exprCtOrigin (HsUntypedBracket {}) = Shouldn'tHappenOrigin "TH untyped bracket" -exprCtOrigin (HsSpliceE {}) = Shouldn'tHappenOrigin "TH splice" +exprCtOrigin (HsTypedSplice {}) = Shouldn'tHappenOrigin "TH typed splice" +exprCtOrigin (HsUntypedSplice {}) = Shouldn'tHappenOrigin "TH untyped splice" exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" exprCtOrigin (XExpr (HsExpanded a _)) = exprCtOrigin a diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs index b5fbea49ed..2180a113da 100644 --- a/compiler/GHC/Tc/Utils/Zonk.hs +++ b/compiler/GHC/Tc/Utils/Zonk.hs @@ -783,10 +783,9 @@ zonkExpr env (HsTypedBracket hsb_tc body) zonkExpr env (HsUntypedBracket hsb_tc body) = (\x -> HsUntypedBracket x body) <$> zonkBracket env hsb_tc -zonkExpr env (HsSpliceE _ (XSplice (HsSplicedT s))) = - runTopSplice s >>= zonkExpr env +zonkExpr env (HsTypedSplice s _) = runTopSplice s >>= zonkExpr env -zonkExpr _ e@(HsSpliceE _ _) = pprPanic "zonkExpr: HsSpliceE" (ppr e) +zonkExpr _ e@(HsUntypedSplice _ _) = pprPanic "zonkExpr: HsUntypedSplice" (ppr e) zonkExpr _ (OpApp x _ _ _) = dataConCantHappen x diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs index b93289c519..b2c2b1e103 100644 --- a/compiler/GHC/Types/Basic.hs +++ b/compiler/GHC/Types/Basic.hs @@ -101,8 +101,6 @@ module GHC.Types.Basic ( IntWithInf, infinity, treatZeroAsInf, subWithInf, mkIntWithInf, intGtLimit, - SpliceExplicitFlag(..), - TypeOrKind(..), isTypeLevel, isKindLevel, Levity(..), mightBeLifted, mightBeUnlifted, @@ -1877,11 +1875,6 @@ treatZeroAsInf n = Int n mkIntWithInf :: Int -> IntWithInf mkIntWithInf = Int -data SpliceExplicitFlag - = ExplicitSplice | -- ^ <=> $(f x y) - ImplicitSplice -- ^ <=> f x y, i.e. a naked top level expression - deriving Data - {- ********************************************************************* * * Types vs Kinds diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs index 026080d3f6..303105e3d4 100644 --- a/compiler/Language/Haskell/Syntax/Decls.hs +++ b/compiler/Language/Haskell/Syntax/Decls.hs @@ -66,7 +66,7 @@ module Language.Haskell.Syntax.Decls ( -- ** @default@ declarations DefaultDecl(..), LDefaultDecl, -- ** Template haskell declaration splice - SpliceExplicitFlag(..), + SpliceDecoration(..), SpliceDecl(..), LSpliceDecl, -- ** Foreign function interface declarations ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..), @@ -95,7 +95,7 @@ module Language.Haskell.Syntax.Decls ( import GHC.Prelude import {-# SOURCE #-} Language.Haskell.Syntax.Expr - ( HsExpr, HsSplice ) + ( HsExpr, HsUntypedSplice ) -- Because Expr imports Decls via HsBracket import Language.Haskell.Syntax.Binds @@ -245,10 +245,21 @@ type LSpliceDecl pass = XRec pass (SpliceDecl pass) data SpliceDecl p = SpliceDecl -- Top level splice (XSpliceDecl p) - (XRec p (HsSplice p)) - SpliceExplicitFlag + (XRec p (HsUntypedSplice p)) + SpliceDecoration -- Whether $( ) variant found, for pretty printing | XSpliceDecl !(XXSpliceDecl p) +-- | A splice can appear with various decorations wrapped around it. This data +-- type captures explicitly how it was originally written, for use in the pretty +-- printer. +data SpliceDecoration + = DollarSplice -- ^ $splice + | BareSplice -- ^ bare splice + deriving (Data, Eq, Show) + +instance Outputable SpliceDecoration where + ppr x = text $ show x + {- ************************************************************************ * * diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs index f964c5d3f6..051edda97f 100644 --- a/compiler/Language/Haskell/Syntax/Expr.hs +++ b/compiler/Language/Haskell/Syntax/Expr.hs @@ -46,13 +46,9 @@ import GHC.Data.FastString -- libraries: import Data.Data hiding (Fixity(..)) -import qualified Data.Data as Data (Fixity(..)) import Data.List.NonEmpty ( NonEmpty ) -import GHCi.RemoteTypes ( ForeignRef ) -import qualified Language.Haskell.TH as TH (Q) - {- Note [RecordDotSyntax field updates] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The extensions @OverloadedRecordDot@ @OverloadedRecordUpdate@ together @@ -603,7 +599,8 @@ data HsExpr p -- 'GHC.Parser.Annotation.AnnClose' -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - | HsSpliceE (XSpliceE p) (HsSplice p) + | HsTypedSplice (XTypedSplice p) (LHsExpr p) -- `$$z` or `$$(f 4)` + | HsUntypedSplice (XUntypedSplice p) (HsUntypedSplice p) ----------------------------------------------------------- -- Arrow notation extension @@ -1542,87 +1539,29 @@ 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. +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 an +/untyped/ TH splice where the parser is applied the "stuff" as a string, thus: + $(p "stuff") + +Notice that it's an /untyped/ TH splice: it can occur in patterns and types, as well +as in expressions; and it runs in the renamer. -} -- | Haskell Splice -data HsSplice id - = HsTypedSplice -- $$z or $$(f 4) - (XTypedSplice id) - SpliceDecoration -- Whether $$( ) variant found, for pretty printing - (IdP id) -- A unique name to identify this splice point - (LHsExpr id) -- See Note [Pending Splices] - - | HsUntypedSplice -- $z or $(f 4) - (XUntypedSplice id) - SpliceDecoration -- Whether $( ) variant found, for pretty printing - (IdP id) -- A unique name to identify this splice point - (LHsExpr id) -- See Note [Pending Splices] - - | HsQuasiQuote -- See Note [Quasi-quote overview] - (XQuasiQuote id) - (IdP id) -- Splice point - (IdP id) -- Quoter - SrcSpan -- The span of the enclosed string - FastString -- The enclosed string - - -- AZ:TODO: use XSplice instead of HsSpliced - | HsSpliced -- See Note [Delaying modFinalizers in untyped splices] in - -- GHC.Rename.Splice. - -- This is the result of splicing a splice. It is produced by - -- the renamer and consumed by the typechecker. It lives only - -- between the two. - (XSpliced id) - ThModFinalizers -- TH finalizers produced by the splice. - (HsSplicedThing id) -- The result of splicing - | XSplice !(XXSplice id) -- Extension point; see Note [Trees That Grow] - -- in Language.Haskell.Syntax.Extension - --- | A splice can appear with various decorations wrapped around it. This data --- type captures explicitly how it was originally written, for use in the pretty --- printer. -data SpliceDecoration - = DollarSplice -- ^ $splice or $$splice - | BareSplice -- ^ bare splice - deriving (Data, Eq, Show) - -instance Outputable SpliceDecoration where - ppr x = text $ show x - - -isTypedSplice :: HsSplice id -> Bool -isTypedSplice (HsTypedSplice {}) = True -isTypedSplice _ = False -- Quasi-quotes are untyped splices - --- | Finalizers produced by a splice with --- 'Language.Haskell.TH.Syntax.addModFinalizer' --- --- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice. For how --- this is used. --- -newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())] +data HsUntypedSplice id + = HsUntypedSpliceExpr -- $z or $(f 4) + (XUntypedSpliceExpr id) + (LHsExpr id) --- A Data instance which ignores the argument of 'ThModFinalizers'. -instance Data ThModFinalizers where - gunfold _ z _ = z $ ThModFinalizers [] - toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix - dataTypeOf a = mkDataType "HsExpr.ThModFinalizers" [toConstr a] - --- | Haskell Spliced Thing --- --- Values that can result from running a splice. -data HsSplicedThing id - = HsSplicedExpr (HsExpr id) -- ^ Haskell Spliced Expression - | HsSplicedTy (HsType id) -- ^ Haskell Spliced Type - | HsSplicedPat (Pat id) -- ^ Haskell Spliced Pattern + | HsQuasiQuote -- See Note [Quasi-quote overview] + (XQuasiQuote id) + (IdP id) -- The quoter (the bit between `[` and `|`) + (XRec id FastString) -- The enclosed string + | XUntypedSplice !(XXUntypedSplice id) -- Extension point; see Note [Trees That Grow] + -- in Language.Haskell.Syntax.Extension -- | Haskell (Untyped) Quote = Expr + Pat + Type + Var data HsQuote p diff --git a/compiler/Language/Haskell/Syntax/Expr.hs-boot b/compiler/Language/Haskell/Syntax/Expr.hs-boot index 3ea7e32708..b6a0d79431 100644 --- a/compiler/Language/Haskell/Syntax/Expr.hs-boot +++ b/compiler/Language/Haskell/Syntax/Expr.hs-boot @@ -12,9 +12,9 @@ import Data.Kind ( Type ) type role HsExpr nominal type role MatchGroup nominal nominal type role GRHSs nominal nominal -type role HsSplice nominal +type role HsUntypedSplice nominal data HsExpr (i :: Type) -data HsSplice (i :: Type) +data HsUntypedSplice (i :: Type) data MatchGroup (a :: Type) (body :: Type) data GRHSs (a :: Type) (body :: Type) type family SyntaxExpr (i :: Type) diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs index dc39d10c99..5cffd96690 100644 --- a/compiler/Language/Haskell/Syntax/Extension.hs +++ b/compiler/Language/Haskell/Syntax/Extension.hs @@ -431,7 +431,8 @@ type family XExprWithTySig x type family XArithSeq x type family XTypedBracket x type family XUntypedBracket x -type family XSpliceE x +type family XTypedSplice x +type family XUntypedSplice x type family XProc x type family XStatic x type family XTick x @@ -463,12 +464,10 @@ type family XMissing x type family XXTupArg x -- ------------------------------------- --- HsSplice type families -type family XTypedSplice x -type family XUntypedSplice x -type family XQuasiQuote x -type family XSpliced x -type family XXSplice x +-- HsUntypedSplice type families +type family XUntypedSpliceExpr x +type family XQuasiQuote x +type family XXUntypedSplice x -- ------------------------------------- -- HsQuoteBracket type families diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs index 2f96d107c0..0e9f11dc1b 100644 --- a/compiler/Language/Haskell/Syntax/Pat.hs +++ b/compiler/Language/Haskell/Syntax/Pat.hs @@ -31,7 +31,7 @@ module Language.Haskell.Syntax.Pat ( import GHC.Prelude -import {-# SOURCE #-} Language.Haskell.Syntax.Expr (SyntaxExpr, LHsExpr, HsSplice) +import {-# SOURCE #-} Language.Haskell.Syntax.Expr (SyntaxExpr, LHsExpr, HsUntypedSplice) -- friends: import Language.Haskell.Syntax.Lit @@ -161,7 +161,7 @@ data Pat p -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation | SplicePat (XSplicePat p) - (HsSplice p) -- ^ Splice Pattern (Includes quasi-quotes) + (HsUntypedSplice p) -- ^ Splice Pattern (Includes quasi-quotes) ------------ Literal and n+k patterns --------------- | LitPat (XLitPat p) diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs index 0c84e9faa6..e394628f25 100644 --- a/compiler/Language/Haskell/Syntax/Type.hs +++ b/compiler/Language/Haskell/Syntax/Type.hs @@ -58,7 +58,7 @@ module Language.Haskell.Syntax.Type ( import GHC.Prelude -import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsSplice ) +import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsUntypedSplice ) import Language.Haskell.Syntax.Extension @@ -836,7 +836,7 @@ data HsType pass -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation | HsSpliceTy (XSpliceTy pass) - (HsSplice pass) -- Includes quasi-quotes + (HsUntypedSplice pass) -- Includes quasi-quotes -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'$('@, -- 'GHC.Parser.Annotation.AnnClose' @')'@ diff --git a/testsuite/tests/deriving/should_compile/T14682.stderr b/testsuite/tests/deriving/should_compile/T14682.stderr index 632af19788..94dc7e591d 100644 --- a/testsuite/tests/deriving/should_compile/T14682.stderr +++ b/testsuite/tests/deriving/should_compile/T14682.stderr @@ -16,8 +16,8 @@ Derived class instances: = [| T14682.Foo $(Language.Haskell.TH.Syntax.lift a1) $(Language.Haskell.TH.Syntax.lift a2) |] - pending(rn) [<a2, Language.Haskell.TH.Syntax.lift a2>, - <a1, Language.Haskell.TH.Syntax.lift a1>] + pending(rn) [<spn, Language.Haskell.TH.Syntax.lift a2>, + <spn, Language.Haskell.TH.Syntax.lift a1>] Language.Haskell.TH.Syntax.liftTyped (T14682.Foo a1 a2) = [|| T14682.Foo $$(Language.Haskell.TH.Syntax.liftTyped a1) diff --git a/testsuite/tests/linear/should_fail/LinearTHFail.stderr b/testsuite/tests/linear/should_fail/LinearTHFail.stderr index 58537e811e..681fa4294d 100644 --- a/testsuite/tests/linear/should_fail/LinearTHFail.stderr +++ b/testsuite/tests/linear/should_fail/LinearTHFail.stderr @@ -5,7 +5,7 @@ LinearTHFail.hs:8:3: error: • In an equation for ‘f’: f x = [| Just $x |] - pending(rn) [<splice, x>] + pending(rn) [<spn, x>] LinearTHFail.hs:11:3: error: • Couldn't match type ‘'Many’ with ‘'One’ diff --git a/testsuite/tests/linters/notes.stdout b/testsuite/tests/linters/notes.stdout index b8822bd476..3f5c1ae0b9 100644 --- a/testsuite/tests/linters/notes.stdout +++ b/testsuite/tests/linters/notes.stdout @@ -1,57 +1,65 @@ ref compiler/GHC/Core/Coercion/Axiom.hs:458:2: Note [RoughMap and rm_empty] -ref compiler/GHC/Core/Opt/OccurAnal.hs:851:15: Note [Loop breaking] +ref compiler/GHC/Core/Opt/OccurAnal.hs:857:15: Note [Loop breaking] ref compiler/GHC/Core/Opt/SetLevels.hs:1598:30: Note [Top level scope] -ref compiler/GHC/Core/Opt/Simplify.hs:2618:13: Note [Case binder next] -ref compiler/GHC/Core/Opt/Simplify.hs:3239:0: Note [Suppressing binder-swaps on linear case] -ref compiler/GHC/Core/Opt/Simplify.hs:3767:8: Note [Lambda-bound unfoldings] -ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1225:37: Note [Gentle mode] -ref compiler/GHC/Core/Opt/Specialise.hs:1593:28: Note [Arity decrease] -ref compiler/GHC/Core/TyCo/Rep.hs:1711:31: Note [What prevents a constraint from floating] -ref compiler/GHC/Driver/Main.hs:1566:34: Note [simpleTidyPgm - mkBootModDetailsTc] -ref compiler/GHC/Driver/Session.hs:3916:49: Note [Eta-reduction in -O0] +ref compiler/GHC/Core/Opt/Simplify.hs:2666:13: Note [Case binder next] +ref compiler/GHC/Core/Opt/Simplify.hs:3288:0: Note [Suppressing binder-swaps on linear case] +ref compiler/GHC/Core/Opt/Simplify.hs:3816:8: Note [Lambda-bound unfoldings] +ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1282:37: Note [Gentle mode] +ref compiler/GHC/Core/Opt/Specialise.hs:1611:28: Note [Arity decrease] +ref compiler/GHC/Core/TyCo/Rep.hs:1748:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Driver/Main.hs:1636:34: Note [simpleTidyPgm - mkBootModDetailsTc] +ref compiler/GHC/Driver/Session.hs:3961:49: Note [Eta-reduction in -O0] +ref compiler/GHC/Hs/Expr.hs:205:63: Note [Pending Splices] +ref compiler/GHC/Hs/Expr.hs:1667:87: Note [Lifecycle of a splice] +ref compiler/GHC/Hs/Expr.hs:1703:7: Note [Pending Splices] ref compiler/GHC/Hs/Extension.hs:140:5: Note [Strict argument type constraints] +ref compiler/GHC/Hs/Pat.hs:140:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Binds.hs:313:33: Note [AbsBinds wrappers] -ref compiler/GHC/HsToCore/Pmc/Solver.hs:853:20: Note [COMPLETE sets on data families] -ref compiler/GHC/Rename/Pat.hs:888:29: Note [Disambiguating record fields] -ref compiler/GHC/StgToCmm.hs:108:18: Note [codegen-split-init] -ref compiler/GHC/StgToCmm.hs:111:18: Note [pipeline-split-init] +ref compiler/GHC/HsToCore/Pmc/Solver.hs:855:20: Note [COMPLETE sets on data families] +ref compiler/GHC/HsToCore/Quote.hs:1460:7: Note [How brackets and nested splices are handled] +ref compiler/GHC/Rename/Pat.hs:887:29: Note [Disambiguating record fields] +ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] +ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] ref compiler/GHC/StgToCmm/Expr.hs:585:4: Note [case on bool] -ref compiler/GHC/StgToCmm/Expr.hs:848:3: Note [alg-alt heap check] -ref compiler/GHC/Tc/Gen/Expr.hs:670:24: Note [Disambiguating record fields] -ref compiler/GHC/Tc/Gen/Expr.hs:1195:7: Note [Disambiguating record fields] -ref compiler/GHC/Tc/Gen/Expr.hs:1298:11: Note [Deprecating ambiguous fields] -ref compiler/GHC/Tc/Gen/HsType.hs:552:56: Note [Skolem escape prevention] -ref compiler/GHC/Tc/Gen/HsType.hs:2623:7: Note [Matching a kind sigature with a declaration] -ref compiler/GHC/Tc/Gen/Pat.hs:169:20: Note [Typing patterns in pattern bindings] -ref compiler/GHC/Tc/Gen/Pat.hs:1077:7: Note [Matching polytyped patterns] +ref compiler/GHC/StgToCmm/Expr.hs:849:3: Note [alg-alt heap check] +ref compiler/GHC/Tc/Gen/Expr.hs:662:24: Note [Disambiguating record fields] +ref compiler/GHC/Tc/Gen/Expr.hs:1196:7: Note [Disambiguating record fields] +ref compiler/GHC/Tc/Gen/Expr.hs:1299:11: Note [Deprecating ambiguous fields] +ref compiler/GHC/Tc/Gen/HsType.hs:551:56: Note [Skolem escape prevention] +ref compiler/GHC/Tc/Gen/HsType.hs:2619:7: Note [Matching a kind sigature with a declaration] +ref compiler/GHC/Tc/Gen/Pat.hs:171:20: Note [Typing patterns in pattern bindings] +ref compiler/GHC/Tc/Gen/Pat.hs:1105:7: Note [Matching polytyped patterns] ref compiler/GHC/Tc/Gen/Sig.hs:78:10: Note [Overview of type signatures] +ref compiler/GHC/Tc/Gen/Splice.hs:361:16: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:536:35: Note [PendingRnSplice] +ref compiler/GHC/Tc/Gen/Splice.hs:664:7: Note [How brackets and nested splices are handled] +ref compiler/GHC/Tc/Gen/Splice.hs:908:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:515:35: Note [Constrained family instances] -ref compiler/GHC/Tc/Module.hs:698:15: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Solver/Canonical.hs:1229:33: Note [Canonical LHS] -ref compiler/GHC/Tc/Solver/Interact.hs:1638:9: Note [No touchables as FunEq RHS] -ref compiler/GHC/Tc/Solver/Rewrite.hs:1032:7: Note [Stability of rewriting] +ref compiler/GHC/Tc/Module.hs:705:15: Note [Extra dependencies from .hs-boot files] +ref compiler/GHC/Tc/Solver/Canonical.hs:1087:33: Note [Canonical LHS] +ref compiler/GHC/Tc/Solver/Interact.hs:1612:9: Note [No touchables as FunEq RHS] +ref compiler/GHC/Tc/Solver/Rewrite.hs:988:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1106:6: Note [Unification variables need fresh Names] -ref compiler/GHC/Tc/Types.hs:696:33: Note [Extra dependencies from .hs-boot files] -ref compiler/GHC/Tc/Types.hs:1466:47: Note [Care with plugin imports] -ref compiler/GHC/Tc/Types/Constraint.hs:238:34: Note [NonCanonical Semantics] -ref compiler/GHC/Types/Demand.hs:307:25: Note [Preserving Boxity of results is rarely a win] +ref compiler/GHC/Tc/Types.hs:702:33: Note [Extra dependencies from .hs-boot files] +ref compiler/GHC/Tc/Types.hs:1433:47: Note [Care with plugin imports] +ref compiler/GHC/Tc/Types/Constraint.hs:253:34: Note [NonCanonical Semantics] +ref compiler/GHC/Types/Demand.hs:308:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Types/Name/Occurrence.hs:301:4: Note [Unique OccNames from Template Haskell] -ref compiler/GHC/Unit/Module/Deps.hs:79:13: Note [Structure of dep_boot_mods] +ref compiler/GHC/Unit/Module/Deps.hs:82:13: Note [Structure of dep_boot_mods] ref compiler/GHC/Utils/Monad.hs:391:34: Note [multiShotIO] -ref compiler/Language/Haskell/Syntax/Binds.hs:226:31: Note [fun_id in Match] -ref compiler/Language/Haskell/Syntax/Expr.hs:1561:32: Note [Quasi-quote overview] +ref compiler/Language/Haskell/Syntax/Binds.hs:204:31: Note [fun_id in Match] ref compiler/Language/Haskell/Syntax/Pat.hs:336:12: Note [Disambiguating record fields] ref configure.ac:212:10: Note [Linking ghc-bin against threaded stage0 RTS] ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref ghc/ghc.mk:62:6: Note [Linking ghc-bin against threaded stage0 RTS] ref hadrian/src/Expression.hs:130:30: Note [Linking ghc-bin against threaded stage0 RTS] -ref libraries/base/GHC/ST.hs:139:7: Note [Definition of runRW#] +ref libraries/base/GHC/ST.hs:134:7: Note [Definition of runRW#] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:212:10: Note [WayFlags] -ref testsuite/driver/testlib.py:152:10: Note [Why is there no stage1 setup function?] -ref testsuite/driver/testlib.py:156:2: Note [Why is there no stage1 setup function?] -ref testsuite/mk/boilerplate.mk:263:2: Note [WayFlags] +ref testsuite/config/ghc:240:10: Note [WayFlags] +ref testsuite/driver/testlib.py:153:10: Note [Why is there no stage1 setup function?] +ref testsuite/driver/testlib.py:157:2: Note [Why is there no stage1 setup function?] +ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables] ref testsuite/tests/perf/should_run/all.T:3:6: Note [Solving from instances when interacting Dicts] ref testsuite/tests/polykinds/CuskFam.hs:16:11: Note [Unifying implicit CUSK variables] diff --git a/testsuite/tests/perf/compiler/hard_hole_fits.hs b/testsuite/tests/perf/compiler/hard_hole_fits.hs index 250c96e5ff..d449a935b2 100644 --- a/testsuite/tests/perf/compiler/hard_hole_fits.hs +++ b/testsuite/tests/perf/compiler/hard_hole_fits.hs @@ -40,7 +40,8 @@ testMe (ExprWithTySig xewts gl hwcb) = _ testMe (ArithSeq xas m_se asi) = _ testMe (HsTypedBracket xb hb) = _ testMe (HsUntypedBracket xb hb) = _ -testMe (HsSpliceE xse hs) = _ +testMe (HsTypedSplice xs hs) = _ +testMe (HsUntypedSplice xs hs) = _ testMe (HsProc xp pat gl) = _ testMe (HsStatic xs gl) = _ testMe (XExpr xe) = _ diff --git a/testsuite/tests/perf/compiler/hard_hole_fits.stderr b/testsuite/tests/perf/compiler/hard_hole_fits.stderr index 55c267076d..4caef50d4c 100644 --- a/testsuite/tests/perf/compiler/hard_hole_fits.stderr +++ b/testsuite/tests/perf/compiler/hard_hole_fits.stderr @@ -135,7 +135,7 @@ hard_hole_fits.hs:20:24: warning: [-Wtyped-holes (in -Wdefault)] hard_hole_fits.hs:21:40: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int • In an equation for ‘testMe’: - testMe (HsLamCase xlc lc_variant mg) = _ + testMe (HsLamCase xlc lc_variant mg) = _ • Relevant bindings include mg :: MatchGroup GhcPs (LHsExpr GhcPs) (bound at hard_hole_fits.hs:21:34) @@ -577,13 +577,13 @@ hard_hole_fits.hs:42:35: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20 (and originally defined in ‘GHC.Enum’)) -hard_hole_fits.hs:43:29: warning: [-Wtyped-holes (in -Wdefault)] +hard_hole_fits.hs:43:32: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int - • In an equation for ‘testMe’: testMe (HsSpliceE xse hs) = _ + • In an equation for ‘testMe’: testMe (HsTypedSplice xs hs) = _ • Relevant bindings include - hs :: HsSplice GhcPs (bound at hard_hole_fits.hs:43:23) - xse :: Language.Haskell.Syntax.Extension.XSpliceE GhcPs - (bound at hard_hole_fits.hs:43:19) + hs :: LHsExpr GhcPs (bound at hard_hole_fits.hs:43:26) + xs :: Language.Haskell.Syntax.Extension.XTypedSplice GhcPs + (bound at hard_hole_fits.hs:43:23) testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1) Valid hole fits include maxBound :: forall a. Bounded a => a @@ -595,15 +595,33 @@ hard_hole_fits.hs:43:29: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20 (and originally defined in ‘GHC.Enum’)) -hard_hole_fits.hs:44:29: warning: [-Wtyped-holes (in -Wdefault)] +hard_hole_fits.hs:44:34: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Int + • In an equation for ‘testMe’: testMe (HsUntypedSplice xs hs) = _ + • Relevant bindings include + hs :: HsUntypedSplice GhcPs (bound at hard_hole_fits.hs:44:28) + xs :: Language.Haskell.Syntax.Extension.XUntypedSplice GhcPs + (bound at hard_hole_fits.hs:44:25) + testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1) + Valid hole fits include + maxBound :: forall a. Bounded a => a + with maxBound @Int + (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20 + (and originally defined in ‘GHC.Enum’)) + minBound :: forall a. Bounded a => a + with minBound @Int + (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20 + (and originally defined in ‘GHC.Enum’)) + +hard_hole_fits.hs:45:29: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int • In an equation for ‘testMe’: testMe (HsProc xp pat gl) = _ • Relevant bindings include - gl :: LHsCmdTop GhcPs (bound at hard_hole_fits.hs:44:23) + gl :: LHsCmdTop GhcPs (bound at hard_hole_fits.hs:45:23) pat :: Language.Haskell.Syntax.Pat.LPat GhcPs - (bound at hard_hole_fits.hs:44:19) + (bound at hard_hole_fits.hs:45:19) xp :: Language.Haskell.Syntax.Extension.XProc GhcPs - (bound at hard_hole_fits.hs:44:16) + (bound at hard_hole_fits.hs:45:16) testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1) Valid hole fits include maxBound :: forall a. Bounded a => a @@ -615,13 +633,13 @@ hard_hole_fits.hs:44:29: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20 (and originally defined in ‘GHC.Enum’)) -hard_hole_fits.hs:45:27: warning: [-Wtyped-holes (in -Wdefault)] +hard_hole_fits.hs:46:27: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int • In an equation for ‘testMe’: testMe (HsStatic xs gl) = _ • Relevant bindings include - gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:45:21) + gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:46:21) xs :: Language.Haskell.Syntax.Extension.XStatic GhcPs - (bound at hard_hole_fits.hs:45:18) + (bound at hard_hole_fits.hs:46:18) testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1) Valid hole fits include maxBound :: forall a. Bounded a => a @@ -633,16 +651,16 @@ hard_hole_fits.hs:45:27: warning: [-Wtyped-holes (in -Wdefault)] (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20 (and originally defined in ‘GHC.Enum’)) -hard_hole_fits.hs:46:1: warning: [-Woverlapping-patterns (in -Wdefault)] +hard_hole_fits.hs:47:1: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In an equation for ‘testMe’: testMe (XExpr xe) = ... -hard_hole_fits.hs:46:21: warning: [-Wtyped-holes (in -Wdefault)] +hard_hole_fits.hs:47:21: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int • In an equation for ‘testMe’: testMe (XExpr xe) = _ • Relevant bindings include xe :: Language.Haskell.Syntax.Extension.XXExpr GhcPs - (bound at hard_hole_fits.hs:46:15) + (bound at hard_hole_fits.hs:47:15) testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1) Valid hole fits include maxBound :: forall a. Bounded a => a diff --git a/testsuite/tests/th/T10598_TH.stderr b/testsuite/tests/th/T10598_TH.stderr index d6c08b0a43..bfd73a176a 100644 --- a/testsuite/tests/th/T10598_TH.stderr +++ b/testsuite/tests/th/T10598_TH.stderr @@ -15,15 +15,15 @@ T10598_TH.hs:(27,2)-(42,51): Splicing declarations standaloneDerivWithStrategyD (Just StockStrategy) (cxt []) [t| Ord $(fooType) |] - pending(rn) [<splice, fooType>], + pending(rn) [<spn, fooType>], standaloneDerivWithStrategyD (Just AnyclassStrategy) (cxt []) [t| D $(fooType) |] - pending(rn) [<splice, fooType>], + pending(rn) [<spn, fooType>], standaloneDerivWithStrategyD (Just NewtypeStrategy) (cxt []) [t| Show $(fooType) |] - pending(rn) [<splice, fooType>]] + pending(rn) [<spn, fooType>]] ======> newtype Foo = MkFoo Int diff --git a/testsuite/tests/th/T14681.stderr b/testsuite/tests/th/T14681.stderr index 0a23fd1473..e325180dd8 100644 --- a/testsuite/tests/th/T14681.stderr +++ b/testsuite/tests/th/T14681.stderr @@ -4,8 +4,8 @@ T14681.hs:(8,2)-(9,63): Splicing declarations [d| g = $(pure $ VarE '(+) `AppE` LitE (IntegerL (- 1)) `AppE` (LitE (IntegerL (- 1)))) |] - pending(rn) [<splice, pure - $ VarE '(+) `AppE` LitE (IntegerL (- 1)) - `AppE` (LitE (IntegerL (- 1)))>] + pending(rn) [<spn, pure + $ VarE '(+) `AppE` LitE (IntegerL (- 1)) + `AppE` (LitE (IntegerL (- 1)))>] ======> g = ((+) (-1)) (-1) diff --git a/testsuite/tests/th/T5508.stderr b/testsuite/tests/th/T5508.stderr index 5511ec6134..02fddac6c7 100644 --- a/testsuite/tests/th/T5508.stderr +++ b/testsuite/tests/th/T5508.stderr @@ -2,6 +2,6 @@ T5508.hs:(7,8)-(9,29): Splicing expression do let x = mkName "x" v = return (LamE [VarP x] $ VarE x) [| $v . id |] - pending(rn) [<splice, v>] + pending(rn) [<spn, v>] ======> ((\ x -> x) . id) diff --git a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr index 965b441735..1731b58b28 100644 --- a/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr +++ b/testsuite/tests/th/overloaded/TH_overloaded_constraints_fail.stderr @@ -6,8 +6,8 @@ TH_overloaded_constraints_fail.hs:20:14: error: • In the expression: idQ In the expression: [| $(idQ) $(qq) |] - pending(rn) [<splice, qq>, <splice, idQ>] + pending(rn) [<spn, qq>, <spn, idQ>] In an equation for ‘quote’: quote = [| $(idQ) $(qq) |] - pending(rn) [<splice, qq>, <splice, idQ>] + pending(rn) [<spn, qq>, <spn, idQ>] diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index b52aa18de9..05c6a1e792 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -1859,7 +1859,8 @@ instance ExactPrint (HsExpr GhcPs) where getAnnotationEntry (ArithSeq an _ _) = fromAnn an getAnnotationEntry (HsTypedBracket an _) = fromAnn an getAnnotationEntry (HsUntypedBracket an _) = fromAnn an - getAnnotationEntry (HsSpliceE an _) = fromAnn an + getAnnotationEntry (HsTypedSplice (_, an) _) = fromAnn an + getAnnotationEntry (HsUntypedSplice an _) = fromAnn an getAnnotationEntry (HsProc an _ _) = fromAnn an getAnnotationEntry (HsStatic an _) = fromAnn an getAnnotationEntry (HsPragE{}) = NoEntryVal @@ -2082,8 +2083,10 @@ instance ExactPrint (HsExpr GhcPs) where markEpAnn an AnnThTyQuote markAnnotated e - - exact (HsSpliceE _ sp) = markAnnotated sp + exact (HsTypedSplice (_, an) e) = do + markEpAnn an AnnDollarDollar + markAnnotated e + exact (HsUntypedSplice _ sp) = markAnnotated sp exact (HsProc an p c) = do debugM $ "HsProc start" @@ -2161,29 +2164,15 @@ instance ExactPrint (HsPragE GhcPs) where -- --------------------------------------------------------------------- -instance ExactPrint (HsSplice GhcPs) where - getAnnotationEntry (HsTypedSplice an _ _ _) = fromAnn an - getAnnotationEntry (HsUntypedSplice an _ _ _) = fromAnn an - getAnnotationEntry (HsQuasiQuote _ _ _ _ _) = NoEntryVal - getAnnotationEntry (HsSpliced _ _ _) = NoEntryVal - - exact (HsTypedSplice an DollarSplice _n e) = do - markEpAnn an AnnDollarDollar - markAnnotated e +instance ExactPrint (HsUntypedSplice GhcPs) where + getAnnotationEntry (HsUntypedSpliceExpr an _) = fromAnn an + getAnnotationEntry (HsQuasiQuote _ _ _) = NoEntryVal - -- = ppr_splice (text "$$") n e empty - -- exact (HsTypedSplice _ BareSplice _ _ ) - -- = panic "Bare typed splice" -- impossible - exact (HsUntypedSplice an decoration _n b) = do - when (decoration == DollarSplice) $ markEpAnn an AnnDollar + exact (HsUntypedSpliceExpr an b) = do + markEpAnn an AnnDollar markAnnotated b - -- exact (HsUntypedSplice _ DollarSplice n e) - -- = ppr_splice (text "$") n e empty - -- exact (HsUntypedSplice _ BareSplice n e) - -- = ppr_splice empty n e empty - - exact (HsQuasiQuote _ _ q ss fs) = do + exact (HsQuasiQuote _ q (L (SrcSpanAnn _ ss) fs)) = do -- The quasiquote string does not honour layout offsets. Store -- the colOffset for now. -- TODO: use local? @@ -2196,10 +2185,6 @@ instance ExactPrint (HsSplice GhcPs) where p <- getPosP debugM $ "HsQuasiQuote:after:(p,ss)=" ++ show (p,ss2range ss) - -- exact (HsSpliced _ _ thing) = ppr thing - -- exact (XSplice x) = case ghcPass @p of - exact x = error $ "exact HsSplice for:" ++ showAst x - -- --------------------------------------------------------------------- -- TODO:AZ: combine these instances diff --git a/utils/haddock b/utils/haddock -Subproject 4dd5c93bded622a6e2e011dc7e2c8976454b53c +Subproject 89afef9daeb6da6624d42d32813d86c1f9b9f0c |