Commit 5ed4d1e2 authored by simonpj's avatar simonpj

[project @ 2003-11-06 17:09:59 by simonpj]

------------------------------------
	Major increment for Template Haskell
	------------------------------------

1.  New abstract data type "Name" which appears where String used to be.
    E.g. 	data Exp = VarE Name | ...

2.  New syntax 'x and ''T, for quoting Names.  It's rather like [| x |]
    and [t| T |] respectively, except that

	a) it's non-monadic:  'x :: Name
	b) you get a Name not an Exp or Type

3.  reify is an ordinary function
	reify :: Name -> Q Info
    New data type Info which tells what TH knows about Name

4.  Local variables work properly.  So this works now (crashed before):
	f x = $( [| x |] )

5.  THSyntax is split up into three modules:

  Language.Haskell.TH		TH "clients" import this

  Language.Haskell.TH.THSyntax	data type declarations and internal stuff

  Language.Haskell.TH.THLib	Support library code (all re-exported
				by TH), including smart constructors and
				pretty printer

6.  Error reporting and recovery are in (not yet well tested)

	report :: Bool {- True <=> fatal -} -> String -> Q ()
	recover :: Q a -> Q a -> Q a

7.  Can find current module

	currentModule :: Q String


Much other cleaning up, needless to say.
parent efd7221c
{-# OPTIONS -fglasgow-exts #-}
module TH_bracket3 where module TH_bracket3 where
d_class = [d| class Classy a b where d_class = [d| class Classy a b where
......
-- test reification of data declarations -- test reification of data declarations
module TH_reifyDecl1 module TH_reifyDecl1 where
where
import Language.Haskell.THSyntax import Language.Haskell.TH
import Text.PrettyPrint.HughesPJ
infixl 3 `m`
-- simple -- simple
data T = A | B data T = A | B
decl_T :: DecQ
decl_T = reifyDecl T
-- parametric -- parametric
data R a = C a | D data R a = C a | D
decl_R :: DecQ
decl_R = reifyDecl R
-- recursive -- recursive
data List a = Nil | Cons a (List a) data List a = Nil | Cons a (List a)
decl_List :: DecQ
decl_List = reifyDecl List
-- infix operator -- infix operator
data Tree a = Leaf | Tree a :+: Tree a data Tree a = Leaf | Tree a :+: Tree a
decl_Tree :: DecQ -- type declaration
decl_Tree = reifyDecl Tree type IntList = [Int]
-- newtype declaration
newtype Length = Length Int
-- simple class
class C a where
m :: a -> Int
test :: ()
test = $(let
display :: Name -> Q ()
display q = do { i <- reify q; report False (render (pprInfo i)) }
in do { display ''T
; display ''R
; display ''List
; display ''Tree
; display ''IntList
; display ''Length
; display 'Leaf
; display 'm
; [| () |] })
TH_reifyDecl1.hs:33: data TH_reifyDecl1.T = TH_reifyDecl1.A | TH_reifyDecl1.B
TH_reifyDecl1.hs:33:
data TH_reifyDecl1.R a_1627393115 = TH_reifyDecl1.C a_1627393115
| TH_reifyDecl1.D
TH_reifyDecl1.hs:33:
data TH_reifyDecl1.List a_1627393111 = TH_reifyDecl1.Nil
| TH_reifyDecl1.Cons a_1627393111 TH_reifyDecl1.List a_1627393111
TH_reifyDecl1.hs:33:
data TH_reifyDecl1.Tree a_1627393107 = TH_reifyDecl1.Leaf
| TH_reifyDecl1.:+: TH_reifyDecl1.Tree a_1627393107 TH_reifyDecl1.Tree a_1627393107
TH_reifyDecl1.hs:33: type TH_reifyDecl1.IntList = GHC.Base.[] GHC.Base.Int
TH_reifyDecl1.hs:33:
newtype TH_reifyDecl1.Length = TH_reifyDecl1.Length GHC.Base.Int
TH_reifyDecl1.hs:33:
Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall a_1627393107 . TH_reifyDecl1.Tree a_1627393107
TH_reifyDecl1.hs:33:
Class op from TH_reifyDecl1.C: TH_reifyDecl1.m :: forall a_1627393101 . (TH_reifyDecl1.C a_1627393101) => a_1627393101 ->
GHC.Base.Int
infixl 3 TH_reifyDecl1.m
Loading package base ... linking ... done.
Loading package haskell98 ... linking ... done.
Loading package haskell-src ... linking ... done.
-- test reification of type synonym declarations
module TH_reifyDecl2
where
import Language.Haskell.THSyntax
-- type declaration
type IntList = [Int]
decl_IntList :: DecQ
decl_IntList = reifyDecl IntList
-- test reification of newtype declarations
module TH_reifyDecl3
where
import Language.Haskell.THSyntax
-- newtype declaration
newtype Length = Length Int
decl_Length :: DecQ
decl_Length = reifyDecl Length
-- test reification of class declarations
module TH_reifyDecl4
where
import Language.Haskell.THSyntax
-- simple class
class C a where
m :: a -> Int
decl_C :: DecQ
decl_C = reifyDecl C
...@@ -3,11 +3,11 @@ ...@@ -3,11 +3,11 @@
module TH_reifyType1 module TH_reifyType1
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
foo :: Int -> Int foo :: Int -> Int
foo x = x + 1 foo x = x + 1
type_foo :: TypeQ type_foo :: InfoQ
type_foo = reifyType foo type_foo = reify 'foo
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
module TH_reifyType1 module TH_reifyType1
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
type_length :: TypeQ type_length :: InfoQ
type_length = reifyType length type_length = reify 'length
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
module TH_repE1 module TH_repE1
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
integralExpr :: ExpQ integralExpr :: ExpQ
integralExpr = [| 42 |] integralExpr = [| 42 |]
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
module Main module Main
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
main :: IO () main :: IO ()
main = mapM_ putStrLn [show an_integral, show an_int, show an_integer, main = mapM_ putStrLn [show an_integral, show an_int, show an_integer,
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
module TH_repE1 module TH_repE1
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
emptyListExpr :: ExpQ emptyListExpr :: ExpQ
emptyListExpr = [| [] |] emptyListExpr = [| [] |]
......
{-# OPTIONS -fglasgow-exts #-} {-# OPTIONS -fglasgow-exts #-}
-- test the representation of unboxed literals -- test the representation of unboxed literals
module Main module Main where
where
import GHC.Base import GHC.Base
import GHC.Float import GHC.Float
import Language.Haskell.THSyntax import Language.Haskell.TH
import Text.PrettyPrint import Text.PrettyPrint
import System.IO import System.IO
main :: IO () main :: IO ()
main = do putStrLn $ show $ $( do e <- [| I# 20# |] main = do putStrLn $ show $ $( do e <- [| I# 20# |]
qIO $ putStrLn $ show e runIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e runIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout runIO $ hFlush stdout
return e ) return e )
putStrLn $ show $ $( do e <- [| F# 12.3# |] putStrLn $ show $ $( do e <- [| F# 12.3# |]
qIO $ putStrLn $ show e runIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e runIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout runIO $ hFlush stdout
return e ) return e )
putStrLn $ show $ $( do e <- [| D# 24.6## |] putStrLn $ show $ $( do e <- [| D# 24.6## |]
qIO $ putStrLn $ show e runIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e runIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout runIO $ hFlush stdout
return e ) return e )
AppE (ConE "GHC.Base:I#") (LitE (IntPrimL 20)) AppE (ConE GHC.Base.I#) (LitE (IntPrimL 20))
GHC.Base:I# 20# GHC.Base.I# 20#
AppE (ConE "GHC.Float:F#") (LitE (FloatPrimL (123 % 10))) AppE (ConE GHC.Float.F#) (LitE (FloatPrimL (123 % 10)))
GHC.Float:F# 12.3# GHC.Float.F# 12.3#
AppE (ConE "GHC.Float:D#") (LitE (DoublePrimL (123 % 5))) AppE (ConE GHC.Float.D#) (LitE (DoublePrimL (123 % 5)))
GHC.Float:D# 24.6## GHC.Float.D# 24.6##
Loading package base ... linking ... done. Loading package base ... linking ... done.
Loading package haskell98 ... linking ... done. Loading package haskell98 ... linking ... done.
Loading package haskell-src ... linking ... done. Loading package haskell-src ... linking ... done.
...@@ -6,24 +6,16 @@ where ...@@ -6,24 +6,16 @@ where
import GHC.Base import GHC.Base
import GHC.Float import GHC.Float
import Language.Haskell.THSyntax import Language.Haskell.TH
import Text.PrettyPrint import Text.PrettyPrint
import System.IO import System.IO
main :: IO () main :: IO ()
main = do putStrLn $ show $ $( do e <- [| I# 20# |] main = do putStrLn $ show $ $( do e <- [| I# 20# |]
qIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout
return e ) return e )
putStrLn $ show $ $( do e <- [| F# 12.3# |] putStrLn $ show $ $( do e <- [| F# 12.3# |]
qIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout
return e ) return e )
putStrLn $ show $ $( do e <- [| D# 24.6## |] putStrLn $ show $ $( do e <- [| D# 24.6## |]
qIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout
return e ) return e )
...@@ -3,8 +3,8 @@ ...@@ -3,8 +3,8 @@
module TH_spliceDecl1 module TH_spliceDecl1
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
-- splice a simple data declaration -- splice a simple data declaration
$(return [DataD [] "T" [] [NormalC "C" []] []]) $(return [DataD [] (mkName "T") [] [NormalC (mkName "C") []] []])
...@@ -3,10 +3,9 @@ ...@@ -3,10 +3,9 @@
module TH_spliceDecl2 module TH_spliceDecl2
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
-- splice a simple quoted declaration (x 2) -- splice a simple quoted declaration (x 2)
$([d| data T1 = C1 |]) $([d| data T1 = C1 |])
$([d| newtype T2 = C2 String |]) $([d| newtype T2 = C2 String |])
...@@ -3,9 +3,9 @@ ...@@ -3,9 +3,9 @@
module TH_spliceDecl3 module TH_spliceDecl3
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
import TH_spliceDecl3_Lib import TH_spliceDecl3_Lib
data T = C data T = C
$(do {d <- reifyDecl T; rename' d}) $(do { TyConI d <- reify ''T; rename' d})
module TH_spliceDecl3_Lib module TH_spliceDecl3_Lib
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
rename' :: Dec -> Q [Dec] rename' :: Dec -> Q [Dec]
rename' (DataD ctxt tyName tyvars cons derivs) = rename' (DataD ctxt tyName tyvars cons derivs) =
return [DataD ctxt (stripMod tyName ++ "'") tyvars (map renameCons cons) derivs] return [DataD ctxt (stripMod tyName) tyvars (map renameCons cons) derivs]
where where
renameCons (NormalC conName tys) = NormalC (stripMod conName ++ "'") tys renameCons (NormalC conName tys) = NormalC (stripMod conName) tys
-- --
stripMod = tail . snd . break (== ':') stripMod v = mkName (nameBase v ++ "'")
module Main where
my_id :: a -> a
my_id x = $( [| x |] )
main = print (my_id "hello")
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
module TH_repE1 module TH_repE1
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
$( do let emptyListExpr :: ExpQ $( do let emptyListExpr :: ExpQ
emptyListExpr = [| [] |] emptyListExpr = [| [] |]
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
module TH_spliceExpr1 module TH_spliceExpr1
where where
import Language.Haskell.THSyntax import Language.Haskell.TH
foo :: Int foo :: Int
foo = $( [| ((+) $ 2) $ 2 |] ) foo = $( [| ((+) $ 2) $ 2 |] )
......
...@@ -7,14 +7,10 @@ setTestOpts(only_ways(['normal'])); ...@@ -7,14 +7,10 @@ setTestOpts(only_ways(['normal']));
test('TH_repE1', normal, compile, ['']) test('TH_repE1', normal, compile, [''])
test('TH_repE2', normal, compile_and_run, ['']) test('TH_repE2', normal, compile_and_run, [''])
test('TH_repE3', normal, compile, ['']) test('TH_repE3', normal, compile, [''])
test('TH_spliceE3', normal, compile, [''])
test('TH_repPrim', normal, compile, ['']) test('TH_repPrim', normal, compile, [''])
test('TH_repPrimOutput', normal, compile_and_run, ['']) test('TH_repPrimOutput', normal, compile_and_run, [''])
test('TH_reifyDecl1', normal, compile, ['']) test('TH_reifyDecl1', normal, compile, [''])
test('TH_reifyDecl2', normal, compile, [''])
test('TH_reifyDecl3', normal, compile, [''])
test('TH_reifyDecl4', normal, compile, [''])
test('TH_reifyType1', normal, compile, ['']) test('TH_reifyType1', normal, compile, [''])
test('TH_reifyType2', normal, compile, ['']) test('TH_reifyType2', normal, compile, [''])
...@@ -23,7 +19,10 @@ test('TH_spliceDecl1', normal, compile, ['-v0']) ...@@ -23,7 +19,10 @@ test('TH_spliceDecl1', normal, compile, ['-v0'])
test('TH_spliceDecl2', normal, compile, ['-v0']) test('TH_spliceDecl2', normal, compile, ['-v0'])
test('TH_spliceDecl3', normal, multimod_compile, ['TH_spliceDecl3', '-v0']) test('TH_spliceDecl3', normal, multimod_compile, ['TH_spliceDecl3', '-v0'])
test('TH_spliceE1', normal, compile_and_run, [''])
test('TH_spliceExpr1', normal, compile, ['-v0']) test('TH_spliceExpr1', normal, compile, ['-v0'])
test('TH_spliceE3', normal, compile, [''])
test('TH_spliceE4', normal, compile_and_run, [''])
test('TH_bracket1', normal, compile, ['']) test('TH_bracket1', normal, compile, [''])
test('TH_bracket2', normal, compile, ['']) test('TH_bracket2', normal, compile, [''])
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment