[Template-haskell] Using a Typ as a Type
Alastair Reid
alastair@reid-consulting-uk.ltd.uk
Wed, 3 Sep 2003 16:05:49 +0100
> Perhaps the thing to
> do is to give a simple but concrete example of what you'd like to do.
The following is a simplified version of what I tried to do in Template
Greencard.
-- a new class
class X a where
-- member parameterized on result type
f :: String -> a
-- member parameterized by argument type
ctype :: a -> String
-- instances for old types
instance X Int where
f = read
ctype _ = "HsInt" -- FFI-defined C type corresponding to Int
-- instances for freshly defined types
newtype T = T Int
deriving Show -- included to make the example work
instance X T where
f s = T (read s)
g (T x) = g x
generate :: String -> Q Typ -> Q [Dec]
generate nm typ = do
-- The next line contains the type splice.
-- Note that it is used to perform a compile-time dictionary
-- lookup not a runtime lookup.
-- I'm not wedded
let x = f "1" :: $typ
-- Generate C code (should be written to a file, not stdout)
-- Code generated depends on type argument
qIO (putStrLn (ctype x ++ " " ++ nm ++ " = " ++ show x ++ ";\n")
-- return a variable definition.
-- again, the definition returned depends on the type
-- because it uses 'x' which was produced as a result of
-- the compile-time dictionary lookup.
[d| $nm = $(literal x) |]
> Remember, the execution of TH program can be described by ordinary
> rewriting rules (replace the LHS of a function by the RHS of the
> function, suitably instantiated), augmented with the one extra rule
> $[| e |] = e
Should this apply to types as well?
--
Alastair