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