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