RE: [Template-haskell] Reification of local names
You're trying to use reify for something it's not designed for. reify looks something up in the type environment, *at the point where that Q computation was spliced in*. So if I say foo :: Q Info foo = reify (mkName "wog") then the reify will look up "wog" wherever I say $foo. Not at the point where foo is defined. In this case, you're going to look up the name in your syntax tree, but you'll look it up in the type environment where $foo is spliced in -- which is the top level of module A. The "right place" to find the type info for a given syntax tree is in the syntax tree. The type checker has processed your fragment [| let f = \x -> x + 2 in f |] You just want to see the types. Currently there is no way to do that, but people often ask for it. One idea: add (Maybe Type) fields to many TH syntax forms, where the type checker can record types. That's simple and direct. A general question to TH aficionados: would this be useful? Remember that the type may not be fully precise, because it's the result of type-checking an as-yet-unspliced fragment. Simon | -----Original Message----- | From: template-haskell-bounces@haskell.org [mailto:template-haskell-bounces@haskell.org] On | Behalf Of Stefan Heimann | Sent: 17 June 2004 15:46 | To: template-haskell@haskell.org | Subject: [Template-haskell] Reification of local names | | Hi! | | I need to extract some type information from the syntax | tree. Therefore I need to reify non-global names. Take the following | example: | | module A where | | import Language.Haskell.TH | | logQ = runIO . putStrLn | | stringOfInfo (ClassI _) = "ClassI" | stringOfInfo (ClassOpI name t _ _) = "ClassOpI " ++ show name ++ " :: " ++ show t | stringOfInfo (TyConI _) = "TyConI" | stringOfInfo (DataConI name t _ _) = "DataConI " ++ show name ++ " :: " ++ show t | stringOfInfo (VarI name t _ _) = "VarI " ++ show name ++ " :: " ++ show t | stringOfInfo (TyVarI name t) = "TyVarI " ++ show name ++ " = " ++ show t | | foo :: Q Exp -> Q [Dec] | foo e' = do e <- e' | case e of | LetE _ (VarE name) -> do info <- reify name | logQ (stringOfInfo info) | return [] | --- | | module Main where | | import A | | $(foo [| let f = \x -> x + 2 | in f |]) | | main = return () | | --- | | What the example does is trying to reify 'f' in the expression | | let f = \x -> x + 2 | in f | | When I now compile the example, I get the following output: | | $ ghc-cvs --make -fth B.hs | Chasing modules from: B.hs | Compiling A ( ./A.hs, ./A.o ) | Compiling Main ( B.hs, B.o ) | Loading package base ... linking ... done. | Loading package haskell98 ... linking ... done. | Loading package template-haskell ... linking ... done. | | B.hs:1:0: tcLookupGlobal: `f' is not in scope | | B.hs:1:0: | Exception when trying to run compile-time code: | Code: foo ([| let f = \ x -> ... in f |] | where []) | Exn: user error (IOEnv failure) | | I am using the development snapshot ghc-6.3.20040612. | | So my question is: Is it simply not possible to reify local | definitions, is it a bug or is it not yet implemented? If it is | possible in general to reify local definitions but just not | implemented at the moment, do you have any schedule on when an | implementation will be available? | | Thanks for helping! | | Stefan | _______________________________________________ | template-haskell mailing list | template-haskell@haskell.org | http://www.haskell.org/mailman/listinfo/template-haskell
On Mon, 2004-06-21 at 17:52, Simon Peyton-Jones wrote:
The "right place" to find the type info for a given syntax tree is in the syntax tree. The type checker has processed your fragment [| let f = \x -> x + 2 in f |] You just want to see the types. Currently there is no way to do that, but people often ask for it.
One idea: add (Maybe Type) fields to many TH syntax forms, where the type checker can record types. That's simple and direct.
A general question to TH aficionados: would this be useful? Remember that the type may not be fully precise, because it's the result of type-checking an as-yet-unspliced fragment.
I would certainly find this useful. I'm currently hacking Mark Jones's Typing Haskell in Haskell implementation to work with TH so that I can find the types of locally defined functions. This obviously not an ideal long term solution (though it would be better if TH could tell us the kinds of types and if we could ask questions about instances of classes - eg "is this type foo (or more generally this tuple of types) an instance of this class bar"). Duncan
Monday 21 June 2004 18:52, Simon Peyton-Jones wrote:
The "right place" to find the type info for a given syntax tree is in the syntax tree. The type checker has processed your fragment [| let f = \x -> x + 2 in f |] You just want to see the types. Currently there is no way to do that, but people often ask for it.
One idea: add (Maybe Type) fields to many TH syntax forms, where the type checker can record types. That's simple and direct.
This is actually the way how we implemented it in Nemerle. Our syntax trees has elements like E_typed { body : Typedtree.Expr } in Parsetree.Expr or T_typed { body : Typedtree.Type } in Parsetree.Type, so we can store typed parts in our ASTs. Our quotations support this with <[ $(e : typed) ]> where `e' is a variable holding typed tree of expression We can also build typed trees for types with quotation like <[ ttype: int ]> For example our `if' expression is a macro checking type of condition to supply special error message: macro @if (cond, e1, e2) syntax ("if", "(", cond, ")", e1, Optional (";"), "else", e2) { def tcond = ty_expr (Nemerle.Macros.ImplicitCTX (), cond); def bool_ty = <[ ttype: bool ]>; expect_type ("if condition", tcond, bool_ty); <[ match ($(tcond : typed)) { | true => $e1 | _ => $e2 } ]> }
A general question to TH aficionados: would this be useful? Remember that the type may not be fully precise, because it's the result of type-checking an as-yet-unspliced fragment.
This is right, but when one has access to what compiler know about program, then this case can be handled inside meta code. And usefulness of this feature can be really impressive. For example, take a look at typed version of SelectFromTuple - it can take one integer and tuple, then generate pattern matching for tuple of size reified form type of given object and selection of specified element. No need to specify size of tuple manually. And this is just a simple example. In practice, we use this feature in some more interesting places, but too complex for a short example here. Kamil Skalski
On Mon, Jun 21, 2004 at 05:52:04PM +0100, Simon Peyton-Jones wrote:
One idea: add (Maybe Type) fields to many TH syntax forms, where the type checker can record types. That's simple and direct.
A general question to TH aficionados: would this be useful? Remember that the type may not be fully precise, because it's the result of type-checking an as-yet-unspliced fragment.
I know almost nothing about views, but would they allow us to treat a datatype with (Maybe Type)s as either one with Types or one identical to what we currently have, at our choice? I think there are probably cases where we will have to lose type info when we manipulate datastructures in the second view, but overall I think this could work well. I don't relish the thought of having to sprinkle Nothings liberally over my code. Thanks Ian
participants (4)
-
Duncan Coutts -
Ian Lynagh -
Kamil Skalski -
Simon Peyton-Jones