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