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
d_class = [d| class Classy a b where
......
-- test reification of data declarations
module TH_reifyDecl1
where
module TH_reifyDecl1 where
import Language.Haskell.THSyntax
import Language.Haskell.TH
import Text.PrettyPrint.HughesPJ
infixl 3 `m`
-- simple
data T = A | B
decl_T :: DecQ
decl_T = reifyDecl T
-- parametric
data R a = C a | D
decl_R :: DecQ
decl_R = reifyDecl R
-- recursive
data List a = Nil | Cons a (List a)
decl_List :: DecQ
decl_List = reifyDecl List
-- infix operator
data Tree a = Leaf | Tree a :+: Tree a
decl_Tree :: DecQ
decl_Tree = reifyDecl Tree
-- type declaration
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 @@
module TH_reifyType1
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
foo :: Int -> Int
foo x = x + 1
type_foo :: TypeQ
type_foo = reifyType foo
type_foo :: InfoQ
type_foo = reify 'foo
......@@ -3,7 +3,7 @@
module TH_reifyType1
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
type_length :: TypeQ
type_length = reifyType length
type_length :: InfoQ
type_length = reify 'length
......@@ -3,7 +3,7 @@
module TH_repE1
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
integralExpr :: ExpQ
integralExpr = [| 42 |]
......
......@@ -3,7 +3,7 @@
module Main
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
main :: IO ()
main = mapM_ putStrLn [show an_integral, show an_int, show an_integer,
......
......@@ -3,7 +3,7 @@
module TH_repE1
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
emptyListExpr :: ExpQ
emptyListExpr = [| [] |]
......
{-# OPTIONS -fglasgow-exts #-}
-- test the representation of unboxed literals
module Main
where
module Main where
import GHC.Base
import GHC.Float
import Language.Haskell.THSyntax
import Language.Haskell.TH
import Text.PrettyPrint
import System.IO
main :: IO ()
main = do putStrLn $ show $ $( do e <- [| I# 20# |]
qIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout
runIO $ putStrLn $ show e
runIO $ putStrLn $ render $ pprExp e
runIO $ hFlush stdout
return e )
putStrLn $ show $ $( do e <- [| F# 12.3# |]
qIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout
runIO $ putStrLn $ show e
runIO $ putStrLn $ render $ pprExp e
runIO $ hFlush stdout
return e )
putStrLn $ show $ $( do e <- [| D# 24.6## |]
qIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout
runIO $ putStrLn $ show e
runIO $ putStrLn $ render $ pprExp e
runIO $ hFlush stdout
return e )
AppE (ConE "GHC.Base:I#") (LitE (IntPrimL 20))
GHC.Base:I# 20#
AppE (ConE "GHC.Float:F#") (LitE (FloatPrimL (123 % 10)))
GHC.Float:F# 12.3#
AppE (ConE "GHC.Float:D#") (LitE (DoublePrimL (123 % 5)))
GHC.Float:D# 24.6##
AppE (ConE GHC.Base.I#) (LitE (IntPrimL 20))
GHC.Base.I# 20#
AppE (ConE GHC.Float.F#) (LitE (FloatPrimL (123 % 10)))
GHC.Float.F# 12.3#
AppE (ConE GHC.Float.D#) (LitE (DoublePrimL (123 % 5)))
GHC.Float.D# 24.6##
Loading package base ... linking ... done.
Loading package haskell98 ... linking ... done.
Loading package haskell-src ... linking ... done.
......@@ -6,24 +6,16 @@ where
import GHC.Base
import GHC.Float
import Language.Haskell.THSyntax
import Language.Haskell.TH
import Text.PrettyPrint
import System.IO
main :: IO ()
main = do putStrLn $ show $ $( do e <- [| I# 20# |]
qIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout
return e )
putStrLn $ show $ $( do e <- [| F# 12.3# |]
qIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout
return e )
putStrLn $ show $ $( do e <- [| D# 24.6## |]
qIO $ putStrLn $ show e
qIO $ putStrLn $ render $ pprExp e
qIO $ hFlush stdout
return e )
......@@ -3,8 +3,8 @@
module TH_spliceDecl1
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
-- splice a simple data declaration
$(return [DataD [] "T" [] [NormalC "C" []] []])
$(return [DataD [] (mkName "T") [] [NormalC (mkName "C") []] []])
......@@ -3,10 +3,9 @@
module TH_spliceDecl2
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
-- splice a simple quoted declaration (x 2)
$([d| data T1 = C1 |])
$([d| newtype T2 = C2 String |])
......@@ -3,9 +3,9 @@
module TH_spliceDecl3
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
import TH_spliceDecl3_Lib
data T = C
$(do {d <- reifyDecl T; rename' d})
$(do { TyConI d <- reify ''T; rename' d})
module TH_spliceDecl3_Lib
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
rename' :: Dec -> Q [Dec]
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
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 @@
module TH_repE1
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
$( do let emptyListExpr :: ExpQ
emptyListExpr = [| [] |]
......
......@@ -3,7 +3,7 @@
module TH_spliceExpr1
where
import Language.Haskell.THSyntax
import Language.Haskell.TH
foo :: Int
foo = $( [| ((+) $ 2) $ 2 |] )
......
......@@ -7,14 +7,10 @@ setTestOpts(only_ways(['normal']));
test('TH_repE1', normal, compile, [''])
test('TH_repE2', normal, compile_and_run, [''])
test('TH_repE3', normal, compile, [''])
test('TH_spliceE3', normal, compile, [''])
test('TH_repPrim', normal, compile, [''])
test('TH_repPrimOutput', normal, compile_and_run, [''])
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_reifyType2', normal, compile, [''])
......@@ -23,7 +19,10 @@ test('TH_spliceDecl1', normal, compile, ['-v0'])
test('TH_spliceDecl2', normal, compile, ['-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_spliceE3', normal, compile, [''])
test('TH_spliceE4', normal, compile_and_run, [''])
test('TH_bracket1', 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