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