Teo Camarasu pushed to branch wip/T26217 at Glasgow Haskell Compiler / GHC
Commits:
-
840aeea0
by Teo Camarasu at 2025-08-17T23:30:11+01:00
-
9ddc10aa
by Teo Camarasu at 2025-08-17T23:30:13+01:00
-
c2a0e9e2
by Teo Camarasu at 2025-08-17T23:30:13+01:00
23 changed files:
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs-boot
- compiler/GHC/Tc/Types/TH.hs
- libraries/base/src/Data/Array/Byte.hs
- libraries/base/src/Data/Fixed.hs
- + libraries/ghc-boot-th/GHC/Boot/TH/Monad.hs
- libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- + libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/TH.hs
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
Changes:
... | ... | @@ -30,7 +30,7 @@ templateHaskellNames :: [Name] |
30 | 30 | -- Should stay in sync with the import list of GHC.HsToCore.Quote
|
31 | 31 | |
32 | 32 | templateHaskellNames = [
|
33 | - returnQName, bindQName, sequenceQName, newNameName, liftName, liftTypedName,
|
|
33 | + sequenceQName, newNameName, liftName, liftTypedName,
|
|
34 | 34 | mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameG_fldName,
|
35 | 35 | mkNameLName,
|
36 | 36 | mkNameSName, mkNameQName,
|
... | ... | @@ -181,26 +181,30 @@ templateHaskellNames = [ |
181 | 181 | -- Quasiquoting
|
182 | 182 | quasiQuoterTyConName, quoteDecName, quoteTypeName, quoteExpName, quotePatName]
|
183 | 183 | |
184 | -thSyn, thLib, qqLib, liftLib :: Module
|
|
184 | +thSyn, thMonad, thLib, qqLib, liftLib :: Module
|
|
185 | 185 | thSyn = mkTHModule (fsLit "GHC.Internal.TH.Syntax")
|
186 | +thMonad = mkTHModule (fsLit "GHC.Internal.TH.Monad")
|
|
186 | 187 | thLib = mkTHModule (fsLit "GHC.Internal.TH.Lib")
|
187 | 188 | qqLib = mkTHModule (fsLit "GHC.Internal.TH.Quote")
|
188 | 189 | liftLib = mkTHModule (fsLit "GHC.Internal.TH.Lift")
|
189 | 190 | |
191 | + |
|
190 | 192 | mkTHModule :: FastString -> Module
|
191 | 193 | mkTHModule m = mkModule ghcInternalUnit (mkModuleNameFS m)
|
192 | 194 | |
193 | -libFun, libTc, thFun, thTc, thCls, thCon, liftFun :: FastString -> Unique -> Name
|
|
195 | +libFun, libTc, thFun, thTc, thCon, liftFun, thMonadTc, thMonadCls, thMonadFun :: FastString -> Unique -> Name
|
|
194 | 196 | libFun = mk_known_key_name varName thLib
|
195 | 197 | libTc = mk_known_key_name tcName thLib
|
196 | 198 | thFun = mk_known_key_name varName thSyn
|
197 | 199 | thTc = mk_known_key_name tcName thSyn
|
198 | -thCls = mk_known_key_name clsName thSyn
|
|
199 | 200 | thCon = mk_known_key_name dataName thSyn
|
200 | 201 | liftFun = mk_known_key_name varName liftLib
|
202 | +thMonadTc = mk_known_key_name tcName thMonad
|
|
203 | +thMonadCls = mk_known_key_name clsName thMonad
|
|
204 | +thMonadFun = mk_known_key_name varName thMonad
|
|
201 | 205 | |
202 | -thFld :: FastString -> FastString -> Unique -> Name
|
|
203 | -thFld con = mk_known_key_name (fieldName con) thSyn
|
|
206 | +thMonadFld :: FastString -> FastString -> Unique -> Name
|
|
207 | +thMonadFld con = mk_known_key_name (fieldName con) thSyn
|
|
204 | 208 | |
205 | 209 | qqFld :: FastString -> Unique -> Name
|
206 | 210 | qqFld = mk_known_key_name (fieldName (fsLit "QuasiQuoter")) qqLib
|
... | ... | @@ -210,14 +214,14 @@ liftClassName :: Name |
210 | 214 | liftClassName = mk_known_key_name clsName liftLib (fsLit "Lift") liftClassKey
|
211 | 215 | |
212 | 216 | quoteClassName :: Name
|
213 | -quoteClassName = thCls (fsLit "Quote") quoteClassKey
|
|
217 | +quoteClassName = thMonadCls (fsLit "Quote") quoteClassKey
|
|
214 | 218 | |
215 | 219 | qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
|
216 | 220 | fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
|
217 | 221 | matchTyConName, clauseTyConName, funDepTyConName, predTyConName,
|
218 | 222 | codeTyConName, injAnnTyConName, overlapTyConName, decsTyConName,
|
219 | 223 | modNameTyConName, quasiQuoterTyConName :: Name
|
220 | -qTyConName = thTc (fsLit "Q") qTyConKey
|
|
224 | +qTyConName = thMonadTc (fsLit "Q") qTyConKey
|
|
221 | 225 | nameTyConName = thTc (fsLit "Name") nameTyConKey
|
222 | 226 | fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey
|
223 | 227 | patTyConName = thTc (fsLit "Pat") patTyConKey
|
... | ... | @@ -230,20 +234,18 @@ matchTyConName = thTc (fsLit "Match") matchTyConKey |
230 | 234 | clauseTyConName = thTc (fsLit "Clause") clauseTyConKey
|
231 | 235 | funDepTyConName = thTc (fsLit "FunDep") funDepTyConKey
|
232 | 236 | predTyConName = thTc (fsLit "Pred") predTyConKey
|
233 | -codeTyConName = thTc (fsLit "Code") codeTyConKey
|
|
237 | +codeTyConName = thMonadTc (fsLit "Code") codeTyConKey
|
|
234 | 238 | injAnnTyConName = thTc (fsLit "InjectivityAnn") injAnnTyConKey
|
235 | 239 | overlapTyConName = thTc (fsLit "Overlap") overlapTyConKey
|
236 | 240 | modNameTyConName = thTc (fsLit "ModName") modNameTyConKey
|
237 | 241 | quasiQuoterTyConName = mk_known_key_name tcName qqLib (fsLit "QuasiQuoter") quasiQuoterTyConKey
|
238 | 242 | |
239 | -returnQName, bindQName, sequenceQName, newNameName, liftName,
|
|
243 | +sequenceQName, newNameName, liftName,
|
|
240 | 244 | mkNameName, mkNameG_vName, mkNameG_fldName, mkNameG_dName, mkNameG_tcName,
|
241 | 245 | mkNameLName, mkNameSName, liftStringName, unTypeName, unTypeCodeName,
|
242 | 246 | unsafeCodeCoerceName, liftTypedName, mkModNameName, mkNameQName :: Name
|
243 | -returnQName = thFun (fsLit "returnQ") returnQIdKey
|
|
244 | -bindQName = thFun (fsLit "bindQ") bindQIdKey
|
|
245 | -sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
|
|
246 | -newNameName = thFun (fsLit "newName") newNameIdKey
|
|
247 | +sequenceQName = thMonadFun (fsLit "sequenceQ") sequenceQIdKey
|
|
248 | +newNameName = thMonadFun (fsLit "newName") newNameIdKey
|
|
247 | 249 | mkNameName = thFun (fsLit "mkName") mkNameIdKey
|
248 | 250 | mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey
|
249 | 251 | mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey
|
... | ... | @@ -253,9 +255,9 @@ mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey |
253 | 255 | mkNameQName = thFun (fsLit "mkNameQ") mkNameQIdKey
|
254 | 256 | mkNameSName = thFun (fsLit "mkNameS") mkNameSIdKey
|
255 | 257 | mkModNameName = thFun (fsLit "mkModName") mkModNameIdKey
|
256 | -unTypeName = thFld (fsLit "TExp") (fsLit "unType") unTypeIdKey
|
|
257 | -unTypeCodeName = thFun (fsLit "unTypeCode") unTypeCodeIdKey
|
|
258 | -unsafeCodeCoerceName = thFun (fsLit "unsafeCodeCoerce") unsafeCodeCoerceIdKey
|
|
258 | +unTypeName = thMonadFld (fsLit "TExp") (fsLit "unType") unTypeIdKey
|
|
259 | +unTypeCodeName = thMonadFun (fsLit "unTypeCode") unTypeCodeIdKey
|
|
260 | +unsafeCodeCoerceName = thMonadFun (fsLit "unsafeCodeCoerce") unsafeCodeCoerceIdKey
|
|
259 | 261 | liftName = liftFun (fsLit "lift") liftIdKey
|
260 | 262 | liftStringName = liftFun (fsLit "liftString") liftStringIdKey
|
261 | 263 | liftTypedName = liftFun (fsLit "liftTyped") liftTypedIdKey
|
... | ... | @@ -808,12 +810,10 @@ dataNamespaceSpecifierDataConKey = mkPreludeDataConUnique 215 |
808 | 810 | -- IdUniques available: 200-499
|
809 | 811 | -- If you want to change this, make sure you check in GHC.Builtin.Names
|
810 | 812 | |
811 | -returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
|
|
813 | +sequenceQIdKey, liftIdKey, newNameIdKey,
|
|
812 | 814 | mkNameIdKey, mkNameG_vIdKey, mkNameG_fldIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
|
813 | 815 | mkNameLIdKey, mkNameSIdKey, unTypeIdKey, unTypeCodeIdKey,
|
814 | 816 | unsafeCodeCoerceIdKey, liftTypedIdKey, mkModNameIdKey, mkNameQIdKey :: Unique
|
815 | -returnQIdKey = mkPreludeMiscIdUnique 200
|
|
816 | -bindQIdKey = mkPreludeMiscIdUnique 201
|
|
817 | 817 | sequenceQIdKey = mkPreludeMiscIdUnique 202
|
818 | 818 | liftIdKey = mkPreludeMiscIdUnique 203
|
819 | 819 | newNameIdKey = mkPreludeMiscIdUnique 204
|
... | ... | @@ -68,7 +68,7 @@ import GHC.Tc.Utils.TcType (TcType, TcTyVar) |
68 | 68 | import {-# SOURCE #-} GHC.Tc.Types.LclEnv (TcLclEnv)
|
69 | 69 | |
70 | 70 | import GHCi.RemoteTypes ( ForeignRef )
|
71 | -import qualified GHC.Boot.TH.Syntax as TH (Q)
|
|
71 | +import qualified GHC.Boot.TH.Monad as TH (Q)
|
|
72 | 72 | |
73 | 73 | -- libraries:
|
74 | 74 | import Data.Data hiding (Fixity(..))
|
... | ... | @@ -245,14 +245,14 @@ first generate a polymorphic definition and then just apply the wrapper at the e |
245 | 245 | |
246 | 246 | [| \x -> x |]
|
247 | 247 | ====>
|
248 | - gensym (unpackString "x"#) `bindQ` \ x1::String ->
|
|
249 | - lam (pvar x1) (var x1)
|
|
248 | + newName (unpackString "x"#) >>= \ x1::Name ->
|
|
249 | + lamE (varP x1) (varE x1)
|
|
250 | 250 | |
251 | 251 | |
252 | 252 | [| \x -> $(f [| x |]) |]
|
253 | 253 | ====>
|
254 | - gensym (unpackString "x"#) `bindQ` \ x1::String ->
|
|
255 | - lam (pvar x1) (f (var x1))
|
|
254 | + newName (unpackString "x"#) >>= \ x1::Name ->
|
|
255 | + lamE (varP x1) (f (varE x1))
|
|
256 | 256 | -}
|
257 | 257 | |
258 | 258 |
... | ... | @@ -68,7 +68,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Splice |
68 | 68 | import GHC.Tc.Zonk.Type
|
69 | 69 | |
70 | 70 | import GHCi.RemoteTypes ( ForeignRef )
|
71 | -import qualified GHC.Boot.TH.Syntax as TH (Q)
|
|
71 | +import qualified GHC.Boot.TH.Monad as TH (Q)
|
|
72 | 72 | |
73 | 73 | import qualified GHC.LanguageExtensions as LangExt
|
74 | 74 | import qualified Data.Set as Set
|
... | ... | @@ -144,6 +144,7 @@ import qualified GHC.LanguageExtensions as LangExt |
144 | 144 | |
145 | 145 | -- THSyntax gives access to internal functions and data types
|
146 | 146 | import qualified GHC.Boot.TH.Syntax as TH
|
147 | +import qualified GHC.Boot.TH.Monad as TH
|
|
147 | 148 | import qualified GHC.Boot.TH.Ppr as TH
|
148 | 149 | |
149 | 150 | #if defined(HAVE_INTERNAL_INTERPRETER)
|
... | ... | @@ -12,6 +12,7 @@ import GHC.Hs.Extension ( GhcRn, GhcPs, GhcTc ) |
12 | 12 | |
13 | 13 | import GHC.Hs ( HsQuote, HsExpr, LHsExpr, LHsType, LPat, LHsDecl, ThModFinalizers, HsUntypedSpliceResult, HsTypedSpliceResult, HsTypedSplice )
|
14 | 14 | import qualified GHC.Boot.TH.Syntax as TH
|
15 | +import qualified GHC.Boot.TH.Monad as TH
|
|
15 | 16 | |
16 | 17 | tcTypedSplice :: HsTypedSpliceResult
|
17 | 18 | -> HsTypedSplice GhcRn
|
... | ... | @@ -18,7 +18,7 @@ module GHC.Tc.Types.TH ( |
18 | 18 | |
19 | 19 | import GHC.Prelude
|
20 | 20 | import GHCi.RemoteTypes
|
21 | -import qualified GHC.Boot.TH.Syntax as TH
|
|
21 | +import qualified GHC.Boot.TH.Monad as TH
|
|
22 | 22 | import GHC.Tc.Types.Evidence
|
23 | 23 | import GHC.Utils.Outputable
|
24 | 24 | import GHC.Tc.Types.TcRef
|
... | ... | @@ -32,6 +32,7 @@ import GHC.Internal.Show (intToDigit) |
32 | 32 | import GHC.Internal.ST (ST(..), runST)
|
33 | 33 | import GHC.Internal.Word (Word8(..))
|
34 | 34 | import GHC.Internal.TH.Syntax
|
35 | +import GHC.Internal.TH.Monad
|
|
35 | 36 | import GHC.Internal.TH.Lift
|
36 | 37 | import GHC.Internal.ForeignPtr
|
37 | 38 | import Prelude
|
... | ... | @@ -91,7 +91,7 @@ import GHC.Internal.TypeLits (KnownNat, natVal) |
91 | 91 | import GHC.Internal.Read
|
92 | 92 | import GHC.Internal.Text.ParserCombinators.ReadPrec
|
93 | 93 | import GHC.Internal.Text.Read.Lex
|
94 | -import qualified GHC.Internal.TH.Syntax as TH
|
|
94 | +import qualified GHC.Internal.TH.Monad as TH
|
|
95 | 95 | import qualified GHC.Internal.TH.Lift as TH
|
96 | 96 | import Data.Typeable
|
97 | 97 | import Prelude
|
1 | +{-# LANGUAGE Safe #-}
|
|
2 | +{-# OPTIONS_HADDOCK not-home #-}
|
|
3 | +module GHC.Boot.TH.Monad
|
|
4 | + (module GHC.Internal.TH.Monad) where
|
|
5 | + |
|
6 | +import GHC.Internal.TH.Monad |
1 | -{-# LANGUAGE Trustworthy #-}
|
|
2 | 1 | {-# LANGUAGE LambdaCase #-}
|
3 | 2 | -- | contains a prettyprinter for the
|
4 | 3 | -- Template Haskell datatypes
|
... | ... | @@ -60,9 +60,11 @@ Library |
60 | 60 | exposed-modules:
|
61 | 61 | GHC.Boot.TH.Lib
|
62 | 62 | GHC.Boot.TH.Syntax
|
63 | + GHC.Boot.TH.Monad
|
|
63 | 64 | other-modules:
|
64 | 65 | GHC.Internal.TH.Lib
|
65 | 66 | GHC.Internal.TH.Syntax
|
67 | + GHC.Internal.TH.Monad
|
|
66 | 68 | GHC.Internal.ForeignSrcLang
|
67 | 69 | GHC.Internal.LanguageExtensions
|
68 | 70 | GHC.Internal.Lexeme
|
... | ... | @@ -74,4 +76,5 @@ Library |
74 | 76 | GHC.Boot.TH.Lib,
|
75 | 77 | GHC.Boot.TH.Lift,
|
76 | 78 | GHC.Boot.TH.Quote,
|
77 | - GHC.Boot.TH.Syntax |
|
79 | + GHC.Boot.TH.Syntax,
|
|
80 | + GHC.Boot.TH.Monad |
... | ... | @@ -298,6 +298,7 @@ Library |
298 | 298 | GHC.Internal.TH.Lib
|
299 | 299 | GHC.Internal.TH.Lift
|
300 | 300 | GHC.Internal.TH.Quote
|
301 | + GHC.Internal.TH.Monad
|
|
301 | 302 | GHC.Internal.TopHandler
|
302 | 303 | GHC.Internal.TypeError
|
303 | 304 | GHC.Internal.TypeLits
|
... | ... | @@ -143,6 +143,7 @@ import GHC.Internal.Arr -- So we can give Data instance for Array |
143 | 143 | import qualified GHC.Internal.Generics as Generics (Fixity(..))
|
144 | 144 | import GHC.Internal.Generics hiding (Fixity(..))
|
145 | 145 | -- So we can give Data instance for U1, V1, ...
|
146 | +import qualified GHC.Internal.TH.Syntax as TH
|
|
146 | 147 | |
147 | 148 | ------------------------------------------------------------------------------
|
148 | 149 | --
|
... | ... | @@ -1353,3 +1354,63 @@ deriving instance Data DecidedStrictness |
1353 | 1354 | |
1354 | 1355 | -- | @since base-4.12.0.0
|
1355 | 1356 | deriving instance Data a => Data (Down a)
|
1357 | + |
|
1358 | +----------------------------------------------------------------------------
|
|
1359 | +-- Data instances for GHC.Internal.TH.Syntax
|
|
1360 | + |
|
1361 | +deriving instance Data TH.AnnLookup
|
|
1362 | +deriving instance Data TH.AnnTarget
|
|
1363 | +deriving instance Data TH.Bang
|
|
1364 | +deriving instance Data TH.BndrVis
|
|
1365 | +deriving instance Data TH.Body
|
|
1366 | +deriving instance Data TH.Bytes
|
|
1367 | +deriving instance Data TH.Callconv
|
|
1368 | +deriving instance Data TH.Clause
|
|
1369 | +deriving instance Data TH.Con
|
|
1370 | +deriving instance Data TH.Dec
|
|
1371 | +deriving instance Data TH.DecidedStrictness
|
|
1372 | +deriving instance Data TH.DerivClause
|
|
1373 | +deriving instance Data TH.DerivStrategy
|
|
1374 | +deriving instance Data TH.DocLoc
|
|
1375 | +deriving instance Data TH.Exp
|
|
1376 | +deriving instance Data TH.FamilyResultSig
|
|
1377 | +deriving instance Data TH.Fixity
|
|
1378 | +deriving instance Data TH.FixityDirection
|
|
1379 | +deriving instance Data TH.Foreign
|
|
1380 | +deriving instance Data TH.FunDep
|
|
1381 | +deriving instance Data TH.Guard
|
|
1382 | +deriving instance Data TH.Info
|
|
1383 | +deriving instance Data TH.InjectivityAnn
|
|
1384 | +deriving instance Data TH.Inline
|
|
1385 | +deriving instance Data TH.Lit
|
|
1386 | +deriving instance Data TH.Loc
|
|
1387 | +deriving instance Data TH.Match
|
|
1388 | +deriving instance Data TH.ModName
|
|
1389 | +deriving instance Data TH.Module
|
|
1390 | +deriving instance Data TH.ModuleInfo
|
|
1391 | +deriving instance Data TH.Name
|
|
1392 | +deriving instance Data TH.NameFlavour
|
|
1393 | +deriving instance Data TH.NameSpace
|
|
1394 | +deriving instance Data TH.NamespaceSpecifier
|
|
1395 | +deriving instance Data TH.OccName
|
|
1396 | +deriving instance Data TH.Overlap
|
|
1397 | +deriving instance Data TH.Pat
|
|
1398 | +deriving instance Data TH.PatSynArgs
|
|
1399 | +deriving instance Data TH.PatSynDir
|
|
1400 | +deriving instance Data TH.Phases
|
|
1401 | +deriving instance Data TH.PkgName
|
|
1402 | +deriving instance Data TH.Pragma
|
|
1403 | +deriving instance Data TH.Range
|
|
1404 | +deriving instance Data TH.Role
|
|
1405 | +deriving instance Data TH.RuleBndr
|
|
1406 | +deriving instance Data TH.RuleMatch
|
|
1407 | +deriving instance Data TH.Safety
|
|
1408 | +deriving instance Data TH.SourceStrictness
|
|
1409 | +deriving instance Data TH.SourceUnpackedness
|
|
1410 | +deriving instance Data TH.Specificity
|
|
1411 | +deriving instance Data TH.Stmt
|
|
1412 | +deriving instance Data TH.TyLit
|
|
1413 | +deriving instance Data TH.TySynEqn
|
|
1414 | +deriving instance Data TH.Type
|
|
1415 | +deriving instance Data TH.TypeFamilyHead
|
|
1416 | +deriving instance Data flag => Data (TH.TyVarBndr flag) |
... | ... | @@ -21,6 +21,7 @@ |
21 | 21 | module GHC.Internal.TH.Lib where
|
22 | 22 | |
23 | 23 | import GHC.Internal.TH.Syntax hiding (Role, InjectivityAnn)
|
24 | +import GHC.Internal.TH.Monad
|
|
24 | 25 | import qualified GHC.Internal.TH.Syntax as TH
|
25 | 26 | |
26 | 27 | #ifdef BOOTSTRAP_TH
|
... | ... | @@ -30,6 +30,7 @@ module GHC.Internal.TH.Lift |
30 | 30 | where
|
31 | 31 | |
32 | 32 | import GHC.Internal.TH.Syntax
|
33 | +import GHC.Internal.TH.Monad
|
|
33 | 34 | import qualified GHC.Internal.TH.Lib as Lib (litE) -- See wrinkle (W4) of Note [Tracking dependencies on primitives]
|
34 | 35 | |
35 | 36 | import GHC.Internal.Data.Either
|
1 | +{-# OPTIONS_HADDOCK not-home #-} -- we want users to import Language.Haskell.TH.Syntax instead
|
|
2 | +{-# LANGUAGE CPP #-}
|
|
3 | +{-# LANGUAGE DataKinds #-}
|
|
4 | +{-# LANGUAGE FlexibleInstances #-}
|
|
5 | +{-# LANGUAGE GADTs#-}
|
|
6 | +{-# LANGUAGE PolyKinds #-}
|
|
7 | +{-# LANGUAGE RankNTypes #-}
|
|
8 | +{-# LANGUAGE RoleAnnotations #-}
|
|
9 | +{-# LANGUAGE ScopedTypeVariables #-}
|
|
10 | +{-# LANGUAGE StandaloneKindSignatures #-}
|
|
11 | +{-# LANGUAGE Trustworthy #-}
|
|
12 | +{-# LANGUAGE UnboxedSums #-}
|
|
13 | + |
|
14 | +-- | This module is used internally in GHC's integration with Template Haskell
|
|
15 | +-- and defines the Monads of Template Haskell, and associated definitions.
|
|
16 | +--
|
|
17 | +-- This is not a part of the public API, and as such, there are no API
|
|
18 | +-- guarantees for this module from version to version.
|
|
19 | +--
|
|
20 | +-- Import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!
|
|
21 | +module GHC.Internal.TH.Monad
|
|
22 | + ( module GHC.Internal.TH.Monad
|
|
23 | + ) where
|
|
24 | + |
|
25 | +#ifdef BOOTSTRAP_TH
|
|
26 | +import Prelude
|
|
27 | +import Data.Data hiding (Fixity(..))
|
|
28 | +import Data.IORef
|
|
29 | +import System.IO.Unsafe ( unsafePerformIO )
|
|
30 | +import Control.Monad.IO.Class (MonadIO (..))
|
|
31 | +import Control.Monad.Fix (MonadFix (..))
|
|
32 | +import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO)
|
|
33 | +import Control.Exception.Base (FixIOException (..))
|
|
34 | +import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar)
|
|
35 | +import System.IO ( hPutStrLn, stderr )
|
|
36 | +import qualified Data.Kind as Kind (Type)
|
|
37 | +import GHC.IO.Unsafe ( unsafeDupableInterleaveIO )
|
|
38 | +import GHC.Types (TYPE, RuntimeRep(..))
|
|
39 | +#else
|
|
40 | +import GHC.Internal.Base hiding (NonEmpty(..),Type, Module, sequence)
|
|
41 | +import GHC.Internal.Data.Data hiding (Fixity(..))
|
|
42 | +import GHC.Internal.Data.Traversable
|
|
43 | +import GHC.Internal.IORef
|
|
44 | +import GHC.Internal.System.IO
|
|
45 | +import GHC.Internal.Data.Foldable
|
|
46 | +import GHC.Internal.Data.Typeable
|
|
47 | +import GHC.Internal.Control.Monad.IO.Class
|
|
48 | +import GHC.Internal.Control.Monad.Fail
|
|
49 | +import GHC.Internal.Control.Monad.Fix
|
|
50 | +import GHC.Internal.Control.Exception
|
|
51 | +import GHC.Internal.Num
|
|
52 | +import GHC.Internal.IO.Unsafe
|
|
53 | +import GHC.Internal.MVar
|
|
54 | +import GHC.Internal.IO.Exception
|
|
55 | +import qualified GHC.Internal.Types as Kind (Type)
|
|
56 | +#endif
|
|
57 | +import GHC.Internal.ForeignSrcLang
|
|
58 | +import GHC.Internal.LanguageExtensions
|
|
59 | +import GHC.Internal.TH.Syntax
|
|
60 | + |
|
61 | +-----------------------------------------------------
|
|
62 | +--
|
|
63 | +-- The Quasi class
|
|
64 | +--
|
|
65 | +-----------------------------------------------------
|
|
66 | + |
|
67 | +class (MonadIO m, MonadFail m) => Quasi m where
|
|
68 | + -- | Fresh names. See 'newName'.
|
|
69 | + qNewName :: String -> m Name
|
|
70 | + |
|
71 | + ------- Error reporting and recovery -------
|
|
72 | + -- | Report an error (True) or warning (False)
|
|
73 | + -- ...but carry on; use 'fail' to stop. See 'report'.
|
|
74 | + qReport :: Bool -> String -> m ()
|
|
75 | + |
|
76 | + -- | See 'recover'.
|
|
77 | + qRecover :: m a -- ^ the error handler
|
|
78 | + -> m a -- ^ action which may fail
|
|
79 | + -> m a -- ^ Recover from the monadic 'fail'
|
|
80 | + |
|
81 | + ------- Inspect the type-checker's environment -------
|
|
82 | + -- | True <=> type namespace, False <=> value namespace. See 'lookupName'.
|
|
83 | + qLookupName :: Bool -> String -> m (Maybe Name)
|
|
84 | + -- | See 'reify'.
|
|
85 | + qReify :: Name -> m Info
|
|
86 | + -- | See 'reifyFixity'.
|
|
87 | + qReifyFixity :: Name -> m (Maybe Fixity)
|
|
88 | + -- | See 'reifyType'.
|
|
89 | + qReifyType :: Name -> m Type
|
|
90 | + -- | Is (n tys) an instance? Returns list of matching instance Decs (with
|
|
91 | + -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'.
|
|
92 | + qReifyInstances :: Name -> [Type] -> m [Dec]
|
|
93 | + -- | See 'reifyRoles'.
|
|
94 | + qReifyRoles :: Name -> m [Role]
|
|
95 | + -- | See 'reifyAnnotations'.
|
|
96 | + qReifyAnnotations :: Data a => AnnLookup -> m [a]
|
|
97 | + -- | See 'reifyModule'.
|
|
98 | + qReifyModule :: Module -> m ModuleInfo
|
|
99 | + -- | See 'reifyConStrictness'.
|
|
100 | + qReifyConStrictness :: Name -> m [DecidedStrictness]
|
|
101 | + |
|
102 | + -- | See 'location'.
|
|
103 | + qLocation :: m Loc
|
|
104 | + |
|
105 | + -- | Input/output (dangerous). See 'runIO'.
|
|
106 | + qRunIO :: IO a -> m a
|
|
107 | + qRunIO = liftIO
|
|
108 | + -- | See 'getPackageRoot'.
|
|
109 | + qGetPackageRoot :: m FilePath
|
|
110 | + |
|
111 | + -- | See 'addDependentFile'.
|
|
112 | + qAddDependentFile :: FilePath -> m ()
|
|
113 | + |
|
114 | + -- | See 'addTempFile'.
|
|
115 | + qAddTempFile :: String -> m FilePath
|
|
116 | + |
|
117 | + -- | See 'addTopDecls'.
|
|
118 | + qAddTopDecls :: [Dec] -> m ()
|
|
119 | + |
|
120 | + -- | See 'addForeignFilePath'.
|
|
121 | + qAddForeignFilePath :: ForeignSrcLang -> String -> m ()
|
|
122 | + |
|
123 | + -- | See 'addModFinalizer'.
|
|
124 | + qAddModFinalizer :: Q () -> m ()
|
|
125 | + |
|
126 | + -- | See 'addCorePlugin'.
|
|
127 | + qAddCorePlugin :: String -> m ()
|
|
128 | + |
|
129 | + -- | See 'getQ'.
|
|
130 | + qGetQ :: Typeable a => m (Maybe a)
|
|
131 | + |
|
132 | + -- | See 'putQ'.
|
|
133 | + qPutQ :: Typeable a => a -> m ()
|
|
134 | + |
|
135 | + -- | See 'isExtEnabled'.
|
|
136 | + qIsExtEnabled :: Extension -> m Bool
|
|
137 | + -- | See 'extsEnabled'.
|
|
138 | + qExtsEnabled :: m [Extension]
|
|
139 | + |
|
140 | + -- | See 'putDoc'.
|
|
141 | + qPutDoc :: DocLoc -> String -> m ()
|
|
142 | + -- | See 'getDoc'.
|
|
143 | + qGetDoc :: DocLoc -> m (Maybe String)
|
|
144 | + |
|
145 | +-----------------------------------------------------
|
|
146 | +-- The IO instance of Quasi
|
|
147 | +-----------------------------------------------------
|
|
148 | + |
|
149 | +-- | This instance is used only when running a Q
|
|
150 | +-- computation in the IO monad, usually just to
|
|
151 | +-- print the result. There is no interesting
|
|
152 | +-- type environment, so reification isn't going to
|
|
153 | +-- work.
|
|
154 | +instance Quasi IO where
|
|
155 | + qNewName = newNameIO
|
|
156 | + |
|
157 | + qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
|
|
158 | + qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
|
|
159 | + |
|
160 | + qLookupName _ _ = badIO "lookupName"
|
|
161 | + qReify _ = badIO "reify"
|
|
162 | + qReifyFixity _ = badIO "reifyFixity"
|
|
163 | + qReifyType _ = badIO "reifyFixity"
|
|
164 | + qReifyInstances _ _ = badIO "reifyInstances"
|
|
165 | + qReifyRoles _ = badIO "reifyRoles"
|
|
166 | + qReifyAnnotations _ = badIO "reifyAnnotations"
|
|
167 | + qReifyModule _ = badIO "reifyModule"
|
|
168 | + qReifyConStrictness _ = badIO "reifyConStrictness"
|
|
169 | + qLocation = badIO "currentLocation"
|
|
170 | + qRecover _ _ = badIO "recover" -- Maybe we could fix this?
|
|
171 | + qGetPackageRoot = badIO "getProjectRoot"
|
|
172 | + qAddDependentFile _ = badIO "addDependentFile"
|
|
173 | + qAddTempFile _ = badIO "addTempFile"
|
|
174 | + qAddTopDecls _ = badIO "addTopDecls"
|
|
175 | + qAddForeignFilePath _ _ = badIO "addForeignFilePath"
|
|
176 | + qAddModFinalizer _ = badIO "addModFinalizer"
|
|
177 | + qAddCorePlugin _ = badIO "addCorePlugin"
|
|
178 | + qGetQ = badIO "getQ"
|
|
179 | + qPutQ _ = badIO "putQ"
|
|
180 | + qIsExtEnabled _ = badIO "isExtEnabled"
|
|
181 | + qExtsEnabled = badIO "extsEnabled"
|
|
182 | + qPutDoc _ _ = badIO "putDoc"
|
|
183 | + qGetDoc _ = badIO "getDoc"
|
|
184 | + |
|
185 | +instance Quote IO where
|
|
186 | + newName = newNameIO
|
|
187 | + |
|
188 | +newNameIO :: String -> IO Name
|
|
189 | +newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
|
|
190 | + ; pure (mkNameU s n) }
|
|
191 | + |
|
192 | +badIO :: String -> IO a
|
|
193 | +badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
|
|
194 | + ; fail "Template Haskell failure" }
|
|
195 | + |
|
196 | +-- Global variable to generate unique symbols
|
|
197 | +counter :: IORef Uniq
|
|
198 | +{-# NOINLINE counter #-}
|
|
199 | +counter = unsafePerformIO (newIORef 0)
|
|
200 | + |
|
201 | + |
|
202 | +-----------------------------------------------------
|
|
203 | +--
|
|
204 | +-- The Q monad
|
|
205 | +--
|
|
206 | +-----------------------------------------------------
|
|
207 | + |
|
208 | +-- | In short, 'Q' provides the 'Quasi' operations in one neat monad for the
|
|
209 | +-- user.
|
|
210 | +--
|
|
211 | +-- The longer story, is that 'Q' wraps an arbitrary 'Quasi'-able monad.
|
|
212 | +-- The perceptive reader notices that 'Quasi' has only two instances, 'Q'
|
|
213 | +-- itself and 'IO', neither of which have concrete implementations.'Q' plays
|
|
214 | +-- the trick of [dependency
|
|
215 | +-- inversion](https://en.wikipedia.org/wiki/Dependency_inversion_principle),
|
|
216 | +-- providing an abstract interface for the user which is later concretely
|
|
217 | +-- fufilled by an concrete 'Quasi' instance, internal to GHC.
|
|
218 | +newtype Q a = Q { unQ :: forall m. Quasi m => m a }
|
|
219 | + |
|
220 | +-- | \"Runs\" the 'Q' monad. Normal users of Template Haskell
|
|
221 | +-- should not need this function, as the splice brackets @$( ... )@
|
|
222 | +-- are the usual way of running a 'Q' computation.
|
|
223 | +--
|
|
224 | +-- This function is primarily used in GHC internals, and for debugging
|
|
225 | +-- splices by running them in 'IO'.
|
|
226 | +--
|
|
227 | +-- Note that many functions in 'Q', such as 'reify' and other compiler
|
|
228 | +-- queries, are not supported when running 'Q' in 'IO'; these operations
|
|
229 | +-- simply fail at runtime. Indeed, the only operations guaranteed to succeed
|
|
230 | +-- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
|
|
231 | +runQ :: Quasi m => Q a -> m a
|
|
232 | +runQ (Q m) = m
|
|
233 | + |
|
234 | +instance Monad Q where
|
|
235 | + Q m >>= k = Q (m >>= \x -> unQ (k x))
|
|
236 | + (>>) = (*>)
|
|
237 | + |
|
238 | +instance MonadFail Q where
|
|
239 | + fail s = report True s >> Q (fail "Q monad failure")
|
|
240 | + |
|
241 | +instance Functor Q where
|
|
242 | + fmap f (Q x) = Q (fmap f x)
|
|
243 | + |
|
244 | +instance Applicative Q where
|
|
245 | + pure x = Q (pure x)
|
|
246 | + Q f <*> Q x = Q (f <*> x)
|
|
247 | + Q m *> Q n = Q (m *> n)
|
|
248 | + |
|
249 | +-- | @since 2.17.0.0
|
|
250 | +instance Semigroup a => Semigroup (Q a) where
|
|
251 | + (<>) = liftA2 (<>)
|
|
252 | + |
|
253 | +-- | @since 2.17.0.0
|
|
254 | +instance Monoid a => Monoid (Q a) where
|
|
255 | + mempty = pure mempty
|
|
256 | + |
|
257 | +-- | If the function passed to 'mfix' inspects its argument,
|
|
258 | +-- the resulting action will throw a 'FixIOException'.
|
|
259 | +--
|
|
260 | +-- @since 2.17.0.0
|
|
261 | +instance MonadFix Q where
|
|
262 | + -- We use the same blackholing approach as in fixIO.
|
|
263 | + -- See Note [Blackholing in fixIO] in System.IO in base.
|
|
264 | + mfix k = do
|
|
265 | + m <- runIO newEmptyMVar
|
|
266 | + ans <- runIO (unsafeDupableInterleaveIO
|
|
267 | + (readMVar m `catch` \BlockedIndefinitelyOnMVar ->
|
|
268 | + throwIO FixIOException))
|
|
269 | + result <- k ans
|
|
270 | + runIO (putMVar m result)
|
|
271 | + return result
|
|
272 | + |
|
273 | + |
|
274 | +-----------------------------------------------------
|
|
275 | +--
|
|
276 | +-- The Quote class
|
|
277 | +--
|
|
278 | +-----------------------------------------------------
|
|
279 | + |
|
280 | + |
|
281 | + |
|
282 | +-- | The 'Quote' class implements the minimal interface which is necessary for
|
|
283 | +-- desugaring quotations.
|
|
284 | +--
|
|
285 | +-- * The @Monad m@ superclass is needed to stitch together the different
|
|
286 | +-- AST fragments.
|
|
287 | +-- * 'newName' is used when desugaring binding structures such as lambdas
|
|
288 | +-- to generate fresh names.
|
|
289 | +--
|
|
290 | +-- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp`
|
|
291 | +--
|
|
292 | +-- For many years the type of a quotation was fixed to be `Q Exp` but by
|
|
293 | +-- more precisely specifying the minimal interface it enables the `Exp` to
|
|
294 | +-- be extracted purely from the quotation without interacting with `Q`.
|
|
295 | +class Monad m => Quote m where
|
|
296 | + {- |
|
|
297 | + Generate a fresh name, which cannot be captured.
|
|
298 | + |
|
299 | + For example, this:
|
|
300 | + |
|
301 | + @f = $(do
|
|
302 | + nm1 <- newName \"x\"
|
|
303 | + let nm2 = 'mkName' \"x\"
|
|
304 | + return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
|
|
305 | + )@
|
|
306 | + |
|
307 | + will produce the splice
|
|
308 | + |
|
309 | + >f = \x0 -> \x -> x0
|
|
310 | + |
|
311 | + In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
|
|
312 | + and is not captured by the binding @VarP nm2@.
|
|
313 | + |
|
314 | + Although names generated by @newName@ cannot /be captured/, they can
|
|
315 | + /capture/ other names. For example, this:
|
|
316 | + |
|
317 | + >g = $(do
|
|
318 | + > nm1 <- newName "x"
|
|
319 | + > let nm2 = mkName "x"
|
|
320 | + > return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
|
|
321 | + > )
|
|
322 | + |
|
323 | + will produce the splice
|
|
324 | + |
|
325 | + >g = \x -> \x0 -> x0
|
|
326 | + |
|
327 | + since the occurrence @VarE nm2@ is captured by the innermost binding
|
|
328 | + of @x@, namely @VarP nm1@.
|
|
329 | + -}
|
|
330 | + newName :: String -> m Name
|
|
331 | + |
|
332 | +instance Quote Q where
|
|
333 | + newName s = Q (qNewName s)
|
|
334 | + |
|
335 | +-----------------------------------------------------
|
|
336 | +--
|
|
337 | +-- The TExp type
|
|
338 | +--
|
|
339 | +-----------------------------------------------------
|
|
340 | + |
|
341 | +type TExp :: TYPE r -> Kind.Type
|
|
342 | +type role TExp nominal -- See Note [Role of TExp]
|
|
343 | +newtype TExp a = TExp
|
|
344 | + { unType :: Exp -- ^ Underlying untyped Template Haskell expression
|
|
345 | + }
|
|
346 | +-- ^ Typed wrapper around an 'Exp'.
|
|
347 | +--
|
|
348 | +-- This is the typed representation of terms produced by typed quotes.
|
|
349 | +--
|
|
350 | +-- Representation-polymorphic since /template-haskell-2.16.0.0/.
|
|
351 | + |
|
352 | +-- | Discard the type annotation and produce a plain Template Haskell
|
|
353 | +-- expression
|
|
354 | +--
|
|
355 | +-- Representation-polymorphic since /template-haskell-2.16.0.0/.
|
|
356 | +unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp
|
|
357 | +unTypeQ m = do { TExp e <- m
|
|
358 | + ; return e }
|
|
359 | + |
|
360 | +-- | Annotate the Template Haskell expression with a type
|
|
361 | +--
|
|
362 | +-- This is unsafe because GHC cannot check for you that the expression
|
|
363 | +-- really does have the type you claim it has.
|
|
364 | +--
|
|
365 | +-- Representation-polymorphic since /template-haskell-2.16.0.0/.
|
|
366 | +unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
|
|
367 | + Quote m => m Exp -> m (TExp a)
|
|
368 | +unsafeTExpCoerce m = do { e <- m
|
|
369 | + ; return (TExp e) }
|
|
370 | + |
|
371 | +{- Note [Role of TExp]
|
|
372 | +~~~~~~~~~~~~~~~~~~~~~~
|
|
373 | +TExp's argument must have a nominal role, not phantom as would
|
|
374 | +be inferred (#8459). Consider
|
|
375 | + |
|
376 | + e :: Code Q Age
|
|
377 | + e = [|| MkAge 3 ||]
|
|
378 | + |
|
379 | + foo = $(coerce e) + 4::Int
|
|
380 | + |
|
381 | +The splice will evaluate to (MkAge 3) and you can't add that to
|
|
382 | +4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -}
|
|
383 | + |
|
384 | +-- Code constructor
|
|
385 | +#if __GLASGOW_HASKELL__ >= 909
|
|
386 | +type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type
|
|
387 | + -- See Note [Foralls to the right in Code]
|
|
388 | +#else
|
|
389 | +type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
|
|
390 | +#endif
|
|
391 | +type role Code representational nominal -- See Note [Role of TExp]
|
|
392 | +newtype Code m a = Code
|
|
393 | + { examineCode :: m (TExp a) -- ^ Underlying monadic value
|
|
394 | + }
|
|
395 | +-- ^ Represents an expression which has type @a@, built in monadic context @m@. Built on top of 'TExp', typed
|
|
396 | +-- expressions allow for type-safe splicing via:
|
|
397 | +--
|
|
398 | +-- - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if
|
|
399 | +-- that expression has type @a@, then the quotation has type
|
|
400 | +-- @Quote m => Code m a@
|
|
401 | +--
|
|
402 | +-- - typed splices inside of typed quotes, written as @$$(...)@ where @...@
|
|
403 | +-- is an arbitrary expression of type @Quote m => Code m a@
|
|
404 | +--
|
|
405 | +-- Traditional expression quotes and splices let us construct ill-typed
|
|
406 | +-- expressions:
|
|
407 | +--
|
|
408 | +-- >>> fmap ppr $ runQ (unTypeCode [| True == $( [| "foo" |] ) |])
|
|
409 | +-- GHC.Internal.Types.True GHC.Internal.Classes.== "foo"
|
|
410 | +-- >>> GHC.Internal.Types.True GHC.Internal.Classes.== "foo"
|
|
411 | +-- <interactive> error:
|
|
412 | +-- • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
|
|
413 | +-- • In the second argument of ‘(==)’, namely ‘"foo"’
|
|
414 | +-- In the expression: True == "foo"
|
|
415 | +-- In an equation for ‘it’: it = True == "foo"
|
|
416 | +--
|
|
417 | +-- With typed expressions, the type error occurs when /constructing/ the
|
|
418 | +-- Template Haskell expression:
|
|
419 | +--
|
|
420 | +-- >>> fmap ppr $ runQ (unTypeCode [|| True == $$( [|| "foo" ||] ) ||])
|
|
421 | +-- <interactive> error:
|
|
422 | +-- • Couldn't match type ‘[Char]’ with ‘Bool’
|
|
423 | +-- Expected type: Code Q Bool
|
|
424 | +-- Actual type: Code Q [Char]
|
|
425 | +-- • In the Template Haskell quotation [|| "foo" ||]
|
|
426 | +-- In the expression: [|| "foo" ||]
|
|
427 | +-- In the Template Haskell splice $$([|| "foo" ||])
|
|
428 | + |
|
429 | + |
|
430 | +{- Note [Foralls to the right in Code]
|
|
431 | +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
432 | +Code has the following type signature:
|
|
433 | + type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type
|
|
434 | + |
|
435 | +This allows us to write
|
|
436 | + data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#)
|
|
437 | + |
|
438 | + tcodeq :: T (Code Q)
|
|
439 | + tcodeq = MkT [||5||] [||5#||]
|
|
440 | + |
|
441 | +If we used the slightly more straightforward signature
|
|
442 | + type Code :: foral r. (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
|
|
443 | + |
|
444 | +then the example above would become ill-typed. (See #23592 for some discussion.)
|
|
445 | +-}
|
|
446 | + |
|
447 | +-- | Unsafely convert an untyped code representation into a typed code
|
|
448 | +-- representation.
|
|
449 | +unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
|
|
450 | + Quote m => m Exp -> Code m a
|
|
451 | +unsafeCodeCoerce m = Code (unsafeTExpCoerce m)
|
|
452 | + |
|
453 | +-- | Lift a monadic action producing code into the typed 'Code'
|
|
454 | +-- representation
|
|
455 | +liftCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . m (TExp a) -> Code m a
|
|
456 | +liftCode = Code
|
|
457 | + |
|
458 | +-- | Extract the untyped representation from the typed representation
|
|
459 | +unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m
|
|
460 | + => Code m a -> m Exp
|
|
461 | +unTypeCode = unTypeQ . examineCode
|
|
462 | + |
|
463 | +-- | Modify the ambient monad used during code generation. For example, you
|
|
464 | +-- can use `hoistCode` to handle a state effect:
|
|
465 | +-- @
|
|
466 | +-- handleState :: Code (StateT Int Q) a -> Code Q a
|
|
467 | +-- handleState = hoistCode (flip runState 0)
|
|
468 | +-- @
|
|
469 | +hoistCode :: forall m n (r :: RuntimeRep) (a :: TYPE r) . Monad m
|
|
470 | + => (forall x . m x -> n x) -> Code m a -> Code n a
|
|
471 | +hoistCode f (Code a) = Code (f a)
|
|
472 | + |
|
473 | + |
|
474 | +-- | Variant of '(>>=)' which allows effectful computations to be injected
|
|
475 | +-- into code generation.
|
|
476 | +bindCode :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
|
|
477 | + => m a -> (a -> Code m b) -> Code m b
|
|
478 | +bindCode q k = liftCode (q >>= examineCode . k)
|
|
479 | + |
|
480 | +-- | Variant of '(>>)' which allows effectful computations to be injected
|
|
481 | +-- into code generation.
|
|
482 | +bindCode_ :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
|
|
483 | + => m a -> Code m b -> Code m b
|
|
484 | +bindCode_ q c = liftCode ( q >> examineCode c)
|
|
485 | + |
|
486 | +-- | A useful combinator for embedding monadic actions into 'Code'
|
|
487 | +-- @
|
|
488 | +-- myCode :: ... => Code m a
|
|
489 | +-- myCode = joinCode $ do
|
|
490 | +-- x <- someSideEffect
|
|
491 | +-- return (makeCodeWith x)
|
|
492 | +-- @
|
|
493 | +joinCode :: forall m (r :: RuntimeRep) (a :: TYPE r) . Monad m
|
|
494 | + => m (Code m a) -> Code m a
|
|
495 | +joinCode = flip bindCode id
|
|
496 | + |
|
497 | +----------------------------------------------------
|
|
498 | +-- Packaged versions for the programmer, hiding the Quasi-ness
|
|
499 | + |
|
500 | + |
|
501 | +-- | Report an error (True) or warning (False),
|
|
502 | +-- but carry on; use 'fail' to stop.
|
|
503 | +report :: Bool -> String -> Q ()
|
|
504 | +report b s = Q (qReport b s)
|
|
505 | +{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6
|
|
506 | + |
|
507 | +-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.
|
|
508 | +reportError :: String -> Q ()
|
|
509 | +reportError = report True
|
|
510 | + |
|
511 | +-- | Report a warning to the user, and carry on.
|
|
512 | +reportWarning :: String -> Q ()
|
|
513 | +reportWarning = report False
|
|
514 | + |
|
515 | +-- | Recover from errors raised by 'reportError' or 'fail'.
|
|
516 | +recover :: Q a -- ^ handler to invoke on failure
|
|
517 | + -> Q a -- ^ computation to run
|
|
518 | + -> Q a
|
|
519 | +recover (Q r) (Q m) = Q (qRecover r m)
|
|
520 | + |
|
521 | +-- We don't export lookupName; the Bool isn't a great API
|
|
522 | +-- Instead we export lookupTypeName, lookupValueName
|
|
523 | +lookupName :: Bool -> String -> Q (Maybe Name)
|
|
524 | +lookupName ns s = Q (qLookupName ns s)
|
|
525 | + |
|
526 | +-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
|
|
527 | +lookupTypeName :: String -> Q (Maybe Name)
|
|
528 | +lookupTypeName s = Q (qLookupName True s)
|
|
529 | + |
|
530 | +-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
|
|
531 | +lookupValueName :: String -> Q (Maybe Name)
|
|
532 | +lookupValueName s = Q (qLookupName False s)
|
|
533 | + |
|
534 | +{-
|
|
535 | +Note [Name lookup]
|
|
536 | +~~~~~~~~~~~~~~~~~~
|
|
537 | +-}
|
|
538 | +{- $namelookup #namelookup#
|
|
539 | +The functions 'lookupTypeName' and 'lookupValueName' provide
|
|
540 | +a way to query the current splice's context for what names
|
|
541 | +are in scope. The function 'lookupTypeName' queries the type
|
|
542 | +namespace, whereas 'lookupValueName' queries the value namespace,
|
|
543 | +but the functions are otherwise identical.
|
|
544 | + |
|
545 | +A call @lookupValueName s@ will check if there is a value
|
|
546 | +with name @s@ in scope at the current splice's location. If
|
|
547 | +there is, the @Name@ of this value is returned;
|
|
548 | +if not, then @Nothing@ is returned.
|
|
549 | + |
|
550 | +The returned name cannot be \"captured\".
|
|
551 | +For example:
|
|
552 | + |
|
553 | +> f = "global"
|
|
554 | +> g = $( do
|
|
555 | +> Just nm <- lookupValueName "f"
|
|
556 | +> [| let f = "local" in $( varE nm ) |]
|
|
557 | + |
|
558 | +In this case, @g = \"global\"@; the call to @lookupValueName@
|
|
559 | +returned the global @f@, and this name was /not/ captured by
|
|
560 | +the local definition of @f@.
|
|
561 | + |
|
562 | +The lookup is performed in the context of the /top-level/ splice
|
|
563 | +being run. For example:
|
|
564 | + |
|
565 | +> f = "global"
|
|
566 | +> g = $( [| let f = "local" in
|
|
567 | +> $(do
|
|
568 | +> Just nm <- lookupValueName "f"
|
|
569 | +> varE nm
|
|
570 | +> ) |] )
|
|
571 | + |
|
572 | +Again in this example, @g = \"global\"@, because the call to
|
|
573 | +@lookupValueName@ queries the context of the outer-most @$(...)@.
|
|
574 | + |
|
575 | +Operators should be queried without any surrounding parentheses, like so:
|
|
576 | + |
|
577 | +> lookupValueName "+"
|
|
578 | + |
|
579 | +Qualified names are also supported, like so:
|
|
580 | + |
|
581 | +> lookupValueName "Prelude.+"
|
|
582 | +> lookupValueName "Prelude.map"
|
|
583 | + |
|
584 | +-}
|
|
585 | + |
|
586 | + |
|
587 | +{- | 'reify' looks up information about the 'Name'. It will fail with
|
|
588 | +a compile error if the 'Name' is not visible. A 'Name' is visible if it is
|
|
589 | +imported or defined in a prior top-level declaration group. See the
|
|
590 | +documentation for 'newDeclarationGroup' for more details.
|
|
591 | + |
|
592 | +It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'
|
|
593 | +to ensure that we are reifying from the right namespace. For instance, in this context:
|
|
594 | + |
|
595 | +> data D = D
|
|
596 | + |
|
597 | +which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)
|
|
598 | +To ensure we get information about @D@-the-value, use 'lookupValueName':
|
|
599 | + |
|
600 | +> do
|
|
601 | +> Just nm <- lookupValueName "D"
|
|
602 | +> reify nm
|
|
603 | + |
|
604 | +and to get information about @D@-the-type, use 'lookupTypeName'.
|
|
605 | +-}
|
|
606 | +reify :: Name -> Q Info
|
|
607 | +reify v = Q (qReify v)
|
|
608 | + |
|
609 | +{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For
|
|
610 | +example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then
|
|
611 | +@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function
|
|
612 | +@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns
|
|
613 | +'Nothing', so you may assume @bar@ has 'defaultFixity'.
|
|
614 | +-}
|
|
615 | +reifyFixity :: Name -> Q (Maybe Fixity)
|
|
616 | +reifyFixity nm = Q (qReifyFixity nm)
|
|
617 | + |
|
618 | +{- | @reifyType nm@ attempts to find the type or kind of @nm@. For example,
|
|
619 | +@reifyType 'not@ returns @Bool -> Bool@, and
|
|
620 | +@reifyType ''Bool@ returns @Type@.
|
|
621 | +This works even if there's no explicit signature and the type or kind is inferred.
|
|
622 | +-}
|
|
623 | +reifyType :: Name -> Q Type
|
|
624 | +reifyType nm = Q (qReifyType nm)
|
|
625 | + |
|
626 | +{- | Template Haskell is capable of reifying information about types and
|
|
627 | +terms defined in previous declaration groups. Top-level declaration splices break up
|
|
628 | +declaration groups.
|
|
629 | + |
|
630 | +For an example, consider this code block. We define a datatype @X@ and
|
|
631 | +then try to call 'reify' on the datatype.
|
|
632 | + |
|
633 | +@
|
|
634 | +module Check where
|
|
635 | + |
|
636 | +data X = X
|
|
637 | + deriving Eq
|
|
638 | + |
|
639 | +$(do
|
|
640 | + info <- reify ''X
|
|
641 | + runIO $ print info
|
|
642 | + )
|
|
643 | +@
|
|
644 | + |
|
645 | +This code fails to compile, noting that @X@ is not available for reification at the site of 'reify'. We can fix this by creating a new declaration group using an empty top-level splice:
|
|
646 | + |
|
647 | +@
|
|
648 | +data X = X
|
|
649 | + deriving Eq
|
|
650 | + |
|
651 | +$(pure [])
|
|
652 | + |
|
653 | +$(do
|
|
654 | + info <- reify ''X
|
|
655 | + runIO $ print info
|
|
656 | + )
|
|
657 | +@
|
|
658 | + |
|
659 | +We provide 'newDeclarationGroup' as a means of documenting this behavior
|
|
660 | +and providing a name for the pattern.
|
|
661 | + |
|
662 | +Since top level splices infer the presence of the @$( ... )@ brackets, we can also write:
|
|
663 | + |
|
664 | +@
|
|
665 | +data X = X
|
|
666 | + deriving Eq
|
|
667 | + |
|
668 | +newDeclarationGroup
|
|
669 | + |
|
670 | +$(do
|
|
671 | + info <- reify ''X
|
|
672 | + runIO $ print info
|
|
673 | + )
|
|
674 | +@
|
|
675 | + |
|
676 | +-}
|
|
677 | +newDeclarationGroup :: Q [Dec]
|
|
678 | +newDeclarationGroup = pure []
|
|
679 | + |
|
680 | +{- | @reifyInstances nm tys@ returns a list of all visible instances (see below for "visible")
|
|
681 | +of @nm tys@. That is,
|
|
682 | +if @nm@ is the name of a type class, then all instances of this class at the types @tys@
|
|
683 | +are returned. Alternatively, if @nm@ is the name of a data family or type family,
|
|
684 | +all instances of this family at the types @tys@ are returned.
|
|
685 | + |
|
686 | +Note that this is a \"shallow\" test; the declarations returned merely have
|
|
687 | +instance heads which unify with @nm tys@, they need not actually be satisfiable.
|
|
688 | + |
|
689 | + - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains
|
|
690 | + the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and
|
|
691 | + @B@ themselves implement 'Eq'
|
|
692 | + |
|
693 | + - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available
|
|
694 | + instance of 'Show'
|
|
695 | + |
|
696 | +There is one edge case: @reifyInstances ''Typeable tys@ currently always
|
|
697 | +produces an empty list (no matter what @tys@ are given).
|
|
698 | + |
|
699 | +In principle, the *visible* instances are
|
|
700 | +* all instances defined in a prior top-level declaration group
|
|
701 | + (see docs on @newDeclarationGroup@), or
|
|
702 | +* all instances defined in any module transitively imported by the
|
|
703 | + module being compiled
|
|
704 | + |
|
705 | +However, actually searching all modules transitively below the one being
|
|
706 | +compiled is unreasonably expensive, so @reifyInstances@ will report only the
|
|
707 | +instance for modules that GHC has had some cause to visit during this
|
|
708 | +compilation. This is a shortcoming: @reifyInstances@ might fail to report
|
|
709 | +instances for a type that is otherwise unusued, or instances defined in a
|
|
710 | +different component. You can work around this shortcoming by explicitly importing the modules
|
|
711 | +whose instances you want to be visible. GHC issue <https://gitlab.haskell.org/ghc/ghc/-/issues/20529#note_388980 #20529>
|
|
712 | +has some discussion around this.
|
|
713 | + |
|
714 | +-}
|
|
715 | +reifyInstances :: Name -> [Type] -> Q [InstanceDec]
|
|
716 | +reifyInstances cls tys = Q (qReifyInstances cls tys)
|
|
717 | + |
|
718 | +{- | @reifyRoles nm@ returns the list of roles associated with the parameters
|
|
719 | +(both visible and invisible) of
|
|
720 | +the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.
|
|
721 | +The returned list should never contain 'InferR'.
|
|
722 | + |
|
723 | +An invisible parameter to a tycon is often a kind parameter. For example, if
|
|
724 | +we have
|
|
725 | + |
|
726 | +@
|
|
727 | +type Proxy :: forall k. k -> Type
|
|
728 | +data Proxy a = MkProxy
|
|
729 | +@
|
|
730 | + |
|
731 | +and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' is
|
|
732 | +the role of the invisible @k@ parameter. Kind parameters are always nominal.
|
|
733 | +-}
|
|
734 | +reifyRoles :: Name -> Q [Role]
|
|
735 | +reifyRoles nm = Q (qReifyRoles nm)
|
|
736 | + |
|
737 | +-- | @reifyAnnotations target@ returns the list of annotations
|
|
738 | +-- associated with @target@. Only the annotations that are
|
|
739 | +-- appropriately typed is returned. So if you have @Int@ and @String@
|
|
740 | +-- annotations for the same target, you have to call this function twice.
|
|
741 | +reifyAnnotations :: Data a => AnnLookup -> Q [a]
|
|
742 | +reifyAnnotations an = Q (qReifyAnnotations an)
|
|
743 | + |
|
744 | +-- | @reifyModule mod@ looks up information about module @mod@. To
|
|
745 | +-- look up the current module, call this function with the return
|
|
746 | +-- value of 'Language.Haskell.TH.Lib.thisModule'.
|
|
747 | +reifyModule :: Module -> Q ModuleInfo
|
|
748 | +reifyModule m = Q (qReifyModule m)
|
|
749 | + |
|
750 | +-- | @reifyConStrictness nm@ looks up the strictness information for the fields
|
|
751 | +-- of the constructor with the name @nm@. Note that the strictness information
|
|
752 | +-- that 'reifyConStrictness' returns may not correspond to what is written in
|
|
753 | +-- the source code. For example, in the following data declaration:
|
|
754 | +--
|
|
755 | +-- @
|
|
756 | +-- data Pair a = Pair a a
|
|
757 | +-- @
|
|
758 | +--
|
|
759 | +-- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most
|
|
760 | +-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the
|
|
761 | +-- @-XStrictData@ language extension was enabled.
|
|
762 | +reifyConStrictness :: Name -> Q [DecidedStrictness]
|
|
763 | +reifyConStrictness n = Q (qReifyConStrictness n)
|
|
764 | + |
|
765 | +-- | Is the list of instances returned by 'reifyInstances' nonempty?
|
|
766 | +--
|
|
767 | +-- If you're confused by an instance not being visible despite being
|
|
768 | +-- defined in the same module and above the splice in question, see the
|
|
769 | +-- docs for 'newDeclarationGroup' for a possible explanation.
|
|
770 | +isInstance :: Name -> [Type] -> Q Bool
|
|
771 | +isInstance nm tys = do { decs <- reifyInstances nm tys
|
|
772 | + ; return (not (null decs)) }
|
|
773 | + |
|
774 | +-- | The location at which this computation is spliced.
|
|
775 | +location :: Q Loc
|
|
776 | +location = Q qLocation
|
|
777 | + |
|
778 | +-- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
|
|
779 | +-- Take care: you are guaranteed the ordering of calls to 'runIO' within
|
|
780 | +-- a single 'Q' computation, but not about the order in which splices are run.
|
|
781 | +--
|
|
782 | +-- Note: for various murky reasons, stdout and stderr handles are not
|
|
783 | +-- necessarily flushed when the compiler finishes running, so you should
|
|
784 | +-- flush them yourself.
|
|
785 | +runIO :: IO a -> Q a
|
|
786 | +runIO m = Q (qRunIO m)
|
|
787 | + |
|
788 | +-- | Get the package root for the current package which is being compiled.
|
|
789 | +-- This can be set explicitly with the -package-root flag but is normally
|
|
790 | +-- just the current working directory.
|
|
791 | +--
|
|
792 | +-- The motivation for this flag is to provide a principled means to remove the
|
|
793 | +-- assumption from splices that they will be executed in the directory where the
|
|
794 | +-- cabal file resides. Projects such as haskell-language-server can't and don't
|
|
795 | +-- change directory when compiling files but instead set the -package-root flag
|
|
796 | +-- appropriately.
|
|
797 | +getPackageRoot :: Q FilePath
|
|
798 | +getPackageRoot = Q qGetPackageRoot
|
|
799 | + |
|
800 | + |
|
801 | + |
|
802 | +-- | Record external files that runIO is using (dependent upon).
|
|
803 | +-- The compiler can then recognize that it should re-compile the Haskell file
|
|
804 | +-- when an external file changes.
|
|
805 | +--
|
|
806 | +-- Expects an absolute file path.
|
|
807 | +--
|
|
808 | +-- Notes:
|
|
809 | +--
|
|
810 | +-- * ghc -M does not know about these dependencies - it does not execute TH.
|
|
811 | +--
|
|
812 | +-- * The dependency is based on file content, not a modification time
|
|
813 | +addDependentFile :: FilePath -> Q ()
|
|
814 | +addDependentFile fp = Q (qAddDependentFile fp)
|
|
815 | + |
|
816 | +-- | Obtain a temporary file path with the given suffix. The compiler will
|
|
817 | +-- delete this file after compilation.
|
|
818 | +addTempFile :: String -> Q FilePath
|
|
819 | +addTempFile suffix = Q (qAddTempFile suffix)
|
|
820 | + |
|
821 | +-- | Add additional top-level declarations. The added declarations will be type
|
|
822 | +-- checked along with the current declaration group.
|
|
823 | +addTopDecls :: [Dec] -> Q ()
|
|
824 | +addTopDecls ds = Q (qAddTopDecls ds)
|
|
825 | + |
|
826 | + |
|
827 | +-- | Emit a foreign file which will be compiled and linked to the object for
|
|
828 | +-- the current module. Currently only languages that can be compiled with
|
|
829 | +-- the C compiler are supported, and the flags passed as part of -optc will
|
|
830 | +-- be also applied to the C compiler invocation that will compile them.
|
|
831 | +--
|
|
832 | +-- Note that for non-C languages (for example C++) @extern "C"@ directives
|
|
833 | +-- must be used to get symbols that we can access from Haskell.
|
|
834 | +--
|
|
835 | +-- To get better errors, it is recommended to use #line pragmas when
|
|
836 | +-- emitting C files, e.g.
|
|
837 | +--
|
|
838 | +-- > {-# LANGUAGE CPP #-}
|
|
839 | +-- > ...
|
|
840 | +-- > addForeignSource LangC $ unlines
|
|
841 | +-- > [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__
|
|
842 | +-- > , ...
|
|
843 | +-- > ]
|
|
844 | +addForeignSource :: ForeignSrcLang -> String -> Q ()
|
|
845 | +addForeignSource lang src = do
|
|
846 | + let suffix = case lang of
|
|
847 | + LangC -> "c"
|
|
848 | + LangCxx -> "cpp"
|
|
849 | + LangObjc -> "m"
|
|
850 | + LangObjcxx -> "mm"
|
|
851 | + LangAsm -> "s"
|
|
852 | + LangJs -> "js"
|
|
853 | + RawObject -> "a"
|
|
854 | + path <- addTempFile suffix
|
|
855 | + runIO $ writeFile path src
|
|
856 | + addForeignFilePath lang path
|
|
857 | + |
|
858 | +-- | Same as 'addForeignSource', but expects to receive a path pointing to the
|
|
859 | +-- foreign file instead of a 'String' of its contents. Consider using this in
|
|
860 | +-- conjunction with 'addTempFile'.
|
|
861 | +--
|
|
862 | +-- This is a good alternative to 'addForeignSource' when you are trying to
|
|
863 | +-- directly link in an object file.
|
|
864 | +addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
|
|
865 | +addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp)
|
|
866 | + |
|
867 | +-- | Add a finalizer that will run in the Q monad after the current module has
|
|
868 | +-- been type checked. This only makes sense when run within a top-level splice.
|
|
869 | +--
|
|
870 | +-- The finalizer is given the local type environment at the splice point. Thus
|
|
871 | +-- 'reify' is able to find the local definitions when executed inside the
|
|
872 | +-- finalizer.
|
|
873 | +addModFinalizer :: Q () -> Q ()
|
|
874 | +addModFinalizer act = Q (qAddModFinalizer (unQ act))
|
|
875 | + |
|
876 | +-- | Adds a core plugin to the compilation pipeline.
|
|
877 | +--
|
|
878 | +-- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc
|
|
879 | +-- in the command line. The major difference is that the plugin module @m@
|
|
880 | +-- must not belong to the current package. When TH executes, it is too late
|
|
881 | +-- to tell the compiler that we needed to compile first a plugin module in the
|
|
882 | +-- current package.
|
|
883 | +addCorePlugin :: String -> Q ()
|
|
884 | +addCorePlugin plugin = Q (qAddCorePlugin plugin)
|
|
885 | + |
|
886 | +-- | Get state from the 'Q' monad. Note that the state is local to the
|
|
887 | +-- Haskell module in which the Template Haskell expression is executed.
|
|
888 | +getQ :: Typeable a => Q (Maybe a)
|
|
889 | +getQ = Q qGetQ
|
|
890 | + |
|
891 | +-- | Replace the state in the 'Q' monad. Note that the state is local to the
|
|
892 | +-- Haskell module in which the Template Haskell expression is executed.
|
|
893 | +putQ :: Typeable a => a -> Q ()
|
|
894 | +putQ x = Q (qPutQ x)
|
|
895 | + |
|
896 | +-- | Determine whether the given language extension is enabled in the 'Q' monad.
|
|
897 | +isExtEnabled :: Extension -> Q Bool
|
|
898 | +isExtEnabled ext = Q (qIsExtEnabled ext)
|
|
899 | + |
|
900 | +-- | List all enabled language extensions.
|
|
901 | +extsEnabled :: Q [Extension]
|
|
902 | +extsEnabled = Q qExtsEnabled
|
|
903 | + |
|
904 | +-- | Add Haddock documentation to the specified location. This will overwrite
|
|
905 | +-- any documentation at the location if it already exists. This will reify the
|
|
906 | +-- specified name, so it must be in scope when you call it. If you want to add
|
|
907 | +-- documentation to something that you are currently splicing, you can use
|
|
908 | +-- 'addModFinalizer' e.g.
|
|
909 | +--
|
|
910 | +-- > do
|
|
911 | +-- > let nm = mkName "x"
|
|
912 | +-- > addModFinalizer $ putDoc (DeclDoc nm) "Hello"
|
|
913 | +-- > [d| $(varP nm) = 42 |]
|
|
914 | +--
|
|
915 | +-- The helper functions 'withDecDoc' and 'withDecsDoc' will do this for you, as
|
|
916 | +-- will the 'funD_doc' and other @_doc@ combinators.
|
|
917 | +-- You most likely want to have the @-haddock@ flag turned on when using this.
|
|
918 | +-- Adding documentation to anything outside of the current module will cause an
|
|
919 | +-- error.
|
|
920 | +putDoc :: DocLoc -> String -> Q ()
|
|
921 | +putDoc t s = Q (qPutDoc t s)
|
|
922 | + |
|
923 | +-- | Retrieves the Haddock documentation at the specified location, if one
|
|
924 | +-- exists.
|
|
925 | +-- It can be used to read documentation on things defined outside of the current
|
|
926 | +-- module, provided that those modules were compiled with the @-haddock@ flag.
|
|
927 | +getDoc :: DocLoc -> Q (Maybe String)
|
|
928 | +getDoc n = Q (qGetDoc n)
|
|
929 | + |
|
930 | +instance MonadIO Q where
|
|
931 | + liftIO = runIO
|
|
932 | + |
|
933 | +instance Quasi Q where
|
|
934 | + qNewName = newName
|
|
935 | + qReport = report
|
|
936 | + qRecover = recover
|
|
937 | + qReify = reify
|
|
938 | + qReifyFixity = reifyFixity
|
|
939 | + qReifyType = reifyType
|
|
940 | + qReifyInstances = reifyInstances
|
|
941 | + qReifyRoles = reifyRoles
|
|
942 | + qReifyAnnotations = reifyAnnotations
|
|
943 | + qReifyModule = reifyModule
|
|
944 | + qReifyConStrictness = reifyConStrictness
|
|
945 | + qLookupName = lookupName
|
|
946 | + qLocation = location
|
|
947 | + qGetPackageRoot = getPackageRoot
|
|
948 | + qAddDependentFile = addDependentFile
|
|
949 | + qAddTempFile = addTempFile
|
|
950 | + qAddTopDecls = addTopDecls
|
|
951 | + qAddForeignFilePath = addForeignFilePath
|
|
952 | + qAddModFinalizer = addModFinalizer
|
|
953 | + qAddCorePlugin = addCorePlugin
|
|
954 | + qGetQ = getQ
|
|
955 | + qPutQ = putQ
|
|
956 | + qIsExtEnabled = isExtEnabled
|
|
957 | + qExtsEnabled = extsEnabled
|
|
958 | + qPutDoc = putDoc
|
|
959 | + qGetDoc = getDoc
|
|
960 | + |
|
961 | + |
|
962 | +----------------------------------------------------
|
|
963 | +-- The following operations are used solely in GHC.HsToCore.Quote when
|
|
964 | +-- desugaring brackets. They are not necessary for the user, who can use
|
|
965 | +-- ordinary return and (>>=) etc
|
|
966 | + |
|
967 | +-- | This function is only used in 'GHC.HsToCore.Quote' when desugaring
|
|
968 | +-- brackets. This is not necessary for the user, who can use the ordinary
|
|
969 | +-- 'return' and '(>>=)' operations.
|
|
970 | +sequenceQ :: forall m . Monad m => forall a . [m a] -> m [a]
|
|
971 | +sequenceQ = sequence |
... | ... | @@ -20,6 +20,7 @@ module GHC.Internal.TH.Quote( |
20 | 20 | ) where
|
21 | 21 | |
22 | 22 | import GHC.Internal.TH.Syntax
|
23 | +import GHC.Internal.TH.Monad
|
|
23 | 24 | import GHC.Internal.Base hiding (Type)
|
24 | 25 | |
25 | 26 |
1 | 1 | {-# OPTIONS_HADDOCK not-home #-} -- we want users to import Language.Haskell.TH.Syntax instead
|
2 | -{-# LANGUAGE CPP, DeriveDataTypeable,
|
|
3 | - DeriveGeneric, FlexibleInstances, DefaultSignatures,
|
|
4 | - RankNTypes, RoleAnnotations, ScopedTypeVariables,
|
|
5 | - MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds,
|
|
6 | - GADTs, UnboxedTuples, UnboxedSums, TypeOperators,
|
|
7 | - Trustworthy, DeriveFunctor, DeriveTraversable,
|
|
8 | - BangPatterns, RecordWildCards, ImplicitParams #-}
|
|
9 | - |
|
10 | -{-# LANGUAGE TemplateHaskellQuotes #-}
|
|
11 | -{-# LANGUAGE StandaloneKindSignatures #-}
|
|
2 | +{-# LANGUAGE CPP #-}
|
|
3 | +{-# LANGUAGE DataKinds #-}
|
|
4 | +{-# LANGUAGE DeriveGeneric #-}
|
|
5 | +{-# LANGUAGE DeriveTraversable #-}
|
|
6 | +{-# LANGUAGE FlexibleInstances #-}
|
|
7 | +{-# LANGUAGE GADTs #-}
|
|
8 | +{-# LANGUAGE PolyKinds #-}
|
|
9 | +{-# LANGUAGE RankNTypes #-}
|
|
10 | +{-# LANGUAGE RoleAnnotations #-}
|
|
11 | +{-# LANGUAGE ScopedTypeVariables #-}
|
|
12 | +#ifdef BOOTSTRAP_TH
|
|
13 | +{-# LANGUAGE Trustworthy #-}
|
|
14 | +#else
|
|
15 | +{-# LANGUAGE Safe #-}
|
|
16 | +#endif
|
|
17 | +{-# LANGUAGE UnboxedTuples #-}
|
|
12 | 18 | |
13 | 19 | -- | This module is used internally in GHC's integration with Template Haskell
|
14 | 20 | -- and defines the abstract syntax of Template Haskell.
|
... | ... | @@ -26,971 +32,37 @@ module GHC.Internal.TH.Syntax |
26 | 32 | |
27 | 33 | #ifdef BOOTSTRAP_TH
|
28 | 34 | import Prelude
|
29 | -import Data.Data hiding (Fixity(..))
|
|
30 | -import Data.IORef
|
|
31 | 35 | import System.IO.Unsafe ( unsafePerformIO )
|
32 | -import Control.Monad.IO.Class (MonadIO (..))
|
|
33 | -import Control.Monad.Fix (MonadFix (..))
|
|
34 | -import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO)
|
|
35 | -import Control.Exception.Base (FixIOException (..))
|
|
36 | -import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar)
|
|
37 | -import System.IO ( hPutStrLn, stderr )
|
|
38 | 36 | import Data.Char ( isAlpha, isAlphaNum, isUpper )
|
39 | 37 | import Data.List.NonEmpty ( NonEmpty(..) )
|
40 | 38 | import Data.Word
|
41 | -import qualified Data.Kind as Kind (Type)
|
|
42 | 39 | import Foreign.ForeignPtr
|
43 | 40 | import Foreign.C.String
|
44 | 41 | import Foreign.C.Types
|
45 | -import GHC.IO.Unsafe ( unsafeDupableInterleaveIO )
|
|
46 | 42 | import GHC.Ptr ( Ptr, plusPtr )
|
47 | 43 | import GHC.Generics ( Generic )
|
48 | -import GHC.Types (TYPE, RuntimeRep(..))
|
|
49 | 44 | #else
|
50 | 45 | import GHC.Internal.Base hiding (NonEmpty(..),Type, Module, sequence)
|
51 | -import GHC.Internal.Data.Data hiding (Fixity(..))
|
|
52 | 46 | import GHC.Internal.Data.NonEmpty (NonEmpty(..))
|
53 | 47 | import GHC.Internal.Data.Traversable
|
54 | 48 | import GHC.Internal.Word
|
55 | 49 | import GHC.Internal.Generics (Generic)
|
56 | -import GHC.Internal.IORef
|
|
57 | -import GHC.Internal.System.IO
|
|
58 | 50 | import GHC.Internal.Show
|
59 | 51 | import GHC.Internal.Integer
|
60 | 52 | import GHC.Internal.Real
|
61 | 53 | import GHC.Internal.Data.Foldable
|
62 | 54 | import GHC.Internal.Foreign.Ptr
|
63 | 55 | import GHC.Internal.ForeignPtr
|
64 | -import GHC.Internal.Data.Typeable
|
|
65 | -import GHC.Internal.Control.Monad.IO.Class
|
|
66 | 56 | import GHC.Internal.Foreign.C.Types
|
67 | 57 | import GHC.Internal.Foreign.C.String
|
68 | -import GHC.Internal.Control.Monad.Fail
|
|
69 | -import GHC.Internal.Control.Monad.Fix
|
|
70 | -import GHC.Internal.Control.Exception
|
|
71 | 58 | import GHC.Internal.Num
|
72 | 59 | import GHC.Internal.IO.Unsafe
|
73 | 60 | import GHC.Internal.List (dropWhile, break, replicate, reverse, last)
|
74 | -import GHC.Internal.MVar
|
|
75 | -import GHC.Internal.IO.Exception
|
|
76 | 61 | import GHC.Internal.Unicode
|
77 | -import qualified GHC.Internal.Types as Kind (Type)
|
|
78 | 62 | #endif
|
79 | 63 | import GHC.Internal.ForeignSrcLang
|
80 | 64 | import GHC.Internal.LanguageExtensions
|
81 | 65 | |
82 | ------------------------------------------------------
|
|
83 | ---
|
|
84 | --- The Quasi class
|
|
85 | ---
|
|
86 | ------------------------------------------------------
|
|
87 | - |
|
88 | -class (MonadIO m, MonadFail m) => Quasi m where
|
|
89 | - -- | Fresh names. See 'newName'.
|
|
90 | - qNewName :: String -> m Name
|
|
91 | - |
|
92 | - ------- Error reporting and recovery -------
|
|
93 | - -- | Report an error (True) or warning (False)
|
|
94 | - -- ...but carry on; use 'fail' to stop. See 'report'.
|
|
95 | - qReport :: Bool -> String -> m ()
|
|
96 | - |
|
97 | - -- | See 'recover'.
|
|
98 | - qRecover :: m a -- ^ the error handler
|
|
99 | - -> m a -- ^ action which may fail
|
|
100 | - -> m a -- ^ Recover from the monadic 'fail'
|
|
101 | - |
|
102 | - ------- Inspect the type-checker's environment -------
|
|
103 | - -- | True <=> type namespace, False <=> value namespace. See 'lookupName'.
|
|
104 | - qLookupName :: Bool -> String -> m (Maybe Name)
|
|
105 | - -- | See 'reify'.
|
|
106 | - qReify :: Name -> m Info
|
|
107 | - -- | See 'reifyFixity'.
|
|
108 | - qReifyFixity :: Name -> m (Maybe Fixity)
|
|
109 | - -- | See 'reifyType'.
|
|
110 | - qReifyType :: Name -> m Type
|
|
111 | - -- | Is (n tys) an instance? Returns list of matching instance Decs (with
|
|
112 | - -- empty sub-Decs) Works for classes and type functions. See 'reifyInstances'.
|
|
113 | - qReifyInstances :: Name -> [Type] -> m [Dec]
|
|
114 | - -- | See 'reifyRoles'.
|
|
115 | - qReifyRoles :: Name -> m [Role]
|
|
116 | - -- | See 'reifyAnnotations'.
|
|
117 | - qReifyAnnotations :: Data a => AnnLookup -> m [a]
|
|
118 | - -- | See 'reifyModule'.
|
|
119 | - qReifyModule :: Module -> m ModuleInfo
|
|
120 | - -- | See 'reifyConStrictness'.
|
|
121 | - qReifyConStrictness :: Name -> m [DecidedStrictness]
|
|
122 | - |
|
123 | - -- | See 'location'.
|
|
124 | - qLocation :: m Loc
|
|
125 | - |
|
126 | - -- | Input/output (dangerous). See 'runIO'.
|
|
127 | - qRunIO :: IO a -> m a
|
|
128 | - qRunIO = liftIO
|
|
129 | - -- | See 'getPackageRoot'.
|
|
130 | - qGetPackageRoot :: m FilePath
|
|
131 | - |
|
132 | - -- | See 'addDependentFile'.
|
|
133 | - qAddDependentFile :: FilePath -> m ()
|
|
134 | - |
|
135 | - -- | See 'addTempFile'.
|
|
136 | - qAddTempFile :: String -> m FilePath
|
|
137 | - |
|
138 | - -- | See 'addTopDecls'.
|
|
139 | - qAddTopDecls :: [Dec] -> m ()
|
|
140 | - |
|
141 | - -- | See 'addForeignFilePath'.
|
|
142 | - qAddForeignFilePath :: ForeignSrcLang -> String -> m ()
|
|
143 | - |
|
144 | - -- | See 'addModFinalizer'.
|
|
145 | - qAddModFinalizer :: Q () -> m ()
|
|
146 | - |
|
147 | - -- | See 'addCorePlugin'.
|
|
148 | - qAddCorePlugin :: String -> m ()
|
|
149 | - |
|
150 | - -- | See 'getQ'.
|
|
151 | - qGetQ :: Typeable a => m (Maybe a)
|
|
152 | - |
|
153 | - -- | See 'putQ'.
|
|
154 | - qPutQ :: Typeable a => a -> m ()
|
|
155 | - |
|
156 | - -- | See 'isExtEnabled'.
|
|
157 | - qIsExtEnabled :: Extension -> m Bool
|
|
158 | - -- | See 'extsEnabled'.
|
|
159 | - qExtsEnabled :: m [Extension]
|
|
160 | - |
|
161 | - -- | See 'putDoc'.
|
|
162 | - qPutDoc :: DocLoc -> String -> m ()
|
|
163 | - -- | See 'getDoc'.
|
|
164 | - qGetDoc :: DocLoc -> m (Maybe String)
|
|
165 | - |
|
166 | ------------------------------------------------------
|
|
167 | --- The IO instance of Quasi
|
|
168 | ------------------------------------------------------
|
|
169 | - |
|
170 | --- | This instance is used only when running a Q
|
|
171 | --- computation in the IO monad, usually just to
|
|
172 | --- print the result. There is no interesting
|
|
173 | --- type environment, so reification isn't going to
|
|
174 | --- work.
|
|
175 | -instance Quasi IO where
|
|
176 | - qNewName = newNameIO
|
|
177 | - |
|
178 | - qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
|
|
179 | - qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
|
|
180 | - |
|
181 | - qLookupName _ _ = badIO "lookupName"
|
|
182 | - qReify _ = badIO "reify"
|
|
183 | - qReifyFixity _ = badIO "reifyFixity"
|
|
184 | - qReifyType _ = badIO "reifyFixity"
|
|
185 | - qReifyInstances _ _ = badIO "reifyInstances"
|
|
186 | - qReifyRoles _ = badIO "reifyRoles"
|
|
187 | - qReifyAnnotations _ = badIO "reifyAnnotations"
|
|
188 | - qReifyModule _ = badIO "reifyModule"
|
|
189 | - qReifyConStrictness _ = badIO "reifyConStrictness"
|
|
190 | - qLocation = badIO "currentLocation"
|
|
191 | - qRecover _ _ = badIO "recover" -- Maybe we could fix this?
|
|
192 | - qGetPackageRoot = badIO "getProjectRoot"
|
|
193 | - qAddDependentFile _ = badIO "addDependentFile"
|
|
194 | - qAddTempFile _ = badIO "addTempFile"
|
|
195 | - qAddTopDecls _ = badIO "addTopDecls"
|
|
196 | - qAddForeignFilePath _ _ = badIO "addForeignFilePath"
|
|
197 | - qAddModFinalizer _ = badIO "addModFinalizer"
|
|
198 | - qAddCorePlugin _ = badIO "addCorePlugin"
|
|
199 | - qGetQ = badIO "getQ"
|
|
200 | - qPutQ _ = badIO "putQ"
|
|
201 | - qIsExtEnabled _ = badIO "isExtEnabled"
|
|
202 | - qExtsEnabled = badIO "extsEnabled"
|
|
203 | - qPutDoc _ _ = badIO "putDoc"
|
|
204 | - qGetDoc _ = badIO "getDoc"
|
|
205 | - |
|
206 | -instance Quote IO where
|
|
207 | - newName = newNameIO
|
|
208 | - |
|
209 | -newNameIO :: String -> IO Name
|
|
210 | -newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))
|
|
211 | - ; pure (mkNameU s n) }
|
|
212 | - |
|
213 | -badIO :: String -> IO a
|
|
214 | -badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
|
|
215 | - ; fail "Template Haskell failure" }
|
|
216 | - |
|
217 | --- Global variable to generate unique symbols
|
|
218 | -counter :: IORef Uniq
|
|
219 | -{-# NOINLINE counter #-}
|
|
220 | -counter = unsafePerformIO (newIORef 0)
|
|
221 | - |
|
222 | - |
|
223 | ------------------------------------------------------
|
|
224 | ---
|
|
225 | --- The Q monad
|
|
226 | ---
|
|
227 | ------------------------------------------------------
|
|
228 | - |
|
229 | --- | In short, 'Q' provides the 'Quasi' operations in one neat monad for the
|
|
230 | --- user.
|
|
231 | ---
|
|
232 | --- The longer story, is that 'Q' wraps an arbitrary 'Quasi'-able monad.
|
|
233 | --- The perceptive reader notices that 'Quasi' has only two instances, 'Q'
|
|
234 | --- itself and 'IO', neither of which have concrete implementations.'Q' plays
|
|
235 | --- the trick of [dependency
|
|
236 | --- inversion](https://en.wikipedia.org/wiki/Dependency_inversion_principle),
|
|
237 | --- providing an abstract interface for the user which is later concretely
|
|
238 | --- fufilled by an concrete 'Quasi' instance, internal to GHC.
|
|
239 | -newtype Q a = Q { unQ :: forall m. Quasi m => m a }
|
|
240 | - |
|
241 | --- | \"Runs\" the 'Q' monad. Normal users of Template Haskell
|
|
242 | --- should not need this function, as the splice brackets @$( ... )@
|
|
243 | --- are the usual way of running a 'Q' computation.
|
|
244 | ---
|
|
245 | --- This function is primarily used in GHC internals, and for debugging
|
|
246 | --- splices by running them in 'IO'.
|
|
247 | ---
|
|
248 | --- Note that many functions in 'Q', such as 'reify' and other compiler
|
|
249 | --- queries, are not supported when running 'Q' in 'IO'; these operations
|
|
250 | --- simply fail at runtime. Indeed, the only operations guaranteed to succeed
|
|
251 | --- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
|
|
252 | -runQ :: Quasi m => Q a -> m a
|
|
253 | -runQ (Q m) = m
|
|
254 | - |
|
255 | -instance Monad Q where
|
|
256 | - Q m >>= k = Q (m >>= \x -> unQ (k x))
|
|
257 | - (>>) = (*>)
|
|
258 | - |
|
259 | -instance MonadFail Q where
|
|
260 | - fail s = report True s >> Q (fail "Q monad failure")
|
|
261 | - |
|
262 | -instance Functor Q where
|
|
263 | - fmap f (Q x) = Q (fmap f x)
|
|
264 | - |
|
265 | -instance Applicative Q where
|
|
266 | - pure x = Q (pure x)
|
|
267 | - Q f <*> Q x = Q (f <*> x)
|
|
268 | - Q m *> Q n = Q (m *> n)
|
|
269 | - |
|
270 | --- | @since 2.17.0.0
|
|
271 | -instance Semigroup a => Semigroup (Q a) where
|
|
272 | - (<>) = liftA2 (<>)
|
|
273 | - |
|
274 | --- | @since 2.17.0.0
|
|
275 | -instance Monoid a => Monoid (Q a) where
|
|
276 | - mempty = pure mempty
|
|
277 | - |
|
278 | --- | If the function passed to 'mfix' inspects its argument,
|
|
279 | --- the resulting action will throw a 'FixIOException'.
|
|
280 | ---
|
|
281 | --- @since 2.17.0.0
|
|
282 | -instance MonadFix Q where
|
|
283 | - -- We use the same blackholing approach as in fixIO.
|
|
284 | - -- See Note [Blackholing in fixIO] in System.IO in base.
|
|
285 | - mfix k = do
|
|
286 | - m <- runIO newEmptyMVar
|
|
287 | - ans <- runIO (unsafeDupableInterleaveIO
|
|
288 | - (readMVar m `catch` \BlockedIndefinitelyOnMVar ->
|
|
289 | - throwIO FixIOException))
|
|
290 | - result <- k ans
|
|
291 | - runIO (putMVar m result)
|
|
292 | - return result
|
|
293 | - |
|
294 | - |
|
295 | ------------------------------------------------------
|
|
296 | ---
|
|
297 | --- The Quote class
|
|
298 | ---
|
|
299 | ------------------------------------------------------
|
|
300 | - |
|
301 | - |
|
302 | - |
|
303 | --- | The 'Quote' class implements the minimal interface which is necessary for
|
|
304 | --- desugaring quotations.
|
|
305 | ---
|
|
306 | --- * The @Monad m@ superclass is needed to stitch together the different
|
|
307 | --- AST fragments.
|
|
308 | --- * 'newName' is used when desugaring binding structures such as lambdas
|
|
309 | --- to generate fresh names.
|
|
310 | ---
|
|
311 | --- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp`
|
|
312 | ---
|
|
313 | --- For many years the type of a quotation was fixed to be `Q Exp` but by
|
|
314 | --- more precisely specifying the minimal interface it enables the `Exp` to
|
|
315 | --- be extracted purely from the quotation without interacting with `Q`.
|
|
316 | -class Monad m => Quote m where
|
|
317 | - {- |
|
|
318 | - Generate a fresh name, which cannot be captured.
|
|
319 | - |
|
320 | - For example, this:
|
|
321 | - |
|
322 | - @f = $(do
|
|
323 | - nm1 <- newName \"x\"
|
|
324 | - let nm2 = 'mkName' \"x\"
|
|
325 | - return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
|
|
326 | - )@
|
|
327 | - |
|
328 | - will produce the splice
|
|
329 | - |
|
330 | - >f = \x0 -> \x -> x0
|
|
331 | - |
|
332 | - In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
|
|
333 | - and is not captured by the binding @VarP nm2@.
|
|
334 | - |
|
335 | - Although names generated by @newName@ cannot /be captured/, they can
|
|
336 | - /capture/ other names. For example, this:
|
|
337 | - |
|
338 | - >g = $(do
|
|
339 | - > nm1 <- newName "x"
|
|
340 | - > let nm2 = mkName "x"
|
|
341 | - > return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
|
|
342 | - > )
|
|
343 | - |
|
344 | - will produce the splice
|
|
345 | - |
|
346 | - >g = \x -> \x0 -> x0
|
|
347 | - |
|
348 | - since the occurrence @VarE nm2@ is captured by the innermost binding
|
|
349 | - of @x@, namely @VarP nm1@.
|
|
350 | - -}
|
|
351 | - newName :: String -> m Name
|
|
352 | - |
|
353 | -instance Quote Q where
|
|
354 | - newName s = Q (qNewName s)
|
|
355 | - |
|
356 | ------------------------------------------------------
|
|
357 | ---
|
|
358 | --- The TExp type
|
|
359 | ---
|
|
360 | ------------------------------------------------------
|
|
361 | - |
|
362 | -type TExp :: TYPE r -> Kind.Type
|
|
363 | -type role TExp nominal -- See Note [Role of TExp]
|
|
364 | -newtype TExp a = TExp
|
|
365 | - { unType :: Exp -- ^ Underlying untyped Template Haskell expression
|
|
366 | - }
|
|
367 | --- ^ Typed wrapper around an 'Exp'.
|
|
368 | ---
|
|
369 | --- This is the typed representation of terms produced by typed quotes.
|
|
370 | ---
|
|
371 | --- Representation-polymorphic since /template-haskell-2.16.0.0/.
|
|
372 | - |
|
373 | --- | Discard the type annotation and produce a plain Template Haskell
|
|
374 | --- expression
|
|
375 | ---
|
|
376 | --- Representation-polymorphic since /template-haskell-2.16.0.0/.
|
|
377 | -unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp
|
|
378 | -unTypeQ m = do { TExp e <- m
|
|
379 | - ; return e }
|
|
380 | - |
|
381 | --- | Annotate the Template Haskell expression with a type
|
|
382 | ---
|
|
383 | --- This is unsafe because GHC cannot check for you that the expression
|
|
384 | --- really does have the type you claim it has.
|
|
385 | ---
|
|
386 | --- Representation-polymorphic since /template-haskell-2.16.0.0/.
|
|
387 | -unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
|
|
388 | - Quote m => m Exp -> m (TExp a)
|
|
389 | -unsafeTExpCoerce m = do { e <- m
|
|
390 | - ; return (TExp e) }
|
|
391 | - |
|
392 | -{- Note [Role of TExp]
|
|
393 | -~~~~~~~~~~~~~~~~~~~~~~
|
|
394 | -TExp's argument must have a nominal role, not phantom as would
|
|
395 | -be inferred (#8459). Consider
|
|
396 | - |
|
397 | - e :: Code Q Age
|
|
398 | - e = [|| MkAge 3 ||]
|
|
399 | - |
|
400 | - foo = $(coerce e) + 4::Int
|
|
401 | - |
|
402 | -The splice will evaluate to (MkAge 3) and you can't add that to
|
|
403 | -4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -}
|
|
404 | - |
|
405 | --- Code constructor
|
|
406 | -#if __GLASGOW_HASKELL__ >= 909
|
|
407 | -type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type
|
|
408 | - -- See Note [Foralls to the right in Code]
|
|
409 | -#else
|
|
410 | -type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
|
|
411 | -#endif
|
|
412 | -type role Code representational nominal -- See Note [Role of TExp]
|
|
413 | -newtype Code m a = Code
|
|
414 | - { examineCode :: m (TExp a) -- ^ Underlying monadic value
|
|
415 | - }
|
|
416 | --- ^ Represents an expression which has type @a@, built in monadic context @m@. Built on top of 'TExp', typed
|
|
417 | --- expressions allow for type-safe splicing via:
|
|
418 | ---
|
|
419 | --- - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if
|
|
420 | --- that expression has type @a@, then the quotation has type
|
|
421 | --- @Quote m => Code m a@
|
|
422 | ---
|
|
423 | --- - typed splices inside of typed quotes, written as @$$(...)@ where @...@
|
|
424 | --- is an arbitrary expression of type @Quote m => Code m a@
|
|
425 | ---
|
|
426 | --- Traditional expression quotes and splices let us construct ill-typed
|
|
427 | --- expressions:
|
|
428 | ---
|
|
429 | --- >>> fmap ppr $ runQ (unTypeCode [| True == $( [| "foo" |] ) |])
|
|
430 | --- GHC.Internal.Types.True GHC.Internal.Classes.== "foo"
|
|
431 | --- >>> GHC.Internal.Types.True GHC.Internal.Classes.== "foo"
|
|
432 | --- <interactive> error:
|
|
433 | --- • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
|
|
434 | --- • In the second argument of ‘(==)’, namely ‘"foo"’
|
|
435 | --- In the expression: True == "foo"
|
|
436 | --- In an equation for ‘it’: it = True == "foo"
|
|
437 | ---
|
|
438 | --- With typed expressions, the type error occurs when /constructing/ the
|
|
439 | --- Template Haskell expression:
|
|
440 | ---
|
|
441 | --- >>> fmap ppr $ runQ (unTypeCode [|| True == $$( [|| "foo" ||] ) ||])
|
|
442 | --- <interactive> error:
|
|
443 | --- • Couldn't match type ‘[Char]’ with ‘Bool’
|
|
444 | --- Expected type: Code Q Bool
|
|
445 | --- Actual type: Code Q [Char]
|
|
446 | --- • In the Template Haskell quotation [|| "foo" ||]
|
|
447 | --- In the expression: [|| "foo" ||]
|
|
448 | --- In the Template Haskell splice $$([|| "foo" ||])
|
|
449 | - |
|
450 | - |
|
451 | -{- Note [Foralls to the right in Code]
|
|
452 | -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
453 | -Code has the following type signature:
|
|
454 | - type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type
|
|
455 | - |
|
456 | -This allows us to write
|
|
457 | - data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#)
|
|
458 | - |
|
459 | - tcodeq :: T (Code Q)
|
|
460 | - tcodeq = MkT [||5||] [||5#||]
|
|
461 | - |
|
462 | -If we used the slightly more straightforward signature
|
|
463 | - type Code :: foral r. (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type
|
|
464 | - |
|
465 | -then the example above would become ill-typed. (See #23592 for some discussion.)
|
|
466 | --}
|
|
467 | - |
|
468 | --- | Unsafely convert an untyped code representation into a typed code
|
|
469 | --- representation.
|
|
470 | -unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
|
|
471 | - Quote m => m Exp -> Code m a
|
|
472 | -unsafeCodeCoerce m = Code (unsafeTExpCoerce m)
|
|
473 | - |
|
474 | --- | Lift a monadic action producing code into the typed 'Code'
|
|
475 | --- representation
|
|
476 | -liftCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . m (TExp a) -> Code m a
|
|
477 | -liftCode = Code
|
|
478 | - |
|
479 | --- | Extract the untyped representation from the typed representation
|
|
480 | -unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m
|
|
481 | - => Code m a -> m Exp
|
|
482 | -unTypeCode = unTypeQ . examineCode
|
|
483 | - |
|
484 | --- | Modify the ambient monad used during code generation. For example, you
|
|
485 | --- can use `hoistCode` to handle a state effect:
|
|
486 | --- @
|
|
487 | --- handleState :: Code (StateT Int Q) a -> Code Q a
|
|
488 | --- handleState = hoistCode (flip runState 0)
|
|
489 | --- @
|
|
490 | -hoistCode :: forall m n (r :: RuntimeRep) (a :: TYPE r) . Monad m
|
|
491 | - => (forall x . m x -> n x) -> Code m a -> Code n a
|
|
492 | -hoistCode f (Code a) = Code (f a)
|
|
493 | - |
|
494 | - |
|
495 | --- | Variant of '(>>=)' which allows effectful computations to be injected
|
|
496 | --- into code generation.
|
|
497 | -bindCode :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
|
|
498 | - => m a -> (a -> Code m b) -> Code m b
|
|
499 | -bindCode q k = liftCode (q >>= examineCode . k)
|
|
500 | - |
|
501 | --- | Variant of '(>>)' which allows effectful computations to be injected
|
|
502 | --- into code generation.
|
|
503 | -bindCode_ :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m
|
|
504 | - => m a -> Code m b -> Code m b
|
|
505 | -bindCode_ q c = liftCode ( q >> examineCode c)
|
|
506 | - |
|
507 | --- | A useful combinator for embedding monadic actions into 'Code'
|
|
508 | --- @
|
|
509 | --- myCode :: ... => Code m a
|
|
510 | --- myCode = joinCode $ do
|
|
511 | --- x <- someSideEffect
|
|
512 | --- return (makeCodeWith x)
|
|
513 | --- @
|
|
514 | -joinCode :: forall m (r :: RuntimeRep) (a :: TYPE r) . Monad m
|
|
515 | - => m (Code m a) -> Code m a
|
|
516 | -joinCode = flip bindCode id
|
|
517 | - |
|
518 | -----------------------------------------------------
|
|
519 | --- Packaged versions for the programmer, hiding the Quasi-ness
|
|
520 | - |
|
521 | - |
|
522 | --- | Report an error (True) or warning (False),
|
|
523 | --- but carry on; use 'fail' to stop.
|
|
524 | -report :: Bool -> String -> Q ()
|
|
525 | -report b s = Q (qReport b s)
|
|
526 | -{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6
|
|
527 | - |
|
528 | --- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.
|
|
529 | -reportError :: String -> Q ()
|
|
530 | -reportError = report True
|
|
531 | - |
|
532 | --- | Report a warning to the user, and carry on.
|
|
533 | -reportWarning :: String -> Q ()
|
|
534 | -reportWarning = report False
|
|
535 | - |
|
536 | --- | Recover from errors raised by 'reportError' or 'fail'.
|
|
537 | -recover :: Q a -- ^ handler to invoke on failure
|
|
538 | - -> Q a -- ^ computation to run
|
|
539 | - -> Q a
|
|
540 | -recover (Q r) (Q m) = Q (qRecover r m)
|
|
541 | - |
|
542 | --- We don't export lookupName; the Bool isn't a great API
|
|
543 | --- Instead we export lookupTypeName, lookupValueName
|
|
544 | -lookupName :: Bool -> String -> Q (Maybe Name)
|
|
545 | -lookupName ns s = Q (qLookupName ns s)
|
|
546 | - |
|
547 | --- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
|
|
548 | -lookupTypeName :: String -> Q (Maybe Name)
|
|
549 | -lookupTypeName s = Q (qLookupName True s)
|
|
550 | - |
|
551 | --- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
|
|
552 | -lookupValueName :: String -> Q (Maybe Name)
|
|
553 | -lookupValueName s = Q (qLookupName False s)
|
|
554 | - |
|
555 | -{-
|
|
556 | -Note [Name lookup]
|
|
557 | -~~~~~~~~~~~~~~~~~~
|
|
558 | --}
|
|
559 | -{- $namelookup #namelookup#
|
|
560 | -The functions 'lookupTypeName' and 'lookupValueName' provide
|
|
561 | -a way to query the current splice's context for what names
|
|
562 | -are in scope. The function 'lookupTypeName' queries the type
|
|
563 | -namespace, whereas 'lookupValueName' queries the value namespace,
|
|
564 | -but the functions are otherwise identical.
|
|
565 | - |
|
566 | -A call @lookupValueName s@ will check if there is a value
|
|
567 | -with name @s@ in scope at the current splice's location. If
|
|
568 | -there is, the @Name@ of this value is returned;
|
|
569 | -if not, then @Nothing@ is returned.
|
|
570 | - |
|
571 | -The returned name cannot be \"captured\".
|
|
572 | -For example:
|
|
573 | - |
|
574 | -> f = "global"
|
|
575 | -> g = $( do
|
|
576 | -> Just nm <- lookupValueName "f"
|
|
577 | -> [| let f = "local" in $( varE nm ) |]
|
|
578 | - |
|
579 | -In this case, @g = \"global\"@; the call to @lookupValueName@
|
|
580 | -returned the global @f@, and this name was /not/ captured by
|
|
581 | -the local definition of @f@.
|
|
582 | - |
|
583 | -The lookup is performed in the context of the /top-level/ splice
|
|
584 | -being run. For example:
|
|
585 | - |
|
586 | -> f = "global"
|
|
587 | -> g = $( [| let f = "local" in
|
|
588 | -> $(do
|
|
589 | -> Just nm <- lookupValueName "f"
|
|
590 | -> varE nm
|
|
591 | -> ) |] )
|
|
592 | - |
|
593 | -Again in this example, @g = \"global\"@, because the call to
|
|
594 | -@lookupValueName@ queries the context of the outer-most @$(...)@.
|
|
595 | - |
|
596 | -Operators should be queried without any surrounding parentheses, like so:
|
|
597 | - |
|
598 | -> lookupValueName "+"
|
|
599 | - |
|
600 | -Qualified names are also supported, like so:
|
|
601 | - |
|
602 | -> lookupValueName "Prelude.+"
|
|
603 | -> lookupValueName "Prelude.map"
|
|
604 | - |
|
605 | --}
|
|
606 | - |
|
607 | - |
|
608 | -{- | 'reify' looks up information about the 'Name'. It will fail with
|
|
609 | -a compile error if the 'Name' is not visible. A 'Name' is visible if it is
|
|
610 | -imported or defined in a prior top-level declaration group. See the
|
|
611 | -documentation for 'newDeclarationGroup' for more details.
|
|
612 | - |
|
613 | -It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'
|
|
614 | -to ensure that we are reifying from the right namespace. For instance, in this context:
|
|
615 | - |
|
616 | -> data D = D
|
|
617 | - |
|
618 | -which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)
|
|
619 | -To ensure we get information about @D@-the-value, use 'lookupValueName':
|
|
620 | - |
|
621 | -> do
|
|
622 | -> Just nm <- lookupValueName "D"
|
|
623 | -> reify nm
|
|
624 | - |
|
625 | -and to get information about @D@-the-type, use 'lookupTypeName'.
|
|
626 | --}
|
|
627 | -reify :: Name -> Q Info
|
|
628 | -reify v = Q (qReify v)
|
|
629 | - |
|
630 | -{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For
|
|
631 | -example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then
|
|
632 | -@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function
|
|
633 | -@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns
|
|
634 | -'Nothing', so you may assume @bar@ has 'defaultFixity'.
|
|
635 | --}
|
|
636 | -reifyFixity :: Name -> Q (Maybe Fixity)
|
|
637 | -reifyFixity nm = Q (qReifyFixity nm)
|
|
638 | - |
|
639 | -{- | @reifyType nm@ attempts to find the type or kind of @nm@. For example,
|
|
640 | -@reifyType 'not@ returns @Bool -> Bool@, and
|
|
641 | -@reifyType ''Bool@ returns @Type@.
|
|
642 | -This works even if there's no explicit signature and the type or kind is inferred.
|
|
643 | --}
|
|
644 | -reifyType :: Name -> Q Type
|
|
645 | -reifyType nm = Q (qReifyType nm)
|
|
646 | - |
|
647 | -{- | Template Haskell is capable of reifying information about types and
|
|
648 | -terms defined in previous declaration groups. Top-level declaration splices break up
|
|
649 | -declaration groups.
|
|
650 | - |
|
651 | -For an example, consider this code block. We define a datatype @X@ and
|
|
652 | -then try to call 'reify' on the datatype.
|
|
653 | - |
|
654 | -@
|
|
655 | -module Check where
|
|
656 | - |
|
657 | -data X = X
|
|
658 | - deriving Eq
|
|
659 | - |
|
660 | -$(do
|
|
661 | - info <- reify ''X
|
|
662 | - runIO $ print info
|
|
663 | - )
|
|
664 | -@
|
|
665 | - |
|
666 | -This code fails to compile, noting that @X@ is not available for reification at the site of 'reify'. We can fix this by creating a new declaration group using an empty top-level splice:
|
|
667 | - |
|
668 | -@
|
|
669 | -data X = X
|
|
670 | - deriving Eq
|
|
671 | - |
|
672 | -$(pure [])
|
|
673 | - |
|
674 | -$(do
|
|
675 | - info <- reify ''X
|
|
676 | - runIO $ print info
|
|
677 | - )
|
|
678 | -@
|
|
679 | - |
|
680 | -We provide 'newDeclarationGroup' as a means of documenting this behavior
|
|
681 | -and providing a name for the pattern.
|
|
682 | - |
|
683 | -Since top level splices infer the presence of the @$( ... )@ brackets, we can also write:
|
|
684 | - |
|
685 | -@
|
|
686 | -data X = X
|
|
687 | - deriving Eq
|
|
688 | - |
|
689 | -newDeclarationGroup
|
|
690 | - |
|
691 | -$(do
|
|
692 | - info <- reify ''X
|
|
693 | - runIO $ print info
|
|
694 | - )
|
|
695 | -@
|
|
696 | - |
|
697 | --}
|
|
698 | -newDeclarationGroup :: Q [Dec]
|
|
699 | -newDeclarationGroup = pure []
|
|
700 | - |
|
701 | -{- | @reifyInstances nm tys@ returns a list of all visible instances (see below for "visible")
|
|
702 | -of @nm tys@. That is,
|
|
703 | -if @nm@ is the name of a type class, then all instances of this class at the types @tys@
|
|
704 | -are returned. Alternatively, if @nm@ is the name of a data family or type family,
|
|
705 | -all instances of this family at the types @tys@ are returned.
|
|
706 | - |
|
707 | -Note that this is a \"shallow\" test; the declarations returned merely have
|
|
708 | -instance heads which unify with @nm tys@, they need not actually be satisfiable.
|
|
709 | - |
|
710 | - - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains
|
|
711 | - the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and
|
|
712 | - @B@ themselves implement 'Eq'
|
|
713 | - |
|
714 | - - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available
|
|
715 | - instance of 'Show'
|
|
716 | - |
|
717 | -There is one edge case: @reifyInstances ''Typeable tys@ currently always
|
|
718 | -produces an empty list (no matter what @tys@ are given).
|
|
719 | - |
|
720 | -In principle, the *visible* instances are
|
|
721 | -* all instances defined in a prior top-level declaration group
|
|
722 | - (see docs on @newDeclarationGroup@), or
|
|
723 | -* all instances defined in any module transitively imported by the
|
|
724 | - module being compiled
|
|
725 | - |
|
726 | -However, actually searching all modules transitively below the one being
|
|
727 | -compiled is unreasonably expensive, so @reifyInstances@ will report only the
|
|
728 | -instance for modules that GHC has had some cause to visit during this
|
|
729 | -compilation. This is a shortcoming: @reifyInstances@ might fail to report
|
|
730 | -instances for a type that is otherwise unusued, or instances defined in a
|
|
731 | -different component. You can work around this shortcoming by explicitly importing the modules
|
|
732 | -whose instances you want to be visible. GHC issue <https://gitlab.haskell.org/ghc/ghc/-/issues/20529#note_388980 #20529>
|
|
733 | -has some discussion around this.
|
|
734 | - |
|
735 | --}
|
|
736 | -reifyInstances :: Name -> [Type] -> Q [InstanceDec]
|
|
737 | -reifyInstances cls tys = Q (qReifyInstances cls tys)
|
|
738 | - |
|
739 | -{- | @reifyRoles nm@ returns the list of roles associated with the parameters
|
|
740 | -(both visible and invisible) of
|
|
741 | -the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.
|
|
742 | -The returned list should never contain 'InferR'.
|
|
743 | - |
|
744 | -An invisible parameter to a tycon is often a kind parameter. For example, if
|
|
745 | -we have
|
|
746 | - |
|
747 | -@
|
|
748 | -type Proxy :: forall k. k -> Type
|
|
749 | -data Proxy a = MkProxy
|
|
750 | -@
|
|
751 | - |
|
752 | -and @reifyRoles Proxy@, we will get @['NominalR', 'PhantomR']@. The 'NominalR' is
|
|
753 | -the role of the invisible @k@ parameter. Kind parameters are always nominal.
|
|
754 | --}
|
|
755 | -reifyRoles :: Name -> Q [Role]
|
|
756 | -reifyRoles nm = Q (qReifyRoles nm)
|
|
757 | - |
|
758 | --- | @reifyAnnotations target@ returns the list of annotations
|
|
759 | --- associated with @target@. Only the annotations that are
|
|
760 | --- appropriately typed is returned. So if you have @Int@ and @String@
|
|
761 | --- annotations for the same target, you have to call this function twice.
|
|
762 | -reifyAnnotations :: Data a => AnnLookup -> Q [a]
|
|
763 | -reifyAnnotations an = Q (qReifyAnnotations an)
|
|
764 | - |
|
765 | --- | @reifyModule mod@ looks up information about module @mod@. To
|
|
766 | --- look up the current module, call this function with the return
|
|
767 | --- value of 'Language.Haskell.TH.Lib.thisModule'.
|
|
768 | -reifyModule :: Module -> Q ModuleInfo
|
|
769 | -reifyModule m = Q (qReifyModule m)
|
|
770 | - |
|
771 | --- | @reifyConStrictness nm@ looks up the strictness information for the fields
|
|
772 | --- of the constructor with the name @nm@. Note that the strictness information
|
|
773 | --- that 'reifyConStrictness' returns may not correspond to what is written in
|
|
774 | --- the source code. For example, in the following data declaration:
|
|
775 | ---
|
|
776 | --- @
|
|
777 | --- data Pair a = Pair a a
|
|
778 | --- @
|
|
779 | ---
|
|
780 | --- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most
|
|
781 | --- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the
|
|
782 | --- @-XStrictData@ language extension was enabled.
|
|
783 | -reifyConStrictness :: Name -> Q [DecidedStrictness]
|
|
784 | -reifyConStrictness n = Q (qReifyConStrictness n)
|
|
785 | - |
|
786 | --- | Is the list of instances returned by 'reifyInstances' nonempty?
|
|
787 | ---
|
|
788 | --- If you're confused by an instance not being visible despite being
|
|
789 | --- defined in the same module and above the splice in question, see the
|
|
790 | --- docs for 'newDeclarationGroup' for a possible explanation.
|
|
791 | -isInstance :: Name -> [Type] -> Q Bool
|
|
792 | -isInstance nm tys = do { decs <- reifyInstances nm tys
|
|
793 | - ; return (not (null decs)) }
|
|
794 | - |
|
795 | --- | The location at which this computation is spliced.
|
|
796 | -location :: Q Loc
|
|
797 | -location = Q qLocation
|
|
798 | - |
|
799 | --- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
|
|
800 | --- Take care: you are guaranteed the ordering of calls to 'runIO' within
|
|
801 | --- a single 'Q' computation, but not about the order in which splices are run.
|
|
802 | ---
|
|
803 | --- Note: for various murky reasons, stdout and stderr handles are not
|
|
804 | --- necessarily flushed when the compiler finishes running, so you should
|
|
805 | --- flush them yourself.
|
|
806 | -runIO :: IO a -> Q a
|
|
807 | -runIO m = Q (qRunIO m)
|
|
808 | - |
|
809 | --- | Get the package root for the current package which is being compiled.
|
|
810 | --- This can be set explicitly with the -package-root flag but is normally
|
|
811 | --- just the current working directory.
|
|
812 | ---
|
|
813 | --- The motivation for this flag is to provide a principled means to remove the
|
|
814 | --- assumption from splices that they will be executed in the directory where the
|
|
815 | --- cabal file resides. Projects such as haskell-language-server can't and don't
|
|
816 | --- change directory when compiling files but instead set the -package-root flag
|
|
817 | --- appropriately.
|
|
818 | -getPackageRoot :: Q FilePath
|
|
819 | -getPackageRoot = Q qGetPackageRoot
|
|
820 | - |
|
821 | - |
|
822 | - |
|
823 | --- | Record external files that runIO is using (dependent upon).
|
|
824 | --- The compiler can then recognize that it should re-compile the Haskell file
|
|
825 | --- when an external file changes.
|
|
826 | ---
|
|
827 | --- Expects an absolute file path.
|
|
828 | ---
|
|
829 | --- Notes:
|
|
830 | ---
|
|
831 | --- * ghc -M does not know about these dependencies - it does not execute TH.
|
|
832 | ---
|
|
833 | --- * The dependency is based on file content, not a modification time
|
|
834 | -addDependentFile :: FilePath -> Q ()
|
|
835 | -addDependentFile fp = Q (qAddDependentFile fp)
|
|
836 | - |
|
837 | --- | Obtain a temporary file path with the given suffix. The compiler will
|
|
838 | --- delete this file after compilation.
|
|
839 | -addTempFile :: String -> Q FilePath
|
|
840 | -addTempFile suffix = Q (qAddTempFile suffix)
|
|
841 | - |
|
842 | --- | Add additional top-level declarations. The added declarations will be type
|
|
843 | --- checked along with the current declaration group.
|
|
844 | -addTopDecls :: [Dec] -> Q ()
|
|
845 | -addTopDecls ds = Q (qAddTopDecls ds)
|
|
846 | - |
|
847 | - |
|
848 | --- | Emit a foreign file which will be compiled and linked to the object for
|
|
849 | --- the current module. Currently only languages that can be compiled with
|
|
850 | --- the C compiler are supported, and the flags passed as part of -optc will
|
|
851 | --- be also applied to the C compiler invocation that will compile them.
|
|
852 | ---
|
|
853 | --- Note that for non-C languages (for example C++) @extern "C"@ directives
|
|
854 | --- must be used to get symbols that we can access from Haskell.
|
|
855 | ---
|
|
856 | --- To get better errors, it is recommended to use #line pragmas when
|
|
857 | --- emitting C files, e.g.
|
|
858 | ---
|
|
859 | --- > {-# LANGUAGE CPP #-}
|
|
860 | --- > ...
|
|
861 | --- > addForeignSource LangC $ unlines
|
|
862 | --- > [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__
|
|
863 | --- > , ...
|
|
864 | --- > ]
|
|
865 | -addForeignSource :: ForeignSrcLang -> String -> Q ()
|
|
866 | -addForeignSource lang src = do
|
|
867 | - let suffix = case lang of
|
|
868 | - LangC -> "c"
|
|
869 | - LangCxx -> "cpp"
|
|
870 | - LangObjc -> "m"
|
|
871 | - LangObjcxx -> "mm"
|
|
872 | - LangAsm -> "s"
|
|
873 | - LangJs -> "js"
|
|
874 | - RawObject -> "a"
|
|
875 | - path <- addTempFile suffix
|
|
876 | - runIO $ writeFile path src
|
|
877 | - addForeignFilePath lang path
|
|
878 | - |
|
879 | --- | Same as 'addForeignSource', but expects to receive a path pointing to the
|
|
880 | --- foreign file instead of a 'String' of its contents. Consider using this in
|
|
881 | --- conjunction with 'addTempFile'.
|
|
882 | ---
|
|
883 | --- This is a good alternative to 'addForeignSource' when you are trying to
|
|
884 | --- directly link in an object file.
|
|
885 | -addForeignFilePath :: ForeignSrcLang -> FilePath -> Q ()
|
|
886 | -addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp)
|
|
887 | - |
|
888 | --- | Add a finalizer that will run in the Q monad after the current module has
|
|
889 | --- been type checked. This only makes sense when run within a top-level splice.
|
|
890 | ---
|
|
891 | --- The finalizer is given the local type environment at the splice point. Thus
|
|
892 | --- 'reify' is able to find the local definitions when executed inside the
|
|
893 | --- finalizer.
|
|
894 | -addModFinalizer :: Q () -> Q ()
|
|
895 | -addModFinalizer act = Q (qAddModFinalizer (unQ act))
|
|
896 | - |
|
897 | --- | Adds a core plugin to the compilation pipeline.
|
|
898 | ---
|
|
899 | --- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc
|
|
900 | --- in the command line. The major difference is that the plugin module @m@
|
|
901 | --- must not belong to the current package. When TH executes, it is too late
|
|
902 | --- to tell the compiler that we needed to compile first a plugin module in the
|
|
903 | --- current package.
|
|
904 | -addCorePlugin :: String -> Q ()
|
|
905 | -addCorePlugin plugin = Q (qAddCorePlugin plugin)
|
|
906 | - |
|
907 | --- | Get state from the 'Q' monad. Note that the state is local to the
|
|
908 | --- Haskell module in which the Template Haskell expression is executed.
|
|
909 | -getQ :: Typeable a => Q (Maybe a)
|
|
910 | -getQ = Q qGetQ
|
|
911 | - |
|
912 | --- | Replace the state in the 'Q' monad. Note that the state is local to the
|
|
913 | --- Haskell module in which the Template Haskell expression is executed.
|
|
914 | -putQ :: Typeable a => a -> Q ()
|
|
915 | -putQ x = Q (qPutQ x)
|
|
916 | - |
|
917 | --- | Determine whether the given language extension is enabled in the 'Q' monad.
|
|
918 | -isExtEnabled :: Extension -> Q Bool
|
|
919 | -isExtEnabled ext = Q (qIsExtEnabled ext)
|
|
920 | - |
|
921 | --- | List all enabled language extensions.
|
|
922 | -extsEnabled :: Q [Extension]
|
|
923 | -extsEnabled = Q qExtsEnabled
|
|
924 | - |
|
925 | --- | Add Haddock documentation to the specified location. This will overwrite
|
|
926 | --- any documentation at the location if it already exists. This will reify the
|
|
927 | --- specified name, so it must be in scope when you call it. If you want to add
|
|
928 | --- documentation to something that you are currently splicing, you can use
|
|
929 | --- 'addModFinalizer' e.g.
|
|
930 | ---
|
|
931 | --- > do
|
|
932 | --- > let nm = mkName "x"
|
|
933 | --- > addModFinalizer $ putDoc (DeclDoc nm) "Hello"
|
|
934 | --- > [d| $(varP nm) = 42 |]
|
|
935 | ---
|
|
936 | --- The helper functions 'withDecDoc' and 'withDecsDoc' will do this for you, as
|
|
937 | --- will the 'funD_doc' and other @_doc@ combinators.
|
|
938 | --- You most likely want to have the @-haddock@ flag turned on when using this.
|
|
939 | --- Adding documentation to anything outside of the current module will cause an
|
|
940 | --- error.
|
|
941 | -putDoc :: DocLoc -> String -> Q ()
|
|
942 | -putDoc t s = Q (qPutDoc t s)
|
|
943 | - |
|
944 | --- | Retrieves the Haddock documentation at the specified location, if one
|
|
945 | --- exists.
|
|
946 | --- It can be used to read documentation on things defined outside of the current
|
|
947 | --- module, provided that those modules were compiled with the @-haddock@ flag.
|
|
948 | -getDoc :: DocLoc -> Q (Maybe String)
|
|
949 | -getDoc n = Q (qGetDoc n)
|
|
950 | - |
|
951 | -instance MonadIO Q where
|
|
952 | - liftIO = runIO
|
|
953 | - |
|
954 | -instance Quasi Q where
|
|
955 | - qNewName = newName
|
|
956 | - qReport = report
|
|
957 | - qRecover = recover
|
|
958 | - qReify = reify
|
|
959 | - qReifyFixity = reifyFixity
|
|
960 | - qReifyType = reifyType
|
|
961 | - qReifyInstances = reifyInstances
|
|
962 | - qReifyRoles = reifyRoles
|
|
963 | - qReifyAnnotations = reifyAnnotations
|
|
964 | - qReifyModule = reifyModule
|
|
965 | - qReifyConStrictness = reifyConStrictness
|
|
966 | - qLookupName = lookupName
|
|
967 | - qLocation = location
|
|
968 | - qGetPackageRoot = getPackageRoot
|
|
969 | - qAddDependentFile = addDependentFile
|
|
970 | - qAddTempFile = addTempFile
|
|
971 | - qAddTopDecls = addTopDecls
|
|
972 | - qAddForeignFilePath = addForeignFilePath
|
|
973 | - qAddModFinalizer = addModFinalizer
|
|
974 | - qAddCorePlugin = addCorePlugin
|
|
975 | - qGetQ = getQ
|
|
976 | - qPutQ = putQ
|
|
977 | - qIsExtEnabled = isExtEnabled
|
|
978 | - qExtsEnabled = extsEnabled
|
|
979 | - qPutDoc = putDoc
|
|
980 | - qGetDoc = getDoc
|
|
981 | - |
|
982 | - |
|
983 | -----------------------------------------------------
|
|
984 | --- The following operations are used solely in GHC.HsToCore.Quote when
|
|
985 | --- desugaring brackets. They are not necessary for the user, who can use
|
|
986 | --- ordinary return and (>>=) etc
|
|
987 | - |
|
988 | --- | This function is only used in 'GHC.HsToCore.Quote' when desugaring
|
|
989 | --- brackets. This is not necessary for the user, who can use the ordinary
|
|
990 | --- 'return' and '(>>=)' operations.
|
|
991 | -sequenceQ :: forall m . Monad m => forall a . [m a] -> m [a]
|
|
992 | -sequenceQ = sequence
|
|
993 | - |
|
994 | 66 | oneName, manyName :: Name
|
995 | 67 | -- | Synonym for @''GHC.Internal.Types.One'@, from @ghc-internal@.
|
996 | 68 | oneName = mkNameG DataName "ghc-internal" "GHC.Internal.Types" "One"
|
... | ... | @@ -1004,19 +76,19 @@ manyName = mkNameG DataName "ghc-internal" "GHC.Internal.Types" "Many" |
1004 | 76 | |
1005 | 77 | -- | The name of a module.
|
1006 | 78 | newtype ModName = ModName String -- Module name
|
1007 | - deriving (Show,Eq,Ord,Data,Generic)
|
|
79 | + deriving (Show,Eq,Ord,Generic)
|
|
1008 | 80 | |
1009 | 81 | -- | The name of a package.
|
1010 | 82 | newtype PkgName = PkgName String -- package name
|
1011 | - deriving (Show,Eq,Ord,Data,Generic)
|
|
83 | + deriving (Show,Eq,Ord,Generic)
|
|
1012 | 84 | |
1013 | 85 | -- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'.
|
1014 | 86 | data Module = Module PkgName ModName -- package qualified module name
|
1015 | - deriving (Show,Eq,Ord,Data,Generic)
|
|
87 | + deriving (Show,Eq,Ord,Generic)
|
|
1016 | 88 | |
1017 | 89 | -- | An "Occurence Name".
|
1018 | 90 | newtype OccName = OccName String
|
1019 | - deriving (Show,Eq,Ord,Data,Generic)
|
|
91 | + deriving (Show,Eq,Ord,Generic)
|
|
1020 | 92 | |
1021 | 93 | -- | Smart constructor for 'ModName'
|
1022 | 94 | mkModName :: String -> ModName
|
... | ... | @@ -1132,7 +204,7 @@ Names constructed using @newName@ and @mkName@ may be used in bindings |
1132 | 204 | (such as @let x = ...@ or @\x -> ...@), but names constructed using
|
1133 | 205 | @lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.
|
1134 | 206 | -}
|
1135 | -data Name = Name OccName NameFlavour deriving (Data, Eq, Generic)
|
|
207 | +data Name = Name OccName NameFlavour deriving (Eq, Generic)
|
|
1136 | 208 | |
1137 | 209 | instance Ord Name where
|
1138 | 210 | -- check if unique is different before looking at strings
|
... | ... | @@ -1148,7 +220,7 @@ data NameFlavour |
1148 | 220 | -- An original name (occurrences only, not binders)
|
1149 | 221 | -- Need the namespace too to be sure which
|
1150 | 222 | -- thing we are naming
|
1151 | - deriving ( Data, Eq, Ord, Show, Generic )
|
|
223 | + deriving ( Eq, Ord, Show, Generic )
|
|
1152 | 224 | |
1153 | 225 | data NameSpace = VarName -- ^ Variables
|
1154 | 226 | | DataName -- ^ Data constructors
|
... | ... | @@ -1162,7 +234,7 @@ data NameSpace = VarName -- ^ Variables |
1162 | 234 | -- of the datatype (regardless of whether this constructor has this field).
|
1163 | 235 | -- - For a field of a pattern synonym, this is the name of the pattern synonym.
|
1164 | 236 | }
|
1165 | - deriving( Eq, Ord, Show, Data, Generic )
|
|
237 | + deriving( Eq, Ord, Show, Generic )
|
|
1166 | 238 | |
1167 | 239 | -- | @Uniq@ is used by GHC to distinguish names from each other.
|
1168 | 240 | type Uniq = Integer
|
... | ... | @@ -1464,7 +536,7 @@ data Loc |
1464 | 536 | , loc_module :: String
|
1465 | 537 | , loc_start :: CharPos
|
1466 | 538 | , loc_end :: CharPos }
|
1467 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
539 | + deriving( Show, Eq, Ord, Generic )
|
|
1468 | 540 | |
1469 | 541 | type CharPos = (Int, Int) -- ^ Line and character position
|
1470 | 542 | |
... | ... | @@ -1547,13 +619,13 @@ data Info |
1547 | 619 | | TyVarI -- Scoped type variable
|
1548 | 620 | Name
|
1549 | 621 | Type -- What it is bound to
|
1550 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
622 | + deriving( Show, Eq, Ord, Generic )
|
|
1551 | 623 | |
1552 | 624 | -- | Obtained from 'reifyModule' in the 'Q' Monad.
|
1553 | 625 | data ModuleInfo =
|
1554 | 626 | -- | Contains the import list of the module.
|
1555 | 627 | ModuleInfo [Module]
|
1556 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
628 | + deriving( Show, Eq, Ord, Generic )
|
|
1557 | 629 | |
1558 | 630 | {- |
|
1559 | 631 | In 'ClassOpI' and 'DataConI', name of the parent class or type
|
... | ... | @@ -1591,11 +663,11 @@ type InstanceDec = Dec |
1591 | 663 | |
1592 | 664 | -- | Fixity, as specified in a @infix[lr] n@ declaration.
|
1593 | 665 | data Fixity = Fixity Int FixityDirection
|
1594 | - deriving( Eq, Ord, Show, Data, Generic )
|
|
666 | + deriving( Eq, Ord, Show, Generic )
|
|
1595 | 667 | |
1596 | 668 | -- | The associativity of an operator, as in an @infix@ declaration.
|
1597 | 669 | data FixityDirection = InfixL | InfixR | InfixN
|
1598 | - deriving( Eq, Ord, Show, Data, Generic )
|
|
670 | + deriving( Eq, Ord, Show, Generic )
|
|
1599 | 671 | |
1600 | 672 | -- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)
|
1601 | 673 | maxPrecedence :: Int
|
... | ... | @@ -1628,7 +700,7 @@ data Lit = CharL Char -- ^ @\'c\'@ |
1628 | 700 | | StringPrimL [Word8] -- ^ @"string"#@. A primitive C-style string, type 'Addr#'
|
1629 | 701 | | BytesPrimL Bytes -- ^ Some raw bytes, type 'Addr#':
|
1630 | 702 | | CharPrimL Char -- ^ @\'c\'#@
|
1631 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
703 | + deriving( Show, Eq, Ord, Generic )
|
|
1632 | 704 | |
1633 | 705 | -- We could add Int, Float, Double etc, as we do in HsLit,
|
1634 | 706 | -- but that could complicate the
|
... | ... | @@ -1650,7 +722,7 @@ data Bytes = Bytes |
1650 | 722 | -- , bytesInitialized :: Bool -- ^ False: only use `bytesSize` to allocate
|
1651 | 723 | -- -- an uninitialized region
|
1652 | 724 | }
|
1653 | - deriving (Data,Generic)
|
|
725 | + deriving (Generic)
|
|
1654 | 726 | |
1655 | 727 | -- We can't derive Show instance for Bytes because we don't want to show the
|
1656 | 728 | -- pointer value but the actual bytes (similarly to what ByteString does). See
|
... | ... | @@ -1717,14 +789,14 @@ data Pat |
1717 | 789 | | TypeP Type -- ^ @{ type p }@
|
1718 | 790 | | InvisP Type -- ^ @{ @p }@
|
1719 | 791 | | OrP (NonEmpty Pat) -- ^ @{ p1; p2 }@
|
1720 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
792 | + deriving( Show, Eq, Ord, Generic )
|
|
1721 | 793 | |
1722 | 794 | -- | A (field name, pattern) pair. See 'RecP'.
|
1723 | 795 | type FieldPat = (Name,Pat)
|
1724 | 796 | |
1725 | 797 | -- | A @case@-alternative
|
1726 | 798 | data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@
|
1727 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
799 | + deriving( Show, Eq, Ord, Generic )
|
|
1728 | 800 | |
1729 | 801 | -- | A clause consists of patterns, guards, a body expression, and a list of
|
1730 | 802 | -- declarations under a @where@. Clauses are seen in equations for function
|
... | ... | @@ -1732,7 +804,7 @@ data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@ |
1732 | 804 | -- etc.
|
1733 | 805 | data Clause = Clause [Pat] Body [Dec]
|
1734 | 806 | -- ^ @f { p1 p2 = body where decs }@
|
1735 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
807 | + deriving( Show, Eq, Ord, Generic )
|
|
1736 | 808 | |
1737 | 809 | -- | A Haskell expression.
|
1738 | 810 | data Exp
|
... | ... | @@ -1827,7 +899,7 @@ data Exp |
1827 | 899 | | ForallE [TyVarBndr Specificity] Exp -- ^ @forall \<vars\>. \<expr\>@
|
1828 | 900 | | ForallVisE [TyVarBndr ()] Exp -- ^ @forall \<vars\> -> \<expr\>@
|
1829 | 901 | | ConstrainedE [Exp] Exp -- ^ @\<ctxt\> => \<expr\>@
|
1830 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
902 | + deriving( Show, Eq, Ord, Generic )
|
|
1831 | 903 | |
1832 | 904 | -- | A (field name, expression) pair. See 'RecConE' and 'RecUpdE'.
|
1833 | 905 | type FieldExp = (Name,Exp)
|
... | ... | @@ -1841,13 +913,13 @@ data Body |
1841 | 913 | -- | e3 = e4 }
|
1842 | 914 | -- where ds@
|
1843 | 915 | | NormalB Exp -- ^ @f p { = e } where ds@
|
1844 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
916 | + deriving( Show, Eq, Ord, Generic )
|
|
1845 | 917 | |
1846 | 918 | -- | A single guard.
|
1847 | 919 | data Guard
|
1848 | 920 | = NormalG Exp -- ^ @f x { | odd x } = x@
|
1849 | 921 | | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@
|
1850 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
922 | + deriving( Show, Eq, Ord, Generic )
|
|
1851 | 923 | |
1852 | 924 | -- | A single statement, as in @do@-notation.
|
1853 | 925 | data Stmt
|
... | ... | @@ -1856,14 +928,14 @@ data Stmt |
1856 | 928 | | NoBindS Exp -- ^ @e@
|
1857 | 929 | | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE')
|
1858 | 930 | | RecS [Stmt] -- ^ @rec { s1; s2 }@
|
1859 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
931 | + deriving( Show, Eq, Ord, Generic )
|
|
1860 | 932 | |
1861 | 933 | -- | A list/enum range expression.
|
1862 | 934 | data Range = FromR Exp -- ^ @[n ..]@
|
1863 | 935 | | FromThenR Exp Exp -- ^ @[n, m ..]@
|
1864 | 936 | | FromToR Exp Exp -- ^ @[n .. m]@
|
1865 | 937 | | FromThenToR Exp Exp Exp -- ^ @[n, m .. k]@
|
1866 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
938 | + deriving( Show, Eq, Ord, Generic )
|
|
1867 | 939 | |
1868 | 940 | -- | A single declaration.
|
1869 | 941 | data Dec
|
... | ... | @@ -1950,7 +1022,7 @@ data Dec |
1950 | 1022 | --
|
1951 | 1023 | -- Implicit parameter binding declaration. Can only be used in let
|
1952 | 1024 | -- and where clauses which consist entirely of implicit bindings.
|
1953 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1025 | + deriving( Show, Eq, Ord, Generic )
|
|
1954 | 1026 | |
1955 | 1027 | -- | A way to specify a namespace to look in when GHC needs to find
|
1956 | 1028 | -- a name's source
|
... | ... | @@ -1962,7 +1034,7 @@ data NamespaceSpecifier |
1962 | 1034 | -- or type variable
|
1963 | 1035 | | DataNamespaceSpecifier -- ^ Name should be a term-level entity, such as a
|
1964 | 1036 | -- function, data constructor, or pattern synonym
|
1965 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1037 | + deriving( Show, Eq, Ord, Generic )
|
|
1966 | 1038 | |
1967 | 1039 | -- | Varieties of allowed instance overlap.
|
1968 | 1040 | data Overlap = Overlappable -- ^ May be overlapped by more specific instances
|
... | ... | @@ -1971,12 +1043,12 @@ data Overlap = Overlappable -- ^ May be overlapped by more specific instances |
1971 | 1043 | | Incoherent -- ^ Both 'Overlapping' and 'Overlappable', and
|
1972 | 1044 | -- pick an arbitrary one if multiple choices are
|
1973 | 1045 | -- available.
|
1974 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1046 | + deriving( Show, Eq, Ord, Generic )
|
|
1975 | 1047 | |
1976 | 1048 | -- | A single @deriving@ clause at the end of a datatype declaration.
|
1977 | 1049 | data DerivClause = DerivClause (Maybe DerivStrategy) Cxt
|
1978 | 1050 | -- ^ @{ deriving stock (Eq, Ord) }@
|
1979 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1051 | + deriving( Show, Eq, Ord, Generic )
|
|
1980 | 1052 | |
1981 | 1053 | -- | What the user explicitly requests when deriving an instance with
|
1982 | 1054 | -- @-XDerivingStrategies@.
|
... | ... | @@ -1984,7 +1056,7 @@ data DerivStrategy = StockStrategy -- ^ @deriving {stock} C@ |
1984 | 1056 | | AnyclassStrategy -- ^ @deriving {anyclass} C@, @-XDeriveAnyClass@
|
1985 | 1057 | | NewtypeStrategy -- ^ @deriving {newtype} C@, @-XGeneralizedNewtypeDeriving@
|
1986 | 1058 | | ViaStrategy Type -- ^ @deriving C {via T}@, @-XDerivingVia@
|
1987 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1059 | + deriving( Show, Eq, Ord, Generic )
|
|
1988 | 1060 | |
1989 | 1061 | -- | A pattern synonym's type. Note that a pattern synonym's /fully/
|
1990 | 1062 | -- specified type has a peculiar shape coming with two forall
|
... | ... | @@ -2040,7 +1112,7 @@ type PatSynType = Type |
2040 | 1112 | -- between @type family@ and @where@.
|
2041 | 1113 | data TypeFamilyHead =
|
2042 | 1114 | TypeFamilyHead Name [TyVarBndr BndrVis] FamilyResultSig (Maybe InjectivityAnn)
|
2043 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1115 | + deriving( Show, Eq, Ord, Generic )
|
|
2044 | 1116 | |
2045 | 1117 | -- | One equation of a type family instance or closed type family. The
|
2046 | 1118 | -- arguments are the left-hand-side type and the right-hand-side result.
|
... | ... | @@ -2060,28 +1132,28 @@ data TypeFamilyHead = |
2060 | 1132 | -- ('VarT' a)
|
2061 | 1133 | -- @
|
2062 | 1134 | data TySynEqn = TySynEqn (Maybe [TyVarBndr ()]) Type Type
|
2063 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1135 | + deriving( Show, Eq, Ord, Generic )
|
|
2064 | 1136 | |
2065 | 1137 | -- | [Functional dependency](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/functional_dependencies.html)
|
2066 | 1138 | -- syntax, as in a class declaration.
|
2067 | 1139 | data FunDep = FunDep [Name] [Name] -- ^ @class C a b {| a -> b}@
|
2068 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1140 | + deriving( Show, Eq, Ord, Generic )
|
|
2069 | 1141 | |
2070 | 1142 | -- | A @foreign@ declaration.
|
2071 | 1143 | data Foreign = ImportF Callconv Safety String Name Type
|
2072 | 1144 | -- ^ @foreign import callconv safety "foreign_name" haskellName :: type@
|
2073 | 1145 | | ExportF Callconv String Name Type
|
2074 | 1146 | -- ^ @foreign export callconv "foreign_name" haskellName :: type@
|
2075 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1147 | + deriving( Show, Eq, Ord, Generic )
|
|
2076 | 1148 | |
2077 | 1149 | -- keep Callconv in sync with module ForeignCall in ghc/compiler/GHC/Types/ForeignCall.hs
|
2078 | 1150 | -- | A calling convention identifier, as in a 'Foreign' declaration.
|
2079 | 1151 | data Callconv = CCall | StdCall | CApi | Prim | JavaScript
|
2080 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1152 | + deriving( Show, Eq, Ord, Generic )
|
|
2081 | 1153 | |
2082 | 1154 | -- | A safety level, as in a 'Foreign' declaration.
|
2083 | 1155 | data Safety = Unsafe | Safe | Interruptible
|
2084 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1156 | + deriving( Show, Eq, Ord, Generic )
|
|
2085 | 1157 | |
2086 | 1158 | data Pragma = InlineP Name Inline RuleMatch Phases
|
2087 | 1159 | -- ^ @{ {\-\# [inline] [rule match] [phases] [phases] name #-} }@. See
|
... | ... | @@ -2106,7 +1178,7 @@ data Pragma = InlineP Name Inline RuleMatch Phases |
2106 | 1178 | -- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@
|
2107 | 1179 | | SCCP Name (Maybe String)
|
2108 | 1180 | -- ^ @{ {\-\# SCC fun "optional_name" \#-} }@
|
2109 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1181 | + deriving( Show, Eq, Ord, Generic )
|
|
2110 | 1182 | |
2111 | 1183 | -- | An inline pragma.
|
2112 | 1184 | data Inline = NoInline
|
... | ... | @@ -2115,7 +1187,7 @@ data Inline = NoInline |
2115 | 1187 | -- ^ @{ {\-\# INLINE ... #-} }@
|
2116 | 1188 | | Inlinable
|
2117 | 1189 | -- ^ @{ {\-\# INLINABLE ... #-} }@
|
2118 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1190 | + deriving (Show, Eq, Ord, Generic)
|
|
2119 | 1191 | |
2120 | 1192 | -- | A @CONLIKE@ modifier, as in one of the various inline pragmas, or lack
|
2121 | 1193 | -- thereof ('FunLike').
|
... | ... | @@ -2123,7 +1195,7 @@ data RuleMatch = ConLike |
2123 | 1195 | -- ^ @{ {\-\# CONLIKE [inline] ... #-} }@
|
2124 | 1196 | | FunLike
|
2125 | 1197 | -- ^ @{ {\-\# [inline] ... #-} }@
|
2126 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1198 | + deriving (Show, Eq, Ord, Generic)
|
|
2127 | 1199 | |
2128 | 1200 | -- | Phase control syntax.
|
2129 | 1201 | data Phases = AllPhases
|
... | ... | @@ -2132,14 +1204,14 @@ data Phases = AllPhases |
2132 | 1204 | -- ^ @[n]@
|
2133 | 1205 | | BeforePhase Int
|
2134 | 1206 | -- ^ @[~n]@
|
2135 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1207 | + deriving (Show, Eq, Ord, Generic)
|
|
2136 | 1208 | |
2137 | 1209 | -- | A binder found in the @forall@ of a @RULES@ pragma.
|
2138 | 1210 | data RuleBndr = RuleVar Name
|
2139 | 1211 | -- ^ @forall {a} ... .@
|
2140 | 1212 | | TypedRuleVar Name Type
|
2141 | 1213 | -- ^ @forall {(a :: t)} ... .@
|
2142 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1214 | + deriving (Show, Eq, Ord, Generic)
|
|
2143 | 1215 | |
2144 | 1216 | -- | The target of an @ANN@ pragma
|
2145 | 1217 | data AnnTarget = ModuleAnnotation
|
... | ... | @@ -2148,7 +1220,7 @@ data AnnTarget = ModuleAnnotation |
2148 | 1220 | -- ^ @{\-\# ANN type {name} ... #-}@
|
2149 | 1221 | | ValueAnnotation Name
|
2150 | 1222 | -- ^ @{\-\# ANN {name} ... #-}@
|
2151 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1223 | + deriving (Show, Eq, Ord, Generic)
|
|
2152 | 1224 | |
2153 | 1225 | -- | A context, as found on the left side of a @=>@ in a type.
|
2154 | 1226 | type Cxt = [Pred] -- ^ @(Eq a, Ord b)@
|
... | ... | @@ -2166,7 +1238,7 @@ data SourceUnpackedness |
2166 | 1238 | = NoSourceUnpackedness -- ^ @C a@
|
2167 | 1239 | | SourceNoUnpack -- ^ @C { {\-\# NOUNPACK \#-\} } a@
|
2168 | 1240 | | SourceUnpack -- ^ @C { {\-\# UNPACK \#-\} } a@
|
2169 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1241 | + deriving (Show, Eq, Ord, Generic)
|
|
2170 | 1242 | |
2171 | 1243 | -- | 'SourceStrictness' corresponds to strictness annotations found in the source code.
|
2172 | 1244 | --
|
... | ... | @@ -2175,7 +1247,7 @@ data SourceUnpackedness |
2175 | 1247 | data SourceStrictness = NoSourceStrictness -- ^ @C a@
|
2176 | 1248 | | SourceLazy -- ^ @C {~}a@
|
2177 | 1249 | | SourceStrict -- ^ @C {!}a@
|
2178 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1250 | + deriving (Show, Eq, Ord, Generic)
|
|
2179 | 1251 | |
2180 | 1252 | -- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness'
|
2181 | 1253 | -- refers to the strictness annotations that the compiler chooses for a data constructor
|
... | ... | @@ -2188,7 +1260,7 @@ data SourceStrictness = NoSourceStrictness -- ^ @C a@ |
2188 | 1260 | data DecidedStrictness = DecidedLazy -- ^ Field inferred to not have a bang.
|
2189 | 1261 | | DecidedStrict -- ^ Field inferred to have a bang.
|
2190 | 1262 | | DecidedUnpack -- ^ Field inferred to be unpacked.
|
2191 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1263 | + deriving (Show, Eq, Ord, Generic)
|
|
2192 | 1264 | |
2193 | 1265 | -- | A data constructor.
|
2194 | 1266 | --
|
... | ... | @@ -2253,7 +1325,7 @@ data Con = |
2253 | 1325 | -- Invariant: the list must be non-empty.
|
2254 | 1326 | [VarBangType] -- ^ The constructor arguments
|
2255 | 1327 | Type -- ^ See Note [GADT return type]
|
2256 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1328 | + deriving (Show, Eq, Ord, Generic)
|
|
2257 | 1329 | |
2258 | 1330 | -- Note [GADT return type]
|
2259 | 1331 | -- ~~~~~~~~~~~~~~~~~~~~~~~
|
... | ... | @@ -2285,7 +1357,7 @@ data Con = |
2285 | 1357 | -- | Strictness information in a data constructor's argument.
|
2286 | 1358 | data Bang = Bang SourceUnpackedness SourceStrictness
|
2287 | 1359 | -- ^ @C { {\-\# UNPACK \#-\} !}a@
|
2288 | - deriving (Show, Eq, Ord, Data, Generic)
|
|
1360 | + deriving (Show, Eq, Ord, Generic)
|
|
2289 | 1361 | |
2290 | 1362 | -- | A type with a strictness annotation, as in data constructors. See 'Con'.
|
2291 | 1363 | type BangType = (Bang, Type)
|
... | ... | @@ -2309,14 +1381,14 @@ data PatSynDir |
2309 | 1381 | = Unidir -- ^ @pattern P x {<-} p@
|
2310 | 1382 | | ImplBidir -- ^ @pattern P x {=} p@
|
2311 | 1383 | | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@
|
2312 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1384 | + deriving( Show, Eq, Ord, Generic )
|
|
2313 | 1385 | |
2314 | 1386 | -- | A pattern synonym's argument type.
|
2315 | 1387 | data PatSynArgs
|
2316 | 1388 | = PrefixPatSyn [Name] -- ^ @pattern P {x y z} = p@
|
2317 | 1389 | | InfixPatSyn Name Name -- ^ @pattern {x P y} = p@
|
2318 | 1390 | | RecordPatSyn [Name] -- ^ @pattern P { {x,y,z} } = p@
|
2319 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1391 | + deriving( Show, Eq, Ord, Generic )
|
|
2320 | 1392 | |
2321 | 1393 | -- | A Haskell type.
|
2322 | 1394 | data Type = ForallT [TyVarBndr Specificity] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@
|
... | ... | @@ -2355,12 +1427,12 @@ data Type = ForallT [TyVarBndr Specificity] Cxt Type -- ^ @forall \<vars\>. \<ct |
2355 | 1427 | | LitT TyLit -- ^ @0@, @1@, @2@, etc.
|
2356 | 1428 | | WildCardT -- ^ @_@
|
2357 | 1429 | | ImplicitParamT String Type -- ^ @?x :: t@
|
2358 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1430 | + deriving( Show, Eq, Ord, Generic )
|
|
2359 | 1431 | |
2360 | 1432 | -- | The specificity of a type variable in a @forall ...@.
|
2361 | 1433 | data Specificity = SpecifiedSpec -- ^ @a@
|
2362 | 1434 | | InferredSpec -- ^ @{a}@
|
2363 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1435 | + deriving( Show, Eq, Ord, Generic )
|
|
2364 | 1436 | |
2365 | 1437 | -- | The @flag@ type parameter is instantiated to one of the following types:
|
2366 | 1438 | --
|
... | ... | @@ -2370,40 +1442,40 @@ data Specificity = SpecifiedSpec -- ^ @a@ |
2370 | 1442 | --
|
2371 | 1443 | data TyVarBndr flag = PlainTV Name flag -- ^ @a@
|
2372 | 1444 | | KindedTV Name flag Kind -- ^ @(a :: k)@
|
2373 | - deriving( Show, Eq, Ord, Data, Generic, Functor, Foldable, Traversable )
|
|
1445 | + deriving( Show, Eq, Ord, Generic, Functor, Foldable, Traversable )
|
|
2374 | 1446 | |
2375 | 1447 | -- | Visibility of a type variable. See [Inferred vs. specified type variables](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_applications.html#inferred-vs-specified-type-variables).
|
2376 | 1448 | data BndrVis = BndrReq -- ^ @a@
|
2377 | 1449 | | BndrInvis -- ^ @\@a@
|
2378 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1450 | + deriving( Show, Eq, Ord, Generic )
|
|
2379 | 1451 | |
2380 | 1452 | -- | Type family result signature
|
2381 | 1453 | data FamilyResultSig = NoSig -- ^ no signature
|
2382 | 1454 | | KindSig Kind -- ^ @k@
|
2383 | 1455 | | TyVarSig (TyVarBndr ()) -- ^ @= r, = (r :: k)@
|
2384 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1456 | + deriving( Show, Eq, Ord, Generic )
|
|
2385 | 1457 | |
2386 | 1458 | -- | Injectivity annotation as in an [injective type family](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_families.html)
|
2387 | 1459 | data InjectivityAnn = InjectivityAnn Name [Name]
|
2388 | - deriving ( Show, Eq, Ord, Data, Generic )
|
|
1460 | + deriving ( Show, Eq, Ord, Generic )
|
|
2389 | 1461 | |
2390 | 1462 | -- | Type-level literals.
|
2391 | 1463 | data TyLit = NumTyLit Integer -- ^ @2@
|
2392 | 1464 | | StrTyLit String -- ^ @\"Hello\"@
|
2393 | 1465 | | CharTyLit Char -- ^ @\'C\'@, @since 4.16.0.0
|
2394 | - deriving ( Show, Eq, Ord, Data, Generic )
|
|
1466 | + deriving ( Show, Eq, Ord, Generic )
|
|
2395 | 1467 | |
2396 | 1468 | -- | Role annotations
|
2397 | 1469 | data Role = NominalR -- ^ @nominal@
|
2398 | 1470 | | RepresentationalR -- ^ @representational@
|
2399 | 1471 | | PhantomR -- ^ @phantom@
|
2400 | 1472 | | InferR -- ^ @_@
|
2401 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1473 | + deriving( Show, Eq, Ord, Generic )
|
|
2402 | 1474 | |
2403 | 1475 | -- | Annotation target for reifyAnnotations
|
2404 | 1476 | data AnnLookup = AnnLookupModule Module
|
2405 | 1477 | | AnnLookupName Name
|
2406 | - deriving( Show, Eq, Ord, Data, Generic )
|
|
1478 | + deriving( Show, Eq, Ord, Generic )
|
|
2407 | 1479 | |
2408 | 1480 | -- | To avoid duplication between kinds and types, they
|
2409 | 1481 | -- are defined to be the same. Naturally, you would never
|
... | ... | @@ -2454,7 +1526,7 @@ data DocLoc |
2454 | 1526 | | ArgDoc Name Int -- ^ At a specific argument of a function, indexed by its
|
2455 | 1527 | -- position.
|
2456 | 1528 | | InstDoc Type -- ^ At a class or family instance.
|
2457 | - deriving ( Show, Eq, Ord, Data, Generic )
|
|
1529 | + deriving ( Show, Eq, Ord, Generic )
|
|
2458 | 1530 | |
2459 | 1531 | -----------------------------------------------------
|
2460 | 1532 | -- Internal helper functions
|
... | ... | @@ -63,6 +63,7 @@ import Foreign |
63 | 63 | import GHC.Generics
|
64 | 64 | import GHC.Stack.CCS
|
65 | 65 | import qualified GHC.Boot.TH.Syntax as TH
|
66 | +import qualified GHC.Boot.TH.Monad as TH
|
|
66 | 67 | import System.Exit
|
67 | 68 | import System.IO
|
68 | 69 | import System.IO.Error
|
... | ... | @@ -114,6 +114,7 @@ import qualified Data.Map as M |
114 | 114 | import Data.Maybe
|
115 | 115 | import GHC.Desugar (AnnotationWrapper(..))
|
116 | 116 | import qualified GHC.Boot.TH.Syntax as TH
|
117 | +import qualified GHC.Boot.TH.Monad as TH
|
|
117 | 118 | import Unsafe.Coerce
|
118 | 119 | |
119 | 120 | -- | Create a new instance of 'QState'
|
... | ... | @@ -22,7 +22,7 @@ module Language.Haskell.TH.Quote |
22 | 22 | , dataToQa, dataToExpQ, dataToPatQ
|
23 | 23 | ) where
|
24 | 24 | |
25 | -import GHC.Boot.TH.Syntax
|
|
25 | +import GHC.Boot.TH.Monad
|
|
26 | 26 | import GHC.Boot.TH.Quote
|
27 | 27 | import Language.Haskell.TH.Syntax (dataToQa, dataToExpQ, dataToPatQ)
|
28 | 28 |
... | ... | @@ -200,6 +200,7 @@ where |
200 | 200 | |
201 | 201 | import GHC.Boot.TH.Lift
|
202 | 202 | import GHC.Boot.TH.Syntax
|
203 | +import GHC.Boot.TH.Monad
|
|
203 | 204 | import System.FilePath
|
204 | 205 | import Data.Data hiding (Fixity(..))
|
205 | 206 | import Data.List.NonEmpty (NonEmpty(..))
|