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