diff options
author | simonpj@microsoft.com <unknown> | 2008-01-18 15:10:16 +0000 |
---|---|---|
committer | simonpj@microsoft.com <unknown> | 2008-01-18 15:10:16 +0000 |
commit | 164d14e1fca14b09e1d435fced8c8ce3fcc1df81 (patch) | |
tree | 98d44731f26c8a64b7d7919bb444c6f411e75490 | |
parent | 6758b39fdb68c1b15de73fdaaf5a900cf0447fb7 (diff) | |
download | haskell-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.
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. |