Syntax.hs 47.2 KB
Newer Older
1
{-# LANGUAGE CPP, DeriveDataTypeable, PolymorphicComponents,
2 3
             RoleAnnotations, DeriveGeneric, TypeSynonymInstances,
             FlexibleInstances #-}
4

5 6 7 8 9
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.Syntax
-- Copyright   :  (c) The University of Glasgow 2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
Jan Stolarek's avatar
Jan Stolarek committed
10
--
11 12 13 14 15 16 17 18
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- Abstract syntax definitions for Template Haskell.
--
-----------------------------------------------------------------------------

19
module Language.Haskell.TH.Syntax where
20

21
import Data.Data (Data(..), Typeable )
22
#if __GLASGOW_HASKELL__ < 709
23
import Control.Applicative( Applicative(..) )
24
#endif
25
import Data.IORef
26
import System.IO.Unsafe ( unsafePerformIO )
27
import Control.Monad (liftM)
28
import System.IO        ( hPutStrLn, stderr )
29
import Data.Char        ( isAlpha, isAlphaNum, isUpper )
reinerp's avatar
reinerp committed
30
import Data.Word        ( Word8 )
31
import GHC.Generics     ( Generic )
32 33 34

-----------------------------------------------------
--
35
--              The Quasi class
36 37 38
--
-----------------------------------------------------

39
class (Monad m, Applicative m) => Quasi m where
40
  qNewName :: String -> m Name
41
        -- ^ Fresh names
42

43 44 45
        -- Error reporting and recovery
  qReport  :: Bool -> String -> m ()    -- ^ Report an error (True) or warning (False)
                                        -- ...but carry on; use 'fail' to stop
aavogt's avatar
aavogt committed
46 47
  qRecover :: m a -- ^ the error handler
           -> m a -- ^ action which may fail
48
           -> m a               -- ^ Recover from the monadic 'fail'
Jan Stolarek's avatar
Jan Stolarek committed
49

50
        -- Inspect the type-checker's environment
51 52 53 54 55
  qLookupName :: Bool -> String -> m (Maybe Name)
       -- True <=> type namespace, False <=> value namespace
  qReify          :: Name -> m Info
  qReifyInstances :: Name -> [Type] -> m [Dec]
       -- Is (n tys) an instance?
Jan Stolarek's avatar
Jan Stolarek committed
56
       -- Returns list of matching instance Decs
57 58
       --    (with empty sub-Decs)
       -- Works for classes and type functions
Austin Seipp's avatar
Austin Seipp committed
59 60
  qReifyRoles       :: Name -> m [Role]
  qReifyAnnotations :: Data a => AnnLookup -> m [a]
61
  qReifyModule      :: Module -> m ModuleInfo
62

63
  qLocation :: m Loc
64 65

  qRunIO :: IO a -> m a
aavogt's avatar
aavogt committed
66
  -- ^ Input/output (dangerous)
67

GregWeber's avatar
GregWeber committed
68
  qAddDependentFile :: FilePath -> m ()
69

70 71
  qAddTopDecls :: [Dec] -> m ()

72 73
  qAddModFinalizer :: Q () -> m ()

gmainland's avatar
gmainland committed
74 75 76 77
  qGetQ :: Typeable a => m (Maybe a)

  qPutQ :: Typeable a => a -> m ()

78
-----------------------------------------------------
79
--      The IO instance of Quasi
Jan Stolarek's avatar
Jan Stolarek committed
80
--
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
--  This instance is used only when running a Q
--  computation in the IO monad, usually just to
--  print the result.  There is no interesting
--  type environment, so reification isn't going to
--  work.
--
-----------------------------------------------------

instance Quasi IO where
  qNewName s = do { n <- readIORef counter
                 ; writeIORef counter (n+1)
                 ; return (mkNameU s n) }

  qReport True  msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
  qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)

97
  qLookupName _ _     = badIO "lookupName"
98
  qReify _            = badIO "reify"
99
  qReifyInstances _ _ = badIO "reifyInstances"
100
  qReifyRoles _       = badIO "reifyRoles"
Austin Seipp's avatar
Austin Seipp committed
101
  qReifyAnnotations _ = badIO "reifyAnnotations"
102
  qReifyModule _      = badIO "reifyModule"
103 104
  qLocation           = badIO "currentLocation"
  qRecover _ _        = badIO "recover" -- Maybe we could fix this?
GregWeber's avatar
GregWeber committed
105
  qAddDependentFile _ = badIO "addDependentFile"
106
  qAddTopDecls _      = badIO "addTopDecls"
107
  qAddModFinalizer _  = badIO "addModFinalizer"
gmainland's avatar
gmainland committed
108 109
  qGetQ               = badIO "getQ"
  qPutQ _             = badIO "putQ"
110 111

  qRunIO m = m
Jan Stolarek's avatar
Jan Stolarek committed
112

113
badIO :: String -> IO a
114 115
badIO op = do   { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
                ; fail "Template Haskell failure" }
