Haskell
Plugin
ghc
ghcup
HaskellDay 1

GHC Source Plugin 作ってみた

タイトル通り GHC Source Plugin を作ってみました!!!

GHC Source Plugin とは何か?

とてもわかりやすい図があるので、ICFP 2018 Source Plugins のスライドから引用させていただきます。

Screen Shot 2018-12-01 at 23.18.49.png

GHC Source Plugin というのは一言で言えば、この図の緑の領域の矢印の場所に差し込む事ができるプラグインです。

GHC に詳しい方は GHC Plugin は昔からあったよね?Core to Core で変換するやつ!と思っていることでしょうが、今回のプラグインは Parser, Renamer, Typechecker の直後に差し込めるため、GHC API を使って普通に処理を書く事ができます。(ちなみに昔からあるのは赤い部分のプラグインです。)

そのため、GHC Source Plugin を作ることで GHC の理解も深まり、GHC の勉強にもなるということです。これは GHC について理解を深めたいと思っている人におすすめの学習方法です。なぜなら GHC は機能がありすぎるため最初にどこからコードリーディングすれば良いか迷子になってしまうためです。

GHC Source Plugin を作るためには何が必要か?

GHC-8.6.1 以上でしか動作しません。また、8.6.1 はバグってるので 8.6.2 を使うことにします。

stack を使っても良いのですが、このように GHC の最新の機能を活用するためには cabal の方が適しています。しかし cabal はビルドツールなので GHC をインストールする方法がありません。そのため、最近では ghcup を使ってインストールしています。(rustup と同じようなやつです!)

ghcup で GHC をインストール!

まずは ghcup をインストールします。ghcup はまだ出来たばかりですが、使いやすくて良いツールだと思います。

