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