116 117 118 119 120 121 122 123 124

-- Global variable to generate unique symbols
counter :: IORef Int
{-# NOINLINE counter #-}
counter = unsafePerformIO (newIORef 0)


-----------------------------------------------------
--
125
--              The Q monad
126 127 128 129 130
--
-----------------------------------------------------

newtype Q a = Q { unQ :: forall m. Quasi m => m a }

131 132 133 134 135
-- \"Runs\" the 'Q' monad. Normal users of Template Haskell
-- should not need this function, as the splice brackets @$( ... )@
-- are the usual way of running a 'Q' computation.
--
-- This function is primarily used in GHC internals, and for debugging
Jan Stolarek's avatar
Jan Stolarek committed
136
-- splices by running them in 'IO'.
137 138 139 140 141
--
-- Note that many functions in 'Q', such as 'reify' and other compiler
-- queries, are not supported when running 'Q' in 'IO'; these operations
-- simply fail at runtime. Indeed, the only operations guaranteed to succeed
-- are 'newName', 'runIO', 'reportError' and 'reportWarning'.
142 143 144 145 146 147 148
runQ :: Quasi m => Q a -> m a
runQ (Q m) = m

instance Monad Q where
  return x   = Q (return x)
  Q m >>= k  = Q (m >>= \x -> unQ (k x))
  Q m >> Q n = Q (m >> n)
149
  fail s     = report True s >> Q (fail "Q monad failure")
150

151 152 153
instance Functor Q where
  fmap f (Q x) = Q (fmap f x)

Jan Stolarek's avatar
Jan Stolarek committed
154 155 156
instance Applicative Q where
  pure x = Q (pure x)
  Q f <*> Q x = Q (f <*> x)
157

gmainland's avatar
gmainland committed
158 159
-----------------------------------------------------
--
160
--              The TExp type
gmainland's avatar
gmainland committed
161 162 163
--
-----------------------------------------------------

164
type role TExp nominal   -- See Note [Role of TExp]
165 166 167 168 169 170 171 172 173
newtype TExp a = TExp { unType :: Exp }

unTypeQ :: Q (TExp a) -> Q Exp
unTypeQ m = do { TExp e <- m
               ; return e }

unsafeTExpCoerce :: Q Exp -> Q (TExp a)
unsafeTExpCoerce m = do { e <- m
                        ; return (TExp e) }
gmainland's avatar
gmainland committed
174

175 176 177 178 179 180 181 182 183 184 185 186 187
{- Note [Role of TExp]
~~~~~~~~~~~~~~~~~~~~~~
TExp's argument must have a nominal role, not phantom as would
be inferred (Trac #8459).  Consider

  e :: TExp Age
  e = MkAge 3

  foo = $(coerce e) + 4::Int

The splice will evaluate to (MkAge 3) and you can't add that to
4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}

188 189
----------------------------------------------------
-- Packaged versions for the programmer, hiding the Quasi-ness
190

Jan Stolarek's avatar
Jan Stolarek committed
191 192
{- |
Generate a fresh name, which cannot be captured.
193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224

For example, this:

@f = $(do
  nm1 <- newName \"x\"
  let nm2 = 'mkName' \"x\"
  return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
 )@

will produce the splice

>f = \x0 -> \x -> x0

In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
and is not captured by the binding @VarP nm2@.

Although names generated by @newName@ cannot /be captured/, they can
/capture/ other names. For example, this:

>g = $(do
>  nm1 <- newName "x"
>  let nm2 = mkName "x"
>  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
> )

will produce the splice

>g = \x -> \x0 -> x0

since the occurrence @VarE nm2@ is captured by the innermost binding
of @x@, namely @VarP nm1@.
-}
225 226 227
newName :: String -> Q Name
newName s = Q (qNewName s)

Jan Stolarek's avatar
Jan Stolarek committed
228
-- | Report an error (True) or warning (False),
229
-- but carry on; use 'fail' to stop.
230 231
report  :: Bool -> String -> Q ()
report b s = Q (qReport b s)
232
{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -- deprecated in 7.6
233 234 235 236 237 238 239 240

-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.
reportError :: String -> Q ()
reportError = report True

-- | Report a warning to the user, and carry on.
reportWarning :: String -> Q ()
reportWarning = report False
241

242 243 244
-- | Recover from errors raised by 'reportError' or 'fail'.
recover :: Q a -- ^ handler to invoke on failure
        -> Q a -- ^ computation to run
aavogt's avatar
aavogt committed
245
        -> Q a
246 247
recover (Q r) (Q m) = Q (qRecover r m)

248 249 250 251 252
-- We don't export lookupName; the Bool isn't a great API
-- Instead we export lookupTypeName, lookupValueName
lookupName :: Bool -> String -> Q (Maybe Name)
lookupName ns s = Q (qLookupName ns s)

253 254
-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
lookupTypeName :: String -> Q (Maybe Name)
255
lookupTypeName  s = Q (qLookupName True s)
256 257 258

-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.
lookupValueName :: String -> Q (Maybe Name)
259 260
lookupValueName s = Q (qLookupName False s)

261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276
{-
Note [Name lookup]
~~~~~~~~~~~~~~~~~~
-}
{- $namelookup #namelookup#
The functions 'lookupTypeName' and 'lookupValueName' provide
a way to query the current splice's context for what names
are in scope. The function 'lookupTypeName' queries the type
namespace, whereas 'lookupValueName' queries the value namespace,
but the functions are otherwise identical.

A call @lookupValueName s@ will check if there is a value
with name @s@ in scope at the current splice's location. If
there is, the @Name@ of this value is returned;
if not, then @Nothing@ is returned.

Jan Stolarek's avatar
Jan Stolarek committed
277
The returned name cannot be \"captured\".
278 279 280 281 282 283 284 285 286 287 288 289 290 291 292
For example:

> f = "global"
> g = $( do
>          Just nm <- lookupValueName "f"
>          [| let f = "local" in $( varE nm ) |]

In this case, @g = \"global\"@; the call to @lookupValueName@
returned the global @f@, and this name was /not/ captured by
the local definition of @f@.

The lookup is performed in the context of the /top-level/ splice
being run. For example:

> f = "global"
Jan Stolarek's avatar
Jan Stolarek committed
293
> g = $( [| let f = "local" in
294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329
>            $(do
>                Just nm <- lookupValueName "f"
>                varE nm
>             ) |] )

Again in this example, @g = \"global\"@, because the call to
@lookupValueName@ queries the context of the outer-most @$(...)@.

Operators should be queried without any surrounding parentheses, like so:

> lookupValueName "+"

Qualified names are also supported, like so:

> lookupValueName "Prelude.+"
> lookupValueName "Prelude.map"

-}


{- | 'reify' looks up information about the 'Name'.

It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'
to ensure that we are reifying from the right namespace. For instance, in this context:

> data D = D

which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)
To ensure we get information about @D@-the-value, use 'lookupValueName':

> do
>   Just nm <- lookupValueName "D"
>   reify nm

and to get information about @D@-the-type, use 'lookupTypeName'.
-}
330 331 332
reify :: Name -> Q Info
reify v = Q (qReify v)

Jan Stolarek's avatar
Jan Stolarek committed
333
{- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is,
334 335 336 337 338
if @nm@ is the name of a type class, then all instances of this class at the types @tys@
are returned. Alternatively, if @nm@ is the name of a data family or type family,
all instances of this family at the types @tys@ are returned.
-}
reifyInstances :: Name -> [Type] -> Q [InstanceDec]
339
reifyInstances cls tys = Q (qReifyInstances cls tys)
340

341 342 343 344 345 346 347
{- | @reifyRoles nm@ returns the list of roles associated with the parameters of
the tycon @nm@. Fails if @nm@ cannot be found or is not a tycon.
The returned list should never contain 'InferR'.
-}
reifyRoles :: Name -> Q [Role]
reifyRoles nm = Q (qReifyRoles nm)

Austin Seipp's avatar
Austin Seipp committed
348 349 350 351 352 353 354
-- | @reifyAnnotations target@ returns the list of annotations
-- associated with @target@.  Only the annotations that are
-- appropriately typed is returned.  So if you have @Int@ and @String@
-- annotations for the same target, you have to call this function twice.
reifyAnnotations :: Data a => AnnLookup -> Q [a]
reifyAnnotations an = Q (qReifyAnnotations an)

355 356 357 358 359 360
-- | @reifyModule mod@ looks up information about module @mod@.  To
-- look up the current module, call this function with the return
-- value of @thisModule@.
reifyModule :: Module -> Q ModuleInfo
reifyModule m = Q (qReifyModule m)

361
-- | Is the list of instances returned by 'reifyInstances' nonempty?
362 363 364
isInstance :: Name -> [Type] -> Q Bool
isInstance nm tys = do { decs <- reifyInstances nm tys
                       ; return (not (null decs)) }
365

366
-- | The location at which this computation is spliced.
367 368
location :: Q Loc
location = Q qLocation
369

dons's avatar
dons committed
370
-- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
Jan Stolarek's avatar
Jan Stolarek committed
371 372
-- Take care: you are guaranteed the ordering of calls to 'runIO' within
-- a single 'Q' computation, but not about the order in which splices are run.
373
--
Jan Stolarek's avatar
Jan Stolarek committed
374
-- Note: for various murky reasons, stdout and stderr handles are not
Gabor Greif's avatar
Gabor Greif committed
375
-- necessarily flushed when the compiler finishes running, so you should
376
-- flush them yourself.
377 378 379
runIO :: IO a -> Q a
runIO m = Q (qRunIO m)

GregWeber's avatar
GregWeber committed
380
-- | Record external files that runIO is using (dependent upon).
381 382 383
-- The compiler can then recognize that it should re-compile the Haskell file
-- when an external file changes.
--
GregWeber's avatar
GregWeber committed
384
-- Expects an absolute file path.
385 386 387 388 389 390
--
-- Notes:
--
--   * ghc -M does not know about these dependencies - it does not execute TH.
--
--   * The dependency is based on file content, not a modification time
GregWeber's avatar
GregWeber committed
391 392 393
addDependentFile :: FilePath -> Q ()
addDependentFile fp = Q (qAddDependentFile fp)

394 395 396 397 398
-- | Add additional top-level declarations. The added declarations will be type
-- checked along with the current declaration group.
addTopDecls :: [Dec] -> Q ()
addTopDecls ds = Q (qAddTopDecls ds)

399 400 401 402 403
-- | Add a finalizer that will run in the Q monad after the current module has
-- been type checked. This only makes sense when run within a top-level splice.
addModFinalizer :: Q () -> Q ()
addModFinalizer act = Q (qAddModFinalizer (unQ act))

gmainland's avatar
gmainland committed
404 405 406 407 408 409 410 411
-- | Get state from the Q monad.
getQ :: Typeable a => Q (Maybe a)
getQ = Q qGetQ

-- | Replace the state in the Q monad.
putQ :: Typeable a => a -> Q ()
putQ x = Q (qPutQ x)

412
instance Quasi Q where
413 414 415 416
  qNewName          = newName
  qReport           = report
  qRecover          = recover
  qReify            = reify
GregWeber's avatar
GregWeber committed
417
  qReifyInstances   = reifyInstances
418
  qReifyRoles       = reifyRoles
Austin Seipp's avatar
Austin Seipp committed
419
  qReifyAnnotations = reifyAnnotations
420
  qReifyModule      = reifyModule
GregWeber's avatar
GregWeber committed
421
  qLookupName       = lookupName
422 423
  qLocation         = location
  qRunIO            = runIO
GregWeber's avatar
GregWeber committed
424
  qAddDependentFile = addDependentFile
425
  qAddTopDecls      = addTopDecls
426
  qAddModFinalizer  = addModFinalizer
gmainland's avatar
gmainland committed
427 428
  qGetQ             = getQ
  qPutQ             = putQ
429 430 431 432


----------------------------------------------------
-- The following operations are used solely in DsMeta when desugaring brackets
433
-- They are not necessary for the user, who can use ordinary return and (>>=) etc
434 435 436 437 438 439 440 441 442 443 444 445 446

returnQ :: a -> Q a
returnQ = return

bindQ :: Q a -> (a -> Q b) -> Q b
bindQ = (>>=)

sequenceQ :: [Q a] -> Q [a]
sequenceQ = sequence


-----------------------------------------------------
--
447
--              The Lift class
448 449 450 451 452
--
-----------------------------------------------------

class Lift t where
  lift :: t -> Q Exp
Jan Stolarek's avatar
Jan Stolarek committed
453

454 455 456 457
instance Lift Integer where
  lift x = return (LitE (IntegerL x))

instance Lift Int where
458 459 460 461
  lift x = return (LitE (IntegerL (fromIntegral x)))

instance Lift Rational where
  lift x = return (LitE (RationalL x))
462 463 464 465 466 467 468 469

instance Lift Char where
  lift x = return (LitE (CharL x))

instance Lift Bool where
  lift True  = return (ConE trueName)
  lift False = return (ConE falseName)

470 471 472 473 474 475 476 477
instance Lift a => Lift (Maybe a) where
  lift Nothing  = return (ConE nothingName)
  lift (Just x) = liftM (ConE justName `AppE`) (lift x)

instance (Lift a, Lift b) => Lift (Either a b) where
  lift (Left x)  = liftM (ConE leftName  `AppE`) (lift x)
  lift (Right y) = liftM (ConE rightName `AppE`) (lift y)

478 479 480
instance Lift a => Lift [a] where
  lift xs = do { xs' <- mapM lift xs; return (ListE xs') }

481 482 483 484
liftString :: String -> Q Exp
-- Used in TcExpr to short-circuit the lifting for strings
liftString s = return (LitE (StringL s))

485 486 487
instance Lift () where
  lift () = return (ConE (tupleDataName 0))

488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514
instance (Lift a, Lift b) => Lift (a, b) where
  lift (a, b)
    = liftM TupE $ sequence [lift a, lift b]

instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
  lift (a, b, c)
    = liftM TupE $ sequence [lift a, lift b, lift c]

instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
  lift (a, b, c, d)
    = liftM TupE $ sequence [lift a, lift b, lift c, lift d]

instance (Lift a, Lift b, Lift c, Lift d, Lift e)
      => Lift (a, b, c, d, e) where
  lift (a, b, c, d, e)
    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e]

instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
      => Lift (a, b, c, d, e, f) where
  lift (a, b, c, d, e, f)
    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f]

instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
      => Lift (a, b, c, d, e, f, g) where
  lift (a, b, c, d, e, f, g)
    = liftM TupE $ sequence [lift a, lift b, lift c, lift d, lift e, lift f, lift g]

515 516 517 518
-- TH has a special form for literal strings,
-- which we should take advantage of.
-- NB: the lhs of the rule has no args, so that
--     the rule will apply to a 'lift' all on its own
Jan Stolarek's avatar
Jan Stolarek committed
519
--     which happens to be the way the type checker
520 521 522 523 524
--     creates it.
{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}


trueName, falseName :: Name
Ian Lynagh's avatar
Ian Lynagh committed
525 526
trueName  = mkNameG DataName "ghc-prim" "GHC.Types" "True"
falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False"
527

528
nothingName, justName :: Name
529 530
nothingName = mkNameG DataName "base" "GHC.Base" "Nothing"
justName    = mkNameG DataName "base" "GHC.Base" "Just"
531 532 533 534 535

leftName, rightName :: Name
leftName  = mkNameG DataName "base" "Data.Either" "Left"
rightName = mkNameG DataName "base" "Data.Either" "Right"

536 537

-----------------------------------------------------
538
--              Names and uniques
539 540
-----------------------------------------------------

541
newtype ModName = ModName String        -- Module name
542
 deriving (Show,Eq,Ord,Typeable,Data,Generic)
