How to get types including constraints out of TypecheckedModule

Hi ghc-devs, I have a question and some code to ponder on for you all: In ghc-mod we have this very useful command to get the type of something in the middle of a module, i.e. not a toplevel binder. Essentially we just optain a TypecheckedModule and traverse the tm_typechecked_source and then extract the Types from that in various places. This all works nice and well but we have one problem, namely the contraints are missing from all types. Now I'm sure there's a good reason GHC doesn't keep those inline in the syntax tree but my question is how do I get them? I've created a testcase that demonstrates the problem: $ git clone https://gist.github.com/DanielG/1101b8273f945ba14184 $ cd 1101b8273f945ba14184 $ ghc -package ghc -package ghc-paths GhcTestcase.hs $ ./GhcTestcase Type: a Even though the type of the binder I'm looking at has the type `Num a => a`. --Daniel

I have not looked in detail, but I'm confident that all the info you want is there. For let/where/top-level bindings, the polymorphic binders you want are in the 'AbsBinds' construct. | AbsBinds { -- Binds abstraction; TRANSLATION abs_tvs :: [TyVar], abs_ev_vars :: [EvVar], -- ^ Includes equality constraints -- | AbsBinds only gets used when idL = idR after renaming, -- but these need to be idL's for the collect... code in HsUtil -- to have the right type abs_exports :: [ABExport idL], -- | Evidence bindings -- Why a list? See TcInstDcls -- Note [Typechecking plan for instance declarations] abs_ev_binds :: [TcEvBinds], -- | Typechecked user bindings abs_binds :: LHsBinds idL } The info you want is in the abs_exports field: data ABExport id = ABE { abe_poly :: id -- ^ Any INLINE pragmas is attached to this Id , abe_mono :: id , abe_wrap :: HsWrapper -- ^ See Note [AbsBinds wrappers] -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly , abe_prags :: TcSpecPrags -- ^ SPECIALISE pragmas This pairs the "polymorphic" and "monomorphic" versions of the bound Ids. You'll find the monomorphic one in the bindings in the abs_binds field; and you'll find the very same binder in the abe_mono field of one of the ABExport records. Then the corresponding abe_poly Id is the polymorphic one, the one with type foo :: forall a. Num a => a I hope this is of some help. If so, would you like to update the Commentary (on the GHC wiki) to add the information you wish had been there in the first place? Thanks! Simon | -----Original Message----- | From: ghc-devs [mailto:ghc-devs-bounces@haskell.org] On Behalf Of Daniel | Gröber | Sent: 18 September 2015 06:00 | To: ghc-devs@haskell.org | Subject: How to get types including constraints out of TypecheckedModule | | Hi ghc-devs, | | I have a question and some code to ponder on for you all: In ghc-mod we | have | this very useful command to get the type of something in the middle of a | module, | i.e. not a toplevel binder. Essentially we just optain a TypecheckedModule | and | traverse the tm_typechecked_source and then extract the Types from that in | various places. | | This all works nice and well but we have one problem, namely the | contraints are | missing from all types. Now I'm sure there's a good reason GHC doesn't | keep | those inline in the syntax tree but my question is how do I get them? | | I've created a testcase that demonstrates the problem: | | $ git clone | https://na01.safelinks.protection.outlook.com/?url=https%3a%2f%2fgist.gith | ub.com%2fDanielG%2f1101b8273f945ba14184&data=01%7c01%7csimonpj%40064d.mgd. | microsoft.com%7c07dcc820e45245b16c6108d2bfe60ca0%7c72f988bf86f141af91ab2d7 | cd011db47%7c1&sdata=40WgQQpssauSfbsTPpDVzhEwwhBHUAwEAGf8%2fADzxxg%3d | $ cd 1101b8273f945ba14184 | $ ghc -package ghc -package ghc-paths GhcTestcase.hs | $ ./GhcTestcase | Type: a | | Even though the type of the binder I'm looking at has the type `Num a => | a`. | | --Daniel

(whoops, didn't send this to the list) On Fri, Sep 18, 2015 at 09:22:09AM +0000, Simon Peyton Jones wrote:
I have not looked in detail, but I'm confident that all the info you want is there. For let/where/top-level bindings, the polymorphic binders you want are in the 'AbsBinds' construct.
| AbsBinds { -- Binds abstraction; TRANSLATION abs_tvs :: [TyVar], abs_ev_vars :: [EvVar], -- ^ Includes equality constraints
-- | AbsBinds only gets used when idL = idR after renaming, -- but these need to be idL's for the collect... code in HsUtil -- to have the right type abs_exports :: [ABExport idL],
-- | Evidence bindings -- Why a list? See TcInstDcls -- Note [Typechecking plan for instance declarations] abs_ev_binds :: [TcEvBinds],
-- | Typechecked user bindings abs_binds :: LHsBinds idL }
The info you want is in the abs_exports field:
data ABExport id = ABE { abe_poly :: id -- ^ Any INLINE pragmas is attached to
Awesome that's exactly what I was looking for. I noticed the constructor before but it looked like that's just for type declarations and not for inferred types coming from the typechecker. this Id
, abe_mono :: id , abe_wrap :: HsWrapper -- ^ See Note [AbsBinds wrappers] -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly , abe_prags :: TcSpecPrags -- ^ SPECIALISE pragmas
This pairs the "polymorphic" and "monomorphic" versions of the bound Ids. You'll find the monomorphic one in the bindings in the abs_binds field; and you'll find the very same binder in the abe_mono field of one of the ABExport records. Then the corresponding abe_poly Id is the polymorphic one, the one with type foo :: forall a. Num a => a
What if I have a binder: (foo, bar) = (show, show) I can now get the polymorphic types of foo and bar respectively but how do I'm not sure how I'm meant to zip up the monomorphic type of `pat_rhs_ty`, i.e. the type of the whole rhs, with the polymorphic types in `abs_exports`. I mean I could just match up the type variables and pull the constraints in by hand but it just seems like there already ought to be a way to do this somewhere? Alternatively my strategy to do this would be to build a map from TyVar to the constraint and then going over the monomorphic types and for each TyVar that's mentioned in the monomorphic type pull in the relevant constraint and apply those to the monomorphic type. Does that sound sensible at all? I have no idea how equality constraints and all that fancy stuff are encoded so I hope that doesn't need any special handling ;)
I hope this is of some help. If so, would you like to update the Commentary (on the GHC wiki) to add the information you wish had been there in the first place? Thanks!
Very much so, thanks :) I'd love to put this in the commentary somewhere but looking at https://ghc.haskell.org/trac/ghc/wiki/Commentary I can't actually find anywhere this would fit in and it just seems like an awefully specific thing to put there. Maybe it would be better to improve the comments instead for the next person that goes looking thoguth the source trying to figure out where the types end up. For example the comment on AbsBinds could mention that this is where the typechecker stores inferred constrainst or something like that. --Daniel
participants (2)
-
Daniel Gröber
-
Simon Peyton Jones