$ (mkdir -p ~/.ghcup/bin && curl https://raw.githubusercontent.com/haskell/ghcup/master/ghcup > ~/.ghcup/bin/ghcup && chmod +x ~/.ghcup/bin/ghcup) && echo "Success"

stack みたいにワンライナーでインストール完了です。

次にパスを通します。

$ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"

必要に応じて .bashrc.bash_profile に追記してください。

これで ghcup が使えるようになりました!

$ ghcup --version
0.0.6

ghcup list

インストール可能な GHC と cabal のバージョンを出してくれます。

$ ghcup list
Available upstream versions:

ghc     8.0.2   
ghc     8.2.2   
ghc     8.4.3   
ghc     8.4.4   recommended
ghc     8.6.1   bad
ghc     8.6.2   latest
cabal-install   2.2.0.0 
cabal-install   2.4.0.0 
cabal-install   2.4.1.0 latest,recommended

8.6.1 はバグ入りなので、bad と表示が出ています。親切ですよね。

ghcup install

今回は 8.6.2 をインストールします。

$ ghcup install 8.6.2
...

ghcup install

これで完了です!簡単ですね。

ghcup set

ghcup は複数バージョンの GHC を管理しているため、明示的に利用したいバージョンを指定するだけですぐにコンパイラを切り替えることができます。

$ ghcup set 8.6.2
Setting GHC to 8.6.2
Done, make sure "/home/guchi/.ghcup/bin" is in your PATH!

$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 8.6.2

試しに他のバージョンに切り替えてみましょう。

$ ghcup set 8.2.2
Setting GHC to 8.2.2
Done, make sure "/home/guchi/.ghcup/bin" is in your PATH!
guchi@degas:~$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 8.2.2

とても簡単ですね!

ghcup show

インストールされているバージョンの一覧を確認するためのコマンドです。また、現在セットされているGHCのバージョンも確認できます。

$ ghcup show
Installed GHCs:
    8.2.2
    8.6.2

Current GHC
    8.6.2

ghcup で cabal をインストール!

ghcup は ghc だけでなく cabal もインストールできちゃんですね。(cabal は cabal-install のことです)

$ ghcup install-cabal
Installing cabal-install-2.4.1.0 into "/home/guchi/.ghcup/bin"
  % Total    % Received % Xferd  Average Speed   Time    Time     Time  Current
                                 Dload  Upload   Total   Spent    Left  Speed
100 4025k  100 4025k    0     0  9341k      0 --:--:-- --:--:-- --:--:-- 9341k
Successfully installed cabal-install into
  /home/guchi/.ghcup/bin

You may want to run the following to get the really latest version:
    cabal new-install cabal-install

And make sure that "~/.cabal/bin" comes *before* "/home/guchi/.ghcup/bin"
in your PATH!

$ cabal --version
cabal-install version 2.4.1.0
compiled using version 2.4.1.0 of the Cabal library

これでインストール完了です。最新版の cabal にする場合は

$ cabal new-install cabal-install

とするだけで大丈夫です。

これで ghccabal が用意できたので準備が整いました!

Plugin の雛形

これは GHC のマニュアルに載っている例を少し改変したものです。基本形は全てこの形式になります。

プラグインのコード

BasicPluginSimple.hs
module BasicPluginSimple (plugin) where

import GhcPlugins
import TcRnTypes (IfM, TcM, TcGblEnv, tcg_binds, tcg_rn_decls)
import HsExtension (GhcTc, GhcRn)
import HsDecls (HsGroup)
import HsExpr (LHsExpr)

plugin :: Plugin
plugin = defaultPlugin
  { parsedResultAction = parsedPlugin
  , renamedResultAction = renamedAction
  , typeCheckResultAction = typecheckPlugin
  , spliceRunAction = metaPlugin
  , interfaceLoadAction = interfaceLoadPlugin
  }

parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedPlugin _ _ pm = do
  dflags <- getDynFlags
  liftIO $ putStrLn $ "parsePlugin: \n" ++ (showSDoc dflags $ ppr $ hpm_module pm)
  return pm

renamedAction :: [CommandLineOption] -> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
renamedAction _ tc gr = do
  dflags <- getDynFlags
  liftIO $ putStrLn $ "typeCheckPlugin (rn): " ++ (showSDoc dflags $ ppr gr)
  return (tc, gr)

typecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
typecheckPlugin _ _ tc = do
  dflags <- getDynFlags
  liftIO $ putStrLn $ "typeCheckPlugin (rn): \n" ++ (showSDoc dflags $ ppr $ tcg_rn_decls tc)
  liftIO $ putStrLn $ "typeCheckPlugin (tc): \n" ++ (showSDoc dflags $ ppr $ tcg_binds tc)
  return tc

metaPlugin :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
metaPlugin _ meta = do
  dflags <- getDynFlags
  liftIO $ putStrLn $ "meta: " ++ (showSDoc dflags $ ppr meta)
  return meta

interfaceLoadPlugin :: [CommandLineOption] -> ModIface -> IfM lcl ModIface
interfaceLoadPlugin _ iface = do
  dflags <- getDynFlags
  liftIO $ putStrLn $ "interface loaded: " ++ (showSDoc dflags $ ppr $ mi_module iface)
  return iface

defaultPlugin が定義されているので、自分が差し込みたい位置のフィールドを適切に上書きするだけです。

フィールド名 差し込まれる位置
parsedResultAction パーズ後
renamedResultAction リネーム後
typeCheckResultAction 型チェック後
spliceRunAction TH などの splice 展開後
interfaceLoadAction ?

プラグインを利用するコード

プラグインを利用する側のコードはこんな感じです。

Example.hs
{-# OPTIONS_GHC -fplugin BasicPluginSimple #-} 
{-# LANGUAGE TemplateHaskell #-}
module Example where

a = ()

$(return [])

単一のパッケージで試す場合はプラグインを利用するファイル内で {-# OPTIONS_GHC -fplugin BasicPluginSimple #-} を宣言しておく必要があります。BasicPluginSimple はプラグイン名に対応しています。

通常は cabal ファイルの ghc-options-fplugin を書く事になると思います。そうすることで全部のモジュールでプラグインが実行されます。

  ghc-options:
    -fplugin=BasicPluginSimple

cabal ファイル

basic-simple.cabal
cabal-version:       >=1.10
name:                basic-simple
version:             0.1.0.0
build-type:          Simple

library
  build-depends:
    base >=4.12 && <4.13,
    ghc==8.6.2

  exposed-modules:
    BasicPluginSimple
    Example

  default-language: Haskell2010

  other-extensions:
    TemplateHaskell

実際に試してみます

$ cabal new-build
...

parsePlugin:
module Example where
a = ()
$(return [])
typeCheckPlugin (rn): a = ()
interface loaded: Language.Haskell.TH.Lib.Internal
interface loaded: Language.Haskell.TH.Syntax
meta: return []
typeCheckPlugin (rn):
typeCheckPlugin (rn):
Nothing
typeCheckPlugin (tc):
{$trModule
   = Module
       (TrNameS "basic-simple-0.1.0.0-inplace"#) (TrNameS "Example"#),
 a = ()}

プラグインで定義した通りに色々出力されていますね!だいたい説明はこんな感じです。

実際に作ってみたプラグイン

まだ実験的にしか作っていませんが、こんなのを作ってみました。

カスタムプレリュードを差し込むプラグイン

module ReplacePrelude (plugin) where

import GhcPlugins
import TcRnTypes (IfM, TcM, TcGblEnv, tcg_binds, tcg_rn_decls)
import HsExtension (GhcTc, GhcRn, GhcPs)
import HsDecls (HsGroup)
import HsExpr (LHsExpr)
import HsSyn

plugin :: Plugin
plugin = defaultPlugin
  { parsedResultAction = parsedPlugin
  }

parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedPlugin _ _ pm = do
  dflags <- getDynFlags

  let extract = hsmodImports . unLoc
      customPrelude = noLoc $ simpleImportDecl $ mkModuleName "RIO"

      m = fmap (updateHsModule customPrelude) $ hpm_module pm
      pm' = pm { hpm_module = m }

  liftIO $ putStrLn $ "import modules: \n" ++ (showSDoc dflags $ ppr $ extract $ hpm_module pm')
  return pm'

updateHsModule :: LImportDecl pass -> HsModule pass -> HsModule pass
updateHsModule importDecl hsm = hsm { hsmodImports = importDecl:decls }
  where decls = hsmodImports hsm

RIO の文字列を埋め込んでますが、たぶんコマンドライン引数から取得できます。また、DynFlags を使って NoImplicitPrelude フラグを有効にすることもできそうです。

モジュールに定義されているデータ型の Strict と Lazy のフィールド数をカウントするプラグイン

module CountStrictFields (plugin) where

import GhcPlugins
import TcRnTypes
import HsExtension
import HsDecls
import HsTypes
import qualified GHC.LanguageExtensions as LangExt

plugin :: Plugin
plugin = defaultPlugin
  { renamedResultAction = renamedAction
  }

renamedAction :: [CommandLineOption] -> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
renamedAction _ tc gr = do
  dflags <- getDynFlags
  let isStrictData = xopt LangExt.StrictData dflags

  let tyClDecls = map unLoc $ tyClGroupTyClDecls $ hs_tyclds gr
      tyDataDecls = filter isDataDecl tyClDecls
      hsDataDefn = map tcdDataDefn tyDataDecls
      lConDecl = concatMap dd_cons hsDataDefn
      decls = filter isConDeclH98 $ map unLoc lConDecl
      lBangTypes = concatMap (hsConDeclArgTys . getConArgs) decls
      fieldNums =
        if isStrictData
        then length lBangTypes
        else length $ filter (isSrcStrict . getSrcStrictness . getBangStrictness) lBangTypes

  liftIO $ putStrLn $ ""
  liftIO $ putStrLn $ "========================================"
  liftIO $ putStrLn $ "StrictData : " ++ (show isStrictData)
  liftIO $ putStrLn $ "strict fields: " ++ (show fieldNums) ++ "/" ++ (show $ length lBangTypes)
  liftIO $ putStrLn $ "========================================"
  liftIO $ putStrLn $ ""

  return (tc, gr)

isConDeclH98 :: ConDecl pass -> Bool
isConDeclH98 ConDeclH98{} = True
isConDeclH98 _ = False

getSrcStrictness :: HsSrcBang -> SrcStrictness
getSrcStrictness (HsSrcBang _ _ ss) = ss

プラグインを利用する側のコード

Example.hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Strict #-}
module Example where

data MyData1   = MyDataCon1
data MyData2 a = MyDataCon2 a
data MyData3 b = MyDataCon3 !b
data MyData4   = MyDataCon4 Int
data MyData5   = MyDataCon5 !Int Int Char Bool !(MyData3 Int)
Lib.hs
{-# LANGUAGE BangPatterns #-}
module Lib where

data MyLib1 = MyLib1
data MyLib2 = MyLib2 (Maybe Int) !(Maybe Int) !(Maybe Int)

実行結果

実行例
$ cabal new-build
...

[1 of 2] Compiling Example

========================================
StrictData : True
strict fields: 8/8
========================================

[2 of 2] Compiling Lib 

========================================
StrictData : False
strict fields: 2/3
========================================

もっとちゃんとしたプラグインの例

僕の例は実験的に色々試しただけですが、実際に有用なプラグインが既にいくつも存在します。

まとめ

  • GHC Source Plugin は GHC の学習に向いている
  • GHC Source Plugin は実用的にとても使えそう
  • GHC Source Plugin はアイデア勝負!
  • GHc Source Plugin たのしい

今回のコードはgithubにあるので、試したい人は実際に試すことができます。

また、GHC Source Plugin に興味を持った人のために、以下に参考となる情報を載せておきます。

簡単に作れるので、みんな作ろう〜!