543

544
newtype PkgName = PkgName String        -- package name
545
 deriving (Show,Eq,Ord,Typeable,Data,Generic)
546

547 548
-- | Obtained from 'reifyModule' and 'thisModule'.
data Module = Module PkgName ModName -- package qualified module name
549
 deriving (Show,Eq,Ord,Typeable,Data,Generic)
550

551
newtype OccName = OccName String
552
 deriving (Show,Eq,Ord,Typeable,Data,Generic)
553

554
mkModName :: String -> ModName
555
mkModName s = ModName s
556 557

modString :: ModName -> String
558
modString (ModName m) = m
559

560 561

mkPkgName :: String -> PkgName
562
mkPkgName s = PkgName s
563 564

pkgString :: PkgName -> String
565
pkgString (PkgName m) = m
566 567


568
-----------------------------------------------------
569
--              OccName
570 571 572
-----------------------------------------------------

mkOccName :: String -> OccName
573
mkOccName s = OccName s
574 575

occString :: OccName -> String
576
occString (OccName occ) = occ
577 578 579


-----------------------------------------------------
580
--               Names
581
-----------------------------------------------------
Jan Stolarek's avatar
Jan Stolarek committed
582
--
aavogt's avatar
aavogt committed
583
-- For "global" names ('NameG') we need a totally unique name,
584 585
-- so we must include the name-space of the thing
--
aavogt's avatar
aavogt committed
586
-- For unique-numbered things ('NameU'), we've got a unique reference
587 588
-- anyway, so no need for name space
--
aavogt's avatar
aavogt committed
589
-- For dynamically bound thing ('NameS') we probably want them to
590 591
-- in a context-dependent way, so again we don't want the name
-- space.  For example:
aavogt's avatar
aavogt committed
592 593 594
--
-- > let v = mkName "T" in [| data $v = $v |]
--
595
-- Here we use the same Name for both type constructor and data constructor
aavogt's avatar
aavogt committed
596 597 598 599 600 601 602 603 604 605
--
--
-- NameL and NameG are bound *outside* the TH syntax tree
-- either globally (NameG) or locally (NameL). Ex:
--
-- > f x = $(h [| (map, x) |])
--
-- The 'map' will be a NameG, and 'x' wil be a NameL
--
-- These Names should never appear in a binding position in a TH syntax tree
606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630

