Make dataToQa aware of Data instances which use functions to implement toConstr
[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 return x = Q (return x)
163 Q m >>= k = Q (m >>= \x -> unQ (k x))
164 Q m >> Q n = Q (m >> n)
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
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 mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
1036 mkNameG_v = mkNameG VarName
1037 mkNameG_tc = mkNameG TcClsName
1038 mkNameG_d = mkNameG DataName
1039
1040 data NameIs = Alone | Applied | Infix
1041
1042 showName :: Name -> String
1043 showName = showName' Alone
1044
1045 showName' :: NameIs -> Name -> String
1046 showName' ni nm
1047 = case ni of
1048 Alone -> nms
1049 Applied
1050 | pnam -> nms
1051 | otherwise -> "(" ++ nms ++ ")"
1052 Infix
1053 | pnam -> "`" ++ nms ++ "`"
1054 | otherwise -> nms
1055 where
1056 -- For now, we make the NameQ and NameG print the same, even though
1057 -- NameQ is a qualified name (so what it means depends on what the
1058 -- current scope is), and NameG is an original name (so its meaning
1059 -- should be independent of what's in scope.
1060 -- We may well want to distinguish them in the end.
1061 -- Ditto NameU and NameL
1062 nms = case nm of
1063 Name occ NameS -> occString occ
1064 Name occ (NameQ m) -> modString m ++ "." ++ occString occ
1065 Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
1066 Name occ (NameU u) -> occString occ ++ "_" ++ show u
1067 Name occ (NameL u) -> occString occ ++ "_" ++ show u
1068
1069 pnam = classify nms
1070
1071 -- True if we are function style, e.g. f, [], (,)
1072 -- False if we are operator style, e.g. +, :+
1073 classify "" = False -- shouldn't happen; . operator is handled below
1074 classify (x:xs) | isAlpha x || (x `elem` "_[]()") =
1075 case dropWhile (/='.') xs of
1076 (_:xs') -> classify xs'
1077 [] -> True
1078 | otherwise = False
1079
1080 instance Show Name where
1081 show = showName
1082
1083 -- Tuple data and type constructors
1084 -- | Tuple data constructor
1085 tupleDataName :: Int -> Name
1086 -- | Tuple type constructor
1087 tupleTypeName :: Int -> Name
1088
1089 tupleDataName 0 = mk_tup_name 0 DataName
1090 tupleDataName 1 = error "tupleDataName 1"
1091 tupleDataName n = mk_tup_name (n-1) DataName
1092
1093 tupleTypeName 0 = mk_tup_name 0 TcClsName
1094 tupleTypeName 1 = error "tupleTypeName 1"
1095 tupleTypeName n = mk_tup_name (n-1) TcClsName
1096
1097 mk_tup_name :: Int -> NameSpace -> Name
1098 mk_tup_name n_commas space
1099 = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
1100 where
1101 occ = mkOccName ('(' : replicate n_commas ',' ++ ")")
1102 tup_mod = mkModName "GHC.Tuple"
1103
1104 -- Unboxed tuple data and type constructors
1105 -- | Unboxed tuple data constructor
1106 unboxedTupleDataName :: Int -> Name
1107 -- | Unboxed tuple type constructor
1108 unboxedTupleTypeName :: Int -> Name
1109
1110 unboxedTupleDataName 0 = error "unboxedTupleDataName 0"
1111 unboxedTupleDataName 1 = error "unboxedTupleDataName 1"
1112 unboxedTupleDataName n = mk_unboxed_tup_name (n-1) DataName
1113
1114 unboxedTupleTypeName 0 = error "unboxedTupleTypeName 0"
1115 unboxedTupleTypeName 1 = error "unboxedTupleTypeName 1"
1116 unboxedTupleTypeName n = mk_unboxed_tup_name (n-1) TcClsName
1117
1118 mk_unboxed_tup_name :: Int -> NameSpace -> Name
1119 mk_unboxed_tup_name n_commas space
1120 = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
1121 where
1122 occ = mkOccName ("(#" ++ replicate n_commas ',' ++ "#)")
1123 tup_mod = mkModName "GHC.Tuple"
1124
1125
1126
1127 -----------------------------------------------------
1128 -- Locations
1129 -----------------------------------------------------
1130
1131 data Loc
1132 = Loc { loc_filename :: String
1133 , loc_package :: String
1134 , loc_module :: String
1135 , loc_start :: CharPos
1136 , loc_end :: CharPos }
1137 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1138
1139 type CharPos = (Int, Int) -- ^ Line and character position
1140
1141
1142 -----------------------------------------------------
1143 --
1144 -- The Info returned by reification
1145 --
1146 -----------------------------------------------------
1147
1148 -- | Obtained from 'reify' in the 'Q' Monad.
1149 data Info
1150 =
1151 -- | A class, with a list of its visible instances
1152 ClassI
1153 Dec
1154 [InstanceDec]
1155
1156 -- | A class method
1157 | ClassOpI
1158 Name
1159 Type
1160 ParentName
1161
1162 -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned using 'PrimTyConI' or 'FamilyI' as appropriate
1163 | TyConI
1164 Dec
1165
1166 -- | A type or data family, with a list of its visible instances. A closed
1167 -- type family is returned with 0 instances.
1168 | FamilyI
1169 Dec
1170 [InstanceDec]
1171
1172 -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'. Examples: @(->)@, @Int#@.
1173 | PrimTyConI
1174 Name
1175 Arity
1176 Unlifted
1177
1178 -- | A data constructor
1179 | DataConI
1180 Name
1181 Type
1182 ParentName
1183
1184 {- |
1185 A \"value\" variable (as opposed to a type variable, see 'TyVarI').
1186
1187 The @Maybe Dec@ field contains @Just@ the declaration which
1188 defined the variable -- including the RHS of the declaration --
1189 or else @Nothing@, in the case where the RHS is unavailable to
1190 the compiler. At present, this value is _always_ @Nothing@:
1191 returning the RHS has not yet been implemented because of
1192 lack of interest.
1193 -}
1194 | VarI
1195 Name
1196 Type
1197 (Maybe Dec)
1198
1199 {- |
1200 A type variable.
1201
1202 The @Type@ field contains the type which underlies the variable.
1203 At present, this is always @'VarT' theName@, but future changes
1204 may permit refinement of this.
1205 -}
1206 | TyVarI -- Scoped type variable
1207 Name
1208 Type -- What it is bound to
1209 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1210
1211 -- | Obtained from 'reifyModule' in the 'Q' Monad.
1212 data ModuleInfo =
1213 -- | Contains the import list of the module.
1214 ModuleInfo [Module]
1215 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1216
1217 {- |
1218 In 'ClassOpI' and 'DataConI', name of the parent class or type
1219 -}
1220 type ParentName = Name
1221
1222 -- | In 'PrimTyConI', arity of the type constructor
1223 type Arity = Int
1224
1225 -- | In 'PrimTyConI', is the type constructor unlifted?
1226 type Unlifted = Bool
1227
1228 -- | 'InstanceDec' desribes a single instance of a class or type function.
1229 -- It is just a 'Dec', but guaranteed to be one of the following:
1230 --
1231 -- * 'InstanceD' (with empty @['Dec']@)
1232 --
1233 -- * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)
1234 --
1235 -- * 'TySynInstD'
1236 type InstanceDec = Dec
1237
1238 data Fixity = Fixity Int FixityDirection
1239 deriving( Eq, Ord, Show, Data, Typeable, Generic )
1240 data FixityDirection = InfixL | InfixR | InfixN
1241 deriving( Eq, Ord, Show, Data, Typeable, Generic )
1242
1243 -- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)
1244 maxPrecedence :: Int
1245 maxPrecedence = (9::Int)
1246
1247 -- | Default fixity: @infixl 9@
1248 defaultFixity :: Fixity
1249 defaultFixity = Fixity maxPrecedence InfixL
1250
1251
1252 {-
1253 Note [Unresolved infix]
1254 ~~~~~~~~~~~~~~~~~~~~~~~
1255 -}
1256 {- $infix #infix#
1257 When implementing antiquotation for quasiquoters, one often wants
1258 to parse strings into expressions:
1259
1260 > parse :: String -> Maybe Exp
1261
1262 But how should we parse @a + b * c@? If we don't know the fixities of
1263 @+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a
1264 + b) * c@.
1265
1266 In cases like this, use 'UInfixE', 'UInfixP', or 'UInfixT', which stand for
1267 \"unresolved infix expression/pattern/type\", respectively. When the compiler
1268 is given a splice containing a tree of @UInfixE@ applications such as
1269
1270 > UInfixE
1271 > (UInfixE e1 op1 e2)
1272 > op2
1273 > (UInfixE e3 op3 e4)
1274
1275 it will look up and the fixities of the relevant operators and
1276 reassociate the tree as necessary.
1277
1278 * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT',
1279 which are of use for parsing expressions like
1280
1281 > (a + b * c) + d * e
1282
1283 * 'InfixE', 'InfixP', and 'InfixT' expressions are never reassociated.
1284
1285 * The 'UInfixE' constructor doesn't support sections. Sections
1286 such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer
1287 sections such as @(a + b * c -)@, use an 'InfixE' constructor for the
1288 outer-most section, and use 'UInfixE' constructors for all
1289 other operators:
1290
1291 > InfixE
1292 > Just (UInfixE ...a + b * c...)
1293 > op
1294 > Nothing
1295
1296 Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered
1297 into 'Exp's differently:
1298
1299 > (+ a + b) ---> InfixE Nothing + (Just $ UInfixE a + b)
1300 > -- will result in a fixity error if (+) is left-infix
1301 > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)
1302 > -- no fixity errors
1303
1304 * Quoted expressions such as
1305
1306 > [| a * b + c |] :: Q Exp
1307 > [p| a : b : c |] :: Q Pat
1308 > [t| T + T |] :: Q Type
1309
1310 will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'InfixT', 'ParensE',
1311 'ParensP', or 'ParensT' constructors.
1312
1313 -}
1314
1315 -----------------------------------------------------
1316 --
1317 -- The main syntax data types
1318 --
1319 -----------------------------------------------------
1320
1321 data Lit = CharL Char
1322 | StringL String
1323 | IntegerL Integer -- ^ Used for overloaded and non-overloaded
1324 -- literals. We don't have a good way to
1325 -- represent non-overloaded literals at
1326 -- the moment. Maybe that doesn't matter?
1327 | RationalL Rational -- Ditto
1328 | IntPrimL Integer
1329 | WordPrimL Integer
1330 | FloatPrimL Rational
1331 | DoublePrimL Rational
1332 | StringPrimL [Word8] -- ^ A primitive C-style string, type Addr#
1333 | CharPrimL Char
1334 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1335
1336 -- We could add Int, Float, Double etc, as we do in HsLit,
1337 -- but that could complicate the
1338 -- supposedly-simple TH.Syntax literal type
1339
1340 -- | Pattern in Haskell given in @{}@
1341 data Pat
1342 = LitP Lit -- ^ @{ 5 or 'c' }@
1343 | VarP Name -- ^ @{ x }@
1344 | TupP [Pat] -- ^ @{ (p1,p2) }@
1345 | UnboxedTupP [Pat] -- ^ @{ (# p1,p2 #) }@
1346 | ConP Name [Pat] -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@
1347 | InfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
1348 | UInfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
1349 --
1350 -- See "Language.Haskell.TH.Syntax#infix"
1351 | ParensP Pat -- ^ @{(p)}@
1352 --
1353 -- See "Language.Haskell.TH.Syntax#infix"
1354 | TildeP Pat -- ^ @{ ~p }@
1355 | BangP Pat -- ^ @{ !p }@
1356 | AsP Name Pat -- ^ @{ x \@ p }@
1357 | WildP -- ^ @{ _ }@
1358 | RecP Name [FieldPat] -- ^ @f (Pt { pointx = x }) = g x@
1359 | ListP [ Pat ] -- ^ @{ [1,2,3] }@
1360 | SigP Pat Type -- ^ @{ p :: t }@
1361 | ViewP Exp Pat -- ^ @{ e -> p }@
1362 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1363
1364 type FieldPat = (Name,Pat)
1365
1366 data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@
1367 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1368 data Clause = Clause [Pat] Body [Dec]
1369 -- ^ @f { p1 p2 = body where decs }@
1370 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1371
1372 data Exp
1373 = VarE Name -- ^ @{ x }@
1374 | ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @
1375 | LitE Lit -- ^ @{ 5 or 'c'}@
1376 | AppE Exp Exp -- ^ @{ f x }@
1377
1378 | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@
1379
1380 -- It's a bit gruesome to use an Exp as the
1381 -- operator, but how else can we distinguish
1382 -- constructors from non-constructors?
1383 -- Maybe there should be a var-or-con type?
1384 -- Or maybe we should leave it to the String itself?
1385
1386 | UInfixE Exp Exp Exp -- ^ @{x + y}@
1387 --
1388 -- See "Language.Haskell.TH.Syntax#infix"
1389 | ParensE Exp -- ^ @{ (e) }@
1390 --
1391 -- See "Language.Haskell.TH.Syntax#infix"
1392 | LamE [Pat] Exp -- ^ @{ \ p1 p2 -> e }@
1393 | LamCaseE [Match] -- ^ @{ \case m1; m2 }@
1394 | TupE [Exp] -- ^ @{ (e1,e2) } @
1395 | UnboxedTupE [Exp] -- ^ @{ (# e1,e2 #) } @
1396 | CondE Exp Exp Exp -- ^ @{ if e1 then e2 else e3 }@
1397 | MultiIfE [(Guard, Exp)] -- ^ @{ if | g1 -> e1 | g2 -> e2 }@
1398 | LetE [Dec] Exp -- ^ @{ let x=e1; y=e2 in e3 }@
1399 | CaseE Exp [Match] -- ^ @{ case e of m1; m2 }@
1400 | DoE [Stmt] -- ^ @{ do { p <- e1; e2 } }@
1401 | CompE [Stmt] -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@
1402 --
1403 -- The result expression of the comprehension is
1404 -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.
1405 --
1406 -- E.g. translation:
1407 --
1408 -- > [ f x | x <- xs ]
1409 --
1410 -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]
1411
1412 | ArithSeqE Range -- ^ @{ [ 1 ,2 .. 10 ] }@
1413 | ListE [ Exp ] -- ^ @{ [1,2,3] }@
1414 | SigE Exp Type -- ^ @{ e :: t }@
1415 | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@
1416 | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@
1417 | StaticE Exp -- ^ @{ static e }@
1418 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1419
1420 type FieldExp = (Name,Exp)
1421
1422 -- Omitted: implicit parameters
1423
1424 data Body
1425 = GuardedB [(Guard,Exp)] -- ^ @f p { | e1 = e2
1426 -- | e3 = e4 }
1427 -- where ds@
1428 | NormalB Exp -- ^ @f p { = e } where ds@
1429 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1430
1431 data Guard
1432 = NormalG Exp -- ^ @f x { | odd x } = x@
1433 | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@
1434 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1435
1436 data Stmt
1437 = BindS Pat Exp
1438 | LetS [ Dec ]
1439 | NoBindS Exp
1440 | ParS [[Stmt]]
1441 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1442
1443 data Range = FromR Exp | FromThenR Exp Exp
1444 | FromToR Exp Exp | FromThenToR Exp Exp Exp
1445 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1446
1447 data Dec
1448 = FunD Name [Clause] -- ^ @{ f p1 p2 = b where decs }@
1449 | ValD Pat Body [Dec] -- ^ @{ p = b where decs }@
1450 | DataD Cxt Name [TyVarBndr]
1451 [Con] [Name] -- ^ @{ data Cxt x => T x = A x | B (T x)
1452 -- deriving (Z,W)}@
1453 | NewtypeD Cxt Name [TyVarBndr]
1454 Con [Name] -- ^ @{ newtype Cxt x => T x = A (B x)
1455 -- deriving (Z,W)}@
1456 | TySynD Name [TyVarBndr] Type -- ^ @{ type T x = (x,x) }@
1457 | ClassD Cxt Name [TyVarBndr]
1458 [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@
1459 | InstanceD Cxt Type [Dec] -- ^ @{ instance Show w => Show [w]
1460 -- where ds }@
1461 | SigD Name Type -- ^ @{ length :: [a] -> Int }@
1462 | ForeignD Foreign -- ^ @{ foreign import ... }
1463 --{ foreign export ... }@
1464
1465 | InfixD Fixity Name -- ^ @{ infix 3 foo }@
1466
1467 -- | pragmas
1468 | PragmaD Pragma -- ^ @{ {\-# INLINE [1] foo #-\} }@
1469
1470 -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
1471 | DataFamilyD Name [TyVarBndr]
1472 (Maybe Kind)
1473 -- ^ @{ data family T a b c :: * }@
1474
1475 | DataInstD Cxt Name [Type]
1476 [Con] [Name] -- ^ @{ data instance Cxt x => T [x] = A x
1477 -- | B (T x)
1478 -- deriving (Z,W)}@
1479 | NewtypeInstD Cxt Name [Type]
1480 Con [Name] -- ^ @{ newtype instance Cxt x => T [x] = A (B x)
1481 -- deriving (Z,W)}@
1482 | TySynInstD Name TySynEqn -- ^ @{ type instance ... }@
1483
1484 -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
1485 | OpenTypeFamilyD Name
1486 [TyVarBndr] FamilyResultSig
1487 (Maybe InjectivityAnn)
1488 -- ^ @{ type family T a b c = (r :: *) | r -> a b }@
1489
1490 | ClosedTypeFamilyD Name
1491 [TyVarBndr] FamilyResultSig
1492 (Maybe InjectivityAnn)
1493 [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 -- | One equation of a type family instance or closed type family. The
1502 -- arguments are the left-hand-side type patterns and the right-hand-side
1503 -- result.
1504 data TySynEqn = TySynEqn [Type] Type
1505 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1506
1507 data FunDep = FunDep [Name] [Name]
1508 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1509
1510 data FamFlavour = TypeFam | DataFam
1511 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1512
1513 data Foreign = ImportF Callconv Safety String Name Type
1514 | ExportF Callconv String Name Type
1515 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1516
1517 -- keep Callconv in sync with module ForeignCall in ghc/compiler/prelude/ForeignCall.hs
1518 data Callconv = CCall | StdCall | CApi | Prim | JavaScript
1519 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1520
1521 data Safety = Unsafe | Safe | Interruptible
1522 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1523
1524 data Pragma = InlineP Name Inline RuleMatch Phases
1525 | SpecialiseP Name Type (Maybe Inline) Phases
1526 | SpecialiseInstP Type
1527 | RuleP String [RuleBndr] Exp Exp Phases
1528 | AnnP AnnTarget Exp
1529 | LineP Int String
1530 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1531
1532 data Inline = NoInline
1533 | Inline
1534 | Inlinable
1535 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1536
1537 data RuleMatch = ConLike
1538 | FunLike
1539 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1540
1541 data Phases = AllPhases
1542 | FromPhase Int
1543 | BeforePhase Int
1544 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1545
1546 data RuleBndr = RuleVar Name
1547 | TypedRuleVar Name Type
1548 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1549
1550 data AnnTarget = ModuleAnnotation
1551 | TypeAnnotation Name
1552 | ValueAnnotation Name
1553 deriving (Show, Eq, Ord, Data, Typeable, Generic)
1554
1555 type Cxt = [Pred] -- ^ @(Eq a, Ord b)@
1556
1557 -- | Since the advent of @ConstraintKinds@, constraints are really just types.
1558 -- Equality constraints use the 'EqualityT' constructor. Constraints may also
1559 -- be tuples of other constraints.
1560 type Pred = Type
1561
1562 data Strict = IsStrict | NotStrict | Unpacked
1563 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1564
1565 data Con = NormalC Name [StrictType] -- ^ @C Int a@
1566 | RecC Name [VarStrictType] -- ^ @C { v :: Int, w :: a }@
1567 | InfixC StrictType Name StrictType -- ^ @Int :+ a@
1568 | ForallC [TyVarBndr] Cxt Con -- ^ @forall a. Eq a => C [a]@
1569 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1570
1571 type StrictType = (Strict, Type)
1572 type VarStrictType = (Name, Strict, Type)
1573
1574 data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> -> \<type\>@
1575 | AppT Type Type -- ^ @T a b@
1576 | SigT Type Kind -- ^ @t :: k@
1577 | VarT Name -- ^ @a@
1578 | ConT Name -- ^ @T@
1579 | PromotedT Name -- ^ @'T@
1580 | InfixT Type Name Type -- ^ @T + T@
1581 | UInfixT Type Name Type -- ^ @T + T@
1582 --
1583 -- See "Language.Haskell.TH.Syntax#infix"
1584 | ParensT Type -- ^ @(T)@
1585
1586 -- See Note [Representing concrete syntax in types]
1587 | TupleT Int -- ^ @(,), (,,), etc.@
1588 | UnboxedTupleT Int -- ^ @(#,#), (#,,#), etc.@
1589 | ArrowT -- ^ @->@
1590 | EqualityT -- ^ @~@
1591 | ListT -- ^ @[]@
1592 | PromotedTupleT Int -- ^ @'(), '(,), '(,,), etc.@
1593 | PromotedNilT -- ^ @'[]@
1594 | PromotedConsT -- ^ @(':)@
1595 | StarT -- ^ @*@
1596 | ConstraintT -- ^ @Constraint@
1597 | LitT TyLit -- ^ @0,1,2, etc.@
1598 | WildCardT (Maybe Name) -- ^ @_, _a, etc.@
1599 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1600
1601 data TyVarBndr = PlainTV Name -- ^ @a@
1602 | KindedTV Name Kind -- ^ @(a :: k)@
1603 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1604
1605 -- | Type family result signature
1606 data FamilyResultSig = NoSig -- ^ no signature
1607 | KindSig Kind -- ^ @k@
1608 | TyVarSig TyVarBndr -- ^ @= r, = (r :: k)@
1609 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1610
1611 -- | Injectivity annotation
1612 data InjectivityAnn = InjectivityAnn Name [Name]
1613 deriving ( Show, Eq, Ord, Data, Typeable, Generic )
1614
1615 data TyLit = NumTyLit Integer -- ^ @2@
1616 | StrTyLit String -- ^ @"Hello"@
1617 deriving ( Show, Eq, Ord, Data, Typeable, Generic )
1618
1619 -- | Role annotations
1620 data Role = NominalR -- ^ @nominal@
1621 | RepresentationalR -- ^ @representational@
1622 | PhantomR -- ^ @phantom@
1623 | InferR -- ^ @_@
1624 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1625
1626 -- | Annotation target for reifyAnnotations
1627 data AnnLookup = AnnLookupModule Module
1628 | AnnLookupName Name
1629 deriving( Show, Eq, Ord, Data, Typeable, Generic )
1630
1631 -- | To avoid duplication between kinds and types, they
1632 -- are defined to be the same. Naturally, you would never
1633 -- have a type be 'StarT' and you would never have a kind
1634 -- be 'SigT', but many of the other constructors are shared.
1635 -- Note that the kind @Bool@ is denoted with 'ConT', not
1636 -- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',
1637 -- not 'PromotedTupleT'.
1638
1639 type Kind = Type
1640
1641 {- Note [Representing concrete syntax in types]
1642 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1643 Haskell has a rich concrete syntax for types, including
1644 t1 -> t2, (t1,t2), [t], and so on
1645 In TH we represent all of this using AppT, with a distinguished
1646 type constructor at the head. So,
1647 Type TH representation
1648 -----------------------------------------------
1649 t1 -> t2 ArrowT `AppT` t2 `AppT` t2
1650 [t] ListT `AppT` t
1651 (t1,t2) TupleT 2 `AppT` t1 `AppT` t2
1652 '(t1,t2) PromotedTupleT 2 `AppT` t1 `AppT` t2
1653
1654 But if the original HsSyn used prefix application, we won't use
1655 these special TH constructors. For example
1656 [] t ConT "[]" `AppT` t
1657 (->) t ConT "->" `AppT` t
1658 In this way we can faithfully represent in TH whether the original
1659 HsType used concrete syntax or not.
1660
1661 The one case that doesn't fit this pattern is that of promoted lists
1662 '[ Maybe, IO ] PromotedListT 2 `AppT` t1 `AppT` t2
1663 but it's very smelly because there really is no type constructor
1664 corresponding to PromotedListT. So we encode HsExplicitListTy with
1665 PromotedConsT and PromotedNilT (which *do* have underlying type
1666 constructors):
1667 '[ Maybe, IO ] PromotedConsT `AppT` Maybe `AppT`
1668 (PromotedConsT `AppT` IO `AppT` PromotedNilT)
1669 -}
1670
1671 -----------------------------------------------------
1672 -- Internal helper functions
1673 -----------------------------------------------------
1674
1675 cmpEq :: Ordering -> Bool
1676 cmpEq EQ = True
1677 cmpEq _ = False
1678
1679 thenCmp :: Ordering -> Ordering -> Ordering
1680 thenCmp EQ o2 = o2
1681 thenCmp o1 _ = o1