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