[Template-haskell] Record constructors
Simon Peyton-Jones
simonpj@microsoft.com
Fri, 14 Feb 2003 10:18:31 -0000
Good point. Indeed, THSyntax has no provision for record types and
record expressions.
Haskell is a pretty large language and I didn't cover the whole of it in
the first pass, I'm afraid.
IAN L, would you care to put in the THSyntax for=20
records
contexts in data type declarations
and add suitable stuff to DsMeta and Convert to get them to and
fro?
(Or someone else!) I'm too much of a bottleneck for stuff like this.
I'm inclined to focus my time on things where it really has to be me.
Simon
| -----Original Message-----
| From: Derek Elkins [mailto:ddarius86@hotmail.com]
| Sent: 14 February 2003 03:09
| To: template-haskell@haskell.org
| Subject: [Template-haskell] Record constructors
|=20
| Quasiquoted expressions involving record construction syntax dies.
| Furthermore, how do you even generate a record constructor
declaration?
| There's no place to put the record name.
|=20
| module Main where
| import Language.Haskell.THSyntax
| import Text.PrettyPrint.HughesPJ (render)
|=20
| data Lang a b =3D Lang {
| tvarAlg :: String -> a,
| arrowAlg :: a -> a -> a,
| varAlg :: String -> b,
| applyAlg :: b -> b -> b,
| lambdaAlg :: (String, a) -> b -> b
| }
|=20
| e =3D [| let t =3D Lang { tvarAlg =3D \s -> (),
| arrowAlg =3D \x y -> (),
| varAlg =3D \s -> (),
| applyAlg =3D \x y -> (),
| lambdaAlg =3D \x y -> ()
| }
| in tvarAlg t |]
|=20
| main =3D do output <- runQ e
| putStrLn $ render $ pprExp output
| putStrLn "\n"
| putStrLn $ show output
|=20
| _________________________________________________________________
| Add photos to your messages with MSN 8. Get 2 months FREE*.
| http://join.msn.com/?page=3Dfeatures/featuredemail
|=20
| _______________________________________________
| template-haskell mailing list
| template-haskell@haskell.org
| http://www.haskell.org/mailman/listinfo/template-haskell