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

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"

Hello,
Maybe you could have a look at Quasi
Quotationhttp://www.haskell.org/haskellwiki/Quasiquotation
.
Regards
J-C
On Sat, Aug 24, 2013 at 11:36 AM, TP
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@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

IIRC you can use haskell-src-exts to parse a string into TH AST structures.
There might even be a quasi-quoter for that; I don't have a real computer
at hand right more, so you'll need to do some research of your own.
On Aug 24, 2013 11:37 AM, "TP"
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@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Tobias Dammers wrote:
IIRC you can use haskell-src-exts to parse a string into TH AST structures. There might even be a quasi-quoter for that; I don't have a real computer at hand right more, so you'll need to do some research of your own.
:m Language.Haskell.Meta parseDecs "s=s+1" Right [ValD (VarP s) (NormalB (UInfixE (VarE s) (VarE +) (LitE (IntegerL 1)))) []] parseExp "x+1" Right (UInfixE (VarE x) (VarE +) (LitE (IntegerL 1))) :i parseDecs
:i parseExp
Thanks Tobias, it led me to the right path. There is indeed a solution in Language.Haskell.Meta: $ ghci parseDecs :: String -> Either String [Language.Haskell.TH.Syntax.Dec] -- Defined in `Language.Haskell.Meta.Parse' parseExp :: String -> Either String Language.Haskell.TH.Syntax.Exp -- Defined in `Language.Haskell.Meta.Parse' Thanks, TP

Excerpts from TP's message of Sat Aug 24 11:36:04 +0200 2013:
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
You actually have eval/exec like features. You can run "ghc" modules in a haskell application to compile a module, then run that code. Eg see this example to get started http://mawercer.de/tmp/haskell-dyn-loading-example.zip Origin of most ideas was this site: http://codeutopia.net/blog/2011/08/20/adventures-in-haskell-dynamic-loading-... Marc Weber

There's a proposalhttp://ghc.haskell.org/trac/ghc/blog/Template%20Haskell%20Proposal#PartD:qua...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
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@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
participants (5)
-
Dag Odenhall
-
jean-christophe mincke
-
Marc Weber
-
Tobias Dammers
-
TP