StringPrimL now takes [Word8]
[packages/template-haskell.git] / Language / Haskell / TH / Syntax.hs
1 {-# LANGUAGE UnboxedTuples #-}
2 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
3 -- The -fno-warn-warnings-deprecations flag is a temporary kludge.
4 -- While working on this module you are encouraged to remove it and fix
5 -- any warnings in the module. See
6 -- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
7 -- for details
8
9 -----------------------------------------------------------------------------
10 -- |
11 -- Module : Language.Haskell.Syntax
12 -- Copyright : (c) The University of Glasgow 2003
13 -- License : BSD-style (see the file libraries/base/LICENSE)
14 --
15 -- Maintainer : libraries@haskell.org
16 -- Stability : experimental
17 -- Portability : portable
18 --
19 -- Abstract syntax definitions for Template Haskell.
20 --
21 -----------------------------------------------------------------------------
22
23 module Language.Haskell.TH.Syntax(
24 Quasi(..), Lift(..), liftString,
25
26 Q, runQ,
27 report, recover, reify,
28 lookupTypeName, lookupValueName,
29 location, runIO, addDependentFile,
30 isInstance, reifyInstances,
31
32 -- * Names
33 Name(..), mkName, newName, nameBase, nameModule,
34 showName, showName', NameIs(..),
35
36 -- * The algebraic data types
37 -- $infix
38 Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind, Cxt,
39 TyLit(..),
40 Pred(..), Match(..), Clause(..), Body(..), Guard(..), Stmt(..),
41 Range(..), Lit(..), Pat(..), FieldExp, FieldPat,
42 Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),
43 Inline(..), InlineSpec(..), StrictType, VarStrictType, FunDep(..),
44 FamFlavour(..), Info(..), Loc(..), CharPos,
45 Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
46
47 -- * Internal functions
48 returnQ, bindQ, sequenceQ,
49 NameFlavour(..), NameSpace (..),
50 mkNameG_v, mkNameG_d, mkNameG_tc, Uniq, mkNameL, mkNameU,
51 tupleTypeName, tupleDataName,
52 unboxedTupleTypeName, unboxedTupleDataName,
53 OccName, mkOccName, occString,
54 ModName, mkModName, modString,
55 PkgName, mkPkgName, pkgString
56 ) where
57
58 import GHC.Base ( Int(..), Int#, (<#), (==#) )
59
60 import Language.Haskell.TH.Syntax.Internals
61 import Data.Data (Data(..), Typeable, mkConstr, mkDataType, constrIndex)
62 import qualified Data.Data as Data
63 import Control.Applicative( Applicative(..) )
64 import Data.IORef
65 import System.IO.Unsafe ( unsafePerformIO )
66 import Control.Monad (liftM)
67 import System.IO ( hPutStrLn, stderr )
68 import Data.Char ( isAlpha )
69 import Data.Word ( Word8 )
70
71 -----------------------------------------------------
72 --
73 -- The Quasi class
74 --
75 -----------------------------------------------------
76
77 class (Monad m, Applicative m) => Quasi m where
78 qNewName :: String -> m Name
79 -- ^ Fresh names
80
81 -- Error reporting and recovery
82 qReport :: Bool -> String -> m () -- ^ Report an error (True) or warning (False)
83 -- ...but carry on; use 'fail' to stop
84 qRecover :: m a -- ^ the error handler
85 -> m a -- ^ action which may fail
86 -> m a -- ^ Recover from the monadic 'fail'
87
88 -- Inspect the type-checker's environment
89 qLookupName :: Bool -> String -> m (Maybe Name)
90 -- True <=> type namespace, False <=> value namespace
91 qReify :: Name -> m Info
92 qReifyInstances :: Name -> [Type] -> m [Dec]
93 -- Is (n tys) an instance?
94 -- Returns list of matching instance Decs
95 -- (with empty sub-Decs)
96 -- Works for classes and type functions
97
98 qLocation :: m Loc
99
100 qRunIO :: IO a -> m a
101 -- ^ Input/output (dangerous)
102
103 qAddDependentFile :: FilePath -> m ()
104
105 -----------------------------------------------------
106 -- The IO instance of Quasi
107 --
108 -- This instance is used only when running a Q
109 -- computation in the IO monad, usually just to
110 -- print the result. There is no interesting
111 -- type environment, so reification isn't going to
112 -- work.
113 --
114 -----------------------------------------------------
115
116 instance Quasi IO where
117 qNewName s = do { n <- readIORef counter
118 ; writeIORef counter (n+1)
119 ; return (mkNameU s n) }
120
121 qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
122 qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
123
124 qLookupName _ _ = badIO "lookupName"
125 qReify _ = badIO "reify"
126 qReifyInstances _ _ = badIO "classInstances"
127 qLocation = badIO "currentLocation"
128 qRecover _ _ = badIO "recover" -- Maybe we could fix this?
129 qAddDependentFile _ = badIO "addDependentFile"
130
131 qRunIO m = m
132
133 badIO :: String -> IO a
134 badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
135 ; fail "Template Haskell failure" }
136
137 -- Global variable to generate unique symbols
138 counter :: IORef Int
139 {-# NOINLINE counter #-}
140 counter = unsafePerformIO (newIORef 0)
141
142
143 -----------------------------------------------------
144 --
145 -- The Q monad
146 --
147 -----------------------------------------------------
148
149 newtype Q a = Q { unQ :: forall m. Quasi m => m a }
150
151 runQ :: Quasi m => Q a -> m a
152 runQ (Q m) = m
153
154 instance Monad Q where
155 return x = Q (return x)
156 Q m >>= k = Q (m >>= \x -> unQ (k x))
157 Q m >> Q n = Q (m >> n)
158 fail s = report True s >> Q (fail "Q monad failure")
159
160 instance Functor Q where
161 fmap f (Q x) = Q (fmap f x)
162
163 instance Applicative Q where
164 pure x = Q (pure x)
165 Q f <*> Q x = Q (f <*> x)
166
167 ----------------------------------------------------
168 -- Packaged versions for the programmer, hiding the Quasi-ness
169 newName :: String -> Q Name
170 newName s = Q (qNewName s)
171
172 report :: Bool -> String -> Q ()
173 report b s = Q (qReport b s)
174
175 recover :: Q a -- ^ recover with this one
176 -> Q a -- ^ failing action
177 -> Q a
178 recover (Q r) (Q m) = Q (qRecover r m)
179
180 -- We don't export lookupName; the Bool isn't a great API
181 -- Instead we export lookupTypeName, lookupValueName
182 lookupName :: Bool -> String -> Q (Maybe Name)
183 lookupName ns s = Q (qLookupName ns s)
184
185 lookupTypeName, lookupValueName :: String -> Q (Maybe Name)
186 lookupTypeName s = Q (qLookupName True s)
187 lookupValueName s = Q (qLookupName False s)
188
189 -- | 'reify' looks up information about the 'Name'
190 reify :: Name -> Q Info
191 reify v = Q (qReify v)
192
193 -- | 'classInstances' looks up instaces of a class
194 reifyInstances :: Name -> [Type] -> Q [Dec]
195 reifyInstances cls tys = Q (qReifyInstances cls tys)
196
197 isInstance :: Name -> [Type] -> Q Bool
198 isInstance nm tys = do { decs <- reifyInstances nm tys
199 ; return (not (null decs)) }
200
201 -- | 'location' gives you the 'Location' at which this
202 -- computation is spliced.
203 location :: Q Loc
204 location = Q qLocation
205
206 -- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
207 -- Take care: you are guaranteed the ordering of calls to 'runIO' within
208 -- a single 'Q' computation, but not about the order in which splices are run.
209 --
210 -- Note: for various murky reasons, stdout and stderr handles are not
211 -- necesarily flushed when the compiler finishes running, so you should
212 -- flush them yourself.
213 runIO :: IO a -> Q a
214 runIO m = Q (qRunIO m)
215
216 -- | Record external files that runIO is using (dependent upon).
217 -- The compiler can then recognize that it should re-compile the file using this TH when the external file changes.
218 -- Note that ghc -M will still not know about these dependencies - it does not execute TH.
219 -- Expects an absolute file path.
220 addDependentFile :: FilePath -> Q ()
221 addDependentFile fp = Q (qAddDependentFile fp)
222
223 instance Quasi Q where
224 qNewName = newName
225 qReport = report
226 qRecover = recover
227 qReify = reify
228 qReifyInstances = reifyInstances
229 qLookupName = lookupName
230 qLocation = location
231 qRunIO = runIO
232 qAddDependentFile = addDependentFile
233
234
235 ----------------------------------------------------
236 -- The following operations are used solely in DsMeta when desugaring brackets
237 -- They are not necessary for the user, who can use ordinary return and (>>=) etc
238
239 returnQ :: a -> Q a
240 returnQ = return
241
242 bindQ :: Q a -> (a -> Q b) -> Q b
243 bindQ = (>>=)
244
245 sequenceQ :: [Q a] -> Q [a]
246 sequenceQ = sequence
247
248
249 -----------------------------------------------------
250 --
251 -- The Lift class
252 --
253 -----------------------------------------------------
254
255 class Lift t where
256 lift :: t -> Q Exp
257
258 instance Lift Integer where
259 lift x = return (LitE (IntegerL x))
260
261 instance Lift Int where
262 lift x= return (LitE (IntegerL (fromIntegral x)))
263
264 instance Lift Char where
265 lift x = return (LitE (CharL x))
266
267 instance Lift Bool where
268 lift True = return (ConE trueName)
269 lift False = return (ConE falseName)
270
271 instance Lift a => Lift (Maybe a) where
272 lift Nothing = return (ConE nothingName)
273 lift (Just x) = liftM (ConE justName `AppE`) (lift x)
274
275 instance (Lift a, Lift b) => Lift (Either a b) where
276 lift (Left x) = liftM (ConE leftName `AppE`) (lift x)
277 lift (Right y) = liftM (ConE rightName `AppE`) (lift y)
278
279 instance Lift a => Lift [a] where
280 lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
281
282 liftString :: String -> Q Exp
283 -- Used in TcExpr to short-circuit the lifting for strings
284 liftString s = return (LitE (StringL s))
285
286 instance (Lift a, Lift b) => Lift (a, b) where
287 lift (a, b)
288 = liftM TupE $ sequence [lift a, lift b]
289
290 instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
291 lift (a, b, c)
292 = liftM TupE $ sequence [lift a, lift b, lift c]
293
294 instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
295 lift (a, b, c, d)
296 = liftM TupE $ sequence [lift a, lift b, lift c, lift d]
297
298 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
299 => Lift (a, b, c, d, e) where
300 lift (a, b, c, d, e)
301 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e]
302
303 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
304 => Lift (a, b, c, d, e, f) where
305 lift (a, b, c, d, e, f)
306 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f]
307
308 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
309 => Lift (a, b, c, d, e, f, g) where
310 lift (a, b, c, d, e, f, g)
311 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g]
312
313 -- TH has a special form for literal strings,
314 -- which we should take advantage of.
315 -- NB: the lhs of the rule has no args, so that
316 -- the rule will apply to a 'lift' all on its own
317 -- which happens to be the way the type checker
318 -- creates it.
319 {-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}
320
321
322 trueName, falseName :: Name
323 trueName = mkNameG DataName "ghc-prim" "GHC.Types" "True"
324 falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False"
325
326 nothingName, justName :: Name
327 nothingName = mkNameG DataName "base" "Data.Maybe" "Nothing"
328 justName = mkNameG DataName "base" "Data.Maybe" "Just"
329
330 leftName, rightName :: Name
331 leftName = mkNameG DataName "base" "Data.Either" "Left"
332 rightName = mkNameG DataName "base" "Data.Either" "Right"
333
334
335 -----------------------------------------------------
336 -- Names and uniques
337 -----------------------------------------------------
338
339 mkModName :: String -> ModName
340 mkModName s = ModName s
341
342 modString :: ModName -> String
343 modString (ModName m) = m
344
345
346 mkPkgName :: String -> PkgName
347 mkPkgName s = PkgName s
348
349 pkgString :: PkgName -> String
350 pkgString (PkgName m) = m
351
352
353 -----------------------------------------------------
354 -- OccName
355 -----------------------------------------------------
356
357 mkOccName :: String -> OccName
358 mkOccName s = OccName s
359
360 occString :: OccName -> String
361 occString (OccName occ) = occ
362
363
364 -----------------------------------------------------
365 -- Names
366 -----------------------------------------------------
367
368 -- |
369 -- For "global" names ('NameG') we need a totally unique name,
370 -- so we must include the name-space of the thing
371 --
372 -- For unique-numbered things ('NameU'), we've got a unique reference
373 -- anyway, so no need for name space
374 --
375 -- For dynamically bound thing ('NameS') we probably want them to
376 -- in a context-dependent way, so again we don't want the name
377 -- space. For example:
378 --
379 -- > let v = mkName "T" in [| data $v = $v |]
380 --
381 -- Here we use the same Name for both type constructor and data constructor
382 --
383 --
384 -- NameL and NameG are bound *outside* the TH syntax tree
385 -- either globally (NameG) or locally (NameL). Ex:
386 --
387 -- > f x = $(h [| (map, x) |])
388 --
389 -- The 'map' will be a NameG, and 'x' wil be a NameL
390 --
391 -- These Names should never appear in a binding position in a TH syntax tree
392 data Name = Name OccName NameFlavour deriving (Typeable, Data)
393
394 data NameFlavour
395 = NameS -- ^ An unqualified name; dynamically bound
396 | NameQ ModName -- ^ A qualified name; dynamically bound
397 | NameU Int# -- ^ A unique local name
398 | NameL Int# -- ^ Local name bound outside of the TH AST
399 | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:
400 -- An original name (occurrences only, not binders)
401 -- Need the namespace too to be sure which
402 -- thing we are naming
403 deriving ( Typeable )
404
405 -- |
406 -- Although the NameFlavour type is abstract, the Data instance is not. The reason for this
407 -- is that currently we use Data to serialize values in annotations, and in order for that to
408 -- work for Template Haskell names introduced via the 'x syntax we need gunfold on NameFlavour
409 -- to work. Bleh!
410 --
411 -- The long term solution to this is to use the binary package for annotation serialization and
412 -- then remove this instance. However, to do _that_ we need to wait on binary to become stable, since
413 -- boot libraries cannot be upgraded seperately from GHC itself.
414 --
415 -- This instance cannot be derived automatically due to bug #2701
416 instance Data NameFlavour where
417 gfoldl _ z NameS = z NameS
418 gfoldl k z (NameQ mn) = z NameQ `k` mn
419 gfoldl k z (NameU i) = z (\(I# i') -> NameU i') `k` (I# i)
420 gfoldl k z (NameL i) = z (\(I# i') -> NameL i') `k` (I# i)
421 gfoldl k z (NameG ns p m) = z NameG `k` ns `k` p `k` m
422 gunfold k z c = case constrIndex c of
423 1 -> z NameS
424 2 -> k $ z NameQ
425 3 -> k $ z (\(I# i) -> NameU i)
426 4 -> k $ z (\(I# i) -> NameL i)
427 5 -> k $ k $ k $ z NameG
428 _ -> error "gunfold: NameFlavour"
429 toConstr NameS = con_NameS
430 toConstr (NameQ _) = con_NameQ
431 toConstr (NameU _) = con_NameU
432 toConstr (NameL _) = con_NameL
433 toConstr (NameG _ _ _) = con_NameG
434 dataTypeOf _ = ty_NameFlavour
435
436 con_NameS, con_NameQ, con_NameU, con_NameL, con_NameG :: Data.Constr
437 con_NameS = mkConstr ty_NameFlavour "NameS" [] Data.Prefix
438 con_NameQ = mkConstr ty_NameFlavour "NameQ" [] Data.Prefix
439 con_NameU = mkConstr ty_NameFlavour "NameU" [] Data.Prefix
440 con_NameL = mkConstr ty_NameFlavour "NameL" [] Data.Prefix
441 con_NameG = mkConstr ty_NameFlavour "NameG" [] Data.Prefix
442
443 ty_NameFlavour :: Data.DataType
444 ty_NameFlavour = mkDataType "Language.Haskell.TH.Syntax.NameFlavour"
445 [con_NameS, con_NameQ, con_NameU,
446 con_NameL, con_NameG]
447
448 data NameSpace = VarName -- ^ Variables
449 | DataName -- ^ Data constructors
450 | TcClsName -- ^ Type constructors and classes; Haskell has them
451 -- in the same name space for now.
452 deriving( Eq, Ord, Data, Typeable )
453
454 type Uniq = Int
455
456 -- | Base, unqualified name.
457 nameBase :: Name -> String
458 nameBase (Name occ _) = occString occ
459
460 nameModule :: Name -> Maybe String
461 nameModule (Name _ (NameQ m)) = Just (modString m)
462 nameModule (Name _ (NameG _ _ m)) = Just (modString m)
463 nameModule _ = Nothing
464
465 mkName :: String -> Name
466 -- ^ The string can have a '.', thus "Foo.baz",
467 -- giving a dynamically-bound qualified name,
468 -- in which case we want to generate a NameQ
469 --
470 -- Parse the string to see if it has a "." in it
471 -- so we know whether to generate a qualified or unqualified name
472 -- It's a bit tricky because we need to parse
473 --
474 -- > Foo.Baz.x as Qual Foo.Baz x
475 --
476 -- So we parse it from back to front
477 mkName str
478 = split [] (reverse str)
479 where
480 split occ [] = Name (mkOccName occ) NameS
481 split occ ('.':rev) | not (null occ),
482 not (null rev), head rev /= '.'
483 = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
484 -- The 'not (null occ)' guard ensures that
485 -- mkName "&." = Name "&." NameS
486 -- The 'rev' guards ensure that
487 -- mkName ".&" = Name ".&" NameS
488 -- mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
489 -- This rather bizarre case actually happened; (.&.) is in Data.Bits
490 split occ (c:rev) = split (c:occ) rev
491
492 -- | Only used internally
493 mkNameU :: String -> Uniq -> Name
494 mkNameU s (I# u) = Name (mkOccName s) (NameU u)
495
496 -- | Only used internally
497 mkNameL :: String -> Uniq -> Name
498 mkNameL s (I# u) = Name (mkOccName s) (NameL u)
499
500 -- | Used for 'x etc, but not available to the programmer
501 mkNameG :: NameSpace -> String -> String -> String -> Name
502 mkNameG ns pkg modu occ
503 = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))
504
505 mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
506 mkNameG_v = mkNameG VarName
507 mkNameG_tc = mkNameG TcClsName
508 mkNameG_d = mkNameG DataName
509
510 instance Eq Name where
511 v1 == v2 = cmpEq (v1 `compare` v2)
512
513 instance Ord Name where
514 (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2) `thenCmp`
515 (o1 `compare` o2)
516
517 instance Eq NameFlavour where
518 f1 == f2 = cmpEq (f1 `compare` f2)
519
520 instance Ord NameFlavour where
521 -- NameS < NameQ < NameU < NameL < NameG
522 NameS `compare` NameS = EQ
523 NameS `compare` _ = LT
524
525 (NameQ _) `compare` NameS = GT
526 (NameQ m1) `compare` (NameQ m2) = m1 `compare` m2
527 (NameQ _) `compare` _ = LT
528
529 (NameU _) `compare` NameS = GT
530 (NameU _) `compare` (NameQ _) = GT
531 (NameU u1) `compare` (NameU u2) | u1 <# u2 = LT
532 | u1 ==# u2 = EQ
533 | otherwise = GT
534 (NameU _) `compare` _ = LT
535
536 (NameL _) `compare` NameS = GT
537 (NameL _) `compare` (NameQ _) = GT
538 (NameL _) `compare` (NameU _) = GT
539 (NameL u1) `compare` (NameL u2) | u1 <# u2 = LT
540 | u1 ==# u2 = EQ
541 | otherwise = GT
542 (NameL _) `compare` _ = LT
543
544 (NameG ns1 p1 m1) `compare` (NameG ns2 p2 m2) = (ns1 `compare` ns2) `thenCmp`
545 (p1 `compare` p2) `thenCmp`
546 (m1 `compare` m2)
547 (NameG _ _ _) `compare` _ = GT
548
549 data NameIs = Alone | Applied | Infix
550
551 showName :: Name -> String
552 showName = showName' Alone
553
554 showName' :: NameIs -> Name -> String
555 showName' ni nm
556 = case ni of
557 Alone -> nms
558 Applied
559 | pnam -> nms
560 | otherwise -> "(" ++ nms ++ ")"
561 Infix
562 | pnam -> "`" ++ nms ++ "`"
563 | otherwise -> nms
564 where
565 -- For now, we make the NameQ and NameG print the same, even though
566 -- NameQ is a qualified name (so what it means depends on what the
567 -- current scope is), and NameG is an original name (so its meaning
568 -- should be independent of what's in scope.
569 -- We may well want to distinguish them in the end.
570 -- Ditto NameU and NameL
571 nms = case nm of
572 Name occ NameS -> occString occ
573 Name occ (NameQ m) -> modString m ++ "." ++ occString occ
574 Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
575 Name occ (NameU u) -> occString occ ++ "_" ++ show (I# u)
576 Name occ (NameL u) -> occString occ ++ "_" ++ show (I# u)
577
578 pnam = classify nms
579
580 -- True if we are function style, e.g. f, [], (,)
581 -- False if we are operator style, e.g. +, :+
582 classify "" = False -- shouldn't happen; . operator is handled below
583 classify (x:xs) | isAlpha x || (x `elem` "_[]()") =
584 case dropWhile (/='.') xs of
585 (_:xs') -> classify xs'
586 [] -> True
587 | otherwise = False
588
589 instance Show Name where
590 show = showName
591
592 -- Tuple data and type constructors
593 tupleDataName :: Int -> Name -- ^ Data constructor
594 tupleTypeName :: Int -> Name -- ^ Type constructor
595
596 tupleDataName 0 = mk_tup_name 0 DataName
597 tupleDataName 1 = error "tupleDataName 1"
598 tupleDataName n = mk_tup_name (n-1) DataName
599
600 tupleTypeName 0 = mk_tup_name 0 TcClsName
601 tupleTypeName 1 = error "tupleTypeName 1"
602 tupleTypeName n = mk_tup_name (n-1) TcClsName
603
604 mk_tup_name :: Int -> NameSpace -> Name
605 mk_tup_name n_commas space
606 = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
607 where
608 occ = mkOccName ('(' : replicate n_commas ',' ++ ")")
609 tup_mod = mkModName "GHC.Tuple"
610
611 -- Unboxed tuple data and type constructors
612 unboxedTupleDataName :: Int -> Name -- ^ Data constructor
613 unboxedTupleTypeName :: Int -> Name -- ^ Type constructor
614
615 unboxedTupleDataName 0 = error "unboxedTupleDataName 0"
616 unboxedTupleDataName 1 = error "unboxedTupleDataName 1"
617 unboxedTupleDataName n = mk_unboxed_tup_name (n-1) DataName
618
619 unboxedTupleTypeName 0 = error "unboxedTupleTypeName 0"
620 unboxedTupleTypeName 1 = error "unboxedTupleTypeName 1"
621 unboxedTupleTypeName n = mk_unboxed_tup_name (n-1) TcClsName
622
623 mk_unboxed_tup_name :: Int -> NameSpace -> Name
624 mk_unboxed_tup_name n_commas space
625 = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
626 where
627 occ = mkOccName ("(#" ++ replicate n_commas ',' ++ "#)")
628 tup_mod = mkModName "GHC.Tuple"
629
630
631
632 -----------------------------------------------------
633 -- Locations
634 -----------------------------------------------------
635
636 data Loc
637 = Loc { loc_filename :: String
638 , loc_package :: String
639 , loc_module :: String
640 , loc_start :: CharPos
641 , loc_end :: CharPos }
642
643 type CharPos = (Int, Int) -- Line and character position
644
645
646 -----------------------------------------------------
647 --
648 -- The Info returned by reification
649 --
650 -----------------------------------------------------
651
652 -- | Obtained from 'reify' in the 'Q' Monad.
653 data Info
654 = -- | A class is reified to its declaration
655 -- and a list of its instances
656 ClassI
657 Dec -- Declaration of the class
658 [InstanceDec] -- The instances of that class
659
660 | ClassOpI
661 Name -- The class op itself
662 Type -- Type of the class-op (fully polymoprhic)
663 Name -- Name of the parent class
664 Fixity
665
666 | TyConI
667 Dec
668
669 | FamilyI -- Type/data families
670 Dec
671 [InstanceDec]
672
673 | PrimTyConI -- Ones that can't be expressed with a data type
674 -- decl, such as (->), Int#
675 Name
676 Int -- Arity
677 Bool -- False => lifted type; True => unlifted
678
679 | DataConI
680 Name -- The data con itself
681 Type -- Type of the constructor (fully polymorphic)
682 Name -- Name of the parent TyCon
683 Fixity
684
685 | VarI
686 Name -- The variable itself
687 Type
688 (Maybe Dec) -- Nothing for lambda-bound variables, and
689 -- for anything else TH can't figure out
690 -- E.g. [| let x = 1 in $(do { d <- reify 'x; .. }) |]
691 Fixity
692
693 | TyVarI -- Scoped type variable
694 Name
695 Type -- What it is bound to
696 deriving( Show, Data, Typeable )
697
698 -- | 'InstanceDec' desribes a single instance of a class or type function
699 -- It is just a 'Dec', but guaranteed to be one of the following:
700 -- InstanceD (with empty [Dec])
701 -- DataInstD or NewtypeInstD (with empty derived [Name])
702 -- TySynInstD
703 type InstanceDec = Dec
704
705 data Fixity = Fixity Int FixityDirection
706 deriving( Eq, Show, Data, Typeable )
707 data FixityDirection = InfixL | InfixR | InfixN
708 deriving( Eq, Show, Data, Typeable )
709
710 maxPrecedence :: Int
711 maxPrecedence = (9::Int)
712
713 defaultFixity :: Fixity
714 defaultFixity = Fixity maxPrecedence InfixL
715
716
717 -----------------------------------------------------
718 --
719 -- The main syntax data types
720 --
721 -----------------------------------------------------
722
723 {- $infix #infix#
724 Note [Unresolved infix]
725 ~~~~~~~~~~~~~~~~~~~~~~~
726
727 When implementing antiquotation for quasiquoters, one often wants
728 to parse strings into expressions:
729
730 > parse :: String -> Maybe 'Exp'
731
732 But how should we parse @a + b * c@? If we don't know the fixities of
733 @+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a
734 + b) * c@.
735
736 In cases like this, use 'UInfixE' or 'UInfixP', which stand for
737 \"unresolved infix expression\" and \"unresolved infix pattern\". When
738 the compiler is given a splice containing a tree of @UInfixE@
739 applications such as
740
741 > UInfixE
742 > (UInfixE e1 op1 e2)
743 > op2
744 > (UInfixE e3 op3 e4)
745
746 it will look up and the fixities of the relevant operators and
747 reassociate the tree as necessary.
748
749 * trees will not be reassociated across 'ParensE' or 'ParensP',
750 which are of use for parsing expressions like
751
752 > (a + b * c) + d * e
753
754 * 'InfixE' and 'InfixP' expressions are never reassociated.
755
756 * The 'UInfixE' constructor doesn't support sections. Sections
757 such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer
758 sections such as @(a + b * c -)@, use an 'InfixE' constructor for the
759 outer-most section, and use 'UInfixE' constructors for all
760 other operators:
761
762 > InfixE
763 > Just (UInfixE ...a + b * c...)
764 > op
765 > Nothing
766
767 Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered
768 into 'Exp's differently:
769
770 > (+ a + b) ---> InfixE Nothing + (Just $ UInfixE a + b)
771 > -- will result in a fixity error if (+) is left-infix
772 > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)
773 > -- no fixity errors
774
775 * Quoted expressions such as
776
777 > [| a * b + c |] :: Q Exp
778 > [p| a : b : c |] :: Q Pat
779
780 will never contain 'UInfixE', 'UInfixP', 'ParensE', or 'ParensP'
781 constructors.
782
783 -}
784
785 data Lit = CharL Char
786 | StringL String
787 | IntegerL Integer -- ^ Used for overloaded and non-overloaded
788 -- literals. We don't have a good way to
789 -- represent non-overloaded literals at
790 -- the moment. Maybe that doesn't matter?
791 | RationalL Rational -- Ditto
792 | IntPrimL Integer
793 | WordPrimL Integer
794 | FloatPrimL Rational
795 | DoublePrimL Rational
796 | StringPrimL [Word8] -- ^ A primitive C-style string, type Addr#
797 deriving( Show, Eq, Data, Typeable )
798
799 -- We could add Int, Float, Double etc, as we do in HsLit,
800 -- but that could complicate the
801 -- suppposedly-simple TH.Syntax literal type
802
803 -- | Pattern in Haskell given in @{}@
804 data Pat
805 = LitP Lit -- ^ @{ 5 or 'c' }@
806 | VarP Name -- ^ @{ x }@
807 | TupP [Pat] -- ^ @{ (p1,p2) }@
808 | UnboxedTupP [Pat] -- ^ @{ (# p1,p2 #) }@
809 | ConP Name [Pat] -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@
810 | InfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
811 | UInfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
812 --
813 -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"
814 | ParensP Pat -- ^ @{(p)}@
815 --
816 -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"
817 | TildeP Pat -- ^ @{ ~p }@
818 | BangP Pat -- ^ @{ !p }@
819 | AsP Name Pat -- ^ @{ x \@ p }@
820 | WildP -- ^ @{ _ }@
821 | RecP Name [FieldPat] -- ^ @f (Pt { pointx = x }) = g x@
822 | ListP [ Pat ] -- ^ @{ [1,2,3] }@
823 | SigP Pat Type -- ^ @{ p :: t }@
824 | ViewP Exp Pat -- ^ @{ e -> p }@
825 deriving( Show, Eq, Data, Typeable )
826
827 type FieldPat = (Name,Pat)
828
829 data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@
830 deriving( Show, Eq, Data, Typeable )
831 data Clause = Clause [Pat] Body [Dec]
832 -- ^ @f { p1 p2 = body where decs }@
833 deriving( Show, Eq, Data, Typeable )
834
835 -- | The 'CompE' constructor represents a list comprehension, and
836 -- takes a ['Stmt']. The result expression of the comprehension is
837 -- the *last* of these, and should be a 'NoBindS'.
838 --
839 -- E.g. translation:
840 --
841 -- > [ f x | x <- xs ]
842 --
843 -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]
844 data Exp
845 = VarE Name -- ^ @{ x }@
846 | ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @
847 | LitE Lit -- ^ @{ 5 or 'c'}@
848 | AppE Exp Exp -- ^ @{ f x }@
849
850 | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@
851 --
852 -- It's a bit gruesome to use an Exp as the
853 -- operator, but how else can we distinguish
854 -- constructors from non-constructors?
855 -- Maybe there should be a var-or-con type?
856 -- Or maybe we should leave it to the String itself?
857
858 | UInfixE Exp Exp Exp -- ^ @{x + y}@
859 --
860 -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"
861 | ParensE Exp -- ^ @{ (e) }@
862 --
863 -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"
864 | LamE [Pat] Exp -- ^ @{ \ p1 p2 -> e }@
865 | TupE [Exp] -- ^ @{ (e1,e2) } @
866 | UnboxedTupE [Exp] -- ^ @{ (# e1,e2 #) } @
867 | CondE Exp Exp Exp -- ^ @{ if e1 then e2 else e3 }@
868 | LetE [Dec] Exp -- ^ @{ let x=e1; y=e2 in e3 }@
869 | CaseE Exp [Match] -- ^ @{ case e of m1; m2 }@
870 | DoE [Stmt] -- ^ @{ do { p <- e1; e2 } }@
871 | CompE [Stmt] -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@
872 | ArithSeqE Range -- ^ @{ [ 1 ,2 .. 10 ] }@
873 | ListE [ Exp ] -- ^ @{ [1,2,3] }@
874 | SigE Exp Type -- ^ @{ e :: t }@
875 | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@
876 | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@
877 deriving( Show, Eq, Data, Typeable )
878
879 type FieldExp = (Name,Exp)
880
881 -- Omitted: implicit parameters
882
883 data Body
884 = GuardedB [(Guard,Exp)] -- ^ @f p { | e1 = e2 | e3 = e4 } where ds@
885 | NormalB Exp -- ^ @f p { = e } where ds@
886 deriving( Show, Eq, Data, Typeable )
887
888 data Guard
889 = NormalG Exp
890 | PatG [Stmt]
891 deriving( Show, Eq, Data, Typeable )
892
893 data Stmt
894 = BindS Pat Exp
895 | LetS [ Dec ]
896 | NoBindS Exp
897 | ParS [[Stmt]]
898 deriving( Show, Eq, Data, Typeable )
899
900 data Range = FromR Exp | FromThenR Exp Exp
901 | FromToR Exp Exp | FromThenToR Exp Exp Exp
902 deriving( Show, Eq, Data, Typeable )
903
904 data Dec
905 = FunD Name [Clause] -- ^ @{ f p1 p2 = b where decs }@
906 | ValD Pat Body [Dec] -- ^ @{ p = b where decs }@
907 | DataD Cxt Name [TyVarBndr]
908 [Con] [Name] -- ^ @{ data Cxt x => T x = A x | B (T x)
909 -- deriving (Z,W)}@
910 | NewtypeD Cxt Name [TyVarBndr]
911 Con [Name] -- ^ @{ newtype Cxt x => T x = A (B x)
912 -- deriving (Z,W)}@
913 | TySynD Name [TyVarBndr] Type -- ^ @{ type T x = (x,x) }@
914 | ClassD Cxt Name [TyVarBndr]
915 [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@
916 | InstanceD Cxt Type [Dec] -- ^ @{ instance Show w => Show [w]
917 -- where ds }@
918 | SigD Name Type -- ^ @{ length :: [a] -> Int }@
919 | ForeignD Foreign
920
921 | InfixD Fixity Name -- ^ @{ infix 3 foo }@
922
923 -- | pragmas
924 | PragmaD Pragma -- ^ @{ {-# INLINE [1] foo #-} }@
925
926 -- | type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
927 | FamilyD FamFlavour Name
928 [TyVarBndr] (Maybe Kind) -- ^ @{ type family T a b c :: * }@
929
930 | DataInstD Cxt Name [Type]
931 [Con] [Name] -- ^ @{ data instance Cxt x => T [x] = A x
932 -- | B (T x)
933 -- deriving (Z,W)}@
934 | NewtypeInstD Cxt Name [Type]
935 Con [Name] -- ^ @{ newtype instance Cxt x => T [x] = A (B x)
936 -- deriving (Z,W)}@
937 | TySynInstD Name [Type] Type -- ^ @{ type instance T (Maybe x) = (x,x) }@
938 deriving( Show, Eq, Data, Typeable )
939
940 data FunDep = FunDep [Name] [Name]
941 deriving( Show, Eq, Data, Typeable )
942
943 data FamFlavour = TypeFam | DataFam
944 deriving( Show, Eq, Data, Typeable )
945
946 data Foreign = ImportF Callconv Safety String Name Type
947 | ExportF Callconv String Name Type
948 deriving( Show, Eq, Data, Typeable )
949
950 data Callconv = CCall | StdCall
951 deriving( Show, Eq, Data, Typeable )
952
953 data Safety = Unsafe | Safe | Interruptible
954 deriving( Show, Eq, Data, Typeable )
955
956 data Pragma = InlineP Name InlineSpec
957 | SpecialiseP Name Type (Maybe InlineSpec)
958 deriving( Show, Eq, Data, Typeable )
959
960 data Inline = NoInline
961 | Inline
962 | Inlinable
963 deriving (Show, Eq, Data, Typeable)
964
965 data InlineSpec
966 = InlineSpec Inline
967 Bool -- False: fun-like; True: constructor-like
968 (Maybe (Bool, Int)) -- False: before phase; True: from phase
969 deriving( Show, Eq, Data, Typeable )
970
971 type Cxt = [Pred] -- ^ @(Eq a, Ord b)@
972
973 data Pred = ClassP Name [Type] -- ^ @Eq (Int, a)@
974 | EqualP Type Type -- ^ @F a ~ Bool@
975 deriving( Show, Eq, Data, Typeable )
976
977 data Strict = IsStrict | NotStrict | Unpacked
978 deriving( Show, Eq, Data, Typeable )
979
980 data Con = NormalC Name [StrictType] -- ^ @C Int a@
981 | RecC Name [VarStrictType] -- ^ @C { v :: Int, w :: a }@
982 | InfixC StrictType Name StrictType -- ^ @Int :+ a@
983 | ForallC [TyVarBndr] Cxt Con -- ^ @forall a. Eq a => C [a]@
984 deriving( Show, Eq, Data, Typeable )
985
986 type StrictType = (Strict, Type)
987 type VarStrictType = (Name, Strict, Type)
988
989 data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall <vars>. <ctxt> -> <type>@
990 | AppT Type Type -- ^ @T a b@
991 | SigT Type Kind -- ^ @t :: k@
992 | VarT Name -- ^ @a@
993 | ConT Name -- ^ @T@
994 | PromotedT Name -- ^ @'T@
995
996 -- See Note [Representing concrete syntax in types]
997 | TupleT Int -- ^ @(,), (,,), etc.@
998 | UnboxedTupleT Int -- ^ @(#,#), (#,,#), etc.@
999 | ArrowT -- ^ @->@
1000 | ListT -- ^ @[]@
1001 | PromotedTupleT Int -- ^ @'(), '(,), '(,,), etc.@
1002 | PromotedNilT -- ^ @'[]@
1003 | PromotedConsT -- ^ @(':)@
1004 | StarT -- ^ @*@
1005 | ConstraintT -- ^ @Constraint@
1006 | LitT TyLit -- ^ @0,1,2, etc.@
1007 deriving( Show, Eq, Data, Typeable )
1008
1009 data TyVarBndr = PlainTV Name -- ^ @a@
1010 | KindedTV Name Kind -- ^ @(a :: k)@
1011 deriving( Show, Eq, Data, Typeable )
1012
1013 data TyLit = NumTyLit Integer -- ^ @2@
1014 | StrTyLit String -- ^ @"Hello"@
1015 deriving ( Show, Eq, Data, Typeable )
1016
1017 -- | To avoid duplication between kinds and types, they
1018 -- are defined to be the same. Naturally, you would never
1019 -- have a type be 'StarT' and you would never have a kind
1020 -- be 'SigT', but many of the other constructors are shared.
1021 -- Note that the kind @Bool@ is denoted with 'ConT', not
1022 -- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',
1023 -- not 'PromotedTupleT'.
1024
1025 type Kind = Type
1026
1027 {- Note [Representing concrete syntax in types]
1028 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1029 Haskell has a rich concrete syntax for types, including
1030 t1 -> t2, (t1,t2), [t], and so on
1031 In TH we represent all of this using AppT, with a distinguished
1032 type construtor at the head. So,
1033 Type TH representation
1034 -----------------------------------------------
1035 t1 -> t2 ArrowT `AppT` t2 `AppT` t2
1036 [t] ListT `AppT` t
1037 (t1,t2) TupleT 2 `AppT` t1 `AppT` t2
1038 '(t1,t2) PromotedTupleT 2 `AppT` t1 `AppT` t2
1039
1040 But if the original HsSyn used prefix application, we won't use
1041 these special TH constructors. For example
1042 [] t ConT "[]" `AppT` t
1043 (->) t ConT "->" `AppT` t
1044 In this way we can faithfully represent in TH whether the original
1045 HsType used concrete syntax or not.
1046
1047 The one case that doesn't fit this pattern is that of promoted lists
1048 '[ Maybe, IO ] PromotedListT 2 `AppT` t1 `AppT` t2
1049 but it's very smelly because there really is no type constructor
1050 corresponding to PromotedListT. So we encode HsExplicitListTy with
1051 PromotedConsT and PromotedNilT (which *do* have underlying type
1052 constructors):
1053 '[ Maybe, IO ] PromotedConsT `AppT` Maybe `AppT`
1054 (PromotedConsT `AppT` IO `AppT` PromotedNilT)
1055 -}
1056
1057 -----------------------------------------------------
1058 -- Internal helper functions
1059 -----------------------------------------------------
1060
1061 cmpEq :: Ordering -> Bool
1062 cmpEq EQ = True
1063 cmpEq _ = False
1064
1065 thenCmp :: Ordering -> Ordering -> Ordering
1066 thenCmp EQ o2 = o2
1067 thenCmp o1 _ = o1
1068