Support code for quasi-quotation feature
authorsimonpj@microsoft.com <unknown>
Fri, 18 Jan 2008 15:10:16 +0000 (15:10 +0000)
committersimonpj@microsoft.com <unknown>
Fri, 18 Jan 2008 15:10:16 +0000 (15:10 +0000)
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.

libraries/template-haskell/Language/Haskell/TH.hs
libraries/template-haskell/Language/Haskell/TH/Quasi.hs [new file with mode: 0644]
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
libraries/template-haskell/template-haskell.cabal

index 16ef073..b3a83ff 100644 (file)
@@ -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 (file)
index 0000000..6027177
--- /dev/null
@@ -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
index 1258ffe..a63d77b 100644 (file)
@@ -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
+
 
 -----------------------------------------------------
 --
index e4de59d..2dfef4b 100644 (file)
@@ -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.