Reification of out-of-scope variables?

Hi all, the community is increasingly using quasiquotation as a means to interoperate with foreign languages. E.g. language-c-inline, inline-c and inline-r allow calling foreign functions using foreign language syntax, rather than "foreign import" declarations. There are efforts underway for Java, Javascript and other languages too. The pattern common to most of these libraries is: * collect the content of all quasiquotes that appear in a module, generate a compilable foreign source file based on that, and then link the object code resulting from compiling that. When the foreign language is itself statically typed, we need to make sure we generate code with proper type annotations, including for any antiquotation variables. In older versions of GHC, we could derive the type annotations from the inferred Haskell types, but this is not possible since 7.8 because the types of any variable in the current "declaration group" are not made available. So libraries like inline-c ask for some extra verbosity from the user: mycossin1 :: Double -> IO Double mycossin1 somex = [cexp| double { cos($(double somex)) * sin($(double somex)) } |] The type annotations inside the quasiquote are redundant with the explicitly provided type signature. C types are typically short enough, but other languages (e.g. C++, Java), have really long fully qualified type names, so the extra annotations are a cost. The are good reasons why types aren't available from within a declaration group (it was possible to observe the order in which type inference works), hence why the extra annotations are necessary. But by the time type checking of the whole module is finished, types are fixed once and for all. So the question is: * Could we make it possible to query the types of local variables at the end of type checking? The reason I ask is: with 'addModFinalizer' and friends that TH provides, we're tantalizingly close to being able to generate foreign code wrappers that have the right types that match those of the antiquotation variables present in a module. Template Haskell already provides 'addModFinalizer'. You feed it a Q action, which will run once the whole module is type checked. If at that point we could ask, "what's the type of somex (above)?", then we could let the user write mycossin2 :: Double -> IO Double mycossin2 somex = [cexp| cos($somex) * sin($somex) |] and yet still generate a C file capturing the content of above quasiquote with the right types: double module_foo_qq1(double v1) { return (cos(v1) * sin(v1)); } since we know that somex :: Double and that the Haskell type "Double" corresponds to C's "double" primitive type. Bound variables have a unique name associated to them, which we can get hold of in Template Haskell using the 'var syntax, but f x = $(let name = 'x in addModFinalizer (reify name >>= \info -> runIO (print info)) >> [| x |]) results in a compiler error, The exact Name `x' is not in scope Probable cause: you used a unique Template Haskell name (NameU), perhaps via newName, but did not bind it If that's it, then -ddump-splices might be useful because by the time the TH finalizer runs, we're no longer in the scope of x. But since the names of the local variables are unique, could it possibly make sense to allow calling reify on them, even outside of their scope, so as to get at their type? Best, Mathieu

I have considered how to add this capability some in the past, it's
something I'd also like to have. Collecting the type info in the module
finalizer is an interesting idea! This may well be the cheapest way to get
the info necessary for this usecase.
As far as I understand it, currently we're in the middle of typechecking
when quasiquotes get run, so we don't yet have concrete. The types of
reified variables may well depend upon the type of the expression generated
by the quasi-quote. There seems to be a straightforward-ish way to resolve
this - run typechecking twice. The first typechecking pass uses
quasi-quotes substituted with stub versions of their output. For this
example, it'd be (undefined :: IO double). To support this, we'd add a
(Maybe ExpQ) field to QuasiQuoter, hopefully doing this in a way that
preserves backwards compatibility (via pattern syns, or adding a new
constructor to QuasiQuoter).
For consistency, we would want to ensure that the stub unifies with the
expression that actually gets used. To enforce this, we'd typecheck
something equivalent to
case True of
True -> ... -- generated code
False -> (undefined :: IO Double) -- stub
My particular use case is similar, in that it's related to FFI. What I
want to do is have quasiquoters for typescript in GHCJS code. Since GHCJS
already runs TH in node, we can actually load up the typescript compiler
and do the typechecking directly at the quasi-quote location. For the
first-pass stubs, we pretend like all the captured variables are the "Any"
type, and ask typescript what it thinks the overall type is. For the
second pass, we have the types of the anti-quotes, and so can typecheck the
whole expression.
It'd also be really cool if we could generated code + typecheck anti-quotes
during the first pass. This would make it possible to use anti-quotes
which are more complicated than just a variable.
-Michael
On Fri, Apr 8, 2016 at 6:48 AM, Boespflug, Mathieu
Hi all,
the community is increasingly using quasiquotation as a means to interoperate with foreign languages. E.g. language-c-inline, inline-c and inline-r allow calling foreign functions using foreign language syntax, rather than "foreign import" declarations. There are efforts underway for Java, Javascript and other languages too. The pattern common to most of these libraries is:
* collect the content of all quasiquotes that appear in a module, generate a compilable foreign source file based on that, and then link the object code resulting from compiling that.
When the foreign language is itself statically typed, we need to make sure we generate code with proper type annotations, including for any antiquotation variables. In older versions of GHC, we could derive the type annotations from the inferred Haskell types, but this is not possible since 7.8 because the types of any variable in the current "declaration group" are not made available. So libraries like inline-c ask for some extra verbosity from the user:
mycossin1 :: Double -> IO Double mycossin1 somex = [cexp| double { cos($(double somex)) * sin($(double somex)) } |]
The type annotations inside the quasiquote are redundant with the explicitly provided type signature. C types are typically short enough, but other languages (e.g. C++, Java), have really long fully qualified type names, so the extra annotations are a cost.
The are good reasons why types aren't available from within a declaration group (it was possible to observe the order in which type inference works), hence why the extra annotations are necessary. But by the time type checking of the whole module is finished, types are fixed once and for all. So the question is:
* Could we make it possible to query the types of local variables at the end of type checking?
The reason I ask is: with 'addModFinalizer' and friends that TH provides, we're tantalizingly close to being able to generate foreign code wrappers that have the right types that match those of the antiquotation variables present in a module.
Template Haskell already provides 'addModFinalizer'. You feed it a Q action, which will run once the whole module is type checked. If at that point we could ask, "what's the type of somex (above)?", then we could let the user write
mycossin2 :: Double -> IO Double mycossin2 somex = [cexp| cos($somex) * sin($somex) |]
and yet still generate a C file capturing the content of above quasiquote with the right types:
double module_foo_qq1(double v1) { return (cos(v1) * sin(v1)); }
since we know that somex :: Double and that the Haskell type "Double" corresponds to C's "double" primitive type.
Bound variables have a unique name associated to them, which we can get hold of in Template Haskell using the 'var syntax, but
f x = $(let name = 'x in addModFinalizer (reify name >>= \info -> runIO (print info)) >> [| x |])
results in a compiler error,
The exact Name `x' is not in scope Probable cause: you used a unique Template Haskell name (NameU), perhaps via newName, but did not bind it If that's it, then -ddump-splices might be useful
because by the time the TH finalizer runs, we're no longer in the scope of x.
But since the names of the local variables are unique, could it possibly make sense to allow calling reify on them, even outside of their scope, so as to get at their type?
Best,
Mathieu _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs

I actually don't think this would be all that hard to do.
Concretely, how would this work:
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called. However, by the time the passed action is run -- after finishing typechecking a mutually-recursive group -- all the local variables' types have settled and are available.
Does that satisfy your needs? Of course, your quasiquoter will still have to output code when it is originally run, so the addGroupFinalizer action could only, say, set up the external file.
If this idea is acceptable, it will still need a volunteer to implement. I'm happy to advise.
Richard
On Apr 8, 2016, at 9:48 AM, "Boespflug, Mathieu"
Hi all,
the community is increasingly using quasiquotation as a means to interoperate with foreign languages. E.g. language-c-inline, inline-c and inline-r allow calling foreign functions using foreign language syntax, rather than "foreign import" declarations. There are efforts underway for Java, Javascript and other languages too. The pattern common to most of these libraries is:
* collect the content of all quasiquotes that appear in a module, generate a compilable foreign source file based on that, and then link the object code resulting from compiling that.
When the foreign language is itself statically typed, we need to make sure we generate code with proper type annotations, including for any antiquotation variables. In older versions of GHC, we could derive the type annotations from the inferred Haskell types, but this is not possible since 7.8 because the types of any variable in the current "declaration group" are not made available. So libraries like inline-c ask for some extra verbosity from the user:
mycossin1 :: Double -> IO Double mycossin1 somex = [cexp| double { cos($(double somex)) * sin($(double somex)) } |]
The type annotations inside the quasiquote are redundant with the explicitly provided type signature. C types are typically short enough, but other languages (e.g. C++, Java), have really long fully qualified type names, so the extra annotations are a cost.
The are good reasons why types aren't available from within a declaration group (it was possible to observe the order in which type inference works), hence why the extra annotations are necessary. But by the time type checking of the whole module is finished, types are fixed once and for all. So the question is:
* Could we make it possible to query the types of local variables at the end of type checking?
The reason I ask is: with 'addModFinalizer' and friends that TH provides, we're tantalizingly close to being able to generate foreign code wrappers that have the right types that match those of the antiquotation variables present in a module.
Template Haskell already provides 'addModFinalizer'. You feed it a Q action, which will run once the whole module is type checked. If at that point we could ask, "what's the type of somex (above)?", then we could let the user write
mycossin2 :: Double -> IO Double mycossin2 somex = [cexp| cos($somex) * sin($somex) |]
and yet still generate a C file capturing the content of above quasiquote with the right types:
double module_foo_qq1(double v1) { return (cos(v1) * sin(v1)); }
since we know that somex :: Double and that the Haskell type "Double" corresponds to C's "double" primitive type.
Bound variables have a unique name associated to them, which we can get hold of in Template Haskell using the 'var syntax, but
f x = $(let name = 'x in addModFinalizer (reify name >>= \info -> runIO (print info)) >> [| x |])
results in a compiler error,
The exact Name `x' is not in scope Probable cause: you used a unique Template Haskell name (NameU), perhaps via newName, but did not bind it If that's it, then -ddump-splices might be useful
because by the time the TH finalizer runs, we're no longer in the scope of x.
But since the names of the local variables are unique, could it possibly make sense to allow calling reify on them, even outside of their scope, so as to get at their type?
Best,
Mathieu _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs

Hello Richard,
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called.
When considering this approach, how could one capture the local typing
environment given that the untyped splices are run in the renamer
where no such environment is populated yet?
Facundo
On Sun, Apr 10, 2016 at 11:22 AM, Richard Eisenberg
I actually don't think this would be all that hard to do.
Concretely, how would this work:
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called. However, by the time the passed action is run -- after finishing typechecking a mutually-recursive group -- all the local variables' types have settled and are available.
Does that satisfy your needs? Of course, your quasiquoter will still have to output code when it is originally run, so the addGroupFinalizer action could only, say, set up the external file.
If this idea is acceptable, it will still need a volunteer to implement. I'm happy to advise.
Richard
On Apr 8, 2016, at 9:48 AM, "Boespflug, Mathieu"
wrote: Hi all,
the community is increasingly using quasiquotation as a means to interoperate with foreign languages. E.g. language-c-inline, inline-c and inline-r allow calling foreign functions using foreign language syntax, rather than "foreign import" declarations. There are efforts underway for Java, Javascript and other languages too. The pattern common to most of these libraries is:
* collect the content of all quasiquotes that appear in a module, generate a compilable foreign source file based on that, and then link the object code resulting from compiling that.
When the foreign language is itself statically typed, we need to make sure we generate code with proper type annotations, including for any antiquotation variables. In older versions of GHC, we could derive the type annotations from the inferred Haskell types, but this is not possible since 7.8 because the types of any variable in the current "declaration group" are not made available. So libraries like inline-c ask for some extra verbosity from the user:
mycossin1 :: Double -> IO Double mycossin1 somex = [cexp| double { cos($(double somex)) * sin($(double somex)) } |]
The type annotations inside the quasiquote are redundant with the explicitly provided type signature. C types are typically short enough, but other languages (e.g. C++, Java), have really long fully qualified type names, so the extra annotations are a cost.
The are good reasons why types aren't available from within a declaration group (it was possible to observe the order in which type inference works), hence why the extra annotations are necessary. But by the time type checking of the whole module is finished, types are fixed once and for all. So the question is:
* Could we make it possible to query the types of local variables at the end of type checking?
The reason I ask is: with 'addModFinalizer' and friends that TH provides, we're tantalizingly close to being able to generate foreign code wrappers that have the right types that match those of the antiquotation variables present in a module.
Template Haskell already provides 'addModFinalizer'. You feed it a Q action, which will run once the whole module is type checked. If at that point we could ask, "what's the type of somex (above)?", then we could let the user write
mycossin2 :: Double -> IO Double mycossin2 somex = [cexp| cos($somex) * sin($somex) |]
and yet still generate a C file capturing the content of above quasiquote with the right types:
double module_foo_qq1(double v1) { return (cos(v1) * sin(v1)); }
since we know that somex :: Double and that the Haskell type "Double" corresponds to C's "double" primitive type.
Bound variables have a unique name associated to them, which we can get hold of in Template Haskell using the 'var syntax, but
f x = $(let name = 'x in addModFinalizer (reify name >>= \info -> runIO (print info)) >> [| x |])
results in a compiler error,
The exact Name `x' is not in scope Probable cause: you used a unique Template Haskell name (NameU), perhaps via newName, but did not bind it If that's it, then -ddump-splices might be useful
because by the time the TH finalizer runs, we're no longer in the scope of x.
But since the names of the local variables are unique, could it possibly make sense to allow calling reify on them, even outside of their scope, so as to get at their type?
Best,
Mathieu _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
_______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs

On Apr 12, 2016, at 5:35 PM, Facundo Domínguez
Hello Richard,
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called.
When considering this approach, how could one capture the local typing environment given that the untyped splices are run in the renamer where no such environment is populated yet?
Ah. Excellent point. I hadn't quite thought it through. Not sure, off the top of my head, how to get around this. Richard

Hi Richard,
Facundo and I had a chat about this offline. Facundo noticed that
there /is/ a form of splicing that runs during type checking, and
therefore has access to the type environment: namely typed splices,
which return a TExp rather than an Exp. Turns out the example from my
first email does work if you adapt it to use typed splices:
f :: Int -> Int
f x = $$(do let {name = mkName x}; info <- reify name; runIO (print
info) [|| x ||])
Running reify still doesn't work inside addModFinalizer, but at least
we do have access to x's type from within the typed splice, so we can
record it for use in the foreign code generation phase later.
The issue is, typed splices run afoul of the very same issue that
caused GHC HQ to move splice expansion out of the type checker and
into the renamer: namely that type inference becomes observable, as
documented here:
https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/BlogPostChanges
In particular,
f x = $$(... same splice as above...) `asTypeOf` True
yields a type error, while
f :: Bool -> Bool
f x = $$(... same splice as above...)
does not.
So let's discuss what the next actions are:
* Should we consider it a bug (and file a ticket) that reification in
typed splices is able to observe the order of type checking, just like
reify used to do in untyped splices?
* While Richard's proposed addGroupFinalizer might not work with
untyped splices, perhaps it can be made to work with typed splices,
since these run in the type checker?
* If part of the solution here is to use typed splices, how do we get
quasiquotation to be syntactic sugar for a *typed* splice? Do we want
to be introducing a typed quasiquotation syntax, just like Geoff did
for much of the rest of Template Haskell?
Facundo and I think that something like Richard's addGroupFinalizer is
still interesting to have, because while reification during type
checking sounds dubious, reification /after/ the declaration group is
fully type checked is perfectly safe.
Best,
--
Mathieu Boespflug
Founder at http://tweag.io.
On 13 April 2016 at 04:25, Richard Eisenberg
On Apr 12, 2016, at 5:35 PM, Facundo Domínguez
wrote: Hello Richard,
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called.
When considering this approach, how could one capture the local typing environment given that the untyped splices are run in the renamer where no such environment is populated yet?
Ah. Excellent point. I hadn't quite thought it through. Not sure, off the top of my head, how to get around this.
Richard

An implementation for untyped splices could be:
* Have a map from internal names to the local typing environments.
* When the renamer runs addGroupFinalizer it generates an internal
name and annotates the AST with the internal name at the location of
the splice.
* When the type checker finds the annotation it inserts the local
typing environment in the map.
* When the finalizer runs, it looks up its local typing environment in the map.
It is not as simple as running the splice in the typechecker, but
would you still be happy merging a solution like this?
Facundo
On Wed, Apr 13, 2016 at 6:09 AM, Boespflug, Mathieu
Hi Richard,
Facundo and I had a chat about this offline. Facundo noticed that there /is/ a form of splicing that runs during type checking, and therefore has access to the type environment: namely typed splices, which return a TExp rather than an Exp. Turns out the example from my first email does work if you adapt it to use typed splices:
f :: Int -> Int f x = $$(do let {name = mkName x}; info <- reify name; runIO (print info) [|| x ||])
Running reify still doesn't work inside addModFinalizer, but at least we do have access to x's type from within the typed splice, so we can record it for use in the foreign code generation phase later.
The issue is, typed splices run afoul of the very same issue that caused GHC HQ to move splice expansion out of the type checker and into the renamer: namely that type inference becomes observable, as documented here:
https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/BlogPostChanges
In particular,
f x = $$(... same splice as above...) `asTypeOf` True
yields a type error, while
f :: Bool -> Bool f x = $$(... same splice as above...)
does not.
So let's discuss what the next actions are:
* Should we consider it a bug (and file a ticket) that reification in typed splices is able to observe the order of type checking, just like reify used to do in untyped splices? * While Richard's proposed addGroupFinalizer might not work with untyped splices, perhaps it can be made to work with typed splices, since these run in the type checker? * If part of the solution here is to use typed splices, how do we get quasiquotation to be syntactic sugar for a *typed* splice? Do we want to be introducing a typed quasiquotation syntax, just like Geoff did for much of the rest of Template Haskell?
Facundo and I think that something like Richard's addGroupFinalizer is still interesting to have, because while reification during type checking sounds dubious, reification /after/ the declaration group is fully type checked is perfectly safe.
Best, -- Mathieu Boespflug Founder at http://tweag.io.
On 13 April 2016 at 04:25, Richard Eisenberg
wrote: On Apr 12, 2016, at 5:35 PM, Facundo Domínguez
wrote: Hello Richard,
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called.
When considering this approach, how could one capture the local typing environment given that the untyped splices are run in the renamer where no such environment is populated yet?
Ah. Excellent point. I hadn't quite thought it through. Not sure, off the top of my head, how to get around this.
Richard

This is a bit invasive, but I don't immediately see an easier way. I'd personally want a few more people to weigh in before accepting this plan of attack. In your favor is that you are Real Users who want the feature to Get Work Done.
Let's see what others think, but I'm not opposed.
Richard
On Apr 13, 2016, at 7:31 AM, Facundo Domínguez
An implementation for untyped splices could be: * Have a map from internal names to the local typing environments. * When the renamer runs addGroupFinalizer it generates an internal name and annotates the AST with the internal name at the location of the splice. * When the type checker finds the annotation it inserts the local typing environment in the map. * When the finalizer runs, it looks up its local typing environment in the map.
It is not as simple as running the splice in the typechecker, but would you still be happy merging a solution like this?
Facundo
On Wed, Apr 13, 2016 at 6:09 AM, Boespflug, Mathieu
wrote: Hi Richard,
Facundo and I had a chat about this offline. Facundo noticed that there /is/ a form of splicing that runs during type checking, and therefore has access to the type environment: namely typed splices, which return a TExp rather than an Exp. Turns out the example from my first email does work if you adapt it to use typed splices:
f :: Int -> Int f x = $$(do let {name = mkName x}; info <- reify name; runIO (print info) [|| x ||])
Running reify still doesn't work inside addModFinalizer, but at least we do have access to x's type from within the typed splice, so we can record it for use in the foreign code generation phase later.
The issue is, typed splices run afoul of the very same issue that caused GHC HQ to move splice expansion out of the type checker and into the renamer: namely that type inference becomes observable, as documented here:
https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/BlogPostChanges
In particular,
f x = $$(... same splice as above...) `asTypeOf` True
yields a type error, while
f :: Bool -> Bool f x = $$(... same splice as above...)
does not.
So let's discuss what the next actions are:
* Should we consider it a bug (and file a ticket) that reification in typed splices is able to observe the order of type checking, just like reify used to do in untyped splices? * While Richard's proposed addGroupFinalizer might not work with untyped splices, perhaps it can be made to work with typed splices, since these run in the type checker? * If part of the solution here is to use typed splices, how do we get quasiquotation to be syntactic sugar for a *typed* splice? Do we want to be introducing a typed quasiquotation syntax, just like Geoff did for much of the rest of Template Haskell?
Facundo and I think that something like Richard's addGroupFinalizer is still interesting to have, because while reification during type checking sounds dubious, reification /after/ the declaration group is fully type checked is perfectly safe.
Best, -- Mathieu Boespflug Founder at http://tweag.io.
On 13 April 2016 at 04:25, Richard Eisenberg
wrote: On Apr 12, 2016, at 5:35 PM, Facundo Domínguez
wrote: Hello Richard,
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called.
When considering this approach, how could one capture the local typing environment given that the untyped splices are run in the renamer where no such environment is populated yet?
Ah. Excellent point. I hadn't quite thought it through. Not sure, off the top of my head, how to get around this.
Richard

Very interesting.
On Apr 13, 2016, at 5:09 AM, "Boespflug, Mathieu"
* Should we consider it a bug (and file a ticket) that reification in typed splices is able to observe the order of type checking, just like reify used to do in untyped splices?
I think so, yes.
* While Richard's proposed addGroupFinalizer might not work with untyped splices, perhaps it can be made to work with typed splices, since these run in the type checker?
I think so, yes. Perhaps it would be more well-typed to have typed TH splices run in a new monad TQ such that TQ allows addGroupFinalizer but Q does not. This may be overkill though.
* If part of the solution here is to use typed splices, how do we get quasiquotation to be syntactic sugar for a *typed* splice? Do we want to be introducing a typed quasiquotation syntax, just like Geoff did for much of the rest of Template Haskell?
Maybe. Quasiquotation sugar is very light: [blah|...|] is the same as $(selector blah "...") where `selector` is the right record selector depending on the splice context. Is it worth trying to expand quasiquotation syntax to work with typed TH? I'm unconvinced it's worth the bother. Also, note that doing [blah||...||] is not backward-compatible, because that looks like an untyped quasiquote that begins and ends with a vertical bar. We could get around this problem by using a new extension, but the waters are just getting muddier, and for seemingly little benefit. Richard
Facundo and I think that something like Richard's addGroupFinalizer is still interesting to have, because while reification during type checking sounds dubious, reification /after/ the declaration group is fully type checked is perfectly safe.
Best, -- Mathieu Boespflug Founder at http://tweag.io.
On 13 April 2016 at 04:25, Richard Eisenberg
wrote: On Apr 12, 2016, at 5:35 PM, Facundo Domínguez
wrote: Hello Richard,
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called.
When considering this approach, how could one capture the local typing environment given that the untyped splices are run in the renamer where no such environment is populated yet?
Ah. Excellent point. I hadn't quite thought it through. Not sure, off the top of my head, how to get around this.
Richard

I'm afraid I'm coming late to the game, so I'm not clear on the extent of the problem (or even precisely what it is that isn't working). In addition to creating a ticket, it would be great to have a wiki page that outlines the problem and proposed solution(s). The TH finalizer stuff was meant to make support for things like language-c-inline easier, but it is incomplete. Before we go munging around again, it would be good to have a list of use cases so we can cover all the bases this time. Geoff On 04/13/2016 04:25 PM, Richard Eisenberg wrote:
Very interesting.
On Apr 13, 2016, at 5:09 AM, "Boespflug, Mathieu"
wrote: * Should we consider it a bug (and file a ticket) that reification in typed splices is able to observe the order of type checking, just like reify used to do in untyped splices? I think so, yes.
* While Richard's proposed addGroupFinalizer might not work with untyped splices, perhaps it can be made to work with typed splices, since these run in the type checker? I think so, yes. Perhaps it would be more well-typed to have typed TH splices run in a new monad TQ such that TQ allows addGroupFinalizer but Q does not. This may be overkill though.
* If part of the solution here is to use typed splices, how do we get quasiquotation to be syntactic sugar for a *typed* splice? Do we want to be introducing a typed quasiquotation syntax, just like Geoff did for much of the rest of Template Haskell? Maybe. Quasiquotation sugar is very light: [blah|...|] is the same as $(selector blah "...") where `selector` is the right record selector depending on the splice context. Is it worth trying to expand quasiquotation syntax to work with typed TH? I'm unconvinced it's worth the bother. Also, note that doing [blah||...||] is not backward-compatible, because that looks like an untyped quasiquote that begins and ends with a vertical bar. We could get around this problem by using a new extension, but the waters are just getting muddier, and for seemingly little benefit.
Richard
Facundo and I think that something like Richard's addGroupFinalizer is still interesting to have, because while reification during type checking sounds dubious, reification /after/ the declaration group is fully type checked is perfectly safe.
Best, -- Mathieu Boespflug Founder at http://tweag.io.
On 13 April 2016 at 04:25, Richard Eisenberg
wrote: On Apr 12, 2016, at 5:35 PM, Facundo Domínguez
wrote: Hello Richard,
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called. When considering this approach, how could one capture the local typing environment given that the untyped splices are run in the renamer where no such environment is populated yet?
Ah. Excellent point. I hadn't quite thought it through. Not sure, off the top of my head, how to get around this.
Richard

Here is the wiki page [1] and here is the ticket [2]
Best
[1] https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Reify
[2] https://ghc.haskell.org/trac/ghc/ticket/11832
On Wed, Apr 13, 2016 at 5:37 PM, Geoffrey Mainland
I'm afraid I'm coming late to the game, so I'm not clear on the extent of the problem (or even precisely what it is that isn't working).
In addition to creating a ticket, it would be great to have a wiki page that outlines the problem and proposed solution(s).
The TH finalizer stuff was meant to make support for things like language-c-inline easier, but it is incomplete. Before we go munging around again, it would be good to have a list of use cases so we can cover all the bases this time.
Geoff
On 04/13/2016 04:25 PM, Richard Eisenberg wrote:
Very interesting.
On Apr 13, 2016, at 5:09 AM, "Boespflug, Mathieu"
wrote: * Should we consider it a bug (and file a ticket) that reification in typed splices is able to observe the order of type checking, just like reify used to do in untyped splices? I think so, yes.
* While Richard's proposed addGroupFinalizer might not work with untyped splices, perhaps it can be made to work with typed splices, since these run in the type checker? I think so, yes. Perhaps it would be more well-typed to have typed TH splices run in a new monad TQ such that TQ allows addGroupFinalizer but Q does not. This may be overkill though.
* If part of the solution here is to use typed splices, how do we get quasiquotation to be syntactic sugar for a *typed* splice? Do we want to be introducing a typed quasiquotation syntax, just like Geoff did for much of the rest of Template Haskell? Maybe. Quasiquotation sugar is very light: [blah|...|] is the same as $(selector blah "...") where `selector` is the right record selector depending on the splice context. Is it worth trying to expand quasiquotation syntax to work with typed TH? I'm unconvinced it's worth the bother. Also, note that doing [blah||...||] is not backward-compatible, because that looks like an untyped quasiquote that begins and ends with a vertical bar. We could get around this problem by using a new extension, but the waters are just getting muddier, and for seemingly little benefit.
Richard
Facundo and I think that something like Richard's addGroupFinalizer is still interesting to have, because while reification during type checking sounds dubious, reification /after/ the declaration group is fully type checked is perfectly safe.
Best, -- Mathieu Boespflug Founder at http://tweag.io.
On 13 April 2016 at 04:25, Richard Eisenberg
wrote: On Apr 12, 2016, at 5:35 PM, Facundo Domínguez
wrote: Hello Richard,
TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called. When considering this approach, how could one capture the local typing environment given that the untyped splices are run in the renamer where no such environment is populated yet?
Ah. Excellent point. I hadn't quite thought it through. Not sure, off the top of my head, how to get around this.
Richard

Wow, thanks! Geoff On 04/13/2016 07:34 PM, Facundo Domínguez wrote:
Here is the wiki page [1] and here is the ticket [2]
Best
[1] https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Reify [2] https://ghc.haskell.org/trac/ghc/ticket/11832
On Wed, Apr 13, 2016 at 5:37 PM, Geoffrey Mainland
wrote: I'm afraid I'm coming late to the game, so I'm not clear on the extent of the problem (or even precisely what it is that isn't working).
In addition to creating a ticket, it would be great to have a wiki page that outlines the problem and proposed solution(s).
The TH finalizer stuff was meant to make support for things like language-c-inline easier, but it is incomplete. Before we go munging around again, it would be good to have a list of use cases so we can cover all the bases this time.
Geoff
On 04/13/2016 04:25 PM, Richard Eisenberg wrote:
Very interesting.
On Apr 13, 2016, at 5:09 AM, "Boespflug, Mathieu"
wrote: * Should we consider it a bug (and file a ticket) that reification in typed splices is able to observe the order of type checking, just like reify used to do in untyped splices? I think so, yes.
* While Richard's proposed addGroupFinalizer might not work with untyped splices, perhaps it can be made to work with typed splices, since these run in the type checker? I think so, yes. Perhaps it would be more well-typed to have typed TH splices run in a new monad TQ such that TQ allows addGroupFinalizer but Q does not. This may be overkill though.
* If part of the solution here is to use typed splices, how do we get quasiquotation to be syntactic sugar for a *typed* splice? Do we want to be introducing a typed quasiquotation syntax, just like Geoff did for much of the rest of Template Haskell? Maybe. Quasiquotation sugar is very light: [blah|...|] is the same as $(selector blah "...") where `selector` is the right record selector depending on the splice context. Is it worth trying to expand quasiquotation syntax to work with typed TH? I'm unconvinced it's worth the bother. Also, note that doing [blah||...||] is not backward-compatible, because that looks like an untyped quasiquote that begins and ends with a vertical bar. We could get around this problem by using a new extension, but the waters are just getting muddier, and for seemingly little benefit.
Richard
Facundo and I think that something like Richard's addGroupFinalizer is still interesting to have, because while reification during type checking sounds dubious, reification /after/ the declaration group is fully type checked is perfectly safe.
Best, -- Mathieu Boespflug Founder at http://tweag.io.
On 13 April 2016 at 04:25, Richard Eisenberg
wrote: On Apr 12, 2016, at 5:35 PM, Facundo Domínguez
wrote: Hello Richard,
> TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called. When considering this approach, how could one capture the local typing environment given that the untyped splices are run in the renamer where no such environment is populated yet?
Ah. Excellent point. I hadn't quite thought it through. Not sure, off the top of my head, how to get around this.
Richard

Michael,
Please, feel free to add your thoughts to the wiki. I couldn't
follow your proposal in enough detail to make it justice.
Facundo
On Wed, Apr 13, 2016 at 8:34 PM, Facundo Domínguez
Here is the wiki page [1] and here is the ticket [2]
Best
[1] https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Reify [2] https://ghc.haskell.org/trac/ghc/ticket/11832
On Wed, Apr 13, 2016 at 5:37 PM, Geoffrey Mainland
wrote: I'm afraid I'm coming late to the game, so I'm not clear on the extent of the problem (or even precisely what it is that isn't working).
In addition to creating a ticket, it would be great to have a wiki page that outlines the problem and proposed solution(s).
The TH finalizer stuff was meant to make support for things like language-c-inline easier, but it is incomplete. Before we go munging around again, it would be good to have a list of use cases so we can cover all the bases this time.
Geoff
On 04/13/2016 04:25 PM, Richard Eisenberg wrote:
Very interesting.
On Apr 13, 2016, at 5:09 AM, "Boespflug, Mathieu"
wrote: * Should we consider it a bug (and file a ticket) that reification in typed splices is able to observe the order of type checking, just like reify used to do in untyped splices? I think so, yes.
* While Richard's proposed addGroupFinalizer might not work with untyped splices, perhaps it can be made to work with typed splices, since these run in the type checker? I think so, yes. Perhaps it would be more well-typed to have typed TH splices run in a new monad TQ such that TQ allows addGroupFinalizer but Q does not. This may be overkill though.
* If part of the solution here is to use typed splices, how do we get quasiquotation to be syntactic sugar for a *typed* splice? Do we want to be introducing a typed quasiquotation syntax, just like Geoff did for much of the rest of Template Haskell? Maybe. Quasiquotation sugar is very light: [blah|...|] is the same as $(selector blah "...") where `selector` is the right record selector depending on the splice context. Is it worth trying to expand quasiquotation syntax to work with typed TH? I'm unconvinced it's worth the bother. Also, note that doing [blah||...||] is not backward-compatible, because that looks like an untyped quasiquote that begins and ends with a vertical bar. We could get around this problem by using a new extension, but the waters are just getting muddier, and for seemingly little benefit.
Richard
Facundo and I think that something like Richard's addGroupFinalizer is still interesting to have, because while reification during type checking sounds dubious, reification /after/ the declaration group is fully type checked is perfectly safe.
Best, -- Mathieu Boespflug Founder at http://tweag.io.
On 13 April 2016 at 04:25, Richard Eisenberg
wrote: On Apr 12, 2016, at 5:35 PM, Facundo Domínguez
wrote: Hello Richard,
> TH will offer a new function `addGroupFinalizer :: Q () -> Q ()` that runs its argument in the local typing environment available when addGroupFinalizer is called. When considering this approach, how could one capture the local typing environment given that the untyped splices are run in the renamer where no such environment is populated yet?
Ah. Excellent point. I hadn't quite thought it through. Not sure, off the top of my head, how to get around this.
Richard

| > * If part of the solution here is to use typed splices, how do we get | > quasiquotation to be syntactic sugar for a *typed* splice? Do we want | > to be introducing a typed quasiquotation syntax, just like Geoff did | > for much of the rest of Template Haskell? | | Maybe. Quasiquotation sugar is very light: [blah|...|] is the same as | $(selector blah "...") where `selector` is the right record selector | depending on the splice context. Is it worth trying to expand | quasiquotation syntax to work with typed TH? I'm unconvinced it's worth | the bother. Also, note that doing [blah||...||] is not backward- | compatible, because that looks like an untyped quasiquote that begins | and ends with a vertical bar. The merit of a typed splice is that if you see $$(f [|| x ||]) and (f [|| x ||]) typechecks, then you know that the splice result will typecheck. You never have to look at the expansion of the splice. Nothing like that can be said about quasiquotes [flob| ...arbitrary string... |] We can't say "if ...arbitrary string.. typechecks then the quasiquote will typecheck. To put it another way, it's equivalent to $(getExprParser flob "...arby string....") and that typechecks trivially, but its expansion of course might not. So there is literally no point in thinking about typed-splices for quasiquotes. Simon

| a TExp rather than an Exp. Turns out the example from my first email | does work if you adapt it to use typed splices: | | f :: Int -> Int | f x = $$(do let {name = mkName x}; info <- reify name; runIO (print | info) [|| x ||]) Hang on! The design for typed splices, describe here, https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/BlogPostChanges says "Unlike TH, the only way to construct a value of type TExp is with a quote. You cannot drop into do-notation, nor use explicit construction of the values in the Exp algebraic data type. That restriction limits expressiveness, but it enables the strong typing guarantees." So why does the above work? $$(e) requires a TExp, and do-notation doesn’t produce a TExp. | * Should we consider it a bug (and file a ticket) that reification in | typed splices is able to observe the order of type checking, just like | reify used to do in untyped splices? Yes I think so!!! Simon

On Apr 15, 2016, at 11:51 AM, Simon Peyton Jones
Hang on! The design for typed splices, describe here, https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/BlogPostChanges says "Unlike TH, the only way to construct a value of type TExp is with a quote. You cannot drop into do-notation, nor use explicit construction of the values in the Exp algebraic data type. That restriction limits expressiveness, but it enables the strong typing guarantees."
So why does the above work? $$(e) requires a TExp, and do-notation doesn’t produce a TExp.
Indeed this is true -- this is what that page says. But it's not what's implemented: when I say $$( _ ) :: Bool, GHC tells me that the hole has type Q (TExp Bool). There still is no way to create a TExp other than to use a type TH quote. Addressing your other message: a typed quasiquoter would be somewhat limited, but not utterly silly. For example, this works:
bool :: String -> Q (TExp Bool) bool "true" = [|| True ||] bool "false" = [|| False ||] bool _ = fail "not a bool"
-- and then, in another module because of the stage restriction: yes :: Bool yes = $$(bool "true")
Now `bool` could be a typed quasiquoter. I don't know whether any of this is worth implementing, but it's not, a priori, a terrible idea. Richard
| * Should we consider it a bug (and file a ticket) that reification in | typed splices is able to observe the order of type checking, just like | reify used to do in untyped splices?
Yes I think so!!!
Simon

Hi all,
For our use case, namely automatic bindings generation via
quasiquotation à la language-c-inline, typed quasiquotation alone
wouldn't solve much. Because in order to be sensible it would likely
have to be restricted (one way or another) to only allowing
reification of variables in the previous declaration groups (since we
AFAICT all agree that the current permissiveness of reification in
typed splices is a bug). That won't fit the use case, since it's
precisely the types of the locally bound variables we're interested in
(see examples on the updated wiki page:
https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Reify).
So that brings us back to the question of allowing addModFinalizer to
capture the local type environment of the call site somehow. There's a
proposal for this that Facundo came up with and wrote up at the end of
the aforementioned wiki page, but does anyone else have a better way
of doing this in mind?
Best,
--
Mathieu Boespflug
Founder at http://tweag.io.
On 16 April 2016 at 16:02, Richard Eisenberg
On Apr 15, 2016, at 11:51 AM, Simon Peyton Jones
wrote: Hang on! The design for typed splices, describe here, https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/BlogPostChanges says "Unlike TH, the only way to construct a value of type TExp is with a quote. You cannot drop into do-notation, nor use explicit construction of the values in the Exp algebraic data type. That restriction limits expressiveness, but it enables the strong typing guarantees."
So why does the above work? $$(e) requires a TExp, and do-notation doesn’t produce a TExp.
Indeed this is true -- this is what that page says. But it's not what's implemented: when I say $$( _ ) :: Bool, GHC tells me that the hole has type Q (TExp Bool).
There still is no way to create a TExp other than to use a type TH quote.
Addressing your other message: a typed quasiquoter would be somewhat limited, but not utterly silly. For example, this works:
bool :: String -> Q (TExp Bool) bool "true" = [|| True ||] bool "false" = [|| False ||] bool _ = fail "not a bool"
-- and then, in another module because of the stage restriction: yes :: Bool yes = $$(bool "true")
Now `bool` could be a typed quasiquoter.
I don't know whether any of this is worth implementing, but it's not, a priori, a terrible idea.
Richard
| * Should we consider it a bug (and file a ticket) that reification in | typed splices is able to observe the order of type checking, just like | reify used to do in untyped splices?
Yes I think so!!!
Simon

I don't have a better idea. I've added a few small comments to the bottom of that wiki page, which still, for me, represents the best solution to this problem.
Richard
On Apr 18, 2016, at 5:01 PM, "Boespflug, Mathieu"
Hi all,
For our use case, namely automatic bindings generation via quasiquotation à la language-c-inline, typed quasiquotation alone wouldn't solve much. Because in order to be sensible it would likely have to be restricted (one way or another) to only allowing reification of variables in the previous declaration groups (since we AFAICT all agree that the current permissiveness of reification in typed splices is a bug). That won't fit the use case, since it's precisely the types of the locally bound variables we're interested in (see examples on the updated wiki page: https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Reify).
So that brings us back to the question of allowing addModFinalizer to capture the local type environment of the call site somehow. There's a proposal for this that Facundo came up with and wrote up at the end of the aforementioned wiki page, but does anyone else have a better way of doing this in mind?
Best, -- Mathieu Boespflug Founder at http://tweag.io.
On 16 April 2016 at 16:02, Richard Eisenberg
wrote: On Apr 15, 2016, at 11:51 AM, Simon Peyton Jones
wrote: Hang on! The design for typed splices, describe here, https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/BlogPostChanges says "Unlike TH, the only way to construct a value of type TExp is with a quote. You cannot drop into do-notation, nor use explicit construction of the values in the Exp algebraic data type. That restriction limits expressiveness, but it enables the strong typing guarantees."
So why does the above work? $$(e) requires a TExp, and do-notation doesn’t produce a TExp.
Indeed this is true -- this is what that page says. But it's not what's implemented: when I say $$( _ ) :: Bool, GHC tells me that the hole has type Q (TExp Bool).
There still is no way to create a TExp other than to use a type TH quote.
Addressing your other message: a typed quasiquoter would be somewhat limited, but not utterly silly. For example, this works:
bool :: String -> Q (TExp Bool) bool "true" = [|| True ||] bool "false" = [|| False ||] bool _ = fail "not a bool"
-- and then, in another module because of the stage restriction: yes :: Bool yes = $$(bool "true")
Now `bool` could be a typed quasiquoter.
I don't know whether any of this is worth implementing, but it's not, a priori, a terrible idea.
Richard
| * Should we consider it a bug (and file a ticket) that reification in | typed splices is able to observe the order of type checking, just like | reify used to do in untyped splices?
Yes I think so!!!
Simon
participants (6)
-
Boespflug, Mathieu
-
Facundo Domínguez
-
Geoffrey Mainland
-
Michael Sloan
-
Richard Eisenberg
-
Simon Peyton Jones