Template Haskell: kind annotations
[ghc.git] / libraries / template-haskell / Language / Haskell / TH / Syntax.hs
1 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
6 -- for details
7 -----------------------------------------------------------------------------
8 -- |
9 -- Module : Language.Haskell.Syntax
10 -- Copyright : (c) The University of Glasgow 2003
11 -- License : BSD-style (see the file libraries/base/LICENSE)
12 --
13 -- Maintainer : libraries@haskell.org
14 -- Stability : experimental
15 -- Portability : portable
16 --
17 -- Abstract syntax definitions for Template Haskell.
18 --
19 -----------------------------------------------------------------------------
20
21 module Language.Haskell.TH.Syntax(
22 Quasi(..), Lift(..),
23
24 Q, runQ,
25 report, recover, reify,
26 location, runIO,
27
28 -- Names
29 Name(..), mkName, newName, nameBase, nameModule,
30 showName, showName', NameIs(..),
31
32 -- The algebraic data types
33 Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind(..),Cxt,
34 Pred(..), Match(..), Clause(..), Body(..), Guard(..), Stmt(..),
35 Range(..), Lit(..), Pat(..), FieldExp, FieldPat,
36 Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),
37 InlineSpec(..), StrictType, VarStrictType, FunDep(..), FamFlavour(..),
38 Info(..), Loc(..), CharPos,
39 Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
40
41 -- Internal functions
42 returnQ, bindQ, sequenceQ,
43 NameFlavour(..), NameSpace (..),
44 mkNameG_v, mkNameG_d, mkNameG_tc, Uniq, mkNameL, mkNameU,
45 tupleTypeName, tupleDataName,
46 OccName, mkOccName, occString,
47 ModName, mkModName, modString,
48 PkgName, mkPkgName, pkgString
49 ) where
50
51 import Data.PackedString
52 import GHC.Base ( Int(..), Int#, (<#), (==#) )
53
54 import Data.Data (Data(..), Typeable, mkConstr, mkDataType, constrIndex)
55 import qualified Data.Data as Data
56 import Data.IORef
57 import System.IO.Unsafe ( unsafePerformIO )
58 import Control.Monad (liftM)
59 import System.IO ( hPutStrLn, stderr )
60 import Data.Char ( isAlpha )
61
62 -----------------------------------------------------
63 --
64 -- The Quasi class
65 --
66 -----------------------------------------------------
67
68 class (Monad m, Functor m) => Quasi m where
69 -- Fresh names
70 qNewName :: String -> m Name
71
72 -- Error reporting and recovery
73 qReport :: Bool -> String -> m () -- Report an error (True) or warning (False)
74 -- ...but carry on; use 'fail' to stop
75 qRecover :: m a -> m a -> m a -- Recover from the monadic 'fail'
76 -- The first arg is the error handler
77
78 -- Inspect the type-checker's environment
79 qReify :: Name -> m Info
80 qLocation :: m Loc
81
82 -- Input/output (dangerous)
83 qRunIO :: IO a -> m a
84
85
86 -----------------------------------------------------
87 -- The IO instance of Quasi
88 --
89 -- This instance is used only when running a Q
90 -- computation in the IO monad, usually just to
91 -- print the result. There is no interesting
92 -- type environment, so reification isn't going to
93 -- work.
94 --
95 -----------------------------------------------------
96
97 instance Quasi IO where
98 qNewName s = do { n <- readIORef counter
99 ; writeIORef counter (n+1)
100 ; return (mkNameU s n) }
101
102 qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
103 qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
104
105 qReify _ = badIO "reify"
106 qLocation = badIO "currentLocation"
107 qRecover _ _ = badIO "recover" -- Maybe we could fix this?
108
109 qRunIO m = m
110
111 badIO :: String -> IO a
112 badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
113 ; fail "Template Haskell failure" }
114
115 -- Global variable to generate unique symbols
116 counter :: IORef Int
117 {-# NOINLINE counter #-}
118 counter = unsafePerformIO (newIORef 0)
119
120
121 -----------------------------------------------------
122 --
123 -- The Q monad
124 --
125 -----------------------------------------------------
126
127 newtype Q a = Q { unQ :: forall m. Quasi m => m a }
128
129 runQ :: Quasi m => Q a -> m a
130 runQ (Q m) = m
131
132 instance Monad Q where
133 return x = Q (return x)
134 Q m >>= k = Q (m >>= \x -> unQ (k x))
135 Q m >> Q n = Q (m >> n)
136 fail s = report True s >> Q (fail "Q monad failure")
137
138 instance Functor Q where
139 fmap f (Q x) = Q (fmap f x)
140
141 ----------------------------------------------------
142 -- Packaged versions for the programmer, hiding the Quasi-ness
143 newName :: String -> Q Name
144 newName s = Q (qNewName s)
145
146 report :: Bool -> String -> Q ()
147 report b s = Q (qReport b s)
148
149 recover :: Q a -> Q a -> Q a
150 recover (Q r) (Q m) = Q (qRecover r m)
151
152 -- | 'reify' looks up information about the 'Name'
153 reify :: Name -> Q Info
154 reify v = Q (qReify v)
155
156 -- | 'location' gives you the 'Location' at which this
157 -- computation is spliced.
158 location :: Q Loc
159 location = Q qLocation
160
161 -- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
162 -- Take care: you are guaranteed the ordering of calls to 'runIO' within
163 -- a single 'Q' computation, but not about the order in which splices are run.
164 --
165 -- Note: for various murky reasons, stdout and stderr handles are not
166 -- necesarily flushed when the compiler finishes running, so you should
167 -- flush them yourself.
168 runIO :: IO a -> Q a
169 runIO m = Q (qRunIO m)
170
171 instance Quasi Q where
172 qNewName = newName
173 qReport = report
174 qRecover = recover
175 qReify = reify
176 qLocation = location
177 qRunIO = runIO
178
179
180 ----------------------------------------------------
181 -- The following operations are used solely in DsMeta when desugaring brackets
182 -- They are not necessary for the user, who can use ordinary return and (>>=) etc
183
184 returnQ :: a -> Q a
185 returnQ = return
186
187 bindQ :: Q a -> (a -> Q b) -> Q b
188 bindQ = (>>=)
189
190 sequenceQ :: [Q a] -> Q [a]
191 sequenceQ = sequence
192
193
194 -----------------------------------------------------
195 --
196 -- The Lift class
197 --
198 -----------------------------------------------------
199
200 class Lift t where
201 lift :: t -> Q Exp
202
203 instance Lift Integer where
204 lift x = return (LitE (IntegerL x))
205
206 instance Lift Int where
207 lift x= return (LitE (IntegerL (fromIntegral x)))
208
209 instance Lift Char where
210 lift x = return (LitE (CharL x))
211
212 instance Lift Bool where
213 lift True = return (ConE trueName)
214 lift False = return (ConE falseName)
215
216 instance Lift a => Lift (Maybe a) where
217 lift Nothing = return (ConE nothingName)
218 lift (Just x) = liftM (ConE justName `AppE`) (lift x)
219
220 instance (Lift a, Lift b) => Lift (Either a b) where
221 lift (Left x) = liftM (ConE leftName `AppE`) (lift x)
222 lift (Right y) = liftM (ConE rightName `AppE`) (lift y)
223
224 instance Lift a => Lift [a] where
225 lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
226
227 instance (Lift a, Lift b) => Lift (a, b) where
228 lift (a, b)
229 = liftM TupE $ sequence [lift a, lift b]
230
231 instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
232 lift (a, b, c)
233 = liftM TupE $ sequence [lift a, lift b, lift c]
234
235 instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
236 lift (a, b, c, d)
237 = liftM TupE $ sequence [lift a, lift b, lift c, lift d]
238
239 instance (Lift a, Lift b, Lift c, Lift d, Lift e)
240 => Lift (a, b, c, d, e) where
241 lift (a, b, c, d, e)
242 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e]
243
244 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
245 => Lift (a, b, c, d, e, f) where
246 lift (a, b, c, d, e, f)
247 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f]
248
249 instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
250 => Lift (a, b, c, d, e, f, g) where
251 lift (a, b, c, d, e, f, g)
252 = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g]
253
254 -- TH has a special form for literal strings,
255 -- which we should take advantage of.
256 -- NB: the lhs of the rule has no args, so that
257 -- the rule will apply to a 'lift' all on its own
258 -- which happens to be the way the type checker
259 -- creates it.
260 {-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}
261
262
263 trueName, falseName :: Name
264 trueName = mkNameG DataName "ghc-prim" "GHC.Bool" "True"
265 falseName = mkNameG DataName "ghc-prim" "GHC.Bool" "False"
266
267 nothingName, justName :: Name
268 nothingName = mkNameG DataName "base" "Data.Maybe" "Nothing"
269 justName = mkNameG DataName "base" "Data.Maybe" "Just"
270
271 leftName, rightName :: Name
272 leftName = mkNameG DataName "base" "Data.Either" "Left"
273 rightName = mkNameG DataName "base" "Data.Either" "Right"
274
275
276 -----------------------------------------------------
277 -- Names and uniques
278 -----------------------------------------------------
279
280 type ModName = PackedString -- Module name
281
282 mkModName :: String -> ModName
283 mkModName s = packString s
284
285 modString :: ModName -> String
286 modString m = unpackPS m
287
288
289 type PkgName = PackedString -- package name
290
291 mkPkgName :: String -> PkgName
292 mkPkgName s = packString s
293
294 pkgString :: PkgName -> String
295 pkgString m = unpackPS m
296
297
298 -----------------------------------------------------
299 -- OccName
300 -----------------------------------------------------
301
302 type OccName = PackedString
303
304 mkOccName :: String -> OccName
305 mkOccName s = packString s
306
307 occString :: OccName -> String
308 occString occ = unpackPS occ
309
310
311 -----------------------------------------------------
312 -- Names
313 -----------------------------------------------------
314
315 -- For "global" names (NameG) we need a totally unique name,
316 -- so we must include the name-space of the thing
317 --
318 -- For unique-numbered things (NameU), we've got a unique reference
319 -- anyway, so no need for name space
320 --
321 -- For dynamically bound thing (NameS) we probably want them to
322 -- in a context-dependent way, so again we don't want the name
323 -- space. For example:
324 -- let v = mkName "T" in [| data $v = $v |]
325 -- Here we use the same Name for both type constructor and data constructor
326
327 data Name = Name OccName NameFlavour deriving (Typeable, Data)
328
329 data NameFlavour
330 = NameS -- An unqualified name; dynamically bound
331 | NameQ ModName -- A qualified name; dynamically bound
332
333 | NameU Int# -- A unique local name
334
335 -- The next two are for lexically-scoped names that
336 -- are bound *outside* the TH syntax tree,
337 -- either globally (NameG) or locally (NameL)
338 -- e.g. f x = $(h [| (map, x) |]
339 -- The 'map' will be a NameG, and 'x' wil be a NameL
340 -- These Names should never appear in a binding position in a TH syntax tree
341
342 | NameL Int# --
343 | NameG NameSpace PkgName ModName -- An original name (occurrences only, not binders)
344 -- Need the namespace too to be sure which
345 -- thing we are naming
346 deriving ( Typeable )
347
348 -- Although the NameFlavour type is abstract, the Data instance is not. The reason for this
349 -- is that currently we use Data to serialize values in annotations, and in order for that to
350 -- work for Template Haskell names introduced via the 'x syntax we need gunfold on NameFlavour
351 -- to work. Bleh!
352 --
353 -- The long term solution to this is to use the binary package for annotation serialization and
354 -- then remove this instance. However, to do _that_ we need to wait on binary to become stable, since
355 -- boot libraries cannot be upgraded seperately from GHC itself.
356 --
357 -- This instance cannot be derived automatically due to bug #2701
358 instance Data NameFlavour where
359 gfoldl _ z NameS = z NameS
360 gfoldl k z (NameQ mn) = z NameQ `k` mn
361 gfoldl k z (NameU i) = z (\(I# i') -> NameU i') `k` (I# i)
362 gfoldl k z (NameL i) = z (\(I# i') -> NameL i') `k` (I# i)
363 gfoldl k z (NameG ns p m) = z NameG `k` ns `k` p `k` m
364 gunfold k z c = case constrIndex c of
365 1 -> z NameS
366 2 -> k $ z NameQ
367 3 -> k $ z (\(I# i) -> NameU i)
368 4 -> k $ z (\(I# i) -> NameL i)
369 5 -> k $ k $ k $ z NameG
370 _ -> error "gunfold: NameFlavour"
371 toConstr NameS = con_NameS
372 toConstr (NameQ _) = con_NameQ
373 toConstr (NameU _) = con_NameU
374 toConstr (NameL _) = con_NameL
375 toConstr (NameG _ _ _) = con_NameG
376 dataTypeOf _ = ty_NameFlavour
377
378 con_NameS, con_NameQ, con_NameU, con_NameL, con_NameG :: Data.Constr
379 con_NameS = mkConstr ty_NameFlavour "NameS" [] Data.Prefix
380 con_NameQ = mkConstr ty_NameFlavour "NameQ" [] Data.Prefix
381 con_NameU = mkConstr ty_NameFlavour "NameU" [] Data.Prefix
382 con_NameL = mkConstr ty_NameFlavour "NameL" [] Data.Prefix
383 con_NameG = mkConstr ty_NameFlavour "NameG" [] Data.Prefix
384
385 ty_NameFlavour :: Data.DataType
386 ty_NameFlavour = mkDataType "Language.Haskell.TH.Syntax.NameFlavour"
387 [con_NameS, con_NameQ, con_NameU,
388 con_NameL, con_NameG]
389
390 data NameSpace = VarName -- Variables
391 | DataName -- Data constructors
392 | TcClsName -- Type constructors and classes; Haskell has them
393 -- in the same name space for now.
394 deriving( Eq, Ord, Data, Typeable )
395
396 type Uniq = Int
397
398 nameBase :: Name -> String
399 nameBase (Name occ _) = occString occ
400
401 nameModule :: Name -> Maybe String
402 nameModule (Name _ (NameQ m)) = Just (modString m)
403 nameModule (Name _ (NameG _ _ m)) = Just (modString m)
404 nameModule _ = Nothing
405
406 mkName :: String -> Name
407 -- The string can have a '.', thus "Foo.baz",
408 -- giving a dynamically-bound qualified name,
409 -- in which case we want to generate a NameQ
410 --
411 -- Parse the string to see if it has a "." in it
412 -- so we know whether to generate a qualified or unqualified name
413 -- It's a bit tricky because we need to parse
414 -- Foo.Baz.x as Qual Foo.Baz x
415 -- So we parse it from back to front
416 mkName str
417 = split [] (reverse str)
418 where
419 split occ [] = Name (mkOccName occ) NameS
420 split occ ('.':rev) | not (null occ),
421 not (null rev), head rev /= '.'
422 = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
423 -- The 'not (null occ)' guard ensures that
424 -- mkName "&." = Name "&." NameS
425 -- The 'rev' guards ensure that
426 -- mkName ".&" = Name ".&" NameS
427 -- mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
428 -- This rather bizarre case actually happened; (.&.) is in Data.Bits
429 split occ (c:rev) = split (c:occ) rev
430
431 mkNameU :: String -> Uniq -> Name -- Only used internally
432 mkNameU s (I# u) = Name (mkOccName s) (NameU u)
433
434 mkNameL :: String -> Uniq -> Name -- Only used internally
435 mkNameL s (I# u) = Name (mkOccName s) (NameL u)
436
437 mkNameG :: NameSpace -> String -> String -> String -> Name -- Used for 'x etc, but not available
438 mkNameG ns pkg modu occ -- to the programmer
439 = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))
440
441 mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
442 mkNameG_v = mkNameG VarName
443 mkNameG_tc = mkNameG TcClsName
444 mkNameG_d = mkNameG DataName
445
446 instance Eq Name where
447 v1 == v2 = cmpEq (v1 `compare` v2)
448
449 instance Ord Name where
450 (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2) `thenCmp`
451 (o1 `compare` o2)
452
453 instance Eq NameFlavour where
454 f1 == f2 = cmpEq (f1 `compare` f2)
455
456 instance Ord NameFlavour where
457 -- NameS < NameQ < NameU < NameL < NameG
458 NameS `compare` NameS = EQ
459 NameS `compare` _ = LT
460
461 (NameQ _) `compare` NameS = GT
462 (NameQ m1) `compare` (NameQ m2) = m1 `compare` m2
463 (NameQ _) `compare` _ = LT
464
465 (NameU _) `compare` NameS = GT
466 (NameU _) `compare` (NameQ _) = GT
467 (NameU u1) `compare` (NameU u2) | u1 <# u2 = LT
468 | u1 ==# u2 = EQ
469 | otherwise = GT
470 (NameU _) `compare` _ = LT
471
472 (NameL _) `compare` NameS = GT
473 (NameL _) `compare` (NameQ _) = GT
474 (NameL _) `compare` (NameU _) = GT
475 (NameL u1) `compare` (NameL u2) | u1 <# u2 = LT
476 | u1 ==# u2 = EQ
477 | otherwise = GT
478 (NameL _) `compare` _ = LT
479
480 (NameG ns1 p1 m1) `compare` (NameG ns2 p2 m2) = (ns1 `compare` ns2) `thenCmp`
481 (p1 `compare` p2) `thenCmp`
482 (m1 `compare` m2)
483 (NameG _ _ _) `compare` _ = GT
484
485 data NameIs = Alone | Applied | Infix
486
487 showName :: Name -> String
488 showName = showName' Alone
489
490 showName' :: NameIs -> Name -> String
491 showName' ni nm
492 = case ni of
493 Alone -> nms
494 Applied
495 | pnam -> nms
496 | otherwise -> "(" ++ nms ++ ")"
497 Infix
498 | pnam -> "`" ++ nms ++ "`"
499 | otherwise -> nms
500 where
501 -- For now, we make the NameQ and NameG print the same, even though
502 -- NameQ is a qualified name (so what it means depends on what the
503 -- current scope is), and NameG is an original name (so its meaning
504 -- should be independent of what's in scope.
505 -- We may well want to distinguish them in the end.
506 -- Ditto NameU and NameL
507 nms = case nm of
508 Name occ NameS -> occString occ
509 Name occ (NameQ m) -> modString m ++ "." ++ occString occ
510 Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
511 Name occ (NameU u) -> occString occ ++ "_" ++ show (I# u)
512 Name occ (NameL u) -> occString occ ++ "_" ++ show (I# u)
513
514 pnam = classify nms
515
516 -- True if we are function style, e.g. f, [], (,)
517 -- False if we are operator style, e.g. +, :+
518 classify "" = False -- shouldn't happen; . operator is handled below
519 classify (x:xs) | isAlpha x || (x `elem` "_[]()") =
520 case dropWhile (/='.') xs of
521 (_:xs') -> classify xs'
522 [] -> True
523 | otherwise = False
524
525 instance Show Name where
526 show = showName
527
528 -- Tuple data and type constructors
529 tupleDataName :: Int -> Name -- Data constructor
530 tupleTypeName :: Int -> Name -- Type constructor
531
532 tupleDataName 0 = mk_tup_name 0 DataName
533 tupleDataName 1 = error "tupleDataName 1"
534 tupleDataName n = mk_tup_name (n-1) DataName
535
536 tupleTypeName 0 = mk_tup_name 0 TcClsName
537 tupleTypeName 1 = error "tupleTypeName 1"
538 tupleTypeName n = mk_tup_name (n-1) TcClsName
539
540 mk_tup_name :: Int -> NameSpace -> Name
541 mk_tup_name n_commas space
542 = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
543 where
544 occ = mkOccName ('(' : replicate n_commas ',' ++ ")")
545 -- XXX Should it be GHC.Unit for 0 commas?
546 tup_mod = mkModName "GHC.Tuple"
547
548
549
550 -----------------------------------------------------
551 -- Locations
552 -----------------------------------------------------
553
554 data Loc
555 = Loc { loc_filename :: String
556 , loc_package :: String
557 , loc_module :: String
558 , loc_start :: CharPos
559 , loc_end :: CharPos }
560
561 type CharPos = (Int, Int) -- Line and character position
562
563
564 -----------------------------------------------------
565 --
566 -- The Info returned by reification
567 --
568 -----------------------------------------------------
569
570 data Info
571 = ClassI Dec
572 | ClassOpI
573 Name -- The class op itself
574 Type -- Type of the class-op (fully polymoprhic)
575 Name -- Name of the parent class
576 Fixity
577
578 | TyConI Dec
579
580 | PrimTyConI -- Ones that can't be expressed with a data type
581 -- decl, such as (->), Int#
582 Name
583 Int -- Arity
584 Bool -- False => lifted type; True => unlifted
585
586 | DataConI
587 Name -- The data con itself
588 Type -- Type of the constructor (fully polymorphic)
589 Name -- Name of the parent TyCon
590 Fixity
591
592 | VarI
593 Name -- The variable itself
594 Type
595 (Maybe Dec) -- Nothing for lambda-bound variables, and
596 -- for anything else TH can't figure out
597 -- E.g. [| let x = 1 in $(do { d <- reify 'x; .. }) |]
598 Fixity
599
600 | TyVarI -- Scoped type variable
601 Name
602 Type -- What it is bound to
603 deriving( Show, Data, Typeable )
604
605 data Fixity = Fixity Int FixityDirection
606 deriving( Eq, Show, Data, Typeable )
607 data FixityDirection = InfixL | InfixR | InfixN
608 deriving( Eq, Show, Data, Typeable )
609
610 maxPrecedence :: Int
611 maxPrecedence = (9::Int)
612
613 defaultFixity :: Fixity
614 defaultFixity = Fixity maxPrecedence InfixL
615
616
617 -----------------------------------------------------
618 --
619 -- The main syntax data types
620 --
621 -----------------------------------------------------
622
623 data Lit = CharL Char
624 | StringL String
625 | IntegerL Integer -- Used for overloaded and non-overloaded
626 -- literals. We don't have a good way to
627 -- represent non-overloaded literals at
628 -- the moment. Maybe that doesn't matter?
629 | RationalL Rational -- Ditto
630 | IntPrimL Integer
631 | WordPrimL Integer
632 | FloatPrimL Rational
633 | DoublePrimL Rational
634 deriving( Show, Eq, Data, Typeable )
635
636 -- We could add Int, Float, Double etc, as we do in HsLit,
637 -- but that could complicate the
638 -- suppposedly-simple TH.Syntax literal type
639
640 data Pat
641 = LitP Lit -- { 5 or 'c' }
642 | VarP Name -- { x }
643 | TupP [Pat] -- { (p1,p2) }
644 | ConP Name [Pat] -- data T1 = C1 t1 t2; {C1 p1 p1} = e
645 | InfixP Pat Name Pat -- foo ({x :+ y}) = e
646 | TildeP Pat -- { ~p }
647 | AsP Name Pat -- { x @ p }
648 | WildP -- { _ }
649 | RecP Name [FieldPat] -- f (Pt { pointx = x }) = g x
650 | ListP [ Pat ] -- { [1,2,3] }
651 | SigP Pat Type -- { p :: t }
652 deriving( Show, Eq, Data, Typeable )
653
654 type FieldPat = (Name,Pat)
655
656 data Match = Match Pat Body [Dec]
657 -- case e of { pat -> body where decs }
658 deriving( Show, Eq, Data, Typeable )
659 data Clause = Clause [Pat] Body [Dec]
660 -- f { p1 p2 = body where decs }
661 deriving( Show, Eq, Data, Typeable )
662
663 data Exp
664 = VarE Name -- { x }
665 | ConE Name -- data T1 = C1 t1 t2; p = {C1} e1 e2
666 | LitE Lit -- { 5 or 'c'}
667 | AppE Exp Exp -- { f x }
668
669 | InfixE (Maybe Exp) Exp (Maybe Exp) -- {x + y} or {(x+)} or {(+ x)} or {(+)}
670 -- It's a bit gruesome to use an Exp as the
671 -- operator, but how else can we distinguish
672 -- constructors from non-constructors?
673 -- Maybe there should be a var-or-con type?
674 -- Or maybe we should leave it to the String itself?
675
676 | LamE [Pat] Exp -- { \ p1 p2 -> e }
677 | TupE [Exp] -- { (e1,e2) }
678 | CondE Exp Exp Exp -- { if e1 then e2 else e3 }
679 | LetE [Dec] Exp -- { let x=e1; y=e2 in e3 }
680 | CaseE Exp [Match] -- { case e of m1; m2 }
681 | DoE [Stmt] -- { do { p <- e1; e2 } }
682 | CompE [Stmt] -- { [ (x,y) | x <- xs, y <- ys ] }
683 | ArithSeqE Range -- { [ 1 ,2 .. 10 ] }
684 | ListE [ Exp ] -- { [1,2,3] }
685 | SigE Exp Type -- { e :: t }
686 | RecConE Name [FieldExp] -- { T { x = y, z = w } }
687 | RecUpdE Exp [FieldExp] -- { (f x) { z = w } }
688 deriving( Show, Eq, Data, Typeable )
689
690 type FieldExp = (Name,Exp)
691
692 -- Omitted: implicit parameters
693
694 data Body
695 = GuardedB [(Guard,Exp)] -- f p { | e1 = e2 | e3 = e4 } where ds
696 | NormalB Exp -- f p { = e } where ds
697 deriving( Show, Eq, Data, Typeable )
698
699 data Guard
700 = NormalG Exp
701 | PatG [Stmt]
702 deriving( Show, Eq, Data, Typeable )
703
704 data Stmt
705 = BindS Pat Exp
706 | LetS [ Dec ]
707 | NoBindS Exp
708 | ParS [[Stmt]]
709 deriving( Show, Eq, Data, Typeable )
710
711 data Range = FromR Exp | FromThenR Exp Exp
712 | FromToR Exp Exp | FromThenToR Exp Exp Exp
713 deriving( Show, Eq, Data, Typeable )
714
715 data Dec
716 = FunD Name [Clause] -- { f p1 p2 = b where decs }
717 | ValD Pat Body [Dec] -- { p = b where decs }
718 | DataD Cxt Name [TyVarBndr]
719 [Con] [Name] -- { data Cxt x => T x = A x | B (T x)
720 -- deriving (Z,W)}
721 | NewtypeD Cxt Name [TyVarBndr]
722 Con [Name] -- { newtype Cxt x => T x = A (B x)
723 -- deriving (Z,W)}
724 | TySynD Name [TyVarBndr] Type -- { type T x = (x,x) }
725 | ClassD Cxt Name [TyVarBndr]
726 [FunDep] [Dec] -- { class Eq a => Ord a where ds }
727 | InstanceD Cxt Type [Dec] -- { instance Show w => Show [w]
728 -- where ds }
729 | SigD Name Type -- { length :: [a] -> Int }
730 | ForeignD Foreign
731 -- pragmas
732 | PragmaD Pragma -- { {-# INLINE [1] foo #-} }
733 -- type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')
734 | FamilyD FamFlavour Name
735 [TyVarBndr] (Maybe Kind) -- { type family T a b c :: * }
736
737 | DataInstD Cxt Name [Type]
738 [Con] [Name] -- { data instance Cxt x => T [x] = A x
739 -- | B (T x)
740 -- deriving (Z,W)}
741 | NewtypeInstD Cxt Name [Type]
742 Con [Name] -- { newtype instance Cxt x => T [x] = A (B x)
743 -- deriving (Z,W)}
744 | TySynInstD Name [Type] Type -- { type instance T (Maybe x) = (x,x) }
745 deriving( Show, Eq, Data, Typeable )
746
747 data FunDep = FunDep [Name] [Name]
748 deriving( Show, Eq, Data, Typeable )
749
750 data FamFlavour = TypeFam | DataFam
751 deriving( Show, Eq, Data, Typeable )
752
753 data Foreign = ImportF Callconv Safety String Name Type
754 | ExportF Callconv String Name Type
755 deriving( Show, Eq, Data, Typeable )
756
757 data Callconv = CCall | StdCall
758 deriving( Show, Eq, Data, Typeable )
759
760 data Safety = Unsafe | Safe | Threadsafe
761 deriving( Show, Eq, Data, Typeable )
762
763 data Pragma = InlineP Name InlineSpec
764 | SpecialiseP Name Type (Maybe InlineSpec)
765 deriving( Show, Eq, Data, Typeable )
766
767 data InlineSpec
768 = InlineSpec Bool -- False: no inline; True: inline
769 Bool -- False: fun-like; True: constructor-like
770 (Maybe (Bool, Int)) -- False: before phase; True: from phase
771 deriving( Show, Eq, Data, Typeable )
772
773 type Cxt = [Pred] -- (Eq a, Ord b)
774
775 data Pred = ClassP Name [Type] -- Eq (Int, a)
776 | EqualP Type Type -- F a ~ Bool
777 deriving( Show, Eq, Data, Typeable )
778
779 data Strict = IsStrict | NotStrict
780 deriving( Show, Eq, Data, Typeable )
781
782 data Con = NormalC Name [StrictType] -- C Int a
783 | RecC Name [VarStrictType] -- C { v :: Int, w :: a }
784 | InfixC StrictType Name StrictType -- Int :+ a
785 | ForallC [TyVarBndr] Cxt Con -- forall a. Eq a => C [a]
786 deriving( Show, Eq, Data, Typeable )
787
788 type StrictType = (Strict, Type)
789 type VarStrictType = (Name, Strict, Type)
790
791 data Type = ForallT [TyVarBndr] Cxt Type -- forall <vars>. <ctxt> -> <type>
792 | VarT Name -- a
793 | ConT Name -- T
794 | TupleT Int -- (,), (,,), etc.
795 | ArrowT -- ->
796 | ListT -- []
797 | AppT Type Type -- T a b
798 | SigT Type Kind -- t :: k
799 deriving( Show, Eq, Data, Typeable )
800
801 data TyVarBndr = PlainTV Name -- a
802 | KindedTV Name Kind -- (a :: k)
803 deriving( Show, Eq, Data, Typeable )
804
805 data Kind = StarK -- '*'
806 | ArrowK Kind Kind -- k1 -> k2
807 deriving( Show, Eq, Data, Typeable )
808
809 -----------------------------------------------------
810 -- Internal helper functions
811 -----------------------------------------------------
812
813 cmpEq :: Ordering -> Bool
814 cmpEq EQ = True
815 cmpEq _ = False
816
817 thenCmp :: Ordering -> Ordering -> Ordering
818 thenCmp EQ o2 = o2
819 thenCmp o1 _ = o1
820