8626332c75661c0ea15e308641f4b5b1de1318e9
[ghc.git] / libraries / template-haskell / Language / Haskell / TH / Syntax.hs
1 {-# OPTIONS_GHC -fglasgow-exts #-}
2 -- Need GlaExts for the nested forall in defn of Q
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module : Language.Haskell.Syntax
6 -- Copyright : (c) The University of Glasgow 2003
7 -- License : BSD-style (see the file libraries/base/LICENSE)
8 --
9 -- Maintainer : libraries@haskell.org
10 -- Stability : experimental
11 -- Portability : portable
12 --
13 -- Abstract syntax definitions for Template Haskell.
14 --
15 -----------------------------------------------------------------------------
16
17 module Language.Haskell.TH.Syntax(
18 Quasi(..), Lift(..),
19
20 Q, runQ,
21 report, recover, reify,
22 currentModule, runIO,
23
24 -- Names
25 Name(..), mkName, newName, nameBase, nameModule,
26
27 -- The algebraic data types
28 Dec(..), Exp(..), Con(..), Type(..), Cxt, Match(..),
29 Clause(..), Body(..), Guard(..), Stmt(..), Range(..),
30 Lit(..), Pat(..), FieldExp, FieldPat,
31 Strict(..), Foreign(..), Callconv(..), Safety(..),
32 StrictType, VarStrictType, FunDep(..),
33 Info(..),
34 Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
35
36 -- Internal functions
37 returnQ, bindQ, sequenceQ,
38 NameFlavour(..), NameSpace (..),
39 mkNameG_v, mkNameG_d, mkNameG_tc, mkNameL, mkNameU,
40 tupleTypeName, tupleDataName,
41 OccName, mkOccName, occString,
42 ModName, mkModName, modString
43 ) where
44
45 import Data.PackedString
46 import GHC.Base ( Int(..), Int#, (<#), (==#) )
47
48 import IO ( hPutStrLn, stderr )
49 import Data.IORef
50 import GHC.IOBase ( unsafePerformIO )
51 import Control.Monad (liftM)
52
53 -----------------------------------------------------
54 --
55 -- The Quasi class
56 --
57 -----------------------------------------------------
58
59 class Monad m => Quasi m where
60 -- Fresh names
61 qNewName :: String -> m Name
62
63 -- Error reporting and recovery
64 qReport :: Bool -> String -> m () -- Report an error (True) or warning (False)
65 -- ...but carry on; use 'fail' to stop
66 qRecover :: m a -> m a -> m a -- Recover from the monadic 'fail'
67 -- The first arg is the error handler
68
69 -- Inspect the type-checker's environment
70 qReify :: Name -> m Info
71 qCurrentModule :: m String
72
73 -- Input/output (dangerous)
74 qRunIO :: IO a -> m a
75
76
77 -----------------------------------------------------
78 -- The IO instance of Quasi
79 --
80 -- This instance is used only when running a Q
81 -- computation in the IO monad, usually just to
82 -- print the result. There is no interesting
83 -- type environment, so reification isn't going to
84 -- work.
85 --
86 -----------------------------------------------------
87
88 instance Quasi IO where
89 qNewName s = do { n <- readIORef counter
90 ; writeIORef counter (n+1)
91 ; return (mkNameU s n) }
92
93 qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
94 qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
95
96 qReify v = badIO "reify"
97 qCurrentModule = badIO "currentModule"
98 qRecover a b = badIO "recover" -- Maybe we could fix this?
99
100 qRunIO m = m
101
102 badIO :: String -> IO a
103 badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
104 ; fail "Template Haskell failure" }
105
106 -- Global variable to generate unique symbols
107 counter :: IORef Int
108 {-# NOINLINE counter #-}
109 counter = unsafePerformIO (newIORef 0)
110
111
112 -----------------------------------------------------
113 --
114 -- The Q monad
115 --
116 -----------------------------------------------------
117
118 newtype Q a = Q { unQ :: forall m. Quasi m => m a }
119
120 runQ :: Quasi m => Q a -> m a
121 runQ (Q m) = m
122
123 instance Monad Q where
124 return x = Q (return x)
125 Q m >>= k = Q (m >>= \x -> unQ (k x))
126 Q m >> Q n = Q (m >> n)
127 fail s = Q (fail s)
128
129 ----------------------------------------------------
130 -- Packaged versions for the programmer, hiding the Quasi-ness
131 newName :: String -> Q Name
132 newName s = Q (qNewName s)
133
134 report :: Bool -> String -> Q ()
135 report b s = Q (qReport b s)
136
137 recover :: Q a -> Q a -> Q a
138 recover (Q r) (Q m) = Q (qRecover r m)
139
140 reify :: Name -> Q Info
141 reify v = Q (qReify v)
142
143 currentModule :: Q String
144 currentModule = Q qCurrentModule
145
146 runIO :: IO a -> Q a
147 runIO m = Q (qRunIO m)
148
149 instance Quasi Q where
150 qNewName = newName
151 qReport = report
152 qRecover = recover
153 qReify = reify
154 qCurrentModule = currentModule
155 qRunIO = runIO
156
157
158 ----------------------------------------------------
159 -- The following operations are used solely in DsMeta when desugaring brackets
160 -- They aren't necessary for the user, who can use ordinary return and (>>=) etc
161
162 returnQ :: a -> Q a
163 returnQ = return
164
165 bindQ :: Q a -> (a -> Q b) -> Q b
166 bindQ = (>>=)
167
168 sequenceQ :: [Q a] -> Q [a]
169 sequenceQ = sequence
170
171
172 -----------------------------------------------------
173 --
174 -- The Lift class
175 --
176 -----------------------------------------------------
177
178 class Lift t where
179 lift :: t -> Q Exp
180
181 instance Lift Integer where
182 lift x = return (LitE (IntegerL x))
183
184 instance Lift Int where
185 lift x= return (LitE (IntegerL (fromIntegral x)))
186
187 instance Lift Char where
188 lift x = return (LitE (CharL x))
189
190 instance Lift Bool where
191 lift True = return (ConE trueName)
192 lift False = return (ConE falseName)
193
194 instance Lift a => Lift [a] where
195 lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
196
197 instance (Lift a, Lift b) => Lift (a, b) where
198 lift (a, b)
199 = liftM TupE $ sequence [lift a, lift b]
200
201 instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
202 lift (a, b, c)
203 = liftM TupE $ sequence [lift a, lift b, lift c]
204
205 instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
206 lift (a, b, c, d)
207 = liftM TupE $ sequence [lift a, lift b, lift c, lift d]
208
209 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
210 => Lift (a, b, c, d, e) where
211 lift (a, b, c, d, e)
212 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e]
213
214 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
215 => Lift (a, b, c, d, e, f) where
216 lift (a, b, c, d, e, f)
217 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f]
218
219 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
220 => Lift (a, b, c, d, e, f, g) where
221 lift (a, b, c, d, e, f, g)
222 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g]
223
224 -- TH has a special form for literal strings,
225 -- which we should take advantage of.
226 -- NB: the lhs of the rule has no args, so that
227 -- the rule will apply to a 'lift' all on its own
228 -- which happens to be the way the type checker
229 -- creates it.
230 {-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}
231
232
233 trueName, falseName :: Name
234 trueName = mkNameG DataName "GHC.Base" "True"
235 falseName = mkNameG DataName "GHC.Base" "False"
236
237
238 -----------------------------------------------------
239 -- Names and uniques
240 -----------------------------------------------------
241
242 type ModName = PackedString -- Module name
243
244 mkModName :: String -> ModName
245 mkModName s = packString s
246
247 modString :: ModName -> String
248 modString m = unpackPS m
249
250
251 -----------------------------------------------------
252 -- OccName
253 -----------------------------------------------------
254
255 type OccName = PackedString
256
257 mkOccName :: String -> OccName
258 mkOccName s = packString s
259
260 occString :: OccName -> String
261 occString occ = unpackPS occ
262
263
264 -----------------------------------------------------
265 -- Names
266 -----------------------------------------------------
267
268 -- For "global" names (NameG) we need a totally unique name,
269 -- so we must include the name-space of the thing
270 --
271 -- For unique-numbered things (NameU), we've got a unique reference
272 -- anyway, so no need for name space
273 --
274 -- For dynamically bound thing (NameS) we probably want them to
275 -- in a context-dependent way, so again we don't want the name
276 -- space. For example:
277 -- let v = mkName "T" in [| data $v = $v |]
278 -- Here we use the same Name for both type constructor and data constructor
279
280 data Name = Name OccName NameFlavour
281
282 data NameFlavour
283 = NameS -- An unqualified name; dynamically bound
284 | NameQ ModName -- A qualified name; dynamically bound
285
286 | NameU Int# -- A unique local name
287
288 -- The next two are for lexically-scoped names that
289 -- are bound *outside* the TH syntax tree,
290 -- either globally (NameG) or locally (NameL)
291 -- e.g. f x = $(h [| (map, x) |]
292 -- The 'map' will be a NameG, and 'x' wil be a NameL
293 -- These Names should never appear in a binding position in a TH syntax tree
294
295 | NameL Int# --
296 | NameG NameSpace ModName -- An original name (occurrences only, not binders)
297 -- Need the namespace too to be sure which
298 -- thing we are naming
299
300 data NameSpace = VarName -- Variables
301 | DataName -- Data constructors
302 | TcClsName -- Type constructors and classes; Haskell has them
303 -- in the same name space for now.
304 deriving( Eq, Ord )
305
306 type Uniq = Int
307
308 nameBase :: Name -> String
309 nameBase (Name occ _) = occString occ
310
311 nameModule :: Name -> Maybe String
312 nameModule (Name _ (NameQ m)) = Just (modString m)
313 nameModule (Name _ (NameG _ m)) = Just (modString m)
314 nameModule other_name = Nothing
315
316 mkName :: String -> Name
317 -- The string can have a '.', thus "Foo.baz",
318 -- giving a dynamically-bound qualified name,
319 -- in which case we want to generate a NameQ
320 --
321 -- Parse the string to see if it has a "." in it
322 -- so we know whether to generate a qualified or unqualified name
323 -- It's a bit tricky because we need to parse
324 -- Foo.Baz.x as Qual Foo.Baz x
325 -- So we parse it from back to front
326 mkName str
327 = split [] (reverse str)
328 where
329 split occ [] = Name (mkOccName occ) NameS
330 split occ ('.':rev) = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
331 split occ (c:rev) = split (c:occ) rev
332
333 mkNameU :: String -> Uniq -> Name -- Only used internally
334 mkNameU s (I# u) = Name (mkOccName s) (NameU u)
335
336 mkNameL :: String -> Uniq -> Name -- Only used internally
337 mkNameL s (I# u) = Name (mkOccName s) (NameL u)
338
339 mkNameG :: NameSpace -> String -> String -> Name -- Used for 'x etc, but not available
340 mkNameG ns mod occ -- to the programmer
341 = Name (mkOccName occ) (NameG ns (mkModName mod))
342
343 mkNameG_v = mkNameG VarName
344 mkNameG_tc = mkNameG TcClsName
345 mkNameG_d = mkNameG DataName
346
347 instance Eq Name where
348 v1 == v2 = cmpEq (v1 `compare` v2)
349
350 instance Ord Name where
351 (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2) `thenCmp`
352 (o1 `compare` o2)
353
354 instance Eq NameFlavour where
355 f1 == f2 = cmpEq (f1 `compare` f2)
356
357 instance Ord NameFlavour where
358 -- NameS < NameQ < NameU < NameL < NameG
359 NameS `compare` NameS = EQ
360 NameS `compare` other = LT
361
362 (NameQ _) `compare` NameS = GT
363 (NameQ m1) `compare` (NameQ m2) = m1 `compare` m2
364 (NameQ _) `compare` other = LT
365
366 (NameU _) `compare` NameS = GT
367 (NameU _) `compare` (NameQ _) = GT
368 (NameU u1) `compare` (NameU u2) | u1 <# u2 = LT
369 | u1 ==# u2 = EQ
370 | otherwise = GT
371 (NameU _) `compare` other = LT
372
373 (NameL _) `compare` NameS = GT
374 (NameL _) `compare` (NameQ _) = GT
375 (NameL _) `compare` (NameU _) = GT
376 (NameL u1) `compare` (NameL u2) | u1 <# u2 = LT
377 | u1 ==# u2 = EQ
378 | otherwise = GT
379 (NameL _) `compare` other = LT
380
381 (NameG ns1 m1) `compare` (NameG ns2 m2) = (ns1 `compare` ns2) `thenCmp`
382 (m1 `compare` m2)
383 (NameG _ _) `compare` other = GT
384
385 instance Show Name where
386 -- For now, we make the NameQ and NameG print the same,
387 -- and ditto NameU and NameL. We may well want to
388 -- distinguish them in the end.
389 show (Name occ NameS) = occString occ
390 show (Name occ (NameU u)) = occString occ ++ "_" ++ show (I# u)
391 show (Name occ (NameQ m)) = modString m ++ "." ++ occString occ
392 show (Name occ (NameL u)) = occString occ ++ "_" ++ show (I# u)
393 show (Name occ (NameG ns m)) = modString m ++ "." ++ occString occ
394
395
396 -- Tuple data and type constructors
397 tupleDataName :: Int -> Name -- Data constructor
398 tupleTypeName :: Int -> Name -- Type constructor
399
400 tupleDataName 0 = mk_tup_name 0 DataName
401 tupleDataName 1 = error "tupleDataName 1"
402 tupleDataName n = mk_tup_name (n-1) DataName
403
404 tupleTypeName 0 = mk_tup_name 0 TcClsName
405 tupleTypeName 1 = error "tupleTypeName 1"
406 tupleTypeName n = mk_tup_name (n-1) TcClsName
407
408 mk_tup_name n_commas space
409 = Name occ (NameG space tup_mod)
410 where
411 occ = mkOccName ('(' : replicate n_commas ',' ++ ")")
412 tup_mod = mkModName "GHC.Tuple"
413
414
415
416
417 -----------------------------------------------------
418 --
419 -- The Info returned by reification
420 --
421 -----------------------------------------------------
422
423 data Info
424 = ClassI Dec
425 | ClassOpI
426 Name -- The class op itself
427 Type -- Type of the class-op (fully polymoprhic)
428 Name -- Name of the parent class
429 Fixity
430
431 | TyConI Dec
432
433 | PrimTyConI -- Ones that can't be expressed with a data type
434 -- decl, such as (->), Int#
435 Name
436 Int -- Arity
437 Bool -- False => lifted type; True => unlifted
438
439 | DataConI
440 Name -- The data con itself
441 Type -- Type of the constructor (fully polymorphic)
442 Name -- Name of the parent TyCon
443 Fixity
444
445 | VarI
446 Name -- The variable itself
447 Type
448 (Maybe Dec) -- Nothing for lambda-bound variables, and
449 -- for anything else TH can't figure out
450 -- E.g. [| let x = 1 in $(do { d <- reify 'x; .. }) |]
451 Fixity
452
453 | TyVarI -- Scoped type variable
454 Name
455 Type -- What it is bound to
456
457 data Fixity = Fixity Int FixityDirection deriving( Eq )
458 data FixityDirection = InfixL | InfixR | InfixN deriving( Eq )
459
460 maxPrecedence = (9::Int)
461 defaultFixity = Fixity maxPrecedence InfixL
462
463
464 -----------------------------------------------------
465 --
466 -- The main syntax data types
467 --
468 -----------------------------------------------------
469
470 data Lit = CharL Char
471 | StringL String
472 | IntegerL Integer -- Used for overloaded and non-overloaded
473 -- literals. We don't have a good way to
474 -- represent non-overloaded literals at
475 -- the moment. Maybe that doesn't matter?
476 | RationalL Rational -- Ditto
477 | IntPrimL Integer
478 | FloatPrimL Rational
479 | DoublePrimL Rational
480 deriving( Show, Eq )
481
482 -- We could add Int, Float, Double etc, as we do in HsLit,
483 -- but that could complicate the
484 -- suppposedly-simple TH.Syntax literal type
485
486 data Pat
487 = LitP Lit -- { 5 or 'c' }
488 | VarP Name -- { x }
489 | TupP [Pat] -- { (p1,p2) }
490 | ConP Name [Pat] -- data T1 = C1 t1 t2; {C1 p1 p1} = e
491 | InfixP Pat Name Pat -- foo ({x :+ y}) = e
492 | TildeP Pat -- { ~p }
493 | AsP Name Pat -- { x @ p }
494 | WildP -- { _ }
495 | RecP Name [FieldPat] -- f (Pt { pointx = x }) = g x
496 | ListP [ Pat ] -- { [1,2,3] }
497 | SigP Pat Type -- p :: t
498 deriving( Show, Eq )
499
500 type FieldPat = (Name,Pat)
501
502 data Match = Match Pat Body [Dec]
503 -- case e of { pat -> body where decs }
504 deriving( Show, Eq )
505 data Clause = Clause [Pat] Body [Dec]
506 -- f { p1 p2 = body where decs }
507 deriving( Show, Eq )
508
509 data Exp
510 = VarE Name -- { x }
511 | ConE Name -- data T1 = C1 t1 t2; p = {C1} e1 e2
512 | LitE Lit -- { 5 or 'c'}
513 | AppE Exp Exp -- { f x }
514
515 | InfixE (Maybe Exp) Exp (Maybe Exp) -- {x + y} or {(x+)} or {(+ x)} or {(+)}
516 -- It's a bit gruesome to use an Exp as the
517 -- operator, but how else can we distinguish
518 -- constructors from non-constructors?
519 -- Maybe there should be a var-or-con type?
520 -- Or maybe we should leave it to the String itself?
521
522 | LamE [Pat] Exp -- { \ p1 p2 -> e }
523 | TupE [Exp] -- { (e1,e2) }
524 | CondE Exp Exp Exp -- { if e1 then e2 else e3 }
525 | LetE [Dec] Exp -- { let x=e1; y=e2 in e3 }
526 | CaseE Exp [Match] -- { case e of m1; m2 }
527 | DoE [Stmt] -- { do { p <- e1; e2 } }
528 | CompE [Stmt] -- { [ (x,y) | x <- xs, y <- ys ] }
529 | ArithSeqE Range -- { [ 1 ,2 .. 10 ] }
530 | ListE [ Exp ] -- { [1,2,3] }
531 | SigE Exp Type -- e :: t
532 | RecConE Name [FieldExp] -- { T { x = y, z = w } }
533 | RecUpdE Exp [FieldExp] -- { (f x) { z = w } }
534 deriving( Show, Eq )
535
536 type FieldExp = (Name,Exp)
537
538 -- Omitted: implicit parameters
539
540 data Body
541 = GuardedB [(Guard,Exp)] -- f p { | e1 = e2 | e3 = e4 } where ds
542 | NormalB Exp -- f p { = e } where ds
543 deriving( Show, Eq )
544
545 data Guard
546 = NormalG Exp
547 | PatG [Stmt]
548 deriving( Show, Eq )
549
550 data Stmt
551 = BindS Pat Exp
552 | LetS [ Dec ]
553 | NoBindS Exp
554 | ParS [[Stmt]]
555 deriving( Show, Eq )
556
557 data Range = FromR Exp | FromThenR Exp Exp
558 | FromToR Exp Exp | FromThenToR Exp Exp Exp
559 deriving( Show, Eq )
560
561 data Dec
562 = FunD Name [Clause] -- { f p1 p2 = b where decs }
563 | ValD Pat Body [Dec] -- { p = b where decs }
564 | DataD Cxt Name [Name]
565 [Con] [Name] -- { data Cxt x => T x = A x | B (T x)
566 -- deriving (Z,W)}
567 | NewtypeD Cxt Name [Name]
568 Con [Name] -- { newtype Cxt x => T x = A (B x)
569 -- deriving (Z,W)}
570 | TySynD Name [Name] Type -- { type T x = (x,x) }
571 | ClassD Cxt Name [Name] [FunDep] [Dec]
572 -- { class Eq a => Ord a where ds }
573 | InstanceD Cxt Type [Dec] -- { instance Show w => Show [w]
574 -- where ds }
575 | SigD Name Type -- { length :: [a] -> Int }
576 | ForeignD Foreign
577 deriving( Show, Eq )
578
579 data FunDep = FunDep [Name] [Name]
580 deriving( Show, Eq )
581
582 data Foreign = ImportF Callconv Safety String Name Type
583 | ExportF Callconv String Name Type
584 deriving( Show, Eq )
585
586 data Callconv = CCall | StdCall
587 deriving( Show, Eq )
588
589 data Safety = Unsafe | Safe | Threadsafe
590 deriving( Show, Eq )
591
592 type Cxt = [Type] -- (Eq a, Ord b)
593
594 data Strict = IsStrict | NotStrict
595 deriving( Show, Eq )
596
597 data Con = NormalC Name [StrictType]
598 | RecC Name [VarStrictType]
599 | InfixC StrictType Name StrictType
600 | ForallC [Name] Cxt Con
601 deriving( Show, Eq )
602
603 type StrictType = (Strict, Type)
604 type VarStrictType = (Name, Strict, Type)
605
606 -- FIXME: Why this special status for "List" (even tuples might be handled
607 -- differently)? -=chak
608 data Type = ForallT [Name] Cxt Type -- forall <vars>. <ctxt> -> <type>
609 | VarT Name -- a
610 | ConT Name -- T
611 | TupleT Int -- (,), (,,), etc.
612 | ArrowT -- ->
613 | ListT -- []
614 | AppT Type Type -- T a b
615 deriving( Show, Eq )
616
617 -----------------------------------------------------
618 -- Internal helper functions
619 -----------------------------------------------------
620
621 cmpEq :: Ordering -> Bool
622 cmpEq EQ = True
623 cmpEq _ = False
624
625 thenCmp :: Ordering -> Ordering -> Ordering
626 thenCmp EQ o2 = o2
627 thenCmp o1 o2 = o1
628