Querying Core for information about variables

Siddharth Bhat siddu.druid at gmail.com
Mon Jul 13 18:24:04 UTC 2020


Hello,

I'm trying to understand how to query information about `Var`s from a
Core plugin. Consider the snippet of haskell:

```
{-# LANGUAGE MagicHash #-}
import GHC.Prim
fib :: Int# -> Int#
fib i = case i of 0# ->  i; 1# ->  i; _ ->  (fib i) +# (fib (i -# 1#))
main :: IO (); main = let x = fib 10# in return ()
```

That compiles to the following (elided) GHC Core, dumped right after
desugar:

```
Rec {
fib [Occ=LoopBreaker] :: Int# -> Int#
[LclId]
fib
  = ...
end Rec }

Main.$trModule :: GHC.Types.Module
[LclIdX]
Main.$trModule
  = GHC.Types.Module
      (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Main"#)

-- RHS size: {terms: 7, types: 3, coercions: 0, joins: 0/0}
main :: IO ()
[LclIdX]
main
  = case fib 10# of { __DEFAULT ->
    return @ IO GHC.Base.$fMonadIO @ () GHC.Tuple.()
    }

-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
:Main.main :: IO ()
[LclIdX]
:Main.main = GHC.TopHandler.runMainIO @ () main
```

I've been  using `occNameString . getOccName` to manipulate names of `Var`s
from the Core
module. I'm rapidly finding this insufficient, and want more information
about a variable. In particular, How to I figure out:

1. When I see the Var with occurence name `fib`, that it belongs to module
`Main`?
2. When I see the Var with name `main`, whether it is `Main.main` or
`:Main.main`?
3. When I see the Var with name `+#`, that this is an inbuilt name?
Similarly
   for `-#` and `()`.
4. When I see the binder $trModule, that it is added by GHC and has type
`GHC.Types.Module`?
5. In general, given a Var, how do I decide where it comes from, and
whether it is
   user-defined or something GHC defined ('wired-in' I believe is the term
I am
   looking for)?
6. When I see a `Var`, how do I learn its type?
7. In general, is there a page that tells me how to 'query' Core/`ModGuts`
from within a core plugin?

Pointers on how to get this information is much appreciated. Also, pointers
on
"learning how to learn" --- that is, how I could have figured this out on
my own /
RTFMing better are also very appreciated!

Thanks a lot,
~Siddharth

-- 
https://bollu.github.io/
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20200713/0e293010/attachment.html>


More information about the ghc-devs mailing list