summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsimonpj@microsoft.com <unknown>2008-01-18 15:10:16 +0000
committersimonpj@microsoft.com <unknown>2008-01-18 15:10:16 +0000
commit164d14e1fca14b09e1d435fced8c8ce3fcc1df81 (patch)
tree98d44731f26c8a64b7d7919bb444c6f411e75490
parent6758b39fdb68c1b15de73fdaaf5a900cf0447fb7 (diff)
downloadhaskell-164d14e1fca14b09e1d435fced8c8ce3fcc1df81.tar.gz
Support code for quasi-quotation feature
This patch supports the quasi-quotation feature. Here's the relevant parts from the message in the big compiler patch: Fri Jan 18 14:55:03 GMT 2008 simonpj@microsoft.com * Add quasi-quotation, courtesy of Geoffrey Mainland This patch adds quasi-quotation, as described in "Nice to be Quoted: Quasiquoting for Haskell" (Geoffrey Mainland, Haskell Workshop 2007) Implemented by Geoffrey and polished by Simon. ...snip... * There is an accompanying patch to the template-haskell library. This involves one interface change: currentModule :: Q String is replaced by location :: Q Loc where Loc is a data type defined in TH.Syntax thus: data Loc = Loc { loc_filename :: String , loc_package :: String , loc_module :: String , loc_start :: CharPos , loc_end :: CharPos } type CharPos = (Int, Int) -- Line and character position So you get a lot more info from 'location' than from 'currentModule'. The location you get is the location of the splice. This works in Template Haskell too of course, and lets a TH program generate much better error messages. * There's also a new module in the template-haskell package called Language.Haskell.TH.Quote, which contains support code for the quasi-quoting feature.
-rw-r--r--libraries/template-haskell/Language/Haskell/TH.hs12
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Quasi.hs62
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs45
-rw-r--r--libraries/template-haskell/template-haskell.cabal1
4 files changed, 98 insertions, 22 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs
index 16ef073e8b..b3a83ffe3c 100644
--- a/libraries/template-haskell/Language/Haskell/TH.hs
+++ b/libraries/template-haskell/Language/Haskell/TH.hs
@@ -3,11 +3,11 @@
module Language.Haskell.TH(
-- The monad and its operations
Q, runQ,
- report, -- :: Bool -> String -> Q ()
- recover, -- :: Q a -> Q a -> Q a
- reify, -- :: Name -> Q Info
- currentModule, -- :: Q String
- runIO, -- :: IO a -> Q a
+ report, -- :: Bool -> String -> Q ()
+ recover, -- :: Q a -> Q a -> Q a
+ reify, -- :: Name -> Q Info
+ location, -- :: Q Location
+ runIO, -- :: IO a -> Q a
-- Names
Name,
@@ -22,7 +22,7 @@ module Language.Haskell.TH(
Clause(..), Body(..), Guard(..), Stmt(..), Range(..),
Lit(..), Pat(..), FieldExp, FieldPat,
Strict(..), Foreign(..), Callconv(..), Safety(..), FunDep(..),
- Info(..),
+ Info(..), Loc(..),
Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
-- Library functions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Quasi.hs b/libraries/template-haskell/Language/Haskell/TH/Quasi.hs
new file mode 100644
index 0000000000..6027177d59
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Quasi.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
+module Language.Haskell.TH.Quasi(
+ QuasiQuoter(..),
+ dataToQa, dataToExpQ, dataToPatQ
+ ) where
+
+import Data.Generics
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Syntax
+
+data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp,
+ quotePat :: String -> Q Pat }
+
+dataToQa :: forall a k q. Data a
+ => (Name -> k)
+ -> (Lit -> Q q)
+ -> (k -> [Q q] -> Q q)
+ -> (forall a . Data a => a -> Maybe (Q q))
+ -> a
+ -> Q q
+dataToQa mkCon mkLit appCon antiQ t =
+ case antiQ t of
+ Nothing ->
+ case constrRep constr of
+ AlgConstr _ ->
+ appCon con conArgs
+ IntConstr n ->
+ mkLit $ integerL n
+ FloatConstr n ->
+ mkLit $ rationalL (toRational n)
+ StringConstr (c:_) ->
+ mkLit $ charL c
+ where
+ constr :: Constr
+ constr = toConstr t
+ constrName :: Constr -> String
+ constrName k =
+ case showConstr k of
+ "(:)" -> ":"
+ name -> name
+ con :: k
+ con = mkCon (mkName (constrName constr))
+ conArgs :: [Q q]
+ conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
+
+ Just y -> y
+
+-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the same
+-- value. It takes a function to handle type-specific cases.
+dataToExpQ :: Data a
+ => (forall a . Data a => a -> Maybe (Q Exp))
+ -> a
+ -> Q Exp
+dataToExpQ = dataToQa conE litE (foldl appE)
+
+-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
+-- value. It takes a function to handle type-specific cases.
+dataToPatQ :: Data a
+ => (forall a . Data a => a -> Maybe (Q Pat))
+ -> a
+ -> Q Pat
+dataToPatQ = dataToQa id litP conP
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 1258ffeda2..a63d77b173 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -26,11 +26,11 @@ module Language.Haskell.TH.Syntax(
Q, runQ,
report, recover, reify,
- currentModule, runIO,
+ location, runIO,
-- Names
Name(..), mkName, newName, nameBase, nameModule,
- showName, showName', NameIs(..),
+ showName, showName', NameIs(..),
-- The algebraic data types
Dec(..), Exp(..), Con(..), Type(..), Cxt, Match(..),
@@ -38,7 +38,7 @@ module Language.Haskell.TH.Syntax(
Lit(..), Pat(..), FieldExp, FieldPat,
Strict(..), Foreign(..), Callconv(..), Safety(..),
StrictType, VarStrictType, FunDep(..),
- Info(..),
+ Info(..), Loc(..), CharPos,
Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
-- Internal functions
@@ -80,7 +80,7 @@ class (Monad m, Functor m) => Quasi m where
-- Inspect the type-checker's environment
qReify :: Name -> m Info
- qCurrentModule :: m String
+ qLocation :: m Loc
-- Input/output (dangerous)
qRunIO :: IO a -> m a
@@ -105,9 +105,9 @@ instance Quasi IO where
qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)
- qReify v = badIO "reify"
- qCurrentModule = badIO "currentModule"
- qRecover a b = badIO "recover" -- Maybe we could fix this?
+ qReify v = badIO "reify"
+ qLocation = badIO "currentLocation"
+ qRecover a b = badIO "recover" -- Maybe we could fix this?
qRunIO m = m
@@ -156,10 +156,10 @@ recover (Q r) (Q m) = Q (qRecover r m)
reify :: Name -> Q Info
reify v = Q (qReify v)
--- | 'currentModule' gives you the name of the module in which this
+-- | 'location' gives you the 'Location' at which this
-- computation is spliced.
-currentModule :: Q String
-currentModule = Q qCurrentModule
+location :: Q Loc
+location = Q qLocation
-- |The 'runIO' function lets you run an I\/O computation in the 'Q' monad.
-- Take care: you are guaranteed the ordering of calls to 'runIO' within
@@ -172,12 +172,12 @@ runIO :: IO a -> Q a
runIO m = Q (qRunIO m)
instance Quasi Q where
- qNewName = newName
- qReport = report
- qRecover = recover
- qReify = reify
- qCurrentModule = currentModule
- qRunIO = runIO
+ qNewName = newName
+ qReport = report
+ qRecover = recover
+ qReify = reify
+ qLocation = location
+ qRunIO = runIO
----------------------------------------------------
@@ -524,6 +524,19 @@ mk_tup_name n_commas space
+-----------------------------------------------------
+-- Locations
+-----------------------------------------------------
+
+data Loc
+ = Loc { loc_filename :: String
+ , loc_package :: String
+ , loc_module :: String
+ , loc_start :: CharPos
+ , loc_end :: CharPos }
+
+type CharPos = (Int, Int) -- Line and character position
+
-----------------------------------------------------
--
diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal
index e4de59dad5..2dfef4b873 100644
--- a/libraries/template-haskell/template-haskell.cabal
+++ b/libraries/template-haskell/template-haskell.cabal
@@ -12,6 +12,7 @@ exposed-modules:
Language.Haskell.TH.PprLib,
Language.Haskell.TH.Ppr,
Language.Haskell.TH.Lib,
+ Language.Haskell.TH.Quote,
Language.Haskell.TH
-- We need to set the package name to template-haskell (without a
-- version number) as it's magic.