b64dfffb938945e8b18968b6c215fb55f3cd3b97
[ghc.git] / libraries / template-haskell / Language / Haskell / TH / Syntax.hs
1 {-# LANGUAGE CPP, DeriveDataTypeable, PolymorphicComponents,
2 DeriveGeneric, FlexibleInstances, DefaultSignatures,
3 ScopedTypeVariables, Rank2Types #-}
4
5 {-# LANGUAGE RoleAnnotations #-}
6 {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
7
8 #if MIN_VERSION_base(4,8,0)
9 #define HAS_NATURAL
10 #endif
11
12 -----------------------------------------------------------------------------
13 -- |
14 -- Module : Language.Haskell.Syntax
15 -- Copyright : (c) The University of Glasgow 2003
16 -- License : BSD-style (see the file libraries/base/LICENSE)
17 --
18 -- Maintainer : libraries@haskell.org
19 -- Stability : experimental
20 -- Portability : portable
21 --
22 -- Abstract syntax definitions for Template Haskell.
23 --
24 -----------------------------------------------------------------------------
25
26 module Language.Haskell.TH.Syntax where
27
28 import Data.Data hiding (Fixity(..))
29 #if __GLASGOW_HASKELL__ < 709
30 import Control.Applicative( Applicative(..) )
31 #endif
32 import Data.IORef
33 import System.IO.Unsafe ( unsafePerformIO )
34 import Control.Monad (liftM)
35 import System.IO ( hPutStrLn, stderr )
36 import Data.Char ( isAlpha, isAlphaNum, isUpper )
37 import Data.Int
38 import Data.Word
39 import Data.Ratio
40 import GHC.Generics ( Generic )
41
42 #ifdef HAS_NATURAL
43 import Numeric.Natural
44 #endif
45
46 -----------------------------------------------------
47 --
48 -- The Quasi class
49 --
50 -----------------------------------------------------
51
52 class (Applicative m, Monad m) => Quasi m where
53 qNewName :: String -> m Name
54 -- ^ Fresh names
55
56 -- Error reporting and recovery
57 qReport :: Bool -> String -> m () -- ^ Report an error (True) or warning (False)
58 -- ...but carry on; use 'fail' to stop
59 qRecover :: m a -- ^ the error handler
60 -> m a -- ^ action which may fail
61 -> m a -- ^ Recover from the monadic 'fail'
62
63 -- Inspect the type-checker's environment
64 qLookupName :: Bool -> String -> m (Maybe Name)
65 -- True <=> type namespace, False <=> value namespace
66 qReify :: Name -> m Info
67 qReifyFixity :: Name -> m Fixity
68 qReifyInstances :: Name -> [Type] -> m [Dec]
69 -- Is (n tys) an instance?
70 -- Returns list of matching instance Decs
71 -- (with empty sub-Decs)
72 -- Works for classes and type functions
73 qReifyRoles :: Name -> m [Role]
74 qReifyAnnotations :: Data a => AnnLookup -> m [a]
75 qReifyModule :: Module -> m ModuleInfo
76
77 qLocation :: m Loc
78
79 qRunIO :: IO a -> m a
80 -- ^ Input/output (dangerous)
81
82 qAddDependentFile :: FilePath -> m ()
83
84 qAddTopDecls :: [Dec] -> m ()
85
86 qAddModFinalizer :: Q () -> m ()
87
88 qGetQ :: Typeable a => m (Maybe a)
89
90 qPutQ :: Typeable a => a -> m ()
91
92 -----------------------------------------------------
93 -- The IO instance of Quasi
94 --
95 -- This instance is used only when running a Q
96 -- computation in the IO monad, usually just to
97 -- print the result. There is no interesting
98 -- type environment, so reification isn't going to
99 -- work.
100 --
101 -----------------------------------------------------
102
103 instance Quasi IO where
104 qNewName s = do { n <- readIORef counter
105 ; writeIORef counter (n+1)
106 ; return (mkNameU s n) }
107
108 qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
109 qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
110
111 qLookupName _ _ = badIO "lookupName"
112 qReify _ = badIO "reify"
113 qReifyFixity _ = badIO "reifyFixity"
114 qReifyInstances _ _ = badIO "reifyInstances"
115 qReifyRoles _ = badIO "reifyRoles"
116 qReifyAnnotations _ = badIO "reifyAnnotations"
117 qReifyModule _ = badIO "reifyModule"
118 qLocation = badIO "currentLocation"
119 qRecover _ _ = badIO "recover" -- Maybe we could fix this?
120 qAddDependentFile _ = badIO "addDependentFile"
121 qAddTopDecls _ = badIO "addTopDecls"
122 qAddModFinalizer _ = badIO "addModFinalizer"
123 qGetQ = badIO "getQ"
124 qPutQ _ = badIO "putQ"
125
126 qRunIO m = m
127
128 badIO :: String -> IO a
129 badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
130 ; fail "Template Haskell failure" }
131
132 -- Global variable to generate unique symbols
133 counter :: IORef Int
134 {-# NOINLINE counter #-}
135 counter = unsafePerformIO (newIORef 0)
136
137
138 -----------------------------------------------------
139 --
140 -- The Q monad
141 --
142 -----------------------------------------------------
143
144 newtype Q a = Q { unQ :: forall m. Quasi m => m a }
145
146 -- \"Runs\" the 'Q' monad. Normal users of Template Haskell
147 -- should not need this function, as the splice brackets @$( ... )@
148 -- are the usual way of running a 'Q' computation.
149 --
150 -- This function is primarily used in GHC internals, and for debugging
151 -- splices by running them in 'IO'.
152 --
153 -- Note that many functions in 'Q', such as 'reify' and other compiler
154 -- queries, are not supported when running 'Q' in 'IO'; these operations
155 -- simply fail at runtime. Indeed, the only operations guaranteed to succeed
156 -- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
157 runQ :: Quasi m => Q a -> m a
158 runQ (Q m) = m
159
160 instance Monad Q where
161 return x = Q (return x)
162 Q m >>= k = Q (m >>= \x -> unQ (k x))
163 Q m >> Q n = Q (m >> n)
164 fail s = report True s >> Q (fail "Q monad failure")
165
166 instance Functor Q where
167 fmap f (Q x) = Q (fmap f x)
168
169 instance Applicative Q where
170 pure x = Q (pure x)
171 Q f <*> Q x = Q (f <*> x)
172
173 -----------------------------------------------------
174 --
175 -- The TExp type
176 --
177 -----------------------------------------------------
178
179 type role TExp nominal -- See Note [Role of TExp]
180 newtype TExp a = TExp { unType :: Exp }
181
182 unTypeQ :: Q (TExp a) -> Q Exp
183 unTypeQ m = do { TExp e <- m
184 ; return e }
185
186 unsafeTExpCoerce :: Q Exp -> Q (TExp a)
187 unsafeTExpCoerce m = do { e <- m
188 ; return (TExp e) }
189
190 {- Note [Role of TExp]
191 ~~~~~~~~~~~~~~~~~~~~~~
192 TExp's argument must have a nominal role, not phantom as would
193 be inferred (Trac #8459). Consider
194
195 e :: TExp Age
196 e = MkAge 3
197
198 foo = $(coerce e) + 4::Int
199
200 The splice will evaluate to (MkAge 3) and you can't add that to
201 4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}
202
203 ----------------------------------------------------
204 -- Packaged versions for the programmer, hiding the Quasi-ness
205
206 {- |
207 Generate a fresh name, which cannot be captured.
208
209 For example, this:
210
211 @f = $(do
212 nm1 <- newName \"x\"
213 let nm2 = 'mkName' \"x\"
214 return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
215 )@
216
217 will produce the splice
218
219 >f = \x0 -> \x -> x0
220
221 In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
222 and is not captured by the binding @VarP nm2@.
223
224 Although names generated by @newName@ cannot /be captured/, they can
225 /capture/ other names. For example, this:
226
227 >g = $(do
228 > nm1 <- newName "x"
229 > let nm2 = mkName "x"
230 > return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
231 > )
232
233 will produce the splice
234
235 >g = \x -> \x0 -> x0
236
237 since the occurrence @VarE nm2@ is captured by the innermost binding
238 of @x@, namely @VarP nm1@.
239 -}
240 newName :: String -> Q Name
241 newName s = Q (qNewName s)
242
243 -- | Report an error (True) or warning (False),
244 -- but carry on; use 'fail' to stop.
245 report :: Bool -> String -> Q ()
246 report b s = Q (qReport b s)
247 {-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6
248
249 -- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.
250 reportError :: String -> Q ()
251 reportError = report True
252
253 -- | Report a warning to the user, and carry on.
254 reportWarning :: String -> Q ()
255 reportWarning = report False
256
257 -- | Recover from errors raised by 'reportError' or 'fail'.
258 recover :: Q a -- ^ handler to invoke on failure
259 -> Q a -- ^ computation to run
260 -> Q a
261 recover (Q r) (Q m) = Q (qRecover r m)
262
263 -- We don't export lookupName; the Bool isn't a great API
264 -- Instead we export lookupTypeName, lookupValueName
265 lookupName :: Bool -> String -> Q (Maybe Name)
266 lookupName ns s = Q (qLookupName ns s)
267
268 -- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
269 lookupTypeName :: String -> Q (Maybe Name)
270 lookupTypeName s = Q (qLookupName True s)
271
272 -- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
273 lookupValueName :: String -> Q (Maybe Name)
274 lookupValueName s = Q (qLookupName False s)
275
276 {-
277 Note [Name lookup]
278 ~~~~~~~~~~~~~~~~~~
279 -}
280 {- $namelookup #namelookup#
281 The functions 'lookupTypeName' and 'lookupValueName' provide
282 a way to query the current splice's context for what names
283 are in scope. The function 'lookupTypeName' queries the type
284 namespace, whereas 'lookupValueName' queries the value namespace,
285 but the functions are otherwise identical.
286
287 A call @lookupValueName s@ will check if there is a value
288 with name @s@ in scope at the current splice's location. If
289 there is, the @Name@ of this value is returned;
290 if not, then @Nothing@ is returned.
291
292 The returned name cannot be \"captured\".
293 For example:
294
295 > f = "global"
296 > g = $( do
297 > Just nm <- lookupValueName "f"
298 > [| let f = "local" in $( varE nm ) |]
299
300 In this case, @g = \"global\"@; the call to @lookupValueName@
301 returned the global @f@, and this name was /not/ captured by
302 the local definition of @f@.
303
304 The lookup is performed in the context of the /top-level/ splice
305 being run. For example:
306
307 > f = "global"
308 > g = $( [| let f = "local" in
309 > $(do
310 > Just nm <- lookupValueName "f"
311 > varE nm
312 > ) |] )
313
314 Again in this example, @g = \"global\"@, because the call to
315 @lookupValueName@ queries the context of the outer-most @$(...)@.
316
317 Operators should be queried without any surrounding parentheses, like so:
318
319 > lookupValueName "+"
320
321 Qualified names are also supported, like so:
322
323 > lookupValueName "Prelude.+"
324 > lookupValueName "Prelude.map"
325
326 -}
327
328
329 {- | 'reify' looks up information about the 'Name'.
330
331 It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'
332 to ensure that we are reifying from the right namespace. For instance, in this context:
333
334 > data D = D
335
336 which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)
337 To ensure we get information about @D@-the-value, use 'lookupValueName':
338
339 > do
340 > Just nm <- lookupValueName "D"
341 > reify nm
342
343 and to get information about @D@-the-type, use 'lookupTypeName'.
344 -}
345 reify :: Name -> Q Info
346 reify v = Q (qReify v)
347
348 {- | @reifyFixity nm@ returns the fixity of @nm@. If a fixity value cannot be
349 found, 'defaultFixity' is returned.
350 -}
351 reifyFixity :: Name -> Q Fixity
352 reifyFixity nm = Q (qReifyFixity nm)
353
354 {- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is,
355 if @nm@ is the name of a type class, then all instances of this class at the types @tys@
356 are returned. Alternatively, if @nm@ is the name of a data family or type family,
357 all instances of this family at the types @tys@ are returned.
358 -}
359 reifyInstances :: Name -> [Type] -> Q [InstanceDec]
360 reifyInstances cls tys = Q (qReifyInstances cls tys)
361
362 {- | @reifyRoles nm@ returns the list of roles associated with the parameters of
363 the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.
364 The returned list should never contain 'InferR'.
365 -}
366 reifyRoles :: Name -> Q [Role]
367 reifyRoles nm = Q (qReifyRoles nm)
368
369 -- | @reifyAnnotations target@ returns the list of annotations
370 -- associated with @target@. Only the annotations that are
371 -- appropriately typed is returned. So if you have @Int@ and @String@
372 -- annotations for the same target, you have to call this function twice.
373 reifyAnnotations :: Data a => AnnLookup -> Q [a]
374 reifyAnnotations an = Q (qReifyAnnotations an)
375
376 -- | @reifyModule mod@ looks up information about module @mod@. To
377 -- look up the current module, call this function with the return
378 -- value of @thisModule@.
379 reifyModule :: Module -> Q ModuleInfo
380 reifyModule m = Q (qReifyModule m)
381
382 -- | Is the list of instances returned by 'reifyInstances' nonempty?
383 isInstance :: Name -> [Type] -> Q Bool
384 isInstance nm tys = do { decs <- reifyInstances nm tys
385 ; return (not (null decs)) }
386
387 -- | The location at which this computation is spliced.
388 location :: Q Loc
389 location = Q qLocation
390
391 -- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
392 -- Take care: you are guaranteed the ordering of calls to 'runIO' within
393 -- a single 'Q' computation, but not about the order in which splices are run.
394 --
395 -- Note: for various murky reasons, stdout and stderr handles are not
396 -- necessarily flushed when the compiler finishes running, so you should
397 -- flush them yourself.
398 runIO :: IO a -> Q a
399 runIO m = Q (qRunIO m)
400
401 -- | Record external files that runIO is using (dependent upon).
402 -- The compiler can then recognize that it should re-compile the Haskell file
403 -- when an external file changes.
404 --
405 -- Expects an absolute file path.
406 --
407 -- Notes:
408 --
409 -- * ghc -M does not know about these dependencies - it does not execute TH.
410 --
411 -- * The dependency is based on file content, not a modification time
412 addDependentFile :: FilePath -> Q ()
413 addDependentFile fp = Q (qAddDependentFile fp)
414
415 -- | Add additional top-level declarations. The added declarations will be type
416 -- checked along with the current declaration group.
417 addTopDecls :: [Dec] -> Q ()
418 addTopDecls ds = Q (qAddTopDecls ds)
419
420 -- | Add a finalizer that will run in the Q monad after the current module has
421 -- been type checked. This only makes sense when run within a top-level splice.
422 addModFinalizer :: Q () -> Q ()
423 addModFinalizer act = Q (qAddModFinalizer (unQ act))
424
425 -- | Get state from the Q monad.
426 getQ :: Typeable a => Q (Maybe a)
427 getQ = Q qGetQ
428
429 -- | Replace the state in the Q monad.
430 putQ :: Typeable a => a -> Q ()
431 putQ x = Q (qPutQ x)
432
433 instance Quasi Q where
434 qNewName = newName
435 qReport = report
436 qRecover = recover
437 qReify = reify
438 qReifyFixity = reifyFixity
439 qReifyInstances = reifyInstances
440 qReifyRoles = reifyRoles
441 qReifyAnnotations = reifyAnnotations
442 qReifyModule = reifyModule
443 qLookupName = lookupName
444 qLocation = location
445 qRunIO = runIO
446 qAddDependentFile = addDependentFile
447 qAddTopDecls = addTopDecls
448 qAddModFinalizer = addModFinalizer
449 qGetQ = getQ
450 qPutQ = putQ
451
452
453 ----------------------------------------------------
454 -- The following operations are used solely in DsMeta when desugaring brackets
455 -- They are not necessary for the user, who can use ordinary return and (>>=) etc
456
457 returnQ :: a -> Q a
458 returnQ = return
459
460 bindQ :: Q a -> (a -> Q b) -> Q b
461 bindQ = (>>=)
462
463 sequenceQ :: [Q a] -> Q [a]
464 sequenceQ = sequence
465
466
467 -----------------------------------------------------
468 --
469 -- The Lift class
470 --
471 -----------------------------------------------------
472
473 -- | A 'Lift' instance can have any of its values turned into a Template
474 -- Haskell expression. This is needed when a value used within a Template
475 -- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@) but not
476 -- at the top level. As an example:
477 --
478 -- > add1 :: Int -> Q Exp
479 -- > add1 x = [| x + 1 |]
480 --
481 -- Template Haskell has no way of knowing what value @x@ will take on at
482 -- splice-time, so it requires the type of @x@ to be an instance of 'Lift'.
483 --
484 -- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@
485 -- GHC language extension:
486 --
487 -- > {-# LANGUAGE DeriveLift #-}
488 -- > module Foo where
489 -- >
490 -- > import Language.Haskell.TH.Syntax
491 -- >
492 -- > data Bar a = Bar1 a (Bar a) | Bar2 String
493 -- > deriving Lift
494 class Lift t where
495 -- | Turn a value into a Template Haskell expression, suitable for use in
496 -- a splice.
497 lift :: t -> Q Exp
498 default lift :: Data t => t -> Q Exp
499 lift = liftData
500
501 -- If you add any instances here, consider updating test th/TH_Lift
502 instance Lift Integer where
503 lift x = return (LitE (IntegerL x))
504
505 instance Lift Int where
506 lift x = return (LitE (IntegerL (fromIntegral x)))
507
508 instance Lift Int8 where
509 lift x = return (LitE (IntegerL (fromIntegral x)))
510
511 instance Lift Int16 where
512 lift x = return (LitE (IntegerL (fromIntegral x)))
513
514 instance Lift Int32 where
515 lift x = return (LitE (IntegerL (fromIntegral x)))
516
517 instance Lift Int64 where
518 lift x = return (LitE (IntegerL (fromIntegral x)))
519
520 instance Lift Word where
521 lift x = return (LitE (IntegerL (fromIntegral x)))
522
523 instance Lift Word8 where
524 lift x = return (LitE (IntegerL (fromIntegral x)))
525
526 instance Lift Word16 where
527 lift x = return (LitE (IntegerL (fromIntegral x)))
528
529 instance Lift Word32 where
530 lift x = return (LitE (IntegerL (fromIntegral x)))
531
532 instance Lift Word64 where
533 lift x = return (LitE (IntegerL (fromIntegral x)))
534
535 #ifdef HAS_NATURAL
536 instance Lift Natural where
537 lift x = return (LitE (IntegerL (fromIntegral x)))
538 #endif
539
540 instance Integral a => Lift (Ratio a) where
541 lift x = return (LitE (RationalL (toRational x)))
542
543 instance Lift Float where
544 lift x = return (LitE (RationalL (toRational x)))
545
546 instance Lift Double where
547 lift x = return (LitE (RationalL (toRational x)))
548
549 instance Lift Char where
550 lift x = return (LitE (CharL x))
551
552 instance Lift Bool where
553 lift True = return (ConE trueName)
554 lift False = return (ConE falseName)
555
556 instance Lift a => Lift (Maybe a) where
557 lift Nothing = return (ConE nothingName)
558 lift (Just x) = liftM (ConE justName `AppE`) (lift x)
559
560 instance (Lift a, Lift b) => Lift (Either a b) where
561 lift (Left x) = liftM (ConE leftName `AppE`) (lift x)
562 lift (Right y) = liftM (ConE rightName `AppE`) (lift y)
563
564 instance Lift a => Lift [a] where
565 lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
566
567 liftString :: String -> Q Exp
568 -- Used in TcExpr to short-circuit the lifting for strings
569 liftString s = return (LitE (StringL s))
570
571 instance Lift () where
572 lift () = return (ConE (tupleDataName 0))
573
574 instance (Lift a, Lift b) => Lift (a, b) where
575 lift (a, b)
576 = liftM TupE $ sequence [lift a, lift b]
577
578 instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
579 lift (a, b, c)
580 = liftM TupE $ sequence [lift a, lift b, lift c]
581
582 instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
583 lift (a, b, c, d)
584 = liftM TupE $ sequence [lift a, lift b, lift c, lift d]
585
586 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
587 => Lift (a, b, c, d, e) where
588 lift (a, b, c, d, e)
589 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e]
590
591 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
592 => Lift (a, b, c, d, e, f) where
593 lift (a, b, c, d, e, f)
594 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f]
595
596 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
597 => Lift (a, b, c, d, e, f, g) where
598 lift (a, b, c, d, e, f, g)
599 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g]
600
601 -- TH has a special form for literal strings,
602 -- which we should take advantage of.
603 -- NB: the lhs of the rule has no args, so that
604 -- the rule will apply to a 'lift' all on its own
605 -- which happens to be the way the type checker
606 -- creates it.
607 {-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}
608
609
610 trueName, falseName :: Name
611 trueName = mkNameG DataName "ghc-prim" "GHC.Types" "True"
612 falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False"
613
614 nothingName, justName :: Name
615 nothingName = mkNameG DataName "base" "GHC.Base" "Nothing"
616 justName = mkNameG DataName "base" "GHC.Base" "Just"
617
618 leftName, rightName :: Name
619 leftName = mkNameG DataName "base" "Data.Either" "Left"
620 rightName = mkNameG DataName "base" "Data.Either" "Right"
621
622 -----------------------------------------------------
623 --
624 -- Generic Lift implementations
625 --
626 -----------------------------------------------------
627
628 -- | 'dataToQa' is an internal utility function for constructing generic
629 -- conversion functions from types with 'Data' instances to various
630 -- quasi-quoting representations. See the source of 'dataToExpQ' and
631 -- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@
632 -- and @appQ@ are overloadable to account for different syntax for
633 -- expressions and patterns; @antiQ@ allows you to override type-specific
634 -- cases, a common usage is just @const Nothing@, which results in
635 -- no overloading.
636 dataToQa :: forall a k q. Data a
637 => (Name -> k)
638 -> (Lit -> Q q)
639 -> (k -> [Q q] -> Q q)
640 -> (forall b . Data b => b -> Maybe (Q q))
641 -> a
642 -> Q q
643 dataToQa mkCon mkLit appCon antiQ t =
644 case antiQ t of
645 Nothing ->
646 case constrRep constr of
647 AlgConstr _ ->
648 appCon (mkCon conName) conArgs
649 where
650 conName :: Name
651 conName =
652 case showConstr constr of
653 "(:)" -> Name (mkOccName ":")
654 (NameG DataName
655 (mkPkgName "ghc-prim")
656 (mkModName "GHC.Types"))
657 con@"[]" -> Name (mkOccName con)
658 (NameG DataName
659 (mkPkgName "ghc-prim")
660 (mkModName "GHC.Types"))
661 con@('(':_) -> Name (mkOccName con)
662 (NameG DataName
663 (mkPkgName "ghc-prim")
664 (mkModName "GHC.Tuple"))
665 con -> mkNameG_d (tyConPackage tycon)
666 (tyConModule tycon)
667 con
668 where
669 tycon :: TyCon
670 tycon = (typeRepTyCon . typeOf) t
671
672 conArgs :: [Q q]
673 conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
674 IntConstr n ->
675 mkLit $ IntegerL n
676 FloatConstr n ->
677 mkLit $ RationalL n
678 CharConstr c ->
679 mkLit $ CharL c
680 where
681 constr :: Constr
682 constr = toConstr t
683
684 Just y -> y
685
686 -- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the
687 -- same value, in the SYB style. It is generalized to take a function
688 -- override type-specific cases; see 'liftData' for a more commonly
689 -- used variant.
690 dataToExpQ :: Data a
691 => (forall b . Data b => b -> Maybe (Q Exp))
692 -> a
693 -> Q Exp
694 dataToExpQ = dataToQa conE litE (foldl appE)
695 where conE s = return (ConE s)
696 appE x y = do { a <- x; b <- y; return (AppE a b)}
697 litE c = return (LitE c)
698
699 -- | 'liftData' is a variant of 'lift' in the 'Lift' type class which
700 -- works for any type with a 'Data' instance.
701 liftData :: Data a => a -> Q Exp
702 liftData = dataToExpQ (const Nothing)
703
704 -- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
705 -- value, in the SYB style. It takes a function to handle type-specific cases,
706 -- alternatively, pass @const Nothing@ to get default behavior.
707 dataToPatQ :: Data a
708 => (forall b . Data b => b -> Maybe (Q Pat))
709 -> a
710 -> Q Pat
711 dataToPatQ = dataToQa id litP conP
712 where litP l = return (LitP l)
713 conP n ps = do ps' <- sequence ps
714 return (ConP n ps')
715
716 -----------------------------------------------------
717 -- Names and uniques
718 -----------------------------------------------------
719
720 newtype ModName = ModName String -- Module name
721 deriving (Show,Eq,Ord,Typeable,Data,Generic)
722
723 newtype PkgName = PkgName String -- package name
724 deriving (Show,Eq,Ord,Typeable,Data,Generic)
725
726 -- | Obtained from 'reifyModule' and 'thisModule'.
727 data Module = Module PkgName ModName -- package qualified module name
728 deriving (Show,Eq,Ord,Typeable,Data,Generic)
729
730 newtype OccName = OccName String
731 deriving (Show,Eq,Ord,Typeable,Data,Generic)
732
733 mkModName :: String -> ModName
734 mkModName s = ModName s
735
736 modString :: ModName -> String
737 modString (ModName m) = m
738
739
740 mkPkgName :: String -> PkgName
741 mkPkgName s = PkgName s
742
743 pkgString :: PkgName -> String
744 pkgString (PkgName m) = m
745
746
747 -----------------------------------------------------
748 -- OccName
749 -----------------------------------------------------
750
751 mkOccName :: String -> OccName
752 mkOccName s = OccName s
753
754 occString :: OccName -> String
755 occString (OccName occ) = occ
756
757
758 -----------------------------------------------------
759 -- Names
760 -----------------------------------------------------
761 --
762 -- For "global" names ('NameG') we need a totally unique name,
763 -- so we must include the name-space of the thing
764 --
765 -- For unique-numbered things ('NameU'), we've got a unique reference
766 -- anyway, so no need for name space
767 --
768 -- For dynamically bound thing ('NameS') we probably want them to
769 -- in a context-dependent way, so again we don't want the name
770 -- space. For example:
771 --
772 -- > let v = mkName "T" in [| data $v = $v |]
773 --
774 -- Here we use the same Name for both type constructor and data constructor
775 --
776 --
777 -- NameL and NameG are bound *outside* the TH syntax tree
778 -- either globally (NameG) or locally (NameL). Ex:
779 --
780 -- > f x = $(h [| (map, x) |])
781 --
782 -- The 'map' will be a NameG, and 'x' wil be a NameL
783 --
784 -- These Names should never appear in a binding position in a TH syntax tree
785
786 {- $namecapture #namecapture#
787 Much of 'Name' API is concerned with the problem of /name capture/, which
788 can be seen in the following example.
789
790 > f expr = [| let x = 0 in $expr |]
791 > ...
792 > g x = $( f [| x |] )
793 > h y = $( f [| y |] )
794
795 A naive desugaring of this would yield:
796
797 > g x = let x = 0 in x
798 > h y = let x = 0 in y
799
800 All of a sudden, @g@ and @h@ have different meanings! In this case,
801 we say that the @x@ in the RHS of @g@ has been /captured/
802 by the binding of @x@ in @f@.
803
804 What we actually want is for the @x@ in @f@ to be distinct from the
805 @x@ in @g@, so we get the following desugaring:
806
807 > g x = let x' = 0 in x
808 > h y = let x' = 0 in y
809
810 which avoids name capture as desired.
811
812 In the general case, we say that a @Name@ can be captured if
813 the thing it refers to can be changed by adding new declarations.
814 -}
815
816 {- |
817 An abstract type representing names in the syntax tree.
818
819 'Name's can be constructed in several ways, which come with different
820 name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for
821 an explanation of name capture):
822
823 * the built-in syntax @'f@ and @''T@ can be used to construct names,
824 The expression @'f@ gives a @Name@ which refers to the value @f@
825 currently in scope, and @''T@ gives a @Name@ which refers to the
826 type @T@ currently in scope. These names can never be captured.
827
828 * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and
829 @''T@ respectively, but the @Name@s are looked up at the point
830 where the current splice is being run. These names can never be
831 captured.
832
833 * 'newName' monadically generates a new name, which can never
834 be captured.
835
836 * 'mkName' generates a capturable name.
837
838 Names constructed using @newName@ and @mkName@ may be used in bindings
839 (such as @let x = ...@ or @\x -> ...@), but names constructed using
840 @lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.
841 -}
842 data Name = Name OccName NameFlavour deriving (Typeable, Data, Eq, Generic)
843
844 instance Ord Name where
845 -- check if unique is different before looking at strings
846 (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2) `thenCmp`
847 (o1 `compare` o2)
848
849 data NameFlavour
850 = NameS -- ^ An unqualified name; dynamically bound
851 | NameQ ModName -- ^ A qualified name; dynamically bound
852 | NameU !Int -- ^ A unique local name
853 | NameL !Int -- ^ Local name bound outside of the TH AST
854 | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:
855 -- An original name (occurrences only, not binders)
856 -- Need the namespace too to be sure which
857 -- thing we are naming
858 deriving ( Typeable, Data, Eq, Ord, Generic )
859
860 data NameSpace = VarName -- ^ Variables
861 | DataName -- ^ Data constructors
862 | TcClsName -- ^ Type constructors and classes; Haskell has them
863 -- in the same name space for now.
864 deriving( Eq, Ord, Data, Typeable, Generic )
865
866 type Uniq = Int
867
868 -- | The name without its module prefix.
869 --
870 -- ==== __Examples__
871 --
872 -- >>> nameBase ''Data.Either.Either
873 -- "Either"
874 -- >>> nameBase (mkName "foo")
875 -- "foo"
876 -- >>> nameBase (mkName "Module.foo")
877 -- "foo"
878 nameBase :: Name -> String
879 nameBase (Name occ _) = occString occ
880
881 -- | Module prefix of a name, if it exists.
882 --
883 -- ==== __Examples__
884 --
885 -- >>> nameModule ''Data.Either.Either"
886 -- Just "Data.Either"
887 -- >>> nameModule (mkName "foo")
888 -- Nothing
889 -- >>> nameModule (mkName "Module.foo")
890 -- Just "Module"
891 nameModule :: Name -> Maybe String
892 nameModule (Name _ (NameQ m)) = Just (modString m)
893 nameModule (Name _ (NameG _ _ m)) = Just (modString m)
894 nameModule _ = Nothing
895
896 -- | A name's package, if it exists.
897 --
898 -- ==== __Examples__
899 --
900 -- >>> namePackage ''Data.Either.Either"
901 -- Just "base"
902 -- >>> namePackage (mkName "foo")
903 -- Nothing
904 -- >>> namePackage (mkName "Module.foo")
905 -- Nothing
906 namePackage :: Name -> Maybe String
907 namePackage (Name _ (NameG _ p _)) = Just (pkgString p)
908 namePackage _ = Nothing
909
910 {- |
911 Generate a capturable name. Occurrences of such names will be
912 resolved according to the Haskell scoping rules at the occurrence
913 site.
914
915 For example:
916
917 > f = [| pi + $(varE (mkName "pi")) |]
918 > ...
919 > g = let pi = 3 in $f
920
921 In this case, @g@ is desugared to
922
923 > g = Prelude.pi + 3
924
925 Note that @mkName@ may be used with qualified names:
926
927 > mkName "Prelude.pi"
928
929 See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could
930 be rewritten using 'dyn' as
931
932 > f = [| pi + $(dyn "pi") |]
933 -}
934 mkName :: String -> Name
935 -- The string can have a '.', thus "Foo.baz",
936 -- giving a dynamically-bound qualified name,
937 -- in which case we want to generate a NameQ
938 --
939 -- Parse the string to see if it has a "." in it
940 -- so we know whether to generate a qualified or unqualified name
941 -- It's a bit tricky because we need to parse
942 --
943 -- > Foo.Baz.x as Qual Foo.Baz x
944 --
945 -- So we parse it from back to front
946 mkName str
947 = split [] (reverse str)
948 where
949 split occ [] = Name (mkOccName occ) NameS
950 split occ ('.':rev) | not (null occ)
951 , is_rev_mod_name rev
952 = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
953 -- The 'not (null occ)' guard ensures that
954 -- mkName "&." = Name "&." NameS
955 -- The 'is_rev_mod' guards ensure that
956 -- mkName ".&" = Name ".&" NameS
957 -- mkName "^.." = Name "^.." NameS -- Trac #8633
958 -- mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
959 -- This rather bizarre case actually happened; (.&.) is in Data.Bits
960 split occ (c:rev) = split (c:occ) rev
961
962 -- Recognises a reversed module name xA.yB.C,
963 -- with at least one component,
964 -- and each component looks like a module name
965 -- (i.e. non-empty, starts with capital, all alpha)
966 is_rev_mod_name rev_mod_str
967 | (compt, rest) <- break (== '.') rev_mod_str
968 , not (null compt), isUpper (last compt), all is_mod_char compt
969 = case rest of
970 [] -> True
971 (_dot : rest') -> is_rev_mod_name rest'
972 | otherwise
973 = False
974
975 is_mod_char c = isAlphaNum c || c == '_' || c == '\''
976
977 -- | Only used internally
978 mkNameU :: String -> Uniq -> Name
979 mkNameU s u = Name (mkOccName s) (NameU u)
980
981 -- | Only used internally
982 mkNameL :: String -> Uniq -> Name
983 mkNameL s u = Name (mkOccName s) (NameL u)
984
985 -- | Used for 'x etc, but not available to the programmer
986 mkNameG :: NameSpace -> String -> String -> String -> Name
987 mkNameG ns pkg modu occ
988 = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))
989
990 mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
991 mkNameG_v = mkNameG VarName
992 mkNameG_tc = mkNameG TcClsName
993 mkNameG_d = mkNameG DataName
994
995 data NameIs = Alone | Applied | Infix
996
997 showName :: Name -> String
998 showName = showName' Alone
999
1000 showName' :: NameIs -> Name -> String
1001 showName' ni nm
1002 = case ni of
1003 Alone -> nms
1004 Applied
1005 | pnam -> nms
1006 | otherwise -> "(" ++ nms ++ ")"
1007 Infix
1008 | pnam -> "`" ++ nms ++ "`"
1009 | otherwise -> nms
1010 where
1011 -- For now, we make the NameQ and NameG print the same, even though
1012 -- NameQ is a qualified name (so what it means depends on what the
1013 -- current scope is), and NameG is an original name (so its meaning
1014 -- should be independent of what's in scope.
1015 -- We may well want to distinguish them in the end.
1016 -- Ditto NameU and NameL
1017 nms = case nm of
1018 Name occ NameS -> occString occ
1019 Name occ (NameQ m) -> modString m ++ "." ++ occString occ
1020 Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
1021 Name occ (NameU u) -> occString occ ++ "_" ++ show u
1022 Name occ (NameL u) -> occString occ ++ "_" ++ show u
1023
1024 pnam = classify nms
1025
1026 -- True if we are function style, e.g. f, [], (,)
1027 -- False if we are operator style, e.g. +, :+
1028 classify "" = False -- shouldn't happen; . operator is handled below
1029 classify (x:xs) | isAlpha x || (x `elem` "_[]()") =
1030 case dropWhile (/='.') xs of
1031 (_:xs') -> classify xs'
1032 [] -> True
1033 | otherwise = False
1034
1035 instance Show Name where
1036 show = showName
1037
1038 -- Tuple data and type constructors
1039 -- | Tuple data constructor
1040 tupleDataName :: Int -> Name
1041 -- | Tuple type constructor
1042 tupleTypeName :: Int -> Name
1043
1044 tupleDataName 0 = mk_tup_name 0 DataName
1045 tupleDataName 1 = error "tupleDataName 1"
1046 tupleDataName n = mk_tup_name (n-1) DataName
1047
1048 tupleTypeName 0 = mk_tup_name 0 TcClsName
1049 tupleTypeName 1 = error "tupleTypeName 1"
1050 tupleTypeName n = mk_tup_name (n-1) TcClsName
1051
1052 mk_tup_name :: Int -> NameSpace -> Name
1053 mk_tup_name n_commas space
1054 = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
1055 where
1056 occ = mkOccName ('(' : replicate n_commas ',' ++ ")")
1057 tup_mod = mkModName "GHC.Tuple"
1058
1059 -- Unboxed tuple data and type constructors
1060 -- | Unboxed tuple data constructor
1061 unboxedTupleDataName :: Int -> Name
1062 -- | Unboxed tuple type constructor
1063 unboxedTupleTypeName :: Int -> Name
1064
1065 unboxedTupleDataName 0 = error "unboxedTupleDataName 0"
1066 unboxedTupleDataName 1 = error "unboxedTupleDataName 1"
1067 unboxedTupleDataName n = mk_unboxed_tup_name (n-1) DataName
1068
1069 unboxedTupleTypeName 0 = error "unboxedTupleTypeName 0"
1070 unboxedTupleTypeName 1 = error "unboxedTupleTypeName 1"
1071 unboxedTupleTypeName n = mk_unboxed_tup_name (n-1) TcClsName
1072
1073 mk_unboxed_tup_name :: Int -> NameSpace -> Name
1074 mk_unboxed_tup_name n_commas space
1075 = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
1076 where
1077 occ = mkOccName ("(#" ++ replicate n_commas ',' ++ "#)")
1078 tup_mod = mkModName "GHC.Tuple"
1079
1080
1081
1082 -----------------------------------------------------
1083 -- Locations
1084 -----------------------------------------------------
1085
1086 data Loc
1087 = Loc { loc_filename :: String
1088 , loc_package :: String
1089 , loc_module :: String
1090 , loc_start :: CharPos
1091 , loc_end :: CharPos }
1092 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1093
1094 type CharPos = (Int, Int) -- ^ Line and character position
1095
1096
1097 -----------------------------------------------------
1098 --
1099 -- The Info returned by reification
1100 --
1101 -----------------------------------------------------
1102
1103 -- | Obtained from 'reify' in the 'Q' Monad.
1104 data Info
1105 =
1106 -- | A class, with a list of its visible instances
1107 ClassI
1108 Dec
1109 [InstanceDec]
1110
1111 -- | A class method
1112 | ClassOpI
1113 Name
1114 Type
1115 ParentName
1116
1117 -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned using 'PrimTyConI' or 'FamilyI' as appropriate
1118 | TyConI
1119 Dec
1120
1121 -- | A type or data family, with a list of its visible instances. A closed
1122 -- type family is returned with 0 instances.
1123 | FamilyI
1124 Dec
1125 [InstanceDec]
1126
1127 -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'. Examples: @(->)@, @Int#@.
1128 | PrimTyConI
1129 Name
1130 Arity
1131 Unlifted
1132
1133 -- | A data constructor
1134 | DataConI
1135 Name
1136 Type
1137 ParentName
1138
1139 {- |
1140 A \"value\" variable (as opposed to a type variable, see 'TyVarI').
1141
1142 The @Maybe Dec@ field contains @Just@ the declaration which
1143 defined the variable -- including the RHS of the declaration --
1144 or else @Nothing@, in the case where the RHS is unavailable to
1145 the compiler. At present, this value is _always_ @Nothing@:
1146 returning the RHS has not yet been implemented because of
1147 lack of interest.
1148 -}
1149 | VarI
1150 Name
1151 Type
1152 (Maybe Dec)
1153
1154 {- |
1155 A type variable.
1156
1157 The @Type@ field contains the type which underlies the variable.
1158 At present, this is always @'VarT' theName@, but future changes
1159 may permit refinement of this.
1160 -}
1161 | TyVarI -- Scoped type variable
1162 Name
1163 Type -- What it is bound to
1164 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1165
1166 -- | Obtained from 'reifyModule' in the 'Q' Monad.
1167 data ModuleInfo =
1168 -- | Contains the import list of the module.
1169 ModuleInfo [Module]
1170 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1171
1172 {- |
1173 In 'ClassOpI' and 'DataConI', name of the parent class or type
1174 -}
1175 type ParentName = Name
1176
1177 -- | In 'PrimTyConI', arity of the type constructor
1178 type Arity = Int
1179
1180 -- | In 'PrimTyConI', is the type constructor unlifted?
1181 type Unlifted = Bool
1182
1183 -- | 'InstanceDec' desribes a single instance of a class or type function.
1184 -- It is just a 'Dec', but guaranteed to be one of the following:
1185 --
1186 -- * 'InstanceD' (with empty @['Dec']@)
1187 --
1188 -- * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)
1189 --
1190 -- * 'TySynInstD'
1191 type InstanceDec = Dec
1192
1193 data Fixity = Fixity Int FixityDirection
1194 deriving( Eq, Ord, Show, Data, Typeable, Generic )
1195 data FixityDirection = InfixL | InfixR | InfixN
1196 deriving( Eq, Ord, Show, Data, Typeable, Generic )
1197
1198 -- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)
1199 maxPrecedence :: Int
1200 maxPrecedence = (9::Int)
1201
1202 -- | Default fixity: @infixl 9@
1203 defaultFixity :: Fixity
1204 defaultFixity = Fixity maxPrecedence InfixL
1205
1206
1207 {-
1208 Note [Unresolved infix]
1209 ~~~~~~~~~~~~~~~~~~~~~~~
1210 -}
1211 {- $infix #infix#
1212 When implementing antiquotation for quasiquoters, one often wants
1213 to parse strings into expressions:
1214
1215 > parse :: String -> Maybe Exp
1216
1217 But how should we parse @a + b * c@? If we don't know the fixities of
1218 @+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a
1219 + b) * c@.
1220
1221 In cases like this, use 'UInfixE', 'UInfixP', or 'UInfixT', which stand for
1222 \"unresolved infix expression/pattern/type\", respectively. When the compiler
1223 is given a splice containing a tree of @UInfixE@ applications such as
1224
1225 > UInfixE
1226 > (UInfixE e1 op1 e2)
1227 > op2
1228 > (UInfixE e3 op3 e4)
1229
1230 it will look up and the fixities of the relevant operators and
1231 reassociate the tree as necessary.
1232
1233 * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT',
1234 which are of use for parsing expressions like
1235
1236 > (a + b * c) + d * e
1237
1238 * 'InfixE', 'InfixP', and 'InfixT' expressions are never reassociated.
1239
1240 * The 'UInfixE' constructor doesn't support sections. Sections
1241 such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer
1242 sections such as @(a + b * c -)@, use an 'InfixE' constructor for the
1243 outer-most section, and use 'UInfixE' constructors for all
1244 other operators:
1245
1246 > InfixE
1247 > Just (UInfixE ...a + b * c...)
1248 > op
1249 > Nothing
1250
1251 Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered
1252 into 'Exp's differently:
1253
1254 > (+ a + b) ---> InfixE Nothing + (Just $ UInfixE a + b)
1255 > -- will result in a fixity error if (+) is left-infix
1256 > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)
1257 > -- no fixity errors
1258
1259 * Quoted expressions such as
1260
1261 > [| a * b + c |] :: Q Exp
1262 > [p| a : b : c |] :: Q Pat
1263 > [t| T + T |] :: Q Type
1264
1265 will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'InfixT', 'ParensE',
1266 'ParensP', or 'ParensT' constructors.
1267
1268 -}
1269
1270 -----------------------------------------------------
1271 --
1272 -- The main syntax data types
1273 --
1274 -----------------------------------------------------
1275
1276 data Lit = CharL Char
1277 | StringL String
1278 | IntegerL Integer -- ^ Used for overloaded and non-overloaded
1279 -- literals. We don't have a good way to
1280 -- represent non-overloaded literals at
1281 -- the moment. Maybe that doesn't matter?
1282 | RationalL Rational -- Ditto
1283 | IntPrimL Integer
1284 | WordPrimL Integer
1285 | FloatPrimL Rational
1286 | DoublePrimL Rational
1287 | StringPrimL [Word8] -- ^ A primitive C-style string, type Addr#
1288 | CharPrimL Char
1289 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1290
1291 -- We could add Int, Float, Double etc, as we do in HsLit,
1292 -- but that could complicate the
1293 -- supposedly-simple TH.Syntax literal type
1294
1295 -- | Pattern in Haskell given in @{}@
1296 data Pat
1297 = LitP Lit -- ^ @{ 5 or 'c' }@
1298 | VarP Name -- ^ @{ x }@
1299 | TupP [Pat] -- ^ @{ (p1,p2) }@
1300 | UnboxedTupP [Pat] -- ^ @{ (# p1,p2 #) }@
1301 | ConP Name [Pat] -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@
1302 | InfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
1303 | UInfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
1304 --
1305 -- See "Language.Haskell.TH.Syntax#infix"
1306 | ParensP Pat -- ^ @{(p)}@
1307 --
1308 -- See "Language.Haskell.TH.Syntax#infix"
1309 | TildeP Pat -- ^ @{ ~p }@
1310 | BangP Pat -- ^ @{ !p }@
1311 | AsP Name Pat -- ^ @{ x \@ p }@
1312 | WildP -- ^ @{ _ }@
1313 | RecP Name [FieldPat] -- ^ @f (Pt { pointx = x }) = g x@
1314 | ListP [ Pat ] -- ^ @{ [1,2,3] }@
1315 | SigP Pat Type -- ^ @{ p :: t }@
1316 | ViewP Exp Pat -- ^ @{ e -> p }@
1317 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1318
1319 type FieldPat = (Name,Pat)
1320
1321 data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@
1322 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1323 data Clause = Clause [Pat] Body [Dec]
1324 -- ^ @f { p1 p2 = body where decs }@
1325 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1326
1327 data Exp
1328 = VarE Name -- ^ @{ x }@
1329 | ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @
1330 | LitE Lit -- ^ @{ 5 or 'c'}@
1331 | AppE Exp Exp -- ^ @{ f x }@
1332
1333 | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@
1334
1335 -- It's a bit gruesome to use an Exp as the
1336 -- operator, but how else can we distinguish
1337 -- constructors from non-constructors?
1338 -- Maybe there should be a var-or-con type?
1339 -- Or maybe we should leave it to the String itself?
1340
1341 | UInfixE Exp Exp Exp -- ^ @{x + y}@
1342 --
1343 -- See "Language.Haskell.TH.Syntax#infix"
1344 | ParensE Exp -- ^ @{ (e) }@
1345 --
1346 -- See "Language.Haskell.TH.Syntax#infix"
1347 | LamE [Pat] Exp -- ^ @{ \ p1 p2 -> e }@
1348 | LamCaseE [Match] -- ^ @{ \case m1; m2 }@
1349 | TupE [Exp] -- ^ @{ (e1,e2) } @
1350 | UnboxedTupE [Exp] -- ^ @{ (# e1,e2 #) } @
1351 | CondE Exp Exp Exp -- ^ @{ if e1 then e2 else e3 }@
1352 | MultiIfE [(Guard, Exp)] -- ^ @{ if | g1 -> e1 | g2 -> e2 }@
1353 | LetE [Dec] Exp -- ^ @{ let x=e1; y=e2 in e3 }@
1354 | CaseE Exp [Match] -- ^ @{ case e of m1; m2 }@
1355 | DoE [Stmt] -- ^ @{ do { p <- e1; e2 } }@
1356 | CompE [Stmt] -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@
1357 --
1358 -- The result expression of the comprehension is
1359 -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.
1360 --
1361 -- E.g. translation:
1362 --
1363 -- > [ f x | x <- xs ]
1364 --
1365 -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]
1366
1367 | ArithSeqE Range -- ^ @{ [ 1 ,2 .. 10 ] }@
1368 | ListE [ Exp ] -- ^ @{ [1,2,3] }@
1369 | SigE Exp Type -- ^ @{ e :: t }@
1370 | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@
1371 | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@
1372 | StaticE Exp -- ^ @{ static e }@
1373 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1374
1375 type FieldExp = (Name,Exp)
1376
1377 -- Omitted: implicit parameters
1378
1379 data Body
1380 = GuardedB [(Guard,Exp)] -- ^ @f p { | e1 = e2
1381 -- | e3 = e4 }
1382 -- where ds@
1383 | NormalB Exp -- ^ @f p { = e } where ds@
1384 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1385
1386 data Guard
1387 = NormalG Exp -- ^ @f x { | odd x } = x@
1388 | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@
1389 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1390
1391 data Stmt
1392 = BindS Pat Exp
1393 | LetS [ Dec ]
1394 | NoBindS Exp
1395 | ParS [[Stmt]]
1396 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1397
1398 data Range = FromR Exp | FromThenR Exp Exp
1399 | FromToR Exp Exp | FromThenToR Exp Exp Exp
1400 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1401
1402 data Dec
1403 = FunD Name [Clause] -- ^ @{ f p1 p2 = b where decs }@
1404 | ValD Pat Body [Dec] -- ^ @{ p = b where decs }@
1405 | DataD Cxt Name [TyVarBndr]
1406 [Con] [Name] -- ^ @{ data Cxt x => T x = A x | B (T x)
1407 -- deriving (Z,W)}@
1408 | NewtypeD Cxt Name [TyVarBndr]
1409 Con [Name] -- ^ @{ newtype Cxt x => T x = A (B x)
1410 -- deriving (Z,W)}@
1411 | TySynD Name [TyVarBndr] Type -- ^ @{ type T x = (x,x) }@
1412 | ClassD Cxt Name [TyVarBndr]
1413 [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@
1414 | InstanceD Cxt Type [Dec] -- ^ @{ instance Show w => Show [w]
1415 -- where ds }@
1416 | SigD Name Type -- ^ @{ length :: [a] -> Int }@
1417 | ForeignD Foreign -- ^ @{ foreign import ... }
1418 --{ foreign export ... }@
1419
1420 | InfixD Fixity Name -- ^ @{ infix 3 foo }@
1421
1422 -- | pragmas
1423 | PragmaD Pragma -- ^ @{ {\-# INLINE [1] foo #-\} }@
1424
1425 -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
1426 | DataFamilyD Name [TyVarBndr]
1427 (Maybe Kind)
1428 -- ^ @{ data family T a b c :: * }@
1429
1430 | DataInstD Cxt Name [Type]
1431 [Con] [Name] -- ^ @{ data instance Cxt x => T [x] = A x
1432 -- | B (T x)
1433 -- deriving (Z,W)}@
1434 | NewtypeInstD Cxt Name [Type]
1435 Con [Name] -- ^ @{ newtype instance Cxt x => T [x] = A (B x)
1436 -- deriving (Z,W)}@
1437 | TySynInstD Name TySynEqn -- ^ @{ type instance ... }@
1438
1439 -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
1440 | OpenTypeFamilyD Name
1441 [TyVarBndr] FamilyResultSig
1442 (Maybe InjectivityAnn)
1443 -- ^ @{ type family T a b c = (r :: *) | r -> a b }@
1444
1445 | ClosedTypeFamilyD Name
1446 [TyVarBndr] FamilyResultSig
1447 (Maybe InjectivityAnn)
1448 [TySynEqn]
1449 -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@
1450
1451 | RoleAnnotD Name [Role] -- ^ @{ type role T nominal representational }@
1452 | StandaloneDerivD Cxt Type -- ^ @{ deriving instance Ord a => Ord (Foo a) }@
1453 | DefaultSigD Name Type -- ^ @{ default size :: Data a => a -> Int }@
1454 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1455
1456 -- | One equation of a type family instance or closed type family. The
1457 -- arguments are the left-hand-side type patterns and the right-hand-side
1458 -- result.
1459 data TySynEqn = TySynEqn [Type] Type
1460 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1461
1462 data FunDep = FunDep [Name] [Name]
1463 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1464
1465 data FamFlavour = TypeFam | DataFam
1466 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1467
1468 data Foreign = ImportF Callconv Safety String Name Type
1469 | ExportF Callconv String Name Type
1470 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1471
1472 -- keep Callconv in sync with module ForeignCall in ghc/compiler/prelude/ForeignCall.hs
1473 data Callconv = CCall | StdCall | CApi | Prim | JavaScript
1474 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1475
1476 data Safety = Unsafe | Safe | Interruptible
1477 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1478
1479 data Pragma = InlineP Name Inline RuleMatch Phases
1480 | SpecialiseP Name Type (Maybe Inline) Phases
1481 | SpecialiseInstP Type
1482 | RuleP String [RuleBndr] Exp Exp Phases
1483 | AnnP AnnTarget Exp
1484 | LineP Int String
1485 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1486
1487 data Inline = NoInline
1488 | Inline
1489 | Inlinable
1490 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1491
1492 data RuleMatch = ConLike
1493 | FunLike
1494 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1495
1496 data Phases = AllPhases
1497 | FromPhase Int
1498 | BeforePhase Int
1499 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1500
1501 data RuleBndr = RuleVar Name
1502 | TypedRuleVar Name Type
1503 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1504
1505 data AnnTarget = ModuleAnnotation
1506 | TypeAnnotation Name
1507 | ValueAnnotation Name
1508 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1509
1510 type Cxt = [Pred] -- ^ @(Eq a, Ord b)@
1511
1512 -- | Since the advent of @ConstraintKinds@, constraints are really just types.
1513 -- Equality constraints use the 'EqualityT' constructor. Constraints may also
1514 -- be tuples of other constraints.
1515 type Pred = Type
1516
1517 data Strict = IsStrict | NotStrict | Unpacked
1518 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1519
1520 data Con = NormalC Name [StrictType] -- ^ @C Int a@
1521 | RecC Name [VarStrictType] -- ^ @C { v :: Int, w :: a }@
1522 | InfixC StrictType Name StrictType -- ^ @Int :+ a@
1523 | ForallC [TyVarBndr] Cxt Con -- ^ @forall a. Eq a => C [a]@
1524 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1525
1526 type StrictType = (Strict, Type)
1527 type VarStrictType = (Name, Strict, Type)
1528
1529 data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> -> \<type\>@
1530 | AppT Type Type -- ^ @T a b@
1531 | SigT Type Kind -- ^ @t :: k@
1532 | VarT Name -- ^ @a@
1533 | ConT Name -- ^ @T@
1534 | PromotedT Name -- ^ @'T@
1535 | InfixT Type Name Type -- ^ @T + T@
1536 | UInfixT Type Name Type -- ^ @T + T@
1537 --
1538 -- See "Language.Haskell.TH.Syntax#infix"
1539 | ParensT Type -- ^ @(T)@
1540
1541 -- See Note [Representing concrete syntax in types]
1542 | TupleT Int -- ^ @(,), (,,), etc.@
1543 | UnboxedTupleT Int -- ^ @(#,#), (#,,#), etc.@
1544 | ArrowT -- ^ @->@
1545 | EqualityT -- ^ @~@
1546 | ListT -- ^ @[]@
1547 | PromotedTupleT Int -- ^ @'(), '(,), '(,,), etc.@
1548 | PromotedNilT -- ^ @'[]@
1549 | PromotedConsT -- ^ @(':)@
1550 | StarT -- ^ @*@
1551 | ConstraintT -- ^ @Constraint@
1552 | LitT TyLit -- ^ @0,1,2, etc.@
1553 | WildCardT (Maybe Name) -- ^ @_, _a, etc.@
1554 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1555
1556 data TyVarBndr = PlainTV Name -- ^ @a@
1557 | KindedTV Name Kind -- ^ @(a :: k)@
1558 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1559
1560 -- | Type family result signature
1561 data FamilyResultSig = NoSig -- ^ no signature
1562 | KindSig Kind -- ^ @k@
1563 | TyVarSig TyVarBndr -- ^ @= r, = (r :: k)@
1564 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1565
1566 -- | Injectivity annotation
1567 data InjectivityAnn = InjectivityAnn Name [Name]
1568 deriving ( Show, Eq, Ord, Data, Typeable, Generic )
1569
1570 data TyLit = NumTyLit Integer -- ^ @2@
1571 | StrTyLit String -- ^ @"Hello"@
1572 deriving ( Show, Eq, Ord, Data, Typeable, Generic )
1573
1574 -- | Role annotations
1575 data Role = NominalR -- ^ @nominal@
1576 | RepresentationalR -- ^ @representational@
1577 | PhantomR -- ^ @phantom@
1578 | InferR -- ^ @_@
1579 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1580
1581 -- | Annotation target for reifyAnnotations
1582 data AnnLookup = AnnLookupModule Module
1583 | AnnLookupName Name
1584 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1585
1586 -- | To avoid duplication between kinds and types, they
1587 -- are defined to be the same. Naturally, you would never
1588 -- have a type be 'StarT' and you would never have a kind
1589 -- be 'SigT', but many of the other constructors are shared.
1590 -- Note that the kind @Bool@ is denoted with 'ConT', not
1591 -- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',
1592 -- not 'PromotedTupleT'.
1593
1594 type Kind = Type
1595
1596 {- Note [Representing concrete syntax in types]
1597 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1598 Haskell has a rich concrete syntax for types, including
1599 t1 -> t2, (t1,t2), [t], and so on
1600 In TH we represent all of this using AppT, with a distinguished
1601 type constructor at the head. So,
1602 Type TH representation
1603 -----------------------------------------------
1604 t1 -> t2 ArrowT `AppT` t2 `AppT` t2
1605 [t] ListT `AppT` t
1606 (t1,t2) TupleT 2 `AppT` t1 `AppT` t2
1607 '(t1,t2) PromotedTupleT 2 `AppT` t1 `AppT` t2
1608
1609 But if the original HsSyn used prefix application, we won't use
1610 these special TH constructors. For example
1611 [] t ConT "[]" `AppT` t
1612 (->) t ConT "->" `AppT` t
1613 In this way we can faithfully represent in TH whether the original
1614 HsType used concrete syntax or not.
1615
1616 The one case that doesn't fit this pattern is that of promoted lists
1617 '[ Maybe, IO ] PromotedListT 2 `AppT` t1 `AppT` t2
1618 but it's very smelly because there really is no type constructor
1619 corresponding to PromotedListT. So we encode HsExplicitListTy with
1620 PromotedConsT and PromotedNilT (which *do* have underlying type
1621 constructors):
1622 '[ Maybe, IO ] PromotedConsT `AppT` Maybe `AppT`
1623 (PromotedConsT `AppT` IO `AppT` PromotedNilT)
1624 -}
1625
1626 -----------------------------------------------------
1627 -- Internal helper functions
1628 -----------------------------------------------------
1629
1630 cmpEq :: Ordering -> Bool
1631 cmpEq EQ = True
1632 cmpEq _ = False
1633
1634 thenCmp :: Ordering -> Ordering -> Ordering
1635 thenCmp EQ o2 = o2
1636 thenCmp o1 _ = o1