{- $namecapture #namecapture#
Much of 'Name' API is concerned with the problem of /name capture/, which
can be seen in the following example.

> f expr = [| let x = 0 in $expr |]
> ...
> g x = $( f [| x |] )
> h y = $( f [| y |] )

A naive desugaring of this would yield:

> g x = let x = 0 in x
> h y = let x = 0 in y

All of a sudden, @g@ and @h@ have different meanings! In this case,
we say that the @x@ in the RHS of @g@ has been /captured/
by the binding of @x@ in @f@.

What we actually want is for the @x@ in @f@ to be distinct from the
@x@ in @g@, so we get the following desugaring:

> g x = let x' = 0 in x
> h y = let x' = 0 in y

Jan Stolarek's avatar
Jan Stolarek committed
631
which avoids name capture as desired.
632 633 634 635 636 637 638 639 640 641 642 643

In the general case, we say that a @Name@ can be captured if
the thing it refers to can be changed by adding new declarations.
-}

{- |
An abstract type representing names in the syntax tree.

'Name's can be constructed in several ways, which come with different
name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for
an explanation of name capture):

Jan Stolarek's avatar
Jan Stolarek committed
644 645
  * the built-in syntax @'f@ and @''T@ can be used to construct names,
    The expression @'f@ gives a @Name@ which refers to the value @f@
