Skip to content

Example plugin #8

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 15 commits into
base: master
Choose a base branch
from
Open

Example plugin #8

wants to merge 15 commits into from

Conversation

angerman
Copy link
Collaborator

@angerman angerman commented Jun 4, 2020

This is an example use case for the Extensible Interface Files, ghc!2948 GHC extension. The idea is to use store and load GHCs core representation from the interface files without having to resort to -fexpose-all-unfoldings or excessive INLINE pragmas. A high level overview is given in README.

Example.hs is the plugin code to be used with GHC, and which contains all the logic to write out, as well as read in the core expressions and inline them.

The setup consists of a Lib module, and a Main module, where the Main module depends on the Lib module. Thus compiling the Main module with the Example plugin should demonstrate the inlining of core expressions.

NOTE: There is also a Makefile that ties this all together and provides a reproducible setup.

Discussion

The Main module contains the following function t:

t :: Int -> Int -> Bool
t a b = g (f a + b)

which we call in the main function of the Main module here:

main = do
-- Simpler examples
print (t x y)

Thus to evaluate t we need f, g as well as x and y, from the Lib module.

f :: Int -> Int
f = plus 1
where
plus = (+)

g :: Int -> Bool
g 0 = True
g _ = False

(1) Without using the plugin we can see that the Main module produces the following core:

 main :: IO ()
 [LclIdX,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
          WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 570 0}]
 main
   = >>
       @IO
       $fMonadIO
       @()
       @()
       (print @Bool $fShowBool (g (+ @Int $fNumInt (f x) y)))
       (>>
          @IO
          $fMonadIO
          @()
          @()
          (print
             @(MyData Bool Int)
             ($fShowMyData @Bool @Int $fShowBool $fShowInt)
             (mapMyData @Int @Int @Bool @Int fn_md md1))
          (>>
             @IO
             $fMonadIO
             @()
             @()
             (print @Int $fShowInt (sumMyData @Int @Int md1))
             (>>
                @IO
                $fMonadIO
                @()
                @()
                (print
                   @Int
                   $fShowInt
                   (sumMyData @Bool @Int (mapMyData @Int @Int @Bool @Int fn_md md1)))
                (print
                   @Int
                   $fShowInt
                   (sumMyData
                      @Bool @Int (mapMyData @Int @Int @Bool @Int fn_md md1))))))

