[Template Haskell] Desugaring TH brackets vs. Desugaring normal HsExprS.
Dominik Bollmann
dominikbollmann at gmail.com
Fri Feb 12 17:17:31 UTC 2016
Hi,
I'm currently trying to understand GHC's implementation of Template
Haskell and I've had the following two questions when reading upon
deSugar/DsMeta.hs and deSugar/dsExpr.hs (disclaimer: I'm a complete
newbie to GHC and do not know pretty much anything about its internals;
so please excuse silly questions).
1) As far as I understand DsMeta, its purpose is to desugar the contents
of TH quotation brackets, e.g. [| \x -> x |]. Given the HsExpr contents,
say `expr`, of a quotation bracket, it creates a CoreExpr
/representation/ of `expr` such that /evaluating/ this CoreExpr
representation yields a TH expression equivalent to `expr`. (This is
similar to how quotations are implemented in the original TH paper).
On the other hand, when instead writing the above TH quote, (i.e., [| \x
-> x |]), explicitly as
newName "x" >>= (\x -> lamE (varP x) (varE x)) (*)
there is no need to build a CoreExpr /representation/ because we already
got the TH value we're interested in; Hence, in this case DsExpr
desugars the above (*) directly to a CoreExpr that represents it.
Is my understanding of the above correct? I tried to confirm it using
the following to splices:
test1 :: Q Exp
test1 = [| \x -> x |]
test2 :: Q Exp
test2 = do
x <- newName "x"
lamE [(varP x)] (varE x)
However, dumping the desugared output of these splices using `-ddump-ds`
gives the exact same CoreExprS:
test1 :: Q Exp
[LclIdX, Str=DmdType]
test1 =
Language.Haskell.TH.Syntax.bindQ
@ Name
@ Exp
(newName (GHC.CString.unpackCString# "x"#))
(\ (x_a399 :: Name) ->
lamE
(GHC.Types.: @ PatQ (varP x_a399) (GHC.Types.[] @ PatQ))
(varE x_a399))
test2 :: Q Exp
[LclIdX, Str=DmdType]
test2 =
>>=
@ Q
Language.Haskell.TH.Syntax.$fMonadQ
@ Name
@ Exp
(newName (GHC.CString.unpackCString# "x"#))
(\ (x_a39a :: Name) ->
lamE
(GHC.Types.: @ PatQ (varP x_a39a) (GHC.Types.[] @ PatQ))
(varE x_a39a))
Could anyone explain to me why both CoreExpr dumps are the same?
Shouldn't the first be a /representation/ that, only when run, yields
the second CoreExpr?
If anyone could help me understanding this, it'd be great!
Thanks, Dominik.
More information about the ghc-devs
mailing list