646 647
    currently in scope, and @''T@ gives a @Name@ which refers to the
    type @T@ currently in scope. These names can never be captured.
Jan Stolarek's avatar
Jan Stolarek committed
648 649

  * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and
650 651 652 653 654 655
     @''T@ respectively, but the @Name@s are looked up at the point
     where the current splice is being run. These names can never be
     captured.

  * 'newName' monadically generates a new name, which can never
     be captured.
Jan Stolarek's avatar
Jan Stolarek committed
656

657 658 659 660 661 662
  * 'mkName' generates a capturable name.

Names constructed using @newName@ and @mkName@ may be used in bindings
(such as @let x = ...@ or @\x -> ...@), but names constructed using
@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.
-}
663
data Name = Name OccName NameFlavour deriving (Typeable, Data, Eq, Generic)
664 665 666 667 668

instance Ord Name where
    -- check if unique is different before looking at strings
  (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2)   `thenCmp`
                                        (o1 `compare` o2)
669 670

data NameFlavour
aavogt's avatar
aavogt committed
671 672
  = NameS           -- ^ An unqualified name; dynamically bound
  | NameQ ModName   -- ^ A qualified name; dynamically bound
673 674
  | NameU !Int      -- ^ A unique local name
  | NameL !Int      -- ^ Local name bound outside of the TH AST
aavogt's avatar
aavogt committed
675 676
  | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST:
                -- An original name (occurrences only, not binders)
677 678
                -- Need the namespace too to be sure which
                -- thing we are naming
679
  deriving ( Typeable, Data, Eq, Ord, Generic )
680

681 682 683 684
data NameSpace = VarName        -- ^ Variables
               | DataName       -- ^ Data constructors
               | TcClsName      -- ^ Type constructors and classes; Haskell has them
                                -- in the same name space for now.
685
               deriving( Eq, Ord, Data, Typeable, Generic )
686 687 688

type Uniq = Int

689
-- | The name without its module prefix
690 691 692
nameBase :: Name -> String
nameBase (Name occ _) = occString occ

693
-- | Module prefix of a name, if it exists
694
nameModule :: Name -> Maybe String
Ian Lynagh's avatar
Ian Lynagh committed
695
nameModule (Name _ (NameQ m))     = Just (modString m)
696
nameModule (Name _ (NameG _ _ m)) = Just (modString m)
Ian Lynagh's avatar
Ian Lynagh committed
697
nameModule _                      = Nothing
698

Jan Stolarek's avatar
Jan Stolarek committed
699
{- |
700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722
Generate a capturable name. Occurrences of such names will be
resolved according to the Haskell scoping rules at the occurrence
site.

For example:

> f = [| pi + $(varE (mkName "pi")) |]
> ...
> g = let pi = 3 in $f

In this case, @g@ is desugared to

> g = Prelude.pi + 3

Note that @mkName@ may be used with qualified names:

> mkName "Prelude.pi"

See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could
be rewritten using 'dyn' as

> f = [| pi + $(dyn "pi") |]
-}
723
mkName :: String -> Name
724
-- The string can have a '.', thus "Foo.baz",
725 726 727 728 729
-- giving a dynamically-bound qualified name,
-- in which case we want to generate a NameQ
--
-- Parse the string to see if it has a "." in it
-- so we know whether to generate a qualified or unqualified name
Jan Stolarek's avatar
Jan Stolarek committed
730
-- It's a bit tricky because we need to parse
aavogt's avatar
aavogt committed
731 732 733
--
-- > Foo.Baz.x   as    Qual Foo.Baz x
--
734 735 736 737 738
-- So we parse it from back to front
mkName str
  = split [] (reverse str)
  where
    split occ []        = Name (mkOccName occ) NameS
739 740 741 742 743 744 745 746 747 748
    split occ ('.':rev) | not (null occ)
                        , is_rev_mod_name rev
                        = Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
        -- The 'not (null occ)' guard ensures that
        --      mkName "&." = Name "&." NameS
        -- The 'is_rev_mod' guards ensure that
        --      mkName ".&" = Name ".&" NameS
        --      mkName "^.." = Name "^.." NameS      -- Trac #8633
        --      mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
        -- This rather bizarre case actually happened; (.&.) is in Data.Bits
749
    split occ (c:rev)   = split (c:occ) rev
750

751 752
    -- Recognises a reversed module name xA.yB.C,
    -- with at least one component,
