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