1{-# LANGUAGE CPP, DeriveDataTypeable, 2 DeriveGeneric, FlexibleInstances, DefaultSignatures, 3 RankNTypes, RoleAnnotations, ScopedTypeVariables, 4 MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds, 5 GADTs, UnboxedTuples, UnboxedSums, TypeInType, 6 Trustworthy, DeriveFunctor #-} 7 8{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} 9 10----------------------------------------------------------------------------- 11-- | 12-- Module : Language.Haskell.Syntax 13-- Copyright : (c) The University of Glasgow 2003 14-- License : BSD-style (see the file libraries/base/LICENSE) 15-- 16-- Maintainer : libraries@haskell.org 17-- Stability : experimental 18-- Portability : portable 19-- 20-- Abstract syntax definitions for Template Haskell. 21-- 22----------------------------------------------------------------------------- 23 24module Language.Haskell.TH.Syntax 25 ( module Language.Haskell.TH.Syntax 26 -- * Language extensions 27 , module Language.Haskell.TH.LanguageExtensions 28 , ForeignSrcLang(..) 29 ) where 30 31import Data.Data hiding (Fixity(..)) 32import Data.IORef 33import System.IO.Unsafe ( unsafePerformIO ) 34import GHC.IO.Unsafe ( unsafeDupableInterleaveIO ) 35import Control.Monad (liftM) 36import Control.Monad.IO.Class (MonadIO (..)) 37import Control.Monad.Fix (MonadFix (..)) 38import Control.Applicative (liftA2) 39import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) 40import Control.Exception.Base (FixIOException (..)) 41import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar) 42import System.IO ( hPutStrLn, stderr ) 43import Data.Char ( isAlpha, isAlphaNum, isUpper, ord ) 44import Data.Int 45import Data.List.NonEmpty ( NonEmpty(..) ) 46import Data.Void ( Void, absurd ) 47import Data.Word 48import Data.Ratio 49import GHC.CString ( unpackCString# ) 50import GHC.Generics ( Generic ) 51import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), 52 TYPE, RuntimeRep(..) ) 53import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) 54import GHC.Ptr ( Ptr, plusPtr ) 55import GHC.Lexeme ( startsVarSym, startsVarId ) 56import GHC.ForeignSrcLang.Type 57import Language.Haskell.TH.LanguageExtensions 58import Numeric.Natural 59import Prelude 60import Foreign.ForeignPtr 61import Foreign.C.String 62import Foreign.C.Types 63 64----------------------------------------------------- 65-- 66-- The Quasi class 67-- 68----------------------------------------------------- 69 70class (MonadIO m, MonadFail m) => Quasi m where 71 qNewName :: String -> m Name 72 -- ^ Fresh names 73 74 -- Error reporting and recovery 75 qReport :: Bool -> String -> m () -- ^ Report an error (True) or warning (False) 76 -- ...but carry on; use 'fail' to stop 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 qLookupName :: Bool -> String -> m (Maybe Name) 83 -- True <=> type namespace, False <=> value namespace 84 qReify :: Name -> m Info 85 qReifyFixity :: Name -> m (Maybe Fixity) 86 qReifyType :: Name -> m Type 87 qReifyInstances :: Name -> [Type] -> m [Dec] 88 -- Is (n tys) an instance? 89 -- Returns list of matching instance Decs 90 -- (with empty sub-Decs) 91 -- Works for classes and type functions 92 qReifyRoles :: Name -> m [Role] 93 qReifyAnnotations :: Data a => AnnLookup -> m [a] 94 qReifyModule :: Module -> m ModuleInfo 95 qReifyConStrictness :: Name -> m [DecidedStrictness] 96 97 qLocation :: m Loc 98 99 qRunIO :: IO a -> m a 100 qRunIO = liftIO 101 -- ^ Input/output (dangerous) 102 103 qAddDependentFile :: FilePath -> m () 104 105 qAddTempFile :: String -> m FilePath 106 107 qAddTopDecls :: [Dec] -> m () 108 109 qAddForeignFilePath :: ForeignSrcLang -> String -> m () 110 111 qAddModFinalizer :: Q () -> m () 112 113 qAddCorePlugin :: String -> m () 114 115 qGetQ :: Typeable a => m (Maybe a) 116 117 qPutQ :: Typeable a => a -> m () 118 119 qIsExtEnabled :: Extension -> m Bool 120 qExtsEnabled :: m [Extension] 121 122----------------------------------------------------- 123-- The IO instance of Quasi 124-- 125-- This instance is used only when running a Q 126-- computation in the IO monad, usually just to 127-- print the result. There is no interesting 128-- type environment, so reification isn't going to 129-- work. 130-- 131----------------------------------------------------- 132 133instance Quasi IO where 134 qNewName = newNameIO 135 136 qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) 137 qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) 138 139 qLookupName _ _ = badIO "lookupName" 140 qReify _ = badIO "reify" 141 qReifyFixity _ = badIO "reifyFixity" 142 qReifyType _ = badIO "reifyFixity" 143 qReifyInstances _ _ = badIO "reifyInstances" 144 qReifyRoles _ = badIO "reifyRoles" 145 qReifyAnnotations _ = badIO "reifyAnnotations" 146 qReifyModule _ = badIO "reifyModule" 147 qReifyConStrictness _ = badIO "reifyConStrictness" 148 qLocation = badIO "currentLocation" 149 qRecover _ _ = badIO "recover" -- Maybe we could fix this? 150 qAddDependentFile _ = badIO "addDependentFile" 151 qAddTempFile _ = badIO "addTempFile" 152 qAddTopDecls _ = badIO "addTopDecls" 153 qAddForeignFilePath _ _ = badIO "addForeignFilePath" 154 qAddModFinalizer _ = badIO "addModFinalizer" 155 qAddCorePlugin _ = badIO "addCorePlugin" 156 qGetQ = badIO "getQ" 157 qPutQ _ = badIO "putQ" 158 qIsExtEnabled _ = badIO "isExtEnabled" 159 qExtsEnabled = badIO "extsEnabled" 160 161instance Quote IO where 162 newName = newNameIO 163 164newNameIO :: String -> IO Name 165newNameIO s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x)) 166 ; pure (mkNameU s n) } 167 168badIO :: String -> IO a 169badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad") 170 ; fail "Template Haskell failure" } 171 172-- Global variable to generate unique symbols 173counter :: IORef Uniq 174{-# NOINLINE counter #-} 175counter = unsafePerformIO (newIORef 0) 176 177 178----------------------------------------------------- 179-- 180-- The Q monad 181-- 182----------------------------------------------------- 183 184newtype Q a = Q { unQ :: forall m. Quasi m => m a } 185 186-- \"Runs\" the 'Q' monad. Normal users of Template Haskell 187-- should not need this function, as the splice brackets @$( ... )@ 188-- are the usual way of running a 'Q' computation. 189-- 190-- This function is primarily used in GHC internals, and for debugging 191-- splices by running them in 'IO'. 192-- 193-- Note that many functions in 'Q', such as 'reify' and other compiler 194-- queries, are not supported when running 'Q' in 'IO'; these operations 195-- simply fail at runtime. Indeed, the only operations guaranteed to succeed 196-- are 'newName', 'runIO', 'reportError' and 'reportWarning'. 197runQ :: Quasi m => Q a -> m a 198runQ (Q m) = m 199 200instance Monad Q where 201 Q m >>= k = Q (m >>= \x -> unQ (k x)) 202 (>>) = (*>) 203 204instance MonadFail Q where 205 fail s = report True s >> Q (fail "Q monad failure") 206 207instance Functor Q where 208 fmap f (Q x) = Q (fmap f x) 209 210instance Applicative Q where 211 pure x = Q (pure x) 212 Q f <*> Q x = Q (f <*> x) 213 Q m *> Q n = Q (m *> n) 214 215-- | @since 2.17.0.0 216instance Semigroup a => Semigroup (Q a) where 217 (<>) = liftA2 (<>) 218 219-- | @since 2.17.0.0 220instance Monoid a => Monoid (Q a) where 221 mempty = pure mempty 222 223-- | If the function passed to 'mfix' inspects its argument, 224-- the resulting action will throw a 'FixIOException'. 225-- 226-- @since 2.17.0.0 227instance MonadFix Q where 228 -- We use the same blackholing approach as in fixIO. 229 -- See Note [Blackholing in fixIO] in System.IO in base. 230 mfix k = do 231 m <- runIO newEmptyMVar 232 ans <- runIO (unsafeDupableInterleaveIO 233 (readMVar m `catch` \BlockedIndefinitelyOnMVar -> 234 throwIO FixIOException)) 235 result <- k ans 236 runIO (putMVar m result) 237 return result 238 239 240----------------------------------------------------- 241-- 242-- The Quote class 243-- 244----------------------------------------------------- 245 246 247 248-- | The 'Quote' class implements the minimal interface which is necessary for 249-- desugaring quotations. 250-- 251-- * The @Monad m@ superclass is needed to stitch together the different 252-- AST fragments. 253-- * 'newName' is used when desugaring binding structures such as lambdas 254-- to generate fresh names. 255-- 256-- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp` 257-- 258-- For many years the type of a quotation was fixed to be `Q Exp` but by 259-- more precisely specifying the minimal interface it enables the `Exp` to 260-- be extracted purely from the quotation without interacting with `Q`. 261class Monad m => Quote m where 262 {- | 263 Generate a fresh name, which cannot be captured. 264 265 For example, this: 266 267 @f = $(do 268 nm1 <- newName \"x\" 269 let nm2 = 'mkName' \"x\" 270 return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1))) 271 )@ 272 273 will produce the splice 274 275 >f = \x0 -> \x -> x0 276 277 In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@, 278 and is not captured by the binding @VarP nm2@. 279 280 Although names generated by @newName@ cannot /be captured/, they can 281 /capture/ other names. For example, this: 282 283 >g = $(do 284 > nm1 <- newName "x" 285 > let nm2 = mkName "x" 286 > return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2))) 287 > ) 288 289 will produce the splice 290 291 >g = \x -> \x0 -> x0 292 293 since the occurrence @VarE nm2@ is captured by the innermost binding 294 of @x@, namely @VarP nm1@. 295 -} 296 newName :: String -> m Name 297 298instance Quote Q where 299 newName s = Q (qNewName s) 300 301----------------------------------------------------- 302-- 303-- The TExp type 304-- 305----------------------------------------------------- 306 307type role TExp nominal -- See Note [Role of TExp] 308newtype TExp (a :: TYPE (r :: RuntimeRep)) = TExp 309 { unType :: Exp -- ^ Underlying untyped Template Haskell expression 310 } 311-- ^ Represents an expression which has type @a@. Built on top of 'Exp', typed 312-- expressions allow for type-safe splicing via: 313-- 314-- - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if 315-- that expression has type @a@, then the quotation has type 316-- @'Q' ('TExp' a)@ 317-- 318-- - typed splices inside of typed quotes, written as @$$(...)@ where @...@ 319-- is an arbitrary expression of type @'Q' ('TExp' a)@ 320-- 321-- Traditional expression quotes and splices let us construct ill-typed 322-- expressions: 323-- 324-- >>> fmap ppr $ runQ [| True == $( [| "foo" |] ) |] 325-- GHC.Types.True GHC.Classes.== "foo" 326-- >>> GHC.Types.True GHC.Classes.== "foo" 327-- <interactive> error: 328-- • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’ 329-- • In the second argument of ‘(==)’, namely ‘"foo"’ 330-- In the expression: True == "foo" 331-- In an equation for ‘it’: it = True == "foo" 332-- 333-- With typed expressions, the type error occurs when /constructing/ the 334-- Template Haskell expression: 335-- 336-- >>> fmap ppr $ runQ [|| True == $$( [|| "foo" ||] ) ||] 337-- <interactive> error: 338-- • Couldn't match type ‘[Char]’ with ‘Bool’ 339-- Expected type: Q (TExp Bool) 340-- Actual type: Q (TExp [Char]) 341-- • In the Template Haskell quotation [|| "foo" ||] 342-- In the expression: [|| "foo" ||] 343-- In the Template Haskell splice $$([|| "foo" ||]) 344-- 345-- Levity-polymorphic since /template-haskell-2.16.0.0/. 346 347-- | Discard the type annotation and produce a plain Template Haskell 348-- expression 349-- 350-- Levity-polymorphic since /template-haskell-2.16.0.0/. 351unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp 352unTypeQ m = do { TExp e <- m 353 ; return e } 354 355-- | Annotate the Template Haskell expression with a type 356-- 357-- This is unsafe because GHC cannot check for you that the expression 358-- really does have the type you claim it has. 359-- 360-- Levity-polymorphic since /template-haskell-2.16.0.0/. 361unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m . 362 Quote m => m Exp -> m (TExp a) 363unsafeTExpCoerce m = do { e <- m 364 ; return (TExp e) } 365 366{- Note [Role of TExp] 367~~~~~~~~~~~~~~~~~~~~~~ 368TExp's argument must have a nominal role, not phantom as would 369be inferred (#8459). Consider 370 371 e :: TExp Age 372 e = MkAge 3 373 374 foo = $(coerce e) + 4::Int 375 376The splice will evaluate to (MkAge 3) and you can't add that to 3774::Int. So you can't coerce a (TExp Age) to a (TExp Int). -} 378 379-- Code constructor 380 381type role Code representational nominal -- See Note [Role of TExp] 382newtype Code m (a :: TYPE (r :: RuntimeRep)) = Code 383 { examineCode :: m (TExp a) -- ^ Underlying monadic value 384 } 385 386-- | Unsafely convert an untyped code representation into a typed code 387-- representation. 388unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m . 389 Quote m => m Exp -> Code m a 390unsafeCodeCoerce m = Code (unsafeTExpCoerce m) 391 392-- | Lift a monadic action producing code into the typed 'Code' 393-- representation 394liftCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . m (TExp a) -> Code m a 395liftCode = Code 396 397-- | Extract the untyped representation from the typed representation 398unTypeCode :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m 399 => Code m a -> m Exp 400unTypeCode = unTypeQ . examineCode 401 402-- | Modify the ambient monad used during code generation. For example, you 403-- can use `hoistCode` to handle a state effect: 404-- @ 405-- handleState :: Code (StateT Int Q) a -> Code Q a 406-- handleState = hoistCode (flip runState 0) 407-- @ 408hoistCode :: forall m n (r :: RuntimeRep) (a :: TYPE r) . Monad m 409 => (forall x . m x -> n x) -> Code m a -> Code n a 410hoistCode f (Code a) = Code (f a) 411 412 413-- | Variant of (>>=) which allows effectful computations to be injected 414-- into code generation. 415bindCode :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m 416 => m a -> (a -> Code m b) -> Code m b 417bindCode q k = liftCode (q >>= examineCode . k) 418 419-- | Variant of (>>) which allows effectful computations to be injected 420-- into code generation. 421bindCode_ :: forall m a (r :: RuntimeRep) (b :: TYPE r) . Monad m 422 => m a -> Code m b -> Code m b 423bindCode_ q c = liftCode ( q >> examineCode c) 424 425-- | A useful combinator for embedding monadic actions into 'Code' 426-- @ 427-- myCode :: ... => Code m a 428-- myCode = joinCode $ do 429-- x <- someSideEffect 430-- return (makeCodeWith x) 431-- @ 432joinCode :: forall m (r :: RuntimeRep) (a :: TYPE r) . Monad m 433 => m (Code m a) -> Code m a 434joinCode = flip bindCode id 435 436---------------------------------------------------- 437-- Packaged versions for the programmer, hiding the Quasi-ness 438 439 440-- | Report an error (True) or warning (False), 441-- but carry on; use 'fail' to stop. 442report :: Bool -> String -> Q () 443report b s = Q (qReport b s) 444{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6 445 446-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'. 447reportError :: String -> Q () 448reportError = report True 449 450-- | Report a warning to the user, and carry on. 451reportWarning :: String -> Q () 452reportWarning = report False 453 454-- | Recover from errors raised by 'reportError' or 'fail'. 455recover :: Q a -- ^ handler to invoke on failure 456 -> Q a -- ^ computation to run 457 -> Q a 458recover (Q r) (Q m) = Q (qRecover r m) 459 460-- We don't export lookupName; the Bool isn't a great API 461-- Instead we export lookupTypeName, lookupValueName 462lookupName :: Bool -> String -> Q (Maybe Name) 463lookupName ns s = Q (qLookupName ns s) 464 465-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details. 466lookupTypeName :: String -> Q (Maybe Name) 467lookupTypeName s = Q (qLookupName True s) 468 469-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details. 470lookupValueName :: String -> Q (Maybe Name) 471lookupValueName s = Q (qLookupName False s) 472 473{- 474Note [Name lookup] 475~~~~~~~~~~~~~~~~~~ 476-} 477{- $namelookup #namelookup# 478The functions 'lookupTypeName' and 'lookupValueName' provide 479a way to query the current splice's context for what names 480are in scope. The function 'lookupTypeName' queries the type 481namespace, whereas 'lookupValueName' queries the value namespace, 482but the functions are otherwise identical. 483 484A call @lookupValueName s@ will check if there is a value 485with name @s@ in scope at the current splice's location. If 486there is, the @Name@ of this value is returned; 487if not, then @Nothing@ is returned. 488 489The returned name cannot be \"captured\". 490For example: 491 492> f = "global" 493> g = $( do 494> Just nm <- lookupValueName "f" 495> [| let f = "local" in $( varE nm ) |] 496 497In this case, @g = \"global\"@; the call to @lookupValueName@ 498returned the global @f@, and this name was /not/ captured by 499the local definition of @f@. 500 501The lookup is performed in the context of the /top-level/ splice 502being run. For example: 503 504> f = "global" 505> g = $( [| let f = "local" in 506> $(do 507> Just nm <- lookupValueName "f" 508> varE nm 509> ) |] ) 510 511Again in this example, @g = \"global\"@, because the call to 512@lookupValueName@ queries the context of the outer-most @$(...)@. 513 514Operators should be queried without any surrounding parentheses, like so: 515 516> lookupValueName "+" 517 518Qualified names are also supported, like so: 519 520> lookupValueName "Prelude.+" 521> lookupValueName "Prelude.map" 522 523-} 524 525 526{- | 'reify' looks up information about the 'Name'. 527 528It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName' 529to ensure that we are reifying from the right namespace. For instance, in this context: 530 531> data D = D 532 533which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.) 534To ensure we get information about @D@-the-value, use 'lookupValueName': 535 536> do 537> Just nm <- lookupValueName "D" 538> reify nm 539 540and to get information about @D@-the-type, use 'lookupTypeName'. 541-} 542reify :: Name -> Q Info 543reify v = Q (qReify v) 544 545{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For 546example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then 547@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function 548@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns 549'Nothing', so you may assume @bar@ has 'defaultFixity'. 550-} 551reifyFixity :: Name -> Q (Maybe Fixity) 552reifyFixity nm = Q (qReifyFixity nm) 553 554{- | @reifyType nm@ attempts to find the type or kind of @nm@. For example, 555@reifyType 'not@ returns @Bool -> Bool@, and 556@reifyType ''Bool@ returns @Type@. 557This works even if there's no explicit signature and the type or kind is inferred. 558-} 559reifyType :: Name -> Q Type 560reifyType nm = Q (qReifyType nm) 561 562{- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is, 563if @nm@ is the name of a type class, then all instances of this class at the types @tys@ 564are returned. Alternatively, if @nm@ is the name of a data family or type family, 565all instances of this family at the types @tys@ are returned. 566 567Note that this is a \"shallow\" test; the declarations returned merely have 568instance heads which unify with @nm tys@, they need not actually be satisfiable. 569 570 - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains 571 the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and 572 @B@ themselves implement 'Eq' 573 574 - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available 575 instance of 'Eq' 576 577There is one edge case: @reifyInstances ''Typeable tys@ currently always 578produces an empty list (no matter what @tys@ are given). 579-} 580reifyInstances :: Name -> [Type] -> Q [InstanceDec] 581reifyInstances cls tys = Q (qReifyInstances cls tys) 582 583{- | @reifyRoles nm@ returns the list of roles associated with the parameters of 584the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon. 585The returned list should never contain 'InferR'. 586-} 587reifyRoles :: Name -> Q [Role] 588reifyRoles nm = Q (qReifyRoles nm) 589 590-- | @reifyAnnotations target@ returns the list of annotations 591-- associated with @target@. Only the annotations that are 592-- appropriately typed is returned. So if you have @Int@ and @String@ 593-- annotations for the same target, you have to call this function twice. 594reifyAnnotations :: Data a => AnnLookup -> Q [a] 595reifyAnnotations an = Q (qReifyAnnotations an) 596 597-- | @reifyModule mod@ looks up information about module @mod@. To 598-- look up the current module, call this function with the return 599-- value of 'Language.Haskell.TH.Lib.thisModule'. 600reifyModule :: Module -> Q ModuleInfo 601reifyModule m = Q (qReifyModule m) 602 603-- | @reifyConStrictness nm@ looks up the strictness information for the fields 604-- of the constructor with the name @nm@. Note that the strictness information 605-- that 'reifyConStrictness' returns may not correspond to what is written in 606-- the source code. For example, in the following data declaration: 607-- 608-- @ 609-- data Pair a = Pair a a 610-- @ 611-- 612-- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most 613-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the 614-- @-XStrictData@ language extension was enabled. 615reifyConStrictness :: Name -> Q [DecidedStrictness] 616reifyConStrictness n = Q (qReifyConStrictness n) 617 618-- | Is the list of instances returned by 'reifyInstances' nonempty? 619isInstance :: Name -> [Type] -> Q Bool 620isInstance nm tys = do { decs <- reifyInstances nm tys 621 ; return (not (null decs)) } 622 623-- | The location at which this computation is spliced. 624location :: Q Loc 625location = Q qLocation 626 627-- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad. 628-- Take care: you are guaranteed the ordering of calls to 'runIO' within 629-- a single 'Q' computation, but not about the order in which splices are run. 630-- 631-- Note: for various murky reasons, stdout and stderr handles are not 632-- necessarily flushed when the compiler finishes running, so you should 633-- flush them yourself. 634runIO :: IO a -> Q a 635runIO m = Q (qRunIO m) 636 637-- | Record external files that runIO is using (dependent upon). 638-- The compiler can then recognize that it should re-compile the Haskell file 639-- when an external file changes. 640-- 641-- Expects an absolute file path. 642-- 643-- Notes: 644-- 645-- * ghc -M does not know about these dependencies - it does not execute TH. 646-- 647-- * The dependency is based on file content, not a modification time 648addDependentFile :: FilePath -> Q () 649addDependentFile fp = Q (qAddDependentFile fp) 650 651-- | Obtain a temporary file path with the given suffix. The compiler will 652-- delete this file after compilation. 653addTempFile :: String -> Q FilePath 654addTempFile suffix = Q (qAddTempFile suffix) 655 656-- | Add additional top-level declarations. The added declarations will be type 657-- checked along with the current declaration group. 658addTopDecls :: [Dec] -> Q () 659addTopDecls ds = Q (qAddTopDecls ds) 660 661-- | 662addForeignFile :: ForeignSrcLang -> String -> Q () 663addForeignFile = addForeignSource 664{-# DEPRECATED addForeignFile 665 "Use 'Language.Haskell.TH.Syntax.addForeignSource' instead" 666 #-} -- deprecated in 8.6 667 668-- | Emit a foreign file which will be compiled and linked to the object for 669-- the current module. Currently only languages that can be compiled with 670-- the C compiler are supported, and the flags passed as part of -optc will 671-- be also applied to the C compiler invocation that will compile them. 672-- 673-- Note that for non-C languages (for example C++) @extern "C"@ directives 674-- must be used to get symbols that we can access from Haskell. 675-- 676-- To get better errors, it is recommended to use #line pragmas when 677-- emitting C files, e.g. 678-- 679-- > {-# LANGUAGE CPP #-} 680-- > ... 681-- > addForeignSource LangC $ unlines 682-- > [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__ 683-- > , ... 684-- > ] 685addForeignSource :: ForeignSrcLang -> String -> Q () 686addForeignSource lang src = do 687 let suffix = case lang of 688 LangC -> "c" 689 LangCxx -> "cpp" 690 LangObjc -> "m" 691 LangObjcxx -> "mm" 692 LangAsm -> "s" 693 RawObject -> "a" 694 path <- addTempFile suffix 695 runIO $ writeFile path src 696 addForeignFilePath lang path 697 698-- | Same as 'addForeignSource', but expects to receive a path pointing to the 699-- foreign file instead of a 'String' of its contents. Consider using this in 700-- conjunction with 'addTempFile'. 701-- 702-- This is a good alternative to 'addForeignSource' when you are trying to 703-- directly link in an object file. 704addForeignFilePath :: ForeignSrcLang -> FilePath -> Q () 705addForeignFilePath lang fp = Q (qAddForeignFilePath lang fp) 706 707-- | Add a finalizer that will run in the Q monad after the current module has 708-- been type checked. This only makes sense when run within a top-level splice. 709-- 710-- The finalizer is given the local type environment at the splice point. Thus 711-- 'reify' is able to find the local definitions when executed inside the 712-- finalizer. 713addModFinalizer :: Q () -> Q () 714addModFinalizer act = Q (qAddModFinalizer (unQ act)) 715 716-- | Adds a core plugin to the compilation pipeline. 717-- 718-- @addCorePlugin m@ has almost the same effect as passing @-fplugin=m@ to ghc 719-- in the command line. The major difference is that the plugin module @m@ 720-- must not belong to the current package. When TH executes, it is too late 721-- to tell the compiler that we needed to compile first a plugin module in the 722-- current package. 723addCorePlugin :: String -> Q () 724addCorePlugin plugin = Q (qAddCorePlugin plugin) 725 726-- | Get state from the 'Q' monad. Note that the state is local to the 727-- Haskell module in which the Template Haskell expression is executed. 728getQ :: Typeable a => Q (Maybe a) 729getQ = Q qGetQ 730 731-- | Replace the state in the 'Q' monad. Note that the state is local to the 732-- Haskell module in which the Template Haskell expression is executed. 733putQ :: Typeable a => a -> Q () 734putQ x = Q (qPutQ x) 735 736-- | Determine whether the given language extension is enabled in the 'Q' monad. 737isExtEnabled :: Extension -> Q Bool 738isExtEnabled ext = Q (qIsExtEnabled ext) 739 740-- | List all enabled language extensions. 741extsEnabled :: Q [Extension] 742extsEnabled = Q qExtsEnabled 743 744instance MonadIO Q where 745 liftIO = runIO 746 747instance Quasi Q where 748 qNewName = newName 749 qReport = report 750 qRecover = recover 751 qReify = reify 752 qReifyFixity = reifyFixity 753 qReifyType = reifyType 754 qReifyInstances = reifyInstances 755 qReifyRoles = reifyRoles 756 qReifyAnnotations = reifyAnnotations 757 qReifyModule = reifyModule 758 qReifyConStrictness = reifyConStrictness 759 qLookupName = lookupName 760 qLocation = location 761 qAddDependentFile = addDependentFile 762 qAddTempFile = addTempFile 763 qAddTopDecls = addTopDecls 764 qAddForeignFilePath = addForeignFilePath 765 qAddModFinalizer = addModFinalizer 766 qAddCorePlugin = addCorePlugin 767 qGetQ = getQ 768 qPutQ = putQ 769 qIsExtEnabled = isExtEnabled 770 qExtsEnabled = extsEnabled 771 772 773---------------------------------------------------- 774-- The following operations are used solely in GHC.HsToCore.Quote when 775-- desugaring brackets. They are not necessary for the user, who can use 776-- ordinary return and (>>=) etc 777 778sequenceQ :: forall m . Monad m => forall a . [m a] -> m [a] 779sequenceQ = sequence 780 781 782----------------------------------------------------- 783-- 784-- The Lift class 785-- 786----------------------------------------------------- 787 788-- | A 'Lift' instance can have any of its values turned into a Template 789-- Haskell expression. This is needed when a value used within a Template 790-- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@ or 791-- @[|| ... ||]@) but not at the top level. As an example: 792-- 793-- > add1 :: Int -> Q (TExp Int) 794-- > add1 x = [|| x + 1 ||] 795-- 796-- Template Haskell has no way of knowing what value @x@ will take on at 797-- splice-time, so it requires the type of @x@ to be an instance of 'Lift'. 798-- 799-- A 'Lift' instance must satisfy @$(lift x) ≡ x@ and @$$(liftTyped x) ≡ x@ 800-- for all @x@, where @$(...)@ and @$$(...)@ are Template Haskell splices. 801-- It is additionally expected that @'lift' x ≡ 'unTypeQ' ('liftTyped' x)@. 802-- 803-- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@ 804-- GHC language extension: 805-- 806-- > {-# LANGUAGE DeriveLift #-} 807-- > module Foo where 808-- > 809-- > import Language.Haskell.TH.Syntax 810-- > 811-- > data Bar a = Bar1 a (Bar a) | Bar2 String 812-- > deriving Lift 813-- 814-- Levity-polymorphic since /template-haskell-2.16.0.0/. 815class Lift (t :: TYPE r) where 816 -- | Turn a value into a Template Haskell expression, suitable for use in 817 -- a splice. 818 lift :: Quote m => t -> m Exp 819 default lift :: (r ~ 'LiftedRep, Quote m) => t -> m Exp 820 lift = unTypeCode . liftTyped 821 822 -- | Turn a value into a Template Haskell typed expression, suitable for use 823 -- in a typed splice. 824 -- 825 -- @since 2.16.0.0 826 liftTyped :: Quote m => t -> Code m t 827 828 829-- If you add any instances here, consider updating test th/TH_Lift 830instance Lift Integer where 831 liftTyped x = unsafeCodeCoerce (lift x) 832 lift x = return (LitE (IntegerL x)) 833 834instance Lift Int where 835 liftTyped x = unsafeCodeCoerce (lift x) 836 lift x = return (LitE (IntegerL (fromIntegral x))) 837 838-- | @since 2.16.0.0 839instance Lift Int# where 840 liftTyped x = unsafeCodeCoerce (lift x) 841 lift x = return (LitE (IntPrimL (fromIntegral (I# x)))) 842 843instance Lift Int8 where 844 liftTyped x = unsafeCodeCoerce (lift x) 845 lift x = return (LitE (IntegerL (fromIntegral x))) 846 847instance Lift Int16 where 848 liftTyped x = unsafeCodeCoerce (lift x) 849 lift x = return (LitE (IntegerL (fromIntegral x))) 850 851instance Lift Int32 where 852 liftTyped x = unsafeCodeCoerce (lift x) 853 lift x = return (LitE (IntegerL (fromIntegral x))) 854 855instance Lift Int64 where 856 liftTyped x = unsafeCodeCoerce (lift x) 857 lift x = return (LitE (IntegerL (fromIntegral x))) 858 859-- | @since 2.16.0.0 860instance Lift Word# where 861 liftTyped x = unsafeCodeCoerce (lift x) 862 lift x = return (LitE (WordPrimL (fromIntegral (W# x)))) 863 864instance Lift Word where 865 liftTyped x = unsafeCodeCoerce (lift x) 866 lift x = return (LitE (IntegerL (fromIntegral x))) 867 868instance Lift Word8 where 869 liftTyped x = unsafeCodeCoerce (lift x) 870 lift x = return (LitE (IntegerL (fromIntegral x))) 871 872instance Lift Word16 where 873 liftTyped x = unsafeCodeCoerce (lift x) 874 lift x = return (LitE (IntegerL (fromIntegral x))) 875 876instance Lift Word32 where 877 liftTyped x = unsafeCodeCoerce (lift x) 878 lift x = return (LitE (IntegerL (fromIntegral x))) 879 880instance Lift Word64 where 881 liftTyped x = unsafeCodeCoerce (lift x) 882 lift x = return (LitE (IntegerL (fromIntegral x))) 883 884instance Lift Natural where 885 liftTyped x = unsafeCodeCoerce (lift x) 886 lift x = return (LitE (IntegerL (fromIntegral x))) 887 888instance Integral a => Lift (Ratio a) where 889 liftTyped x = unsafeCodeCoerce (lift x) 890 lift x = return (LitE (RationalL (toRational x))) 891 892instance Lift Float where 893 liftTyped x = unsafeCodeCoerce (lift x) 894 lift x = return (LitE (RationalL (toRational x))) 895 896-- | @since 2.16.0.0 897instance Lift Float# where 898 liftTyped x = unsafeCodeCoerce (lift x) 899 lift x = return (LitE (FloatPrimL (toRational (F# x)))) 900 901instance Lift Double where 902 liftTyped x = unsafeCodeCoerce (lift x) 903 lift x = return (LitE (RationalL (toRational x))) 904 905-- | @since 2.16.0.0 906instance Lift Double# where 907 liftTyped x = unsafeCodeCoerce (lift x) 908 lift x = return (LitE (DoublePrimL (toRational (D# x)))) 909 910instance Lift Char where 911 liftTyped x = unsafeCodeCoerce (lift x) 912 lift x = return (LitE (CharL x)) 913 914-- | @since 2.16.0.0 915instance Lift Char# where 916 liftTyped x = unsafeCodeCoerce (lift x) 917 lift x = return (LitE (CharPrimL (C# x))) 918 919instance Lift Bool where 920 liftTyped x = unsafeCodeCoerce (lift x) 921 922 lift True = return (ConE trueName) 923 lift False = return (ConE falseName) 924 925-- | Produces an 'Addr#' literal from the NUL-terminated C-string starting at 926-- the given memory address. 927-- 928-- @since 2.16.0.0 929instance Lift Addr# where 930 liftTyped x = unsafeCodeCoerce (lift x) 931 lift x 932 = return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x)))) 933 934instance Lift a => Lift (Maybe a) where 935 liftTyped x = unsafeCodeCoerce (lift x) 936 937 lift Nothing = return (ConE nothingName) 938 lift (Just x) = liftM (ConE justName `AppE`) (lift x) 939 940instance (Lift a, Lift b) => Lift (Either a b) where 941 liftTyped x = unsafeCodeCoerce (lift x) 942 943 lift (Left x) = liftM (ConE leftName `AppE`) (lift x) 944 lift (Right y) = liftM (ConE rightName `AppE`) (lift y) 945 946instance Lift a => Lift [a] where 947 liftTyped x = unsafeCodeCoerce (lift x) 948 lift xs = do { xs' <- mapM lift xs; return (ListE xs') } 949 950liftString :: Quote m => String -> m Exp 951-- Used in GHC.Tc.Gen.Expr to short-circuit the lifting for strings 952liftString s = return (LitE (StringL s)) 953 954-- | @since 2.15.0.0 955instance Lift a => Lift (NonEmpty a) where 956 liftTyped x = unsafeCodeCoerce (lift x) 957 958 lift (x :| xs) = do 959 x' <- lift x 960 xs' <- lift xs 961 return (InfixE (Just x') (ConE nonemptyName) (Just xs')) 962 963-- | @since 2.15.0.0 964instance Lift Void where 965 liftTyped = liftCode . absurd 966 lift = pure . absurd 967 968instance Lift () where 969 liftTyped x = unsafeCodeCoerce (lift x) 970 lift () = return (ConE (tupleDataName 0)) 971 972instance (Lift a, Lift b) => Lift (a, b) where 973 liftTyped x = unsafeCodeCoerce (lift x) 974 lift (a, b) 975 = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b] 976 977instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where 978 liftTyped x = unsafeCodeCoerce (lift x) 979 lift (a, b, c) 980 = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c] 981 982instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where 983 liftTyped x = unsafeCodeCoerce (lift x) 984 lift (a, b, c, d) 985 = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c, lift d] 986 987instance (Lift a, Lift b, Lift c, Lift d, Lift e) 988 => Lift (a, b, c, d, e) where 989 liftTyped x = unsafeCodeCoerce (lift x) 990 lift (a, b, c, d, e) 991 = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b 992 , lift c, lift d, lift e ] 993 994instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f) 995 => Lift (a, b, c, d, e, f) where 996 liftTyped x = unsafeCodeCoerce (lift x) 997 lift (a, b, c, d, e, f) 998 = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c 999 , lift d, lift e, lift f ] 1000 1001instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) 1002 => Lift (a, b, c, d, e, f, g) where 1003 liftTyped x = unsafeCodeCoerce (lift x) 1004 lift (a, b, c, d, e, f, g) 1005 = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c 1006 , lift d, lift e, lift f, lift g ] 1007 1008-- | @since 2.16.0.0 1009instance Lift (# #) where 1010 liftTyped x = unsafeCodeCoerce (lift x) 1011 lift (# #) = return (ConE (unboxedTupleTypeName 0)) 1012 1013-- | @since 2.16.0.0 1014instance (Lift a) => Lift (# a #) where 1015 liftTyped x = unsafeCodeCoerce (lift x) 1016 lift (# a #) 1017 = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a] 1018 1019-- | @since 2.16.0.0 1020instance (Lift a, Lift b) => Lift (# a, b #) where 1021 liftTyped x = unsafeCodeCoerce (lift x) 1022 lift (# a, b #) 1023 = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b] 1024 1025-- | @since 2.16.0.0 1026instance (Lift a, Lift b, Lift c) 1027 => Lift (# a, b, c #) where 1028 liftTyped x = unsafeCodeCoerce (lift x) 1029 lift (# a, b, c #) 1030 = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b, lift c] 1031 1032-- | @since 2.16.0.0 1033instance (Lift a, Lift b, Lift c, Lift d) 1034 => Lift (# a, b, c, d #) where 1035 liftTyped x = unsafeCodeCoerce (lift x) 1036 lift (# a, b, c, d #) 1037 = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b 1038 , lift c, lift d ] 1039 1040-- | @since 2.16.0.0 1041instance (Lift a, Lift b, Lift c, Lift d, Lift e) 1042 => Lift (# a, b, c, d, e #) where 1043 liftTyped x = unsafeCodeCoerce (lift x) 1044 lift (# a, b, c, d, e #) 1045 = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b 1046 , lift c, lift d, lift e ] 1047 1048-- | @since 2.16.0.0 1049instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f) 1050 => Lift (# a, b, c, d, e, f #) where 1051 liftTyped x = unsafeCodeCoerce (lift x) 1052 lift (# a, b, c, d, e, f #) 1053 = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c 1054 , lift d, lift e, lift f ] 1055 1056-- | @since 2.16.0.0 1057instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) 1058 => Lift (# a, b, c, d, e, f, g #) where 1059 liftTyped x = unsafeCodeCoerce (lift x) 1060 lift (# a, b, c, d, e, f, g #) 1061 = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c 1062 , lift d, lift e, lift f 1063 , lift g ] 1064 1065-- | @since 2.16.0.0 1066instance (Lift a, Lift b) => Lift (# a | b #) where 1067 liftTyped x = unsafeCodeCoerce (lift x) 1068 lift x 1069 = case x of 1070 (# y | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 2 1071 (# | y #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 2 1072 1073-- | @since 2.16.0.0 1074instance (Lift a, Lift b, Lift c) 1075 => Lift (# a | b | c #) where 1076 liftTyped x = unsafeCodeCoerce (lift x) 1077 lift x 1078 = case x of 1079 (# y | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 3 1080 (# | y | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 3 1081 (# | | y #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 3 1082 1083-- | @since 2.16.0.0 1084instance (Lift a, Lift b, Lift c, Lift d) 1085 => Lift (# a | b | c | d #) where 1086 liftTyped x = unsafeCodeCoerce (lift x) 1087 lift x 1088 = case x of 1089 (# y | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 4 1090 (# | y | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 4 1091 (# | | y | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 4 1092 (# | | | y #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 4 1093 1094-- | @since 2.16.0.0 1095instance (Lift a, Lift b, Lift c, Lift d, Lift e) 1096 => Lift (# a | b | c | d | e #) where 1097 liftTyped x = unsafeCodeCoerce (lift x) 1098 lift x 1099 = case x of 1100 (# y | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 5 1101 (# | y | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 5 1102 (# | | y | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 5 1103 (# | | | y | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 5 1104 (# | | | | y #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 5 1105 1106-- | @since 2.16.0.0 1107instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f) 1108 => Lift (# a | b | c | d | e | f #) where 1109 liftTyped x = unsafeCodeCoerce (lift x) 1110 lift x 1111 = case x of 1112 (# y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 6 1113 (# | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 6 1114 (# | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 6 1115 (# | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 6 1116 (# | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 6 1117 (# | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 6 1118 1119-- | @since 2.16.0.0 1120instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g) 1121 => Lift (# a | b | c | d | e | f | g #) where 1122 liftTyped x = unsafeCodeCoerce (lift x) 1123 lift x 1124 = case x of 1125 (# y | | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 7 1126 (# | y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 7 1127 (# | | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 7 1128 (# | | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 7 1129 (# | | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 7 1130 (# | | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 7 1131 (# | | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 7 <*> pure 7 1132 1133-- TH has a special form for literal strings, 1134-- which we should take advantage of. 1135-- NB: the lhs of the rule has no args, so that 1136-- the rule will apply to a 'lift' all on its own 1137-- which happens to be the way the type checker 1138-- creates it. 1139{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-} 1140 1141 1142trueName, falseName :: Name 1143trueName = mkNameG DataName "ghc-prim" "GHC.Types" "True" 1144falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False" 1145 1146nothingName, justName :: Name 1147nothingName = mkNameG DataName "base" "GHC.Maybe" "Nothing" 1148justName = mkNameG DataName "base" "GHC.Maybe" "Just" 1149 1150leftName, rightName :: Name 1151leftName = mkNameG DataName "base" "Data.Either" "Left" 1152rightName = mkNameG DataName "base" "Data.Either" "Right" 1153 1154nonemptyName :: Name 1155nonemptyName = mkNameG DataName "base" "GHC.Base" ":|" 1156 1157oneName, manyName :: Name 1158oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One" 1159manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many" 1160----------------------------------------------------- 1161-- 1162-- Generic Lift implementations 1163-- 1164----------------------------------------------------- 1165 1166-- | 'dataToQa' is an internal utility function for constructing generic 1167-- conversion functions from types with 'Data' instances to various 1168-- quasi-quoting representations. See the source of 'dataToExpQ' and 1169-- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@ 1170-- and @appQ@ are overloadable to account for different syntax for 1171-- expressions and patterns; @antiQ@ allows you to override type-specific 1172-- cases, a common usage is just @const Nothing@, which results in 1173-- no overloading. 1174dataToQa :: forall m a k q. (Quote m, Data a) 1175 => (Name -> k) 1176 -> (Lit -> m q) 1177 -> (k -> [m q] -> m q) 1178 -> (forall b . Data b => b -> Maybe (m q)) 1179 -> a 1180 -> m q 1181dataToQa mkCon mkLit appCon antiQ t = 1182 case antiQ t of 1183 Nothing -> 1184 case constrRep constr of 1185 AlgConstr _ -> 1186 appCon (mkCon funOrConName) conArgs 1187 where 1188 funOrConName :: Name 1189 funOrConName = 1190 case showConstr constr of 1191 "(:)" -> Name (mkOccName ":") 1192 (NameG DataName 1193 (mkPkgName "ghc-prim") 1194 (mkModName "GHC.Types")) 1195 con@"[]" -> Name (mkOccName con) 1196 (NameG DataName 1197 (mkPkgName "ghc-prim") 1198 (mkModName "GHC.Types")) 1199 con@('(':_) -> Name (mkOccName con) 1200 (NameG DataName 1201 (mkPkgName "ghc-prim") 1202 (mkModName "GHC.Tuple")) 1203 1204 -- Tricky case: see Note [Data for non-algebraic types] 1205 fun@(x:_) | startsVarSym x || startsVarId x 1206 -> mkNameG_v tyconPkg tyconMod fun 1207 con -> mkNameG_d tyconPkg tyconMod con 1208 1209 where 1210 tycon :: TyCon 1211 tycon = (typeRepTyCon . typeOf) t 1212 1213 tyconPkg, tyconMod :: String 1214 tyconPkg = tyConPackage tycon 1215 tyconMod = tyConModule tycon 1216 1217 conArgs :: [m q] 1218 conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t 1219 IntConstr n -> 1220 mkLit $ IntegerL n 1221 FloatConstr n -> 1222 mkLit $ RationalL n 1223 CharConstr c -> 1224 mkLit $ CharL c 1225 where 1226 constr :: Constr 1227 constr = toConstr t 1228 1229 Just y -> y 1230 1231 1232{- Note [Data for non-algebraic types] 1233~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1234Class Data was originally intended for algebraic data types. But 1235it is possible to use it for abstract types too. For example, in 1236package `text` we find 1237 1238 instance Data Text where 1239 ... 1240 toConstr _ = packConstr 1241 1242 packConstr :: Constr 1243 packConstr = mkConstr textDataType "pack" [] Prefix 1244 1245Here `packConstr` isn't a real data constructor, it's an ordinary 1246function. Two complications 1247 1248* In such a case, we must take care to build the Name using 1249 mkNameG_v (for values), not mkNameG_d (for data constructors). 1250 See #10796. 1251 1252* The pseudo-constructor is named only by its string, here "pack". 1253 But 'dataToQa' needs the TyCon of its defining module, and has 1254 to assume it's defined in the same module as the TyCon itself. 1255 But nothing enforces that; #12596 shows what goes wrong if 1256 "pack" is defined in a different module than the data type "Text". 1257 -} 1258 1259-- | 'dataToExpQ' converts a value to a 'Exp' representation of the 1260-- same value, in the SYB style. It is generalized to take a function 1261-- override type-specific cases; see 'liftData' for a more commonly 1262-- used variant. 1263dataToExpQ :: (Quote m, Data a) 1264 => (forall b . Data b => b -> Maybe (m Exp)) 1265 -> a 1266 -> m Exp 1267dataToExpQ = dataToQa varOrConE litE (foldl appE) 1268 where 1269 -- Make sure that VarE is used if the Constr value relies on a 1270 -- function underneath the surface (instead of a constructor). 1271 -- See #10796. 1272 varOrConE s = 1273 case nameSpace s of 1274 Just VarName -> return (VarE s) 1275 Just DataName -> return (ConE s) 1276 _ -> error $ "Can't construct an expression from name " 1277 ++ showName s 1278 appE x y = do { a <- x; b <- y; return (AppE a b)} 1279 litE c = return (LitE c) 1280 1281-- | 'liftData' is a variant of 'lift' in the 'Lift' type class which 1282-- works for any type with a 'Data' instance. 1283liftData :: (Quote m, Data a) => a -> m Exp 1284liftData = dataToExpQ (const Nothing) 1285 1286-- | 'dataToPatQ' converts a value to a 'Pat' representation of the same 1287-- value, in the SYB style. It takes a function to handle type-specific cases, 1288-- alternatively, pass @const Nothing@ to get default behavior. 1289dataToPatQ :: (Quote m, Data a) 1290 => (forall b . Data b => b -> Maybe (m Pat)) 1291 -> a 1292 -> m Pat 1293dataToPatQ = dataToQa id litP conP 1294 where litP l = return (LitP l) 1295 conP n ps = 1296 case nameSpace n of 1297 Just DataName -> do 1298 ps' <- sequence ps 1299 return (ConP n ps') 1300 _ -> error $ "Can't construct a pattern from name " 1301 ++ showName n 1302 1303----------------------------------------------------- 1304-- Names and uniques 1305----------------------------------------------------- 1306 1307newtype ModName = ModName String -- Module name 1308 deriving (Show,Eq,Ord,Data,Generic) 1309 1310newtype PkgName = PkgName String -- package name 1311 deriving (Show,Eq,Ord,Data,Generic) 1312 1313-- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'. 1314data Module = Module PkgName ModName -- package qualified module name 1315 deriving (Show,Eq,Ord,Data,Generic) 1316 1317newtype OccName = OccName String 1318 deriving (Show,Eq,Ord,Data,Generic) 1319 1320mkModName :: String -> ModName 1321mkModName s = ModName s 1322 1323modString :: ModName -> String 1324modString (ModName m) = m 1325 1326 1327mkPkgName :: String -> PkgName 1328mkPkgName s = PkgName s 1329 1330pkgString :: PkgName -> String 1331pkgString (PkgName m) = m 1332 1333 1334----------------------------------------------------- 1335-- OccName 1336----------------------------------------------------- 1337 1338mkOccName :: String -> OccName 1339mkOccName s = OccName s 1340 1341occString :: OccName -> String 1342occString (OccName occ) = occ 1343 1344 1345----------------------------------------------------- 1346-- Names 1347----------------------------------------------------- 1348-- 1349-- For "global" names ('NameG') we need a totally unique name, 1350-- so we must include the name-space of the thing 1351-- 1352-- For unique-numbered things ('NameU'), we've got a unique reference 1353-- anyway, so no need for name space 1354-- 1355-- For dynamically bound thing ('NameS') we probably want them to 1356-- in a context-dependent way, so again we don't want the name 1357-- space. For example: 1358-- 1359-- > let v = mkName "T" in [| data $v = $v |] 1360-- 1361-- Here we use the same Name for both type constructor and data constructor 1362-- 1363-- 1364-- NameL and NameG are bound *outside* the TH syntax tree 1365-- either globally (NameG) or locally (NameL). Ex: 1366-- 1367-- > f x = $(h [| (map, x) |]) 1368-- 1369-- The 'map' will be a NameG, and 'x' wil be a NameL 1370-- 1371-- These Names should never appear in a binding position in a TH syntax tree 1372 1373{- $namecapture #namecapture# 1374Much of 'Name' API is concerned with the problem of /name capture/, which 1375can be seen in the following example. 1376 1377> f expr = [| let x = 0 in $expr |] 1378> ... 1379> g x = $( f [| x |] ) 1380> h y = $( f [| y |] ) 1381 1382A naive desugaring of this would yield: 1383 1384> g x = let x = 0 in x 1385> h y = let x = 0 in y 1386 1387All of a sudden, @g@ and @h@ have different meanings! In this case, 1388we say that the @x@ in the RHS of @g@ has been /captured/ 1389by the binding of @x@ in @f@. 1390 1391What we actually want is for the @x@ in @f@ to be distinct from the 1392@x@ in @g@, so we get the following desugaring: 1393 1394> g x = let x' = 0 in x 1395> h y = let x' = 0 in y 1396 1397which avoids name capture as desired. 1398 1399In the general case, we say that a @Name@ can be captured if 1400the thing it refers to can be changed by adding new declarations. 1401-} 1402 1403{- | 1404An abstract type representing names in the syntax tree. 1405 1406'Name's can be constructed in several ways, which come with different 1407name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for 1408an explanation of name capture): 1409 1410 * the built-in syntax @'f@ and @''T@ can be used to construct names, 1411 The expression @'f@ gives a @Name@ which refers to the value @f@ 1412 currently in scope, and @''T@ gives a @Name@ which refers to the 1413 type @T@ currently in scope. These names can never be captured. 1414 1415 * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and 1416 @''T@ respectively, but the @Name@s are looked up at the point 1417 where the current splice is being run. These names can never be 1418 captured. 1419 1420 * 'newName' monadically generates a new name, which can never 1421 be captured. 1422 1423 * 'mkName' generates a capturable name. 1424 1425Names constructed using @newName@ and @mkName@ may be used in bindings 1426(such as @let x = ...@ or @\x -> ...@), but names constructed using 1427@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not. 1428-} 1429data Name = Name OccName NameFlavour deriving (Data, Eq, Generic) 1430 1431instance Ord Name where 1432 -- check if unique is different before looking at strings 1433 (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2) `thenCmp` 1434 (o1 `compare` o2) 1435 1436data NameFlavour 1437 = NameS -- ^ An unqualified name; dynamically bound 1438 | NameQ ModName -- ^ A qualified name; dynamically bound 1439 | NameU !Uniq -- ^ A unique local name 1440 | NameL !Uniq -- ^ Local name bound outside of the TH AST 1441 | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST: 1442 -- An original name (occurrences only, not binders) 1443 -- Need the namespace too to be sure which 1444 -- thing we are naming 1445 deriving ( Data, Eq, Ord, Show, Generic ) 1446 1447data NameSpace = VarName -- ^ Variables 1448 | DataName -- ^ Data constructors 1449 | TcClsName -- ^ Type constructors and classes; Haskell has them 1450 -- in the same name space for now. 1451 deriving( Eq, Ord, Show, Data, Generic ) 1452 1453-- | @Uniq@ is used by GHC to distinguish names from each other. 1454type Uniq = Integer 1455 1456-- | The name without its module prefix. 1457-- 1458-- ==== __Examples__ 1459-- 1460-- >>> nameBase ''Data.Either.Either 1461-- "Either" 1462-- >>> nameBase (mkName "foo") 1463-- "foo" 1464-- >>> nameBase (mkName "Module.foo") 1465-- "foo" 1466nameBase :: Name -> String 1467nameBase (Name occ _) = occString occ 1468 1469-- | Module prefix of a name, if it exists. 1470-- 1471-- ==== __Examples__ 1472-- 1473-- >>> nameModule ''Data.Either.Either 1474-- Just "Data.Either" 1475-- >>> nameModule (mkName "foo") 1476-- Nothing 1477-- >>> nameModule (mkName "Module.foo") 1478-- Just "Module" 1479nameModule :: Name -> Maybe String 1480nameModule (Name _ (NameQ m)) = Just (modString m) 1481nameModule (Name _ (NameG _ _ m)) = Just (modString m) 1482nameModule _ = Nothing 1483 1484-- | A name's package, if it exists. 1485-- 1486-- ==== __Examples__ 1487-- 1488-- >>> namePackage ''Data.Either.Either 1489-- Just "base" 1490-- >>> namePackage (mkName "foo") 1491-- Nothing 1492-- >>> namePackage (mkName "Module.foo") 1493-- Nothing 1494namePackage :: Name -> Maybe String 1495namePackage (Name _ (NameG _ p _)) = Just (pkgString p) 1496namePackage _ = Nothing 1497 1498-- | Returns whether a name represents an occurrence of a top-level variable 1499-- ('VarName'), data constructor ('DataName'), type constructor, or type class 1500-- ('TcClsName'). If we can't be sure, it returns 'Nothing'. 1501-- 1502-- ==== __Examples__ 1503-- 1504-- >>> nameSpace 'Prelude.id 1505-- Just VarName 1506-- >>> nameSpace (mkName "id") 1507-- Nothing -- only works for top-level variable names 1508-- >>> nameSpace 'Data.Maybe.Just 1509-- Just DataName 1510-- >>> nameSpace ''Data.Maybe.Maybe 1511-- Just TcClsName 1512-- >>> nameSpace ''Data.Ord.Ord 1513-- Just TcClsName 1514nameSpace :: Name -> Maybe NameSpace 1515nameSpace (Name _ (NameG ns _ _)) = Just ns 1516nameSpace _ = Nothing 1517 1518{- | 1519Generate a capturable name. Occurrences of such names will be 1520resolved according to the Haskell scoping rules at the occurrence 1521site. 1522 1523For example: 1524 1525> f = [| pi + $(varE (mkName "pi")) |] 1526> ... 1527> g = let pi = 3 in $f 1528 1529In this case, @g@ is desugared to 1530 1531> g = Prelude.pi + 3 1532 1533Note that @mkName@ may be used with qualified names: 1534 1535> mkName "Prelude.pi" 1536 1537See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could 1538be rewritten using 'Language.Haskell.TH.Lib.dyn' as 1539 1540> f = [| pi + $(dyn "pi") |] 1541-} 1542mkName :: String -> Name 1543-- The string can have a '.', thus "Foo.baz", 1544-- giving a dynamically-bound qualified name, 1545-- in which case we want to generate a NameQ 1546-- 1547-- Parse the string to see if it has a "." in it 1548-- so we know whether to generate a qualified or unqualified name 1549-- It's a bit tricky because we need to parse 1550-- 1551-- > Foo.Baz.x as Qual Foo.Baz x 1552-- 1553-- So we parse it from back to front 1554mkName str 1555 = split [] (reverse str) 1556 where 1557 split occ [] = Name (mkOccName occ) NameS 1558 split occ ('.':rev) | not (null occ) 1559 , is_rev_mod_name rev 1560 = Name (mkOccName occ) (NameQ (mkModName (reverse rev))) 1561 -- The 'not (null occ)' guard ensures that 1562 -- mkName "&." = Name "&." NameS 1563 -- The 'is_rev_mod' guards ensure that 1564 -- mkName ".&" = Name ".&" NameS 1565 -- mkName "^.." = Name "^.." NameS -- #8633 1566 -- mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits") 1567 -- This rather bizarre case actually happened; (.&.) is in Data.Bits 1568 split occ (c:rev) = split (c:occ) rev 1569 1570 -- Recognises a reversed module name xA.yB.C, 1571 -- with at least one component, 1572 -- and each component looks like a module name 1573 -- (i.e. non-empty, starts with capital, all alpha) 1574 is_rev_mod_name rev_mod_str 1575 | (compt, rest) <- break (== '.') rev_mod_str 1576 , not (null compt), isUpper (last compt), all is_mod_char compt 1577 = case rest of 1578 [] -> True 1579 (_dot : rest') -> is_rev_mod_name rest' 1580 | otherwise 1581 = False 1582 1583 is_mod_char c = isAlphaNum c || c == '_' || c == '\'' 1584 1585-- | Only used internally 1586mkNameU :: String -> Uniq -> Name 1587mkNameU s u = Name (mkOccName s) (NameU u) 1588 1589-- | Only used internally 1590mkNameL :: String -> Uniq -> Name 1591mkNameL s u = Name (mkOccName s) (NameL u) 1592 1593-- | Used for 'x etc, but not available to the programmer 1594mkNameG :: NameSpace -> String -> String -> String -> Name 1595mkNameG ns pkg modu occ 1596 = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu)) 1597 1598mkNameS :: String -> Name 1599mkNameS n = Name (mkOccName n) NameS 1600 1601mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name 1602mkNameG_v = mkNameG VarName 1603mkNameG_tc = mkNameG TcClsName 1604mkNameG_d = mkNameG DataName 1605 1606data NameIs = Alone | Applied | Infix 1607 1608showName :: Name -> String 1609showName = showName' Alone 1610 1611showName' :: NameIs -> Name -> String 1612showName' ni nm 1613 = case ni of 1614 Alone -> nms 1615 Applied 1616 | pnam -> nms 1617 | otherwise -> "(" ++ nms ++ ")" 1618 Infix 1619 | pnam -> "`" ++ nms ++ "`" 1620 | otherwise -> nms 1621 where 1622 -- For now, we make the NameQ and NameG print the same, even though 1623 -- NameQ is a qualified name (so what it means depends on what the 1624 -- current scope is), and NameG is an original name (so its meaning 1625 -- should be independent of what's in scope. 1626 -- We may well want to distinguish them in the end. 1627 -- Ditto NameU and NameL 1628 nms = case nm of 1629 Name occ NameS -> occString occ 1630 Name occ (NameQ m) -> modString m ++ "." ++ occString occ 1631 Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ 1632 Name occ (NameU u) -> occString occ ++ "_" ++ show u 1633 Name occ (NameL u) -> occString occ ++ "_" ++ show u 1634 1635 pnam = classify nms 1636 1637 -- True if we are function style, e.g. f, [], (,) 1638 -- False if we are operator style, e.g. +, :+ 1639 classify "" = False -- shouldn't happen; . operator is handled below 1640 classify (x:xs) | isAlpha x || (x `elem` "_[]()") = 1641 case dropWhile (/='.') xs of 1642 (_:xs') -> classify xs' 1643 [] -> True 1644 | otherwise = False 1645 1646instance Show Name where 1647 show = showName 1648 1649-- Tuple data and type constructors 1650-- | Tuple data constructor 1651tupleDataName :: Int -> Name 1652-- | Tuple type constructor 1653tupleTypeName :: Int -> Name 1654 1655tupleDataName n = mk_tup_name n DataName True 1656tupleTypeName n = mk_tup_name n TcClsName True 1657 1658-- Unboxed tuple data and type constructors 1659-- | Unboxed tuple data constructor 1660unboxedTupleDataName :: Int -> Name 1661-- | Unboxed tuple type constructor 1662unboxedTupleTypeName :: Int -> Name 1663 1664unboxedTupleDataName n = mk_tup_name n DataName False 1665unboxedTupleTypeName n = mk_tup_name n TcClsName False 1666 1667mk_tup_name :: Int -> NameSpace -> Bool -> Name 1668mk_tup_name n space boxed 1669 = Name (mkOccName tup_occ) (NameG space (mkPkgName "ghc-prim") tup_mod) 1670 where 1671 withParens thing 1672 | boxed = "(" ++ thing ++ ")" 1673 | otherwise = "(#" ++ thing ++ "#)" 1674 tup_occ | n == 1 = if boxed then "Solo" else "Solo#" 1675 | otherwise = withParens (replicate n_commas ',') 1676 n_commas = n - 1 1677 tup_mod = mkModName "GHC.Tuple" 1678 1679-- Unboxed sum data and type constructors 1680-- | Unboxed sum data constructor 1681unboxedSumDataName :: SumAlt -> SumArity -> Name 1682-- | Unboxed sum type constructor 1683unboxedSumTypeName :: SumArity -> Name 1684 1685unboxedSumDataName alt arity 1686 | alt > arity 1687 = error $ prefix ++ "Index out of bounds." ++ debug_info 1688 1689 | alt <= 0 1690 = error $ prefix ++ "Alt must be > 0." ++ debug_info 1691 1692 | arity < 2 1693 = error $ prefix ++ "Arity must be >= 2." ++ debug_info 1694 1695 | otherwise 1696 = Name (mkOccName sum_occ) 1697 (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Prim")) 1698 1699 where 1700 prefix = "unboxedSumDataName: " 1701 debug_info = " (alt: " ++ show alt ++ ", arity: " ++ show arity ++ ")" 1702 1703 -- Synced with the definition of mkSumDataConOcc in GHC.Builtin.Types 1704 sum_occ = '(' : '#' : bars nbars_before ++ '_' : bars nbars_after ++ "#)" 1705 bars i = replicate i '|' 1706 nbars_before = alt - 1 1707 nbars_after = arity - alt 1708 1709unboxedSumTypeName arity 1710 | arity < 2 1711 = error $ "unboxedSumTypeName: Arity must be >= 2." 1712 ++ " (arity: " ++ show arity ++ ")" 1713 1714 | otherwise 1715 = Name (mkOccName sum_occ) 1716 (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Prim")) 1717 1718 where 1719 -- Synced with the definition of mkSumTyConOcc in GHC.Builtin.Types 1720 sum_occ = '(' : '#' : replicate (arity - 1) '|' ++ "#)" 1721 1722----------------------------------------------------- 1723-- Locations 1724----------------------------------------------------- 1725 1726data Loc 1727 = Loc { loc_filename :: String 1728 , loc_package :: String 1729 , loc_module :: String 1730 , loc_start :: CharPos 1731 , loc_end :: CharPos } 1732 deriving( Show, Eq, Ord, Data, Generic ) 1733 1734type CharPos = (Int, Int) -- ^ Line and character position 1735 1736 1737----------------------------------------------------- 1738-- 1739-- The Info returned by reification 1740-- 1741----------------------------------------------------- 1742 1743-- | Obtained from 'reify' in the 'Q' Monad. 1744data Info 1745 = 1746 -- | A class, with a list of its visible instances 1747 ClassI 1748 Dec 1749 [InstanceDec] 1750 1751 -- | A class method 1752 | ClassOpI 1753 Name 1754 Type 1755 ParentName 1756 1757 -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned 1758 -- using 'PrimTyConI' or 'FamilyI' as appropriate. At present, this reified 1759 -- declaration will never have derived instances attached to it (if you wish 1760 -- to check for an instance, see 'reifyInstances'). 1761 | TyConI 1762 Dec 1763 1764 -- | A type or data family, with a list of its visible instances. A closed 1765 -- type family is returned with 0 instances. 1766 | FamilyI 1767 Dec 1768 [InstanceDec] 1769 1770 -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'. 1771 -- Examples: @(->)@, @Int#@. 1772 | PrimTyConI 1773 Name 1774 Arity 1775 Unlifted 1776 1777 -- | A data constructor 1778 | DataConI 1779 Name 1780 Type 1781 ParentName 1782 1783 -- | A pattern synonym 1784 | PatSynI 1785 Name 1786 PatSynType 1787 1788 {- | 1789 A \"value\" variable (as opposed to a type variable, see 'TyVarI'). 1790 1791 The @Maybe Dec@ field contains @Just@ the declaration which 1792 defined the variable - including the RHS of the declaration - 1793 or else @Nothing@, in the case where the RHS is unavailable to 1794 the compiler. At present, this value is /always/ @Nothing@: 1795 returning the RHS has not yet been implemented because of 1796 lack of interest. 1797 -} 1798 | VarI 1799 Name 1800 Type 1801 (Maybe Dec) 1802 1803 {- | 1804 A type variable. 1805 1806 The @Type@ field contains the type which underlies the variable. 1807 At present, this is always @'VarT' theName@, but future changes 1808 may permit refinement of this. 1809 -} 1810 | TyVarI -- Scoped type variable 1811 Name 1812 Type -- What it is bound to 1813 deriving( Show, Eq, Ord, Data, Generic ) 1814 1815-- | Obtained from 'reifyModule' in the 'Q' Monad. 1816data ModuleInfo = 1817 -- | Contains the import list of the module. 1818 ModuleInfo [Module] 1819 deriving( Show, Eq, Ord, Data, Generic ) 1820 1821{- | 1822In 'ClassOpI' and 'DataConI', name of the parent class or type 1823-} 1824type ParentName = Name 1825 1826-- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a 1827-- particular data constructor. 'SumAlt's are one-indexed and should never 1828-- exceed the value of its corresponding 'SumArity'. For example: 1829-- 1830-- * @(\#_|\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2) 1831-- 1832-- * @(\#|_\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2) 1833type SumAlt = Int 1834 1835-- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of 1836-- 'SumAlt's. For example, @(\#|\#)@ has a 'SumArity' of 2. 1837type SumArity = Int 1838 1839-- | In 'PrimTyConI', arity of the type constructor 1840type Arity = Int 1841 1842-- | In 'PrimTyConI', is the type constructor unlifted? 1843type Unlifted = Bool 1844 1845-- | 'InstanceDec' describes a single instance of a class or type function. 1846-- It is just a 'Dec', but guaranteed to be one of the following: 1847-- 1848-- * 'InstanceD' (with empty @['Dec']@) 1849-- 1850-- * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@) 1851-- 1852-- * 'TySynInstD' 1853type InstanceDec = Dec 1854 1855data Fixity = Fixity Int FixityDirection 1856 deriving( Eq, Ord, Show, Data, Generic ) 1857data FixityDirection = InfixL | InfixR | InfixN 1858 deriving( Eq, Ord, Show, Data, Generic ) 1859 1860-- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9) 1861maxPrecedence :: Int 1862maxPrecedence = (9::Int) 1863 1864-- | Default fixity: @infixl 9@ 1865defaultFixity :: Fixity 1866defaultFixity = Fixity maxPrecedence InfixL 1867 1868 1869{- 1870Note [Unresolved infix] 1871~~~~~~~~~~~~~~~~~~~~~~~ 1872-} 1873{- $infix #infix# 1874When implementing antiquotation for quasiquoters, one often wants 1875to parse strings into expressions: 1876 1877> parse :: String -> Maybe Exp 1878 1879But how should we parse @a + b * c@? If we don't know the fixities of 1880@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a 1881+ b) * c@. 1882 1883In cases like this, use 'UInfixE', 'UInfixP', or 'UInfixT', which stand for 1884\"unresolved infix expression/pattern/type\", respectively. When the compiler 1885is given a splice containing a tree of @UInfixE@ applications such as 1886 1887> UInfixE 1888> (UInfixE e1 op1 e2) 1889> op2 1890> (UInfixE e3 op3 e4) 1891 1892it will look up and the fixities of the relevant operators and 1893reassociate the tree as necessary. 1894 1895 * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT', 1896 which are of use for parsing expressions like 1897 1898 > (a + b * c) + d * e 1899 1900 * 'InfixE', 'InfixP', and 'InfixT' expressions are never reassociated. 1901 1902 * The 'UInfixE' constructor doesn't support sections. Sections 1903 such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer 1904 sections such as @(a + b * c -)@, use an 'InfixE' constructor for the 1905 outer-most section, and use 'UInfixE' constructors for all 1906 other operators: 1907 1908 > InfixE 1909 > Just (UInfixE ...a + b * c...) 1910 > op 1911 > Nothing 1912 1913 Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered 1914 into 'Exp's differently: 1915 1916 > (+ a + b) ---> InfixE Nothing + (Just $ UInfixE a + b) 1917 > -- will result in a fixity error if (+) is left-infix 1918 > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b) 1919 > -- no fixity errors 1920 1921 * Quoted expressions such as 1922 1923 > [| a * b + c |] :: Q Exp 1924 > [p| a : b : c |] :: Q Pat 1925 > [t| T + T |] :: Q Type 1926 1927 will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'InfixT', 'ParensE', 1928 'ParensP', or 'ParensT' constructors. 1929 1930-} 1931 1932----------------------------------------------------- 1933-- 1934-- The main syntax data types 1935-- 1936----------------------------------------------------- 1937 1938data Lit = CharL Char 1939 | StringL String 1940 | IntegerL Integer -- ^ Used for overloaded and non-overloaded 1941 -- literals. We don't have a good way to 1942 -- represent non-overloaded literals at 1943 -- the moment. Maybe that doesn't matter? 1944 | RationalL Rational -- Ditto 1945 | IntPrimL Integer 1946 | WordPrimL Integer 1947 | FloatPrimL Rational 1948 | DoublePrimL Rational 1949 | StringPrimL [Word8] -- ^ A primitive C-style string, type 'Addr#' 1950 | BytesPrimL Bytes -- ^ Some raw bytes, type 'Addr#': 1951 | CharPrimL Char 1952 deriving( Show, Eq, Ord, Data, Generic ) 1953 1954 -- We could add Int, Float, Double etc, as we do in HsLit, 1955 -- but that could complicate the 1956 -- supposedly-simple TH.Syntax literal type 1957 1958-- | Raw bytes embedded into the binary. 1959-- 1960-- Avoid using Bytes constructor directly as it is likely to change in the 1961-- future. Use helpers such as `mkBytes` in Language.Haskell.TH.Lib instead. 1962data Bytes = Bytes 1963 { bytesPtr :: ForeignPtr Word8 -- ^ Pointer to the data 1964 , bytesOffset :: Word -- ^ Offset from the pointer 1965 , bytesSize :: Word -- ^ Number of bytes 1966 -- Maybe someday: 1967 -- , bytesAlignement :: Word -- ^ Alignement constraint 1968 -- , bytesReadOnly :: Bool -- ^ Shall we embed into a read-only 1969 -- -- section or not 1970 -- , bytesInitialized :: Bool -- ^ False: only use `bytesSize` to allocate 1971 -- -- an uninitialized region 1972 } 1973 deriving (Data,Generic) 1974 1975-- We can't derive Show instance for Bytes because we don't want to show the 1976-- pointer value but the actual bytes (similarly to what ByteString does). See 1977-- #16457. 1978instance Show Bytes where 1979 show b = unsafePerformIO $ withForeignPtr (bytesPtr b) $ \ptr -> 1980 peekCStringLen ( ptr `plusPtr` fromIntegral (bytesOffset b) 1981 , fromIntegral (bytesSize b) 1982 ) 1983 1984-- We can't derive Eq and Ord instances for Bytes because we don't want to 1985-- compare pointer values but the actual bytes (similarly to what ByteString 1986-- does). See #16457 1987instance Eq Bytes where 1988 (==) = eqBytes 1989 1990instance Ord Bytes where 1991 compare = compareBytes 1992 1993eqBytes :: Bytes -> Bytes -> Bool 1994eqBytes a@(Bytes fp off len) b@(Bytes fp' off' len') 1995 | len /= len' = False -- short cut on length 1996 | fp == fp' && off == off' = True -- short cut for the same bytes 1997 | otherwise = compareBytes a b == EQ 1998 1999compareBytes :: Bytes -> Bytes -> Ordering 2000compareBytes (Bytes _ _ 0) (Bytes _ _ 0) = EQ -- short cut for empty Bytes 2001compareBytes (Bytes fp1 off1 len1) (Bytes fp2 off2 len2) = 2002 unsafePerformIO $ 2003 withForeignPtr fp1 $ \p1 -> 2004 withForeignPtr fp2 $ \p2 -> do 2005 i <- memcmp (p1 `plusPtr` fromIntegral off1) 2006 (p2 `plusPtr` fromIntegral off2) 2007 (fromIntegral (min len1 len2)) 2008 return $! (i `compare` 0) <> (len1 `compare` len2) 2009 2010foreign import ccall unsafe "memcmp" 2011 memcmp :: Ptr a -> Ptr b -> CSize -> IO CInt 2012 2013 2014-- | Pattern in Haskell given in @{}@ 2015data Pat 2016 = LitP Lit -- ^ @{ 5 or \'c\' }@ 2017 | VarP Name -- ^ @{ x }@ 2018 | TupP [Pat] -- ^ @{ (p1,p2) }@ 2019 | UnboxedTupP [Pat] -- ^ @{ (\# p1,p2 \#) }@ 2020 | UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\#|p|\#) }@ 2021 | ConP Name [Pat] -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@ 2022 | InfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@ 2023 | UInfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@ 2024 -- 2025 -- See "Language.Haskell.TH.Syntax#infix" 2026 | ParensP Pat -- ^ @{(p)}@ 2027 -- 2028 -- See "Language.Haskell.TH.Syntax#infix" 2029 | TildeP Pat -- ^ @{ ~p }@ 2030 | BangP Pat -- ^ @{ !p }@ 2031 | AsP Name Pat -- ^ @{ x \@ p }@ 2032 | WildP -- ^ @{ _ }@ 2033 | RecP Name [FieldPat] -- ^ @f (Pt { pointx = x }) = g x@ 2034 | ListP [ Pat ] -- ^ @{ [1,2,3] }@ 2035 | SigP Pat Type -- ^ @{ p :: t }@ 2036 | ViewP Exp Pat -- ^ @{ e -> p }@ 2037 deriving( Show, Eq, Ord, Data, Generic ) 2038 2039type FieldPat = (Name,Pat) 2040 2041data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@ 2042 deriving( Show, Eq, Ord, Data, Generic ) 2043data Clause = Clause [Pat] Body [Dec] 2044 -- ^ @f { p1 p2 = body where decs }@ 2045 deriving( Show, Eq, Ord, Data, Generic ) 2046 2047data Exp 2048 = VarE Name -- ^ @{ x }@ 2049 | ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @ 2050 | LitE Lit -- ^ @{ 5 or \'c\'}@ 2051 | AppE Exp Exp -- ^ @{ f x }@ 2052 | AppTypeE Exp Type -- ^ @{ f \@Int }@ 2053 2054 | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@ 2055 2056 -- It's a bit gruesome to use an Exp as the operator when a Name 2057 -- would suffice. Historically, Exp was used to make it easier to 2058 -- distinguish between infix constructors and non-constructors. 2059 -- This is a bit overkill, since one could just as well call 2060 -- `startsConId` or `startsConSym` (from `GHC.Lexeme`) on a Name. 2061 -- Unfortunately, changing this design now would involve lots of 2062 -- code churn for consumers of the TH API, so we continue to use 2063 -- an Exp as the operator and perform an extra check during conversion 2064 -- to ensure that the Exp is a constructor or a variable (#16895). 2065 2066 | UInfixE Exp Exp Exp -- ^ @{x + y}@ 2067 -- 2068 -- See "Language.Haskell.TH.Syntax#infix" 2069 | ParensE Exp -- ^ @{ (e) }@ 2070 -- 2071 -- See "Language.Haskell.TH.Syntax#infix" 2072 | LamE [Pat] Exp -- ^ @{ \\ p1 p2 -> e }@ 2073 | LamCaseE [Match] -- ^ @{ \\case m1; m2 }@ 2074 | TupE [Maybe Exp] -- ^ @{ (e1,e2) } @ 2075 -- 2076 -- The 'Maybe' is necessary for handling 2077 -- tuple sections. 2078 -- 2079 -- > (1,) 2080 -- 2081 -- translates to 2082 -- 2083 -- > TupE [Just (LitE (IntegerL 1)),Nothing] 2084 2085 | UnboxedTupE [Maybe Exp] -- ^ @{ (\# e1,e2 \#) } @ 2086 -- 2087 -- The 'Maybe' is necessary for handling 2088 -- tuple sections. 2089 -- 2090 -- > (# 'c', #) 2091 -- 2092 -- translates to 2093 -- 2094 -- > UnboxedTupE [Just (LitE (CharL 'c')),Nothing] 2095 2096 | UnboxedSumE Exp SumAlt SumArity -- ^ @{ (\#|e|\#) }@ 2097 | CondE Exp Exp Exp -- ^ @{ if e1 then e2 else e3 }@ 2098 | MultiIfE [(Guard, Exp)] -- ^ @{ if | g1 -> e1 | g2 -> e2 }@ 2099 | LetE [Dec] Exp -- ^ @{ let { x=e1; y=e2 } in e3 }@ 2100 | CaseE Exp [Match] -- ^ @{ case e of m1; m2 }@ 2101 | DoE (Maybe ModName) [Stmt] -- ^ @{ do { p <- e1; e2 } }@ or a qualified do if 2102 -- the module name is present 2103 | MDoE (Maybe ModName) [Stmt] -- ^ @{ mdo { x <- e1 y; y <- e2 x; } }@ or a qualified 2104 -- mdo if the module name is present 2105 | CompE [Stmt] -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@ 2106 -- 2107 -- The result expression of the comprehension is 2108 -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'. 2109 -- 2110 -- E.g. translation: 2111 -- 2112 -- > [ f x | x <- xs ] 2113 -- 2114 -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))] 2115 2116 | ArithSeqE Range -- ^ @{ [ 1 ,2 .. 10 ] }@ 2117 | ListE [ Exp ] -- ^ @{ [1,2,3] }@ 2118 | SigE Exp Type -- ^ @{ e :: t }@ 2119 | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@ 2120 | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@ 2121 | StaticE Exp -- ^ @{ static e }@ 2122 | UnboundVarE Name -- ^ @{ _x }@ 2123 -- 2124 -- This is used for holes or unresolved 2125 -- identifiers in AST quotes. Note that 2126 -- it could either have a variable name 2127 -- or constructor name. 2128 | LabelE String -- ^ @{ #x }@ ( Overloaded label ) 2129 | ImplicitParamVarE String -- ^ @{ ?x }@ ( Implicit parameter ) 2130 deriving( Show, Eq, Ord, Data, Generic ) 2131 2132type FieldExp = (Name,Exp) 2133 2134-- Omitted: implicit parameters 2135 2136data Body 2137 = GuardedB [(Guard,Exp)] -- ^ @f p { | e1 = e2 2138 -- | e3 = e4 } 2139 -- where ds@ 2140 | NormalB Exp -- ^ @f p { = e } where ds@ 2141 deriving( Show, Eq, Ord, Data, Generic ) 2142 2143data Guard 2144 = NormalG Exp -- ^ @f x { | odd x } = x@ 2145 | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@ 2146 deriving( Show, Eq, Ord, Data, Generic ) 2147 2148data Stmt 2149 = BindS Pat Exp -- ^ @p <- e@ 2150 | LetS [ Dec ] -- ^ @{ let { x=e1; y=e2 } }@ 2151 | NoBindS Exp -- ^ @e@ 2152 | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE') 2153 | RecS [Stmt] -- ^ @rec { s1; s2 }@ 2154 deriving( Show, Eq, Ord, Data, Generic ) 2155 2156data Range = FromR Exp | FromThenR Exp Exp 2157 | FromToR Exp Exp | FromThenToR Exp Exp Exp 2158 deriving( Show, Eq, Ord, Data, Generic ) 2159 2160data Dec 2161 = FunD Name [Clause] -- ^ @{ f p1 p2 = b where decs }@ 2162 | ValD Pat Body [Dec] -- ^ @{ p = b where decs }@ 2163 | DataD Cxt Name [TyVarBndr ()] 2164 (Maybe Kind) -- Kind signature (allowed only for GADTs) 2165 [Con] [DerivClause] 2166 -- ^ @{ data Cxt x => T x = A x | B (T x) 2167 -- deriving (Z,W) 2168 -- deriving stock Eq }@ 2169 | NewtypeD Cxt Name [TyVarBndr ()] 2170 (Maybe Kind) -- Kind signature 2171 Con [DerivClause] -- ^ @{ newtype Cxt x => T x = A (B x) 2172 -- deriving (Z,W Q) 2173 -- deriving stock Eq }@ 2174 | TySynD Name [TyVarBndr ()] Type -- ^ @{ type T x = (x,x) }@ 2175 | ClassD Cxt Name [TyVarBndr ()] 2176 [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@ 2177 | InstanceD (Maybe Overlap) Cxt Type [Dec] 2178 -- ^ @{ instance {\-\# OVERLAPS \#-\} 2179 -- Show w => Show [w] where ds }@ 2180 | SigD Name Type -- ^ @{ length :: [a] -> Int }@ 2181 | KiSigD Name Kind -- ^ @{ type TypeRep :: k -> Type }@ 2182 | ForeignD Foreign -- ^ @{ foreign import ... } 2183 --{ foreign export ... }@ 2184 2185 | InfixD Fixity Name -- ^ @{ infix 3 foo }@ 2186 2187 -- | pragmas 2188 | PragmaD Pragma -- ^ @{ {\-\# INLINE [1] foo \#-\} }@ 2189 2190 -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD') 2191 | DataFamilyD Name [TyVarBndr ()] 2192 (Maybe Kind) 2193 -- ^ @{ data family T a b c :: * }@ 2194 2195 | DataInstD Cxt (Maybe [TyVarBndr ()]) Type 2196 (Maybe Kind) -- Kind signature 2197 [Con] [DerivClause] -- ^ @{ data instance Cxt x => T [x] 2198 -- = A x | B (T x) 2199 -- deriving (Z,W) 2200 -- deriving stock Eq }@ 2201 2202 | NewtypeInstD Cxt (Maybe [TyVarBndr ()]) Type -- Quantified type vars 2203 (Maybe Kind) -- Kind signature 2204 Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x] 2205 -- = A (B x) 2206 -- deriving (Z,W) 2207 -- deriving stock Eq }@ 2208 | TySynInstD TySynEqn -- ^ @{ type instance ... }@ 2209 2210 -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD') 2211 | OpenTypeFamilyD TypeFamilyHead 2212 -- ^ @{ type family T a b c = (r :: *) | r -> a b }@ 2213 2214 | ClosedTypeFamilyD TypeFamilyHead [TySynEqn] 2215 -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@ 2216 2217 | RoleAnnotD Name [Role] -- ^ @{ type role T nominal representational }@ 2218 | StandaloneDerivD (Maybe DerivStrategy) Cxt Type 2219 -- ^ @{ deriving stock instance Ord a => Ord (Foo a) }@ 2220 | DefaultSigD Name Type -- ^ @{ default size :: Data a => a -> Int }@ 2221 2222 -- | Pattern Synonyms 2223 | PatSynD Name PatSynArgs PatSynDir Pat 2224 -- ^ @{ pattern P v1 v2 .. vn <- p }@ unidirectional or 2225 -- @{ pattern P v1 v2 .. vn = p }@ implicit bidirectional or 2226 -- @{ pattern P v1 v2 .. vn <- p 2227 -- where P v1 v2 .. vn = e }@ explicit bidirectional 2228 -- 2229 -- also, besides prefix pattern synonyms, both infix and record 2230 -- pattern synonyms are supported. See 'PatSynArgs' for details 2231 2232 | PatSynSigD Name PatSynType -- ^ A pattern synonym's type signature. 2233 2234 | ImplicitParamBindD String Exp 2235 -- ^ @{ ?x = expr }@ 2236 -- 2237 -- Implicit parameter binding declaration. Can only be used in let 2238 -- and where clauses which consist entirely of implicit bindings. 2239 deriving( Show, Eq, Ord, Data, Generic ) 2240 2241-- | Varieties of allowed instance overlap. 2242data Overlap = Overlappable -- ^ May be overlapped by more specific instances 2243 | Overlapping -- ^ May overlap a more general instance 2244 | Overlaps -- ^ Both 'Overlapping' and 'Overlappable' 2245 | Incoherent -- ^ Both 'Overlappable' and 'Overlappable', and 2246 -- pick an arbitrary one if multiple choices are 2247 -- available. 2248 deriving( Show, Eq, Ord, Data, Generic ) 2249 2250-- | A single @deriving@ clause at the end of a datatype. 2251data DerivClause = DerivClause (Maybe DerivStrategy) Cxt 2252 -- ^ @{ deriving stock (Eq, Ord) }@ 2253 deriving( Show, Eq, Ord, Data, Generic ) 2254 2255-- | What the user explicitly requests when deriving an instance. 2256data DerivStrategy = StockStrategy -- ^ A \"standard\" derived instance 2257 | AnyclassStrategy -- ^ @-XDeriveAnyClass@ 2258 | NewtypeStrategy -- ^ @-XGeneralizedNewtypeDeriving@ 2259 | ViaStrategy Type -- ^ @-XDerivingVia@ 2260 deriving( Show, Eq, Ord, Data, Generic ) 2261 2262-- | A pattern synonym's type. Note that a pattern synonym's /fully/ 2263-- specified type has a peculiar shape coming with two forall 2264-- quantifiers and two constraint contexts. For example, consider the 2265-- pattern synonym 2266-- 2267-- > pattern P x1 x2 ... xn = <some-pattern> 2268-- 2269-- P's complete type is of the following form 2270-- 2271-- > pattern P :: forall universals. required constraints 2272-- > => forall existentials. provided constraints 2273-- > => t1 -> t2 -> ... -> tn -> t 2274-- 2275-- consisting of four parts: 2276-- 2277-- 1. the (possibly empty lists of) universally quantified type 2278-- variables and required constraints on them. 2279-- 2. the (possibly empty lists of) existentially quantified 2280-- type variables and the provided constraints on them. 2281-- 3. the types @t1@, @t2@, .., @tn@ of @x1@, @x2@, .., @xn@, respectively 2282-- 4. the type @t@ of @\<some-pattern\>@, mentioning only universals. 2283-- 2284-- Pattern synonym types interact with TH when (a) reifying a pattern 2285-- synonym, (b) pretty printing, or (c) specifying a pattern synonym's 2286-- type signature explicitly: 2287-- 2288-- * Reification always returns a pattern synonym's /fully/ specified 2289-- type in abstract syntax. 2290-- 2291-- * Pretty printing via 'Language.Haskell.TH.Ppr.pprPatSynType' abbreviates 2292-- a pattern synonym's type unambiguously in concrete syntax: The rule of 2293-- thumb is to print initial empty universals and the required 2294-- context as @() =>@, if existentials and a provided context 2295-- follow. If only universals and their required context, but no 2296-- existentials are specified, only the universals and their 2297-- required context are printed. If both or none are specified, so 2298-- both (or none) are printed. 2299-- 2300-- * When specifying a pattern synonym's type explicitly with 2301-- 'PatSynSigD' either one of the universals, the existentials, or 2302-- their contexts may be left empty. 2303-- 2304-- See the GHC user's guide for more information on pattern synonyms 2305-- and their types: 2306-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#pattern-synonyms>. 2307type PatSynType = Type 2308 2309-- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By 2310-- analogy with "head" for type classes and type class instances as 2311-- defined in /Type classes: an exploration of the design space/, the 2312-- @TypeFamilyHead@ is defined to be the elements of the declaration 2313-- between @type family@ and @where@. 2314data TypeFamilyHead = 2315 TypeFamilyHead Name [TyVarBndr ()] FamilyResultSig (Maybe InjectivityAnn) 2316 deriving( Show, Eq, Ord, Data, Generic ) 2317 2318-- | One equation of a type family instance or closed type family. The 2319-- arguments are the left-hand-side type and the right-hand-side result. 2320-- 2321-- For instance, if you had the following type family: 2322-- 2323-- @ 2324-- type family Foo (a :: k) :: k where 2325-- forall k (a :: k). Foo \@k a = a 2326-- @ 2327-- 2328-- The @Foo \@k a = a@ equation would be represented as follows: 2329-- 2330-- @ 2331-- 'TySynEqn' ('Just' ['PlainTV' k, 'KindedTV' a ('VarT' k)]) 2332-- ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a)) 2333-- ('VarT' a) 2334-- @ 2335data TySynEqn = TySynEqn (Maybe [TyVarBndr ()]) Type Type 2336 deriving( Show, Eq, Ord, Data, Generic ) 2337 2338data FunDep = FunDep [Name] [Name] 2339 deriving( Show, Eq, Ord, Data, Generic ) 2340 2341data Foreign = ImportF Callconv Safety String Name Type 2342 | ExportF Callconv String Name Type 2343 deriving( Show, Eq, Ord, Data, Generic ) 2344 2345-- keep Callconv in sync with module ForeignCall in ghc/compiler/GHC/Types/ForeignCall.hs 2346data Callconv = CCall | StdCall | CApi | Prim | JavaScript 2347 deriving( Show, Eq, Ord, Data, Generic ) 2348 2349data Safety = Unsafe | Safe | Interruptible 2350 deriving( Show, Eq, Ord, Data, Generic ) 2351 2352data Pragma = InlineP Name Inline RuleMatch Phases 2353 | SpecialiseP Name Type (Maybe Inline) Phases 2354 | SpecialiseInstP Type 2355 | RuleP String (Maybe [TyVarBndr ()]) [RuleBndr] Exp Exp Phases 2356 | AnnP AnnTarget Exp 2357 | LineP Int String 2358 | CompleteP [Name] (Maybe Name) 2359 -- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@ 2360 deriving( Show, Eq, Ord, Data, Generic ) 2361 2362data Inline = NoInline 2363 | Inline 2364 | Inlinable 2365 deriving (Show, Eq, Ord, Data, Generic) 2366 2367data RuleMatch = ConLike 2368 | FunLike 2369 deriving (Show, Eq, Ord, Data, Generic) 2370 2371data Phases = AllPhases 2372 | FromPhase Int 2373 | BeforePhase Int 2374 deriving (Show, Eq, Ord, Data, Generic) 2375 2376data RuleBndr = RuleVar Name 2377 | TypedRuleVar Name Type 2378 deriving (Show, Eq, Ord, Data, Generic) 2379 2380data AnnTarget = ModuleAnnotation 2381 | TypeAnnotation Name 2382 | ValueAnnotation Name 2383 deriving (Show, Eq, Ord, Data, Generic) 2384 2385type Cxt = [Pred] -- ^ @(Eq a, Ord b)@ 2386 2387-- | Since the advent of @ConstraintKinds@, constraints are really just types. 2388-- Equality constraints use the 'EqualityT' constructor. Constraints may also 2389-- be tuples of other constraints. 2390type Pred = Type 2391 2392data SourceUnpackedness 2393 = NoSourceUnpackedness -- ^ @C a@ 2394 | SourceNoUnpack -- ^ @C { {\-\# NOUNPACK \#-\} } a@ 2395 | SourceUnpack -- ^ @C { {\-\# UNPACK \#-\} } a@ 2396 deriving (Show, Eq, Ord, Data, Generic) 2397 2398data SourceStrictness = NoSourceStrictness -- ^ @C a@ 2399 | SourceLazy -- ^ @C {~}a@ 2400 | SourceStrict -- ^ @C {!}a@ 2401 deriving (Show, Eq, Ord, Data, Generic) 2402 2403-- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness' 2404-- refers to the strictness that the compiler chooses for a data constructor 2405-- field, which may be different from what is written in source code. See 2406-- 'reifyConStrictness' for more information. 2407data DecidedStrictness = DecidedLazy 2408 | DecidedStrict 2409 | DecidedUnpack 2410 deriving (Show, Eq, Ord, Data, Generic) 2411 2412-- | A single data constructor. 2413-- 2414-- The constructors for 'Con' can roughly be divided up into two categories: 2415-- those for constructors with \"vanilla\" syntax ('NormalC', 'RecC', and 2416-- 'InfixC'), and those for constructors with GADT syntax ('GadtC' and 2417-- 'RecGadtC'). The 'ForallC' constructor, which quantifies additional type 2418-- variables and class contexts, can surround either variety of constructor. 2419-- However, the type variables that it quantifies are different depending 2420-- on what constructor syntax is used: 2421-- 2422-- * If a 'ForallC' surrounds a constructor with vanilla syntax, then the 2423-- 'ForallC' will only quantify /existential/ type variables. For example: 2424-- 2425-- @ 2426-- data Foo a = forall b. MkFoo a b 2427-- @ 2428-- 2429-- In @MkFoo@, 'ForallC' will quantify @b@, but not @a@. 2430-- 2431-- * If a 'ForallC' surrounds a constructor with GADT syntax, then the 2432-- 'ForallC' will quantify /all/ type variables used in the constructor. 2433-- For example: 2434-- 2435-- @ 2436-- data Bar a b where 2437-- MkBar :: (a ~ b) => c -> MkBar a b 2438-- @ 2439-- 2440-- In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@. 2441data Con = NormalC Name [BangType] -- ^ @C Int a@ 2442 | RecC Name [VarBangType] -- ^ @C { v :: Int, w :: a }@ 2443 | InfixC BangType Name BangType -- ^ @Int :+ a@ 2444 | ForallC [TyVarBndr Specificity] Cxt Con -- ^ @forall a. Eq a => C [a]@ 2445 | GadtC [Name] [BangType] 2446 Type -- See Note [GADT return type] 2447 -- ^ @C :: a -> b -> T b Int@ 2448 | RecGadtC [Name] [VarBangType] 2449 Type -- See Note [GADT return type] 2450 -- ^ @C :: { v :: Int } -> T b Int@ 2451 deriving (Show, Eq, Ord, Data, Generic) 2452 2453-- Note [GADT return type] 2454-- ~~~~~~~~~~~~~~~~~~~~~~~ 2455-- 2456-- The return type of a GADT constructor does not necessarily match the name of 2457-- the data type: 2458-- 2459-- type S = T 2460-- 2461-- data T a where 2462-- MkT :: S Int 2463-- 2464-- 2465-- type S a = T 2466-- 2467-- data T a where 2468-- MkT :: S Char Int 2469-- 2470-- 2471-- type Id a = a 2472-- type S a = T 2473-- 2474-- data T a where 2475-- MkT :: Id (S Char Int) 2476-- 2477-- 2478-- That is why we allow the return type stored by a constructor to be an 2479-- arbitrary type. See also #11341 2480 2481data Bang = Bang SourceUnpackedness SourceStrictness 2482 -- ^ @C { {\-\# UNPACK \#-\} !}a@ 2483 deriving (Show, Eq, Ord, Data, Generic) 2484 2485type BangType = (Bang, Type) 2486type VarBangType = (Name, Bang, Type) 2487 2488-- | As of @template-haskell-2.11.0.0@, 'Strict' has been replaced by 'Bang'. 2489type Strict = Bang 2490 2491-- | As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 2492-- 'BangType'. 2493type StrictType = BangType 2494 2495-- | As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 2496-- 'VarBangType'. 2497type VarStrictType = VarBangType 2498 2499-- | A pattern synonym's directionality. 2500data PatSynDir 2501 = Unidir -- ^ @pattern P x {<-} p@ 2502 | ImplBidir -- ^ @pattern P x {=} p@ 2503 | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@ 2504 deriving( Show, Eq, Ord, Data, Generic ) 2505 2506-- | A pattern synonym's argument type. 2507data PatSynArgs 2508 = PrefixPatSyn [Name] -- ^ @pattern P {x y z} = p@ 2509 | InfixPatSyn Name Name -- ^ @pattern {x P y} = p@ 2510 | RecordPatSyn [Name] -- ^ @pattern P { {x,y,z} } = p@ 2511 deriving( Show, Eq, Ord, Data, Generic ) 2512 2513data Type = ForallT [TyVarBndr Specificity] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@ 2514 | ForallVisT [TyVarBndr ()] Type -- ^ @forall \<vars\> -> \<type\>@ 2515 | AppT Type Type -- ^ @T a b@ 2516 | AppKindT Type Kind -- ^ @T \@k t@ 2517 | SigT Type Kind -- ^ @t :: k@ 2518 | VarT Name -- ^ @a@ 2519 | ConT Name -- ^ @T@ 2520 | PromotedT Name -- ^ @'T@ 2521 | InfixT Type Name Type -- ^ @T + T@ 2522 | UInfixT Type Name Type -- ^ @T + T@ 2523 -- 2524 -- See "Language.Haskell.TH.Syntax#infix" 2525 | ParensT Type -- ^ @(T)@ 2526 2527 -- See Note [Representing concrete syntax in types] 2528 | TupleT Int -- ^ @(,), (,,), etc.@ 2529 | UnboxedTupleT Int -- ^ @(\#,\#), (\#,,\#), etc.@ 2530 | UnboxedSumT SumArity -- ^ @(\#|\#), (\#||\#), etc.@ 2531 | ArrowT -- ^ @->@ 2532 | MulArrowT -- ^ @FUN@ 2533 | EqualityT -- ^ @~@ 2534 | ListT -- ^ @[]@ 2535 | PromotedTupleT Int -- ^ @'(), '(,), '(,,), etc.@ 2536 | PromotedNilT -- ^ @'[]@ 2537 | PromotedConsT -- ^ @(':)@ 2538 | StarT -- ^ @*@ 2539 | ConstraintT -- ^ @Constraint@ 2540 | LitT TyLit -- ^ @0,1,2, etc.@ 2541 | WildCardT -- ^ @_@ 2542 | ImplicitParamT String Type -- ^ @?x :: t@ 2543 deriving( Show, Eq, Ord, Data, Generic ) 2544 2545data Specificity = SpecifiedSpec -- ^ @a@ 2546 | InferredSpec -- ^ @{a}@ 2547 deriving( Show, Eq, Ord, Data, Generic ) 2548 2549data TyVarBndr flag = PlainTV Name flag -- ^ @a@ 2550 | KindedTV Name flag Kind -- ^ @(a :: k)@ 2551 deriving( Show, Eq, Ord, Data, Generic, Functor ) 2552 2553-- | Type family result signature 2554data FamilyResultSig = NoSig -- ^ no signature 2555 | KindSig Kind -- ^ @k@ 2556 | TyVarSig (TyVarBndr ()) -- ^ @= r, = (r :: k)@ 2557 deriving( Show, Eq, Ord, Data, Generic ) 2558 2559-- | Injectivity annotation 2560data InjectivityAnn = InjectivityAnn Name [Name] 2561 deriving ( Show, Eq, Ord, Data, Generic ) 2562 2563data TyLit = NumTyLit Integer -- ^ @2@ 2564 | StrTyLit String -- ^ @\"Hello\"@ 2565 deriving ( Show, Eq, Ord, Data, Generic ) 2566 2567-- | Role annotations 2568data Role = NominalR -- ^ @nominal@ 2569 | RepresentationalR -- ^ @representational@ 2570 | PhantomR -- ^ @phantom@ 2571 | InferR -- ^ @_@ 2572 deriving( Show, Eq, Ord, Data, Generic ) 2573 2574-- | Annotation target for reifyAnnotations 2575data AnnLookup = AnnLookupModule Module 2576 | AnnLookupName Name 2577 deriving( Show, Eq, Ord, Data, Generic ) 2578 2579-- | To avoid duplication between kinds and types, they 2580-- are defined to be the same. Naturally, you would never 2581-- have a type be 'StarT' and you would never have a kind 2582-- be 'SigT', but many of the other constructors are shared. 2583-- Note that the kind @Bool@ is denoted with 'ConT', not 2584-- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT', 2585-- not 'PromotedTupleT'. 2586 2587type Kind = Type 2588 2589{- Note [Representing concrete syntax in types] 2590~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2591Haskell has a rich concrete syntax for types, including 2592 t1 -> t2, (t1,t2), [t], and so on 2593In TH we represent all of this using AppT, with a distinguished 2594type constructor at the head. So, 2595 Type TH representation 2596 ----------------------------------------------- 2597 t1 -> t2 ArrowT `AppT` t2 `AppT` t2 2598 [t] ListT `AppT` t 2599 (t1,t2) TupleT 2 `AppT` t1 `AppT` t2 2600 '(t1,t2) PromotedTupleT 2 `AppT` t1 `AppT` t2 2601 2602But if the original HsSyn used prefix application, we won't use 2603these special TH constructors. For example 2604 [] t ConT "[]" `AppT` t 2605 (->) t ConT "->" `AppT` t 2606In this way we can faithfully represent in TH whether the original 2607HsType used concrete syntax or not. 2608 2609The one case that doesn't fit this pattern is that of promoted lists 2610 '[ Maybe, IO ] PromotedListT 2 `AppT` t1 `AppT` t2 2611but it's very smelly because there really is no type constructor 2612corresponding to PromotedListT. So we encode HsExplicitListTy with 2613PromotedConsT and PromotedNilT (which *do* have underlying type 2614constructors): 2615 '[ Maybe, IO ] PromotedConsT `AppT` Maybe `AppT` 2616 (PromotedConsT `AppT` IO `AppT` PromotedNilT) 2617-} 2618 2619----------------------------------------------------- 2620-- Internal helper functions 2621----------------------------------------------------- 2622 2623cmpEq :: Ordering -> Bool 2624cmpEq EQ = True 2625cmpEq _ = False 2626 2627thenCmp :: Ordering -> Ordering -> Ordering 2628thenCmp EQ o2 = o2 2629thenCmp o1 _ = o1 2630