753 754 755 756 757 758 759 760 761 762 763 764 765
    -- and each component looks like a module name
    --   (i.e. non-empty, starts with capital, all alpha)
    is_rev_mod_name rev_mod_str
      | (compt, rest) <- break (== '.') rev_mod_str
      , not (null compt), isUpper (last compt), all is_mod_char compt
      = case rest of
          []             -> True
          (_dot : rest') -> is_rev_mod_name rest'
      | otherwise
      = False

    is_mod_char c = isAlphaNum c || c == '_' || c == '\''

aavogt's avatar
aavogt committed
766 767
-- | Only used internally
mkNameU :: String -> Uniq -> Name
768
mkNameU s u = Name (mkOccName s) (NameU u)
769

aavogt's avatar
aavogt committed
770 771
-- | Only used internally
mkNameL :: String -> Uniq -> Name
772
mkNameL s u = Name (mkOccName s) (NameL u)
773

aavogt's avatar
aavogt committed
774 775 776
-- | Used for 'x etc, but not available to the programmer
mkNameG :: NameSpace -> String -> String -> String -> Name
mkNameG ns pkg modu occ
Ian Lynagh's avatar
Ian Lynagh committed
777
  = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu))
778

779
mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name
780 781 782 783
mkNameG_v  = mkNameG VarName
mkNameG_tc = mkNameG TcClsName
mkNameG_d  = mkNameG DataName

Ian Lynagh's avatar
Ian Lynagh committed
784 785 786 787 788 789 790 791 792 793 794 795 796 797 798
data NameIs = Alone | Applied | Infix

showName :: Name -> String
showName = showName' Alone

showName' :: NameIs -> Name -> String
showName' ni nm
 = case ni of
       Alone        -> nms
       Applied
        | pnam      -> nms
        | otherwise -> "(" ++ nms ++ ")"
       Infix
        | pnam      -> "`" ++ nms ++ "`"
        | otherwise -> nms
799
    where
800 801 802 803 804 805
        -- For now, we make the NameQ and NameG print the same, even though
        -- NameQ is a qualified name (so what it means depends on what the
        -- current scope is), and NameG is an original name (so its meaning
        -- should be independent of what's in scope.
        -- We may well want to distinguish them in the end.
        -- Ditto NameU and NameL
806
        nms = case nm of
Ian Lynagh's avatar
Ian Lynagh committed
807 808 809
                    Name occ NameS         -> occString occ
                    Name occ (NameQ m)     -> modString m ++ "." ++ occString occ
                    Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ
810 811
                    Name occ (NameU u)     -> occString occ ++ "_" ++ show u
                    Name occ (NameL u)     -> occString occ ++ "_" ++ show u
812 813 814

        pnam = classify nms

Ian Lynagh's avatar
Ian Lynagh committed
815 816
        -- True if we are function style, e.g. f, [], (,)
        -- False if we are operator style, e.g. +, :+
817
        classify "" = False -- shouldn't happen; . operator is handled below
Ian Lynagh's avatar
Ian Lynagh committed
818
        classify (x:xs) | isAlpha x || (x `elem` "_[]()") =
819 820 821 822
                            case dropWhile (/='.') xs of
                                  (_:xs') -> classify xs'
                                  []      -> True
                        | otherwise = False
823

824
instance Show Name where
Ian Lynagh's avatar
Ian Lynagh committed
825
  show = showName
826

827
-- Tuple data and type constructors
828 829 830 831
-- | Tuple data constructor
tupleDataName :: Int -> Name
-- | Tuple type constructor
tupleTypeName :: Int -> Name
832

833
tupleDataName 0 = mk_tup_name 0 DataName
834
tupleDataName 1 = error "tupleDataName 1"
835
tupleDataName n = mk_tup_name (n-1) DataName
836

837
tupleTypeName 0 = mk_tup_name 0 TcClsName
838
tupleTypeName 1 = error "tupleTypeName 1"
839
tupleTypeName n = mk_tup_name (n-1) TcClsName
840

Ian Lynagh's avatar
Ian Lynagh committed
841
mk_tup_name :: Int -> NameSpace -> Name
842
mk_tup_name n_commas space
Ian Lynagh's avatar
Ian Lynagh committed
843
  = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
844 845
  where
    occ = mkOccName ('(' : replicate n_commas ',' ++ ")")
Ian Lynagh's avatar
Ian Lynagh committed
846
    tup_mod = mkModName "GHC.Tuple"
847

848
-- Unboxed tuple data and type constructors
849 850 851 852
-- | Unboxed tuple data constructor
unboxedTupleDataName :: Int -> Name
-- | Unboxed tuple type constructor
unboxedTupleTypeName :: Int -> Name
853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868

unboxedTupleDataName 0 = error "unboxedTupleDataName 0"
unboxedTupleDataName 1 = error "unboxedTupleDataName 1"
unboxedTupleDataName n = mk_unboxed_tup_name (n-1) DataName

unboxedTupleTypeName 0 = error "unboxedTupleTypeName 0"
unboxedTupleTypeName 1 = error "unboxedTupleTypeName 1"
unboxedTupleTypeName n = mk_unboxed_tup_name (n-1) TcClsName

mk_unboxed_tup_name :: Int -> NameSpace -> Name
mk_unboxed_tup_name n_commas space
  = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
  where
    occ = mkOccName ("(#" ++ replicate n_commas ',' ++ "#)")
    tup_mod = mkModName "GHC.Tuple"

869

870

871
-----------------------------------------------------
872
--              Locations
873 874 875 876
-----------------------------------------------------

data Loc
  = Loc { loc_filename :: String
877 878 879 880
        , loc_package  :: String
        , loc_module   :: String
        , loc_start    :: CharPos
        , loc_end      :: CharPos }
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
881
   deriving( Show, Eq, Ord, Data, Typeable, Generic )
882

883
type CharPos = (Int, Int)       -- ^ Line and character position
884

885

886 887
-----------------------------------------------------
--
888
--      The Info returned by reification
889 890 891
--
-----------------------------------------------------

aavogt's avatar
aavogt committed
892 893
-- | Obtained from 'reify' in the 'Q' Monad.
data Info
Jan Stolarek's avatar
Jan Stolarek committed
894
  =
895
  -- | A class, with a list of its visible instances
Jan Stolarek's avatar
Jan Stolarek committed
896
  ClassI
897 898
      Dec
      [InstanceDec]
Jan Stolarek's avatar
Jan Stolarek committed
899

900
  -- | A class method
901
  | ClassOpI
902 903 904 905
       Name
       Type
       ParentName
       Fixity
Jan Stolarek's avatar
Jan Stolarek committed
906

907
  -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned using 'PrimTyConI' or 'FamilyI' as appropriate
Jan Stolarek's avatar
Jan Stolarek committed
908
  | TyConI
909 910
        Dec

911 912
  -- | A type or data family, with a list of its visible instances. A closed
  -- type family is returned with 0 instances.
Jan Stolarek's avatar
Jan Stolarek committed
913
  | FamilyI
914 915
        Dec
        [InstanceDec]
Jan Stolarek's avatar
Jan Stolarek committed
916

917
  -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'. Examples: @(->)@, @Int#@.
Jan Stolarek's avatar
Jan Stolarek committed
918
  | PrimTyConI
919 920 921
       Name
       Arity
       Unlifted
Jan Stolarek's avatar
Jan Stolarek committed
922

923
  -- | A data constructor
Jan Stolarek's avatar
Jan Stolarek committed
924
  | DataConI
925 926 927 928
       Name
       Type
       ParentName
       Fixity
929

Jan Stolarek's avatar
Jan Stolarek committed
930
  {- |
931
  A \"value\" variable (as opposed to a type variable, see 'TyVarI').
Jan Stolarek's avatar
Jan Stolarek committed
932 933 934

  The @Maybe Dec@ field contains @Just@ the declaration which
  defined the variable -- including the RHS of the declaration --
935 936 937 938 939
  or else @Nothing@, in the case where the RHS is unavailable to
  the compiler. At present, this value is _always_ @Nothing@:
  returning the RHS has not yet been implemented because of
  lack of interest.
  -}
Jan Stolarek's avatar
Jan Stolarek committed
940
  | VarI
941 942 943 944
       Name
       Type
       (Maybe Dec)
       Fixity
945

Jan Stolarek's avatar
Jan Stolarek committed
946
  {- |
947
  A type variable.
Jan Stolarek's avatar
Jan Stolarek committed
948

949 950 951 952
  The @Type@ field contains the type which underlies the variable.
  At present, this is always @'VarT' theName@, but future changes
  may permit refinement of this.
  -}
953 954 955
  | TyVarI      -- Scoped type variable
        Name
        Type    -- What it is bound to
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
956
  deriving( Show, Eq, Ord, Data, Typeable, Generic )
957

958 959 960 961
-- | Obtained from 'reifyModule' in the 'Q' Monad.
data ModuleInfo =
  -- | Contains the import list of the module.
  ModuleInfo [Module]
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
962
  deriving( Show, Eq, Ord, Data, Typeable, Generic )
963

Jan Stolarek's avatar
Jan Stolarek committed
964
{- |
965 966 967 968 969 970 971 972 973 974 975
In 'ClassOpI' and 'DataConI', name of the parent class or type
-}
type ParentName = Name

-- | In 'PrimTyConI', arity of the type constructor
type Arity = Int

-- | In 'PrimTyConI', is the type constructor unlifted?
type Unlifted = Bool

-- | 'InstanceDec' desribes a single instance of a class or type function.
976
-- It is just a 'Dec', but guaranteed to be one of the following:
977 978 979 980 981 982
--
--   * 'InstanceD' (with empty @['Dec']@)
--
--   * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)
--
--   * 'TySynInstD'
983
type InstanceDec = Dec
984

985
data Fixity          = Fixity Int FixityDirection
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
986
    deriving( Eq, Ord, Show, Data, Typeable, Generic )
987
data FixityDirection = InfixL | InfixR | InfixN
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
988
    deriving( Eq, Ord, Show, Data, Typeable, Generic )
989

990
-- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9)
991
maxPrecedence :: Int
992
maxPrecedence = (9::Int)
993

994
-- | Default fixity: @infixl 9@
995
defaultFixity :: Fixity