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