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