[Haskell-cafe] reasons why Template Haskell does not propose something similar to Python exec() or eval()

Dag Odenhall dag.odenhall at gmail.com
Sun Aug 25 11:42:51 CEST 2013


There's a proposal<http://ghc.haskell.org/trac/ghc/blog/Template%20Haskell%20Proposal#PartD:quasiquotation>for
adding a proper Haskell
QuasiQuoter as part of template-haskell. Until then, as others have noted
your best option is the haskell-src-meta package, but be aware that this
uses a separate parser.


On Sat, Aug 24, 2013 at 11:36 AM, TP <paratribulations at free.fr> wrote:

> Hi everybody,
>
> I continue to learn and test Template Haskell (one more time thanks to John
> Lato for his post at:
>
> http://www.mail-archive.com/haskell-cafe@haskell.org/msg106696.html
>
> that made me understand a lot of things).
>
> I have a question about the way Template Haskell is working. Why Template
> Haskell does not propose something similar to Python (or bash) exec() or
> eval(), i.e. does not offer the possibility to take a (quoted) string in
> input, to make abstract syntax in output (to be executed later in a splice
> $()).
> For example, in Python, to make an affectation 'a="a"' programatically, I
> can simply do (at runtime; even if I am here only concerned with what
> Template Haskell could do, i.e. at compile time):
> > def f(s): return '%s = \'%s\'' % (s,s)
> > exec(f("a"))
> > a
> 'a'
>
> With Template Haskell, I am compelled to make a function returning the
> abstract syntax corresponding to variable declaration:
>
> ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s)
>
> (see complete example in Post Scriptum).
> This works fine, but it is less direct. I am sure that the Template Haskell
> approach has many advantages, but I am unable to list them. I think it is
> important to have the reasons in mind. Could you help me?
>
> Thanks in advance,
>
> TP
>
>
> PS: the complete Haskell example:
>
> -----------------------------------
> module MakeVard where
> import Language.Haskell.TH
>
> makeVard :: Monad m => String -> m [Dec]
> -- Equivalent to "%s = \"%s\""
> makeVard s = return [ ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s)
> []
> ]
> -----------------------------------
>
> tested by
>
> -----------------------------------
> {-# LANGUAGE TemplateHaskell #-}
> import MakeVard
>
> $(makeVard "a")
>
> main = do
>
> print a
> -----------------------------------
>
> resulting in
> $ runghc -ddump-splices test.hs
> test_makeVar.hs:1:1: Splicing declarations
>     makeVard "a"
>   ======>
>     test_makeVar.hs:4:3-14
>     a = "a"
> "a"
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130825/c4c2dc24/attachment.htm>


More information about the Haskell-Cafe mailing list