(2) when using the Example plugin, we observe that the Main modules core now looks like this:

 main :: IO ()
 [LclIdX,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
          WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 670 0}]
 main
   = >>
       @IO
       $fMonadIO
       @()
       @()
       (print
          @Bool
          $fShowBool
          (case + @Int
                  $fNumInt
                  (+ @Int $fNumInt (I# 1#) (I# 1#))
                  (+ @Int $fNumInt x (I# 2#))
           of
           { I# ds ->
           case ds of {
             __DEFAULT -> False;
             0# -> True
           }
           }))
       (>>
          @IO
          $fMonadIO
          @()
          @()
          (print
             @(MyData Bool Int)
             ($fShowMyData @Bool @Int $fShowBool $fShowInt)
             (mapMyData @Int @Int @Bool @Int fn_md md1))
          (>>
             @IO
             $fMonadIO
             @()
             @()
             (print @Int $fShowInt (sumMyData @Int @Int md1))
             (>>
                @IO
                $fMonadIO
                @()
                @()
                (print
                   @Int
                   $fShowInt
                   (sumMyData @Bool @Int (mapMyData @Int @Int @Bool @Int fn_md md1)))
                (print
                   @Int
                   $fShowInt
                   (sumMyData
                      @Bool @Int (mapMyData @Int @Int @Bool @Int fn_md md1))))))

Please observe that we can see in (2), that the following expression from (1)

g (+ @Int $fNumInt (f x) y)

was replaced by

case + @Int
                  $fNumInt
                  (+ @Int $fNumInt (I# 1#) (I# 1#))
                  (+ @Int $fNumInt x (I# 2#))
           of
           { I# ds ->
           case ds of {
             __DEFAULT -> False;
             0# -> True
           }
           }

If we now treat Lib as it's own cabal package, this also works - with identical results. This is because the loading process is agnostic to package, so as long as the bindings exist, they will be loaded. In the case of one-shot compilation, modules appear as external anyway, so we would have to explicitly test for external package names if we wanted (for some reason) to exclude this working outside of the home package.

Copy link
Collaborator Author

@angerman angerman left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Left some comments. So far so good. Will need to be adapted to the new changes where the Plugin has control over the written out core info.

Copy link

@michaelpj michaelpj left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Looks generally good!

* `bindsPass` - print the bindings (after the inliner has optionally run), for `diff`ing
* `printer` - using the `print` plugin flag:
pretty-print the `HscEnv` `ModGuts` to the console, for debugging
* `serialiser` - using the `inline` plugin flag:

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

As discussed on Slack, this is the bit we really need to control via a GHC flag if we can.

Because the core bindings contain GHC `Name`s and `FastString`s, which are serialised
in a lookup table, we need to use `putWithUserData` to write to a raw `BinHandle`. If
our data didn't contain either of these types, we could use `registerInterfaceData`
to avoid the raw handle and instead go via the `GHC.Binary` instance.

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Just checking: is this stuff documented in GHC for less savvy users?

of serialised `Iface`* structures into proper in-memory reference-based structures.

We want to cache the binds we load, so we use `newLoadBind` to initialise the `IORef`
for this - giving us an `IO` function mapping `Name`s to `Bind Id`s.

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Another advantage of having this in GHC would be hiding this stuff from poor users 😅 although for our usecase it's fine if it's hairy.

-}
inlineCore :: (Name -> IO (Maybe (Bind CoreBndr))) -> Bind Id -> IO (Bind Id)
inlineCore lookup (NonRec n expr) = NonRec n <$> inlineCoreExpr lookup expr
inlineCore lookup (Rec pairs) = Rec <$> mapM inlineCorePair pairs

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Just while I'm here, I'd probably write something like:

Rec <$> for pairs $ \(n, b) -> (n,) <$> inlineCoreExpr lookup b

go (Var v) = do
look <- lookup (varName v)
return $ case look of
Just (NonRec _ expr) -> expr

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What about recursive bindings?

go (App e1 e2 ) = App <$> go e1 <*> go e2
go (Lam b e ) = Lam b <$> go e
go (Let b e ) = Let b <$> go e
go (Case e b t alts) = Case e b t <$> mapM goAlt alts

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You can do the same trick with for to make inlining goAlts palatable.

we assume (based on which types of bindings we have determined become top-level
recursive bindings):
* The binding has at least one case
* All cases have the same `Name`.

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

🤔

Is this really right? What about

odd = ... even ...
even = ... odd ...

?

from the `ModGuts` instead. However, since we're running this plugin early in
the core pipeline, the current module's binds won't have passed through the
core optimisation phases yet, so if we're inlining `Name`s from this module
we'll have to rely on the optimisations being run on our already inlined ASTs.

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is fine. Although it also depends when we do the serialization of the ModGuts for dependent modules, no? If we do it before we do lots of optimization then we'll also get unoptimized code from them. I think we probably should do it relatively early, but I'm not sure.


-- This structure is infinite on the last field, so we want to make sure that
-- the inlining takes that into account and only inlines the first field.
-- We should consider that Plutus will need to know about the infinite recursion

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It handles this already, so that's fine.

Currently, without extensible interface files, Plutus uses the unfoldings to recover the Core
represented by a name from an external module. Unfoldings are normally used by GHC perform regular
Haskell inlining. However, this has a number of disadvantages:
* The user needs to annotate all such external bindings with `INLINE`

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

INLINABLE

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

Successfully merging this pull request may close these issues.

3 participants