[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