@nwtgck

Edited at 2018-04-30

HaskellでC言語コンパイラ動かしたり、関数化しやすくして再利用性を高めたりしてみたよ

ELVMを使って、HaskellでC言語コンパイラが動いたりします。自動生成されたコードを純粋関数化しやすくして再利用性を高められるようにしたりします。

ELVM公式リポジトリ

先駆者さんたち

参考にさせていただいた記事です。
@kw_udon さんの「コンパイル時Cコンパイラ」とても話題でしたよね。
@rhysd さんと @yutopp さんの記事がELVMのバックエンドを作るときに参考になりました。

ELVMでできること

8cc¹でC言語をELVM IRに変換できる²
elcでELVM IRを色んな言語に変換できる

C言語 => [elvm/8cc]　=> ELVM IR

ELVM IR => [elc] => Java, Python, Haskell ...

そして、すごいことに、「8ccとelcは自分自身をコンパイル」できてしまいます！セルフホスト可能と呼ぶらしく、「8ccとelcが純粋なJavaとか純粋なPythonとか純粋なHaskell、...」になれちゃうわけです！

ということで、なぜかHaskellのバックエンドがなかったので実装して、C言語をHaskellに変換できるようにします。現在公式にマージしてもらえたので、使えるようになりました！

Haskellバックエンドの実装

ELVM　IRはとてもシンプルに設計されています。

A, B, C, D, SP, BPのレジスタとメモリがあって、
以下の命令たちをHaskellに変換できるようにすれば、C言語をHaskellに変換できてしまいます。

MOVE
ADD
SUB
LOAD
STORE
PUTC
GETC
EXIT
JEQ/JNE/.. ジャンプ系
EQ/NE/.. 比較系
DUMP

(https://github.com/shinh/elvm/blob/master/ELVM.md)

レジスタに代入したり、メモリに添え字でアクセスしたり書き換えたりする必要があるので、
シンプルにIORefとIOArray　使って実装してしまいました。
詳しい実装は、こちらのdiffになります。https://github.com/shinh/elvm/commit/2256d71b2cdf1128261c4d258d54fa912e306e7a

バックエンドを動かしてみる

Haskellのバックエンドを実際に使ってみます。

自作言語RillでCコンパイラを動かした話 - Qiitaから変換元のC言語のコードを使わせていただきます。

hello.c

// (from: https://qiita.com/yutopp/items/9718a1efba1ddc4577dd)

int putchar(int c);
void print_str(const char* p);
int puts(const char* p);

int main() {
    puts("hello Haskell world!");
    return 0;
}

void print_str(const char* p) {
  for (; *p; p++)
    putchar(*p);
}

int puts(const char* p) {
    print_str(p);
    putchar('\n');
}

以下がhello.c => hello.hsにする手順になります。

# 公式リポジトリをクローン
git clone https://github.com/shinh/elvm.git
# リポジトリに移動
cd elvm/
# makeする
make
# hello.c => hello.eir
./out/8cc -S -I. -Ilibc -o hello.eir hello.c
# hello.eir => hello.hs
./out/elc -hs hello.eir > hello.hs

自動生成された　`hello.hs`

import Data.Array.IO
import Data.IORef
import Data.Char
import Data.Bits
import System.Exit
import Control.Exception

main :: IO ()
main = do
 aRef <- newIORef 0 :: IO (IORef Int)
 bRef <- newIORef 0 :: IO (IORef Int)
 cRef <- newIORef 0 :: IO (IORef Int)
 dRef <- newIORef 0 :: IO (IORef Int)
 bpRef <- newIORef 0 :: IO (IORef Int)
 spRef <- newIORef 0 :: IO (IORef Int)
 pcRef <- newIORef 0 :: IO (IORef Int)
 mem <- newArray (0, 16777215) 0 :: IO (IOArray Int Int)
 let init0 :: IO ()
     init0 = do
      writeArray mem 0 104
      writeArray mem 1 101
      writeArray mem 2 108
      ...
      writeArray mem 18 100
      writeArray mem 19 33
      writeArray mem 21 22
      return ()

 let func0 :: IO ()
     func0 = do
      let whileLoop :: IO ()
          whileLoop = do
           pc <- readIORef pcRef
           if 0 <= pc && pc < 128
            then do
             case pc of
              -1 -> return () -- dummy

              0 -> do
               if (True) then (writeIORef pcRef (1 - 1)) else return ()
...

全文はgistに置きました。gist

ちゃんと、実行できました！

$ runhaskell hello.hs 
hello Haskell world!

Haskell製のCコンパイラをつくる

ここまでできていれば、簡単にC言語コンパイラをHaskellに移植できてます

8cc.c => 8cc.hs
elc.c => elc.hs

以下の手順で8cc.hsとelc.hsを作ります

# 8cc.c => 8cc.eir
./out/8cc -S -I. -Ilibc -I8cc/include -o 8cc.eir out/8cc.c
# elc.c => elc.eir
./out/8cc -S -I. -Ilibc -I8cc/include -o elc.eir out/elc.c

# 8cc.eir => 8cc.hs
./out/elc -hs 8cc.eir > 8cc.hs
# elc.eir => elc.hs
./out/elc -hs elc.eir > elc.hs

GHCでコンパイルしてみます。

ghc -O0 8cc.hs
ghc -O0 elc.hs

すごく時間がかかります...

$ time ghc -O0 8cc.hs
[1 of 1] Compiling Main             ( 8cc.hs, 8cc.o )
Linking 8cc ...

real    6m19.074s
user    6m4.080s
sys 0m12.986s

$ time ghc -O0 elc.hs
[1 of 1] Compiling Main             ( elc.hs, elc.o )
Linking elc ...

real    11m20.866s
user    10m22.773s
sys 0m50.309s

こんなに時間がかかってしまいました。行数が多いのでしょうがないですが³。
* 8cc.hsは264263行
* elc.hsは427087行

hello.c => a.out をコンパイル。(ただ、僕の環境だとa.outは実行できなかったです... x86...)

# hello.c => a.out
 (echo x86 && cat hello.c | ./8cc) | ./elc > a.out
chmod +x a.out
./a.out

でも大丈夫です。hello.c => hello.hsにもできますよ
そこからGHCでコンパイルしちゃいます

# hello.c => hello.hs
(echo hs && cat hello.c | ./8cc) | ./elc > hello.hs
ghc hello.hs
./hello

他にもhello.c => hello.pyにもできますよ。
なのでPython環境がある人は動かせますね

# hello.c => hello.py
(echo py && cat hello.c | ./8cc) | ./elc > hello.py
python3 hello.py

大事なことは ./8ccも./elcのHaskellの実装で動いているということです！

Haskell製C言語コンパイラのリポジトリ

少しコードを改良して、GitHubで公開しました。
nwtgck/8cc-elc-hs

（ものすごくコンパイルに時間がかかるで注意です！）

再利用性を高める！

ここからHaskellぽい話になります。

いきなりですが、再利用性ってとても大事ですよね。例えば、関数型言語のエンジニアさんたちは、小さな関数に分けたり、それを組み合わせて、プログラムを設計していますよね。うまく再利用すれば、同じコード避けて保守性が上がったり、小さい単位でのテストが可能だったり、他にも多くの恩恵を得ることができますね。

ですが今のELVMの実装だと、せっかくのC言語で書かれたアルゴリズムをHaskellで移植できても、main :: IO ()になってしまいます。そのため引数も渡せなければ、戻り値も受け取れず、再利用性が乏しいです。できれば、純粋関数にして、呼び出して使いたい！再利用性を高めたい!

どうやって再利用性を高めるか？

アイデア1. ELVM IRを拡張して、関数の構文を用意する
アイデア2. ELVM IRをそのままに、再利用できるようにHaskellコードを生成する

アイデア1では、引数や戻り値といったものをELVM IRに拡張させて、関数という概念をELVM IRに用意することによって再利用性を実現します。ですが、デメリットしてELVM IRのシンプルな設計に影響しますし、なにより他の言語のバックエンドもそれに対応させないといけないということがあります。

アイデア2は、どうにかして、ELVM IRはそのままに、自動生成されたHaskellだけで対処する方法です。このアイデアの問題点は、ELVM IRは関数という概念がなく、引数とか渡せないし、戻り値も特に何のに、どうやって実装するかです。

"ELVM IRをそのままに、再利用できるようにHaskellコードを生成する"の実現

両者のトレードオフと、実現可能なものを考えた結果、「アイデア2. ELVM IRをそのままに、再利用できるようにHaskellコードを生成する」を実現することにしました。

着目したのは、GETCとPUTC命令です⁴。
これらは、通常の実装では標準入力、標準出力を使います。
純粋関数の引数をを入力とすればいいはずです。例えば、['A', '2', 'o', 'o', 'x', 'o', '$']の順にGETCに値を流しこみたいです。出力はリストの要素がPUTCされるたびに増えていくようにすればいいですよね。

実際のコード生成で使われるコード

（ここから先のコードで使われる言語拡張とimportを一覧します。試したい人をコンパイルエラーを救いたいです。）

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE Strict #-}

import Data.IORef
import Data.Char
import Data.Bits
import Control.Monad.Catch
import Data.Array.MArray
import Data.Array.IO
import Data.Array.ST
import Data.Ix
import Data.IORef
import Data.STRef
import Control.Monad.Trans
import Control.Monad.Trans.Identity
import Control.Monad.Trans.State
import Control.Monad.ST

`GETC`と`PUTC`の一般化

GETCとPUTCのコード生成をより一般化して、任意のコンテキストから値を読んだり、書き込めたらいいですよね。モナドくんが活躍します。

型クラスGetPutIntを以下のように定義します。これをGETC, PUTCのコード生成を一般化するときに使います⁵。

class Monad m => GetPutInt m where
  getInt :: m Int
  putInt :: Int -> m ()

以下のように、いままで通りに使えるようにIOもこれに対応できます。

instance GetPutInt IO where
  getInt = catch (fmap ord getChar) (\(SomeException e) -> return 0)
  putInt = putChar . chr

純粋関数として使うときのためにInOut型を以下のように定義して、GetPutIntのインスタンスにします。

-- Stateモナドの中で、入力と出力の状態として使われる
data InOut = InOut {input :: [Int], output :: [Int]} deriving (Show, Eq)

instance Monad m => GetPutInt (StateT InOut m) where
  getInt = do
    xs <- gets input
    case xs of
      [] -> return 0 --　入力が枯渇したときは常に0
      x:xs -> do
       modify (\inOut -> inOut{input=xs}) -- 入力要素の先頭を一つ減らす
       return x -- 入力要素の先頭を返す
  putInt i = do
    modify (\inOut@InOut{output} -> inOut{output=output ++ [i]}) -- 末尾にappendするだけ

InOutが非効率だなと思ったときは、[Int]をByteStringにしたり、
data InOut i o = ...のようにして、より一般化したりもできるでは思ってます。GetPutIntのインスタンスにさえすればいいということですね。

IdentityTもインスタンスにしていると便利なので、実装します。

instance GetPutInt m => GetPutInt (IdentityT m) where
  getInt = lift getInt
  putInt = lift . putInt

現在のところまでで、以下のように一般的にgeneralMainがかけます

generalMain :: forall m. (GetPutInt m) => m ()
generalMain = do
 ...
 i1 <- getInt :: m Int
 putInt i1
 ...

`IORef`の一般化

以下のように、今まではIO決め打ちだったので、IORefを使うということが、コンパイラも理解できました。

main :: IO ()
main = do
 aRef <- newIORRef 0 :: IO (IORef Int)
 bRef <- newIORRef 0 :: IO (IORef Int)
 cRef <- newIORRef 0 :: IO (IORef Int)
 ...

ですが、GetPutInt m => mなmとういう一般化をしているので、IORefが使えるわけではありません。
以下のような、イメージのコードになるはずです。

-- （イメージです）
generalMain :: forall m. (GetPutInt m) => m ()
generalMain = do
 aRef <- newRef 0 :: m (???Ref Int)
 bRef <- newRef 0 :: m (???Ref Int)
 cRef <- newRef 0 :: m (???Ref Int)
 ...

そこで、???Refも一般化します。MRef型クラスを作ります。定義は以下のとおりです。⁶

class Monad m => MRef m r where
  newRef    :: a -> m (r a)
  readRef   :: r a -> m a
  writeRef  :: r a -> a -> m ()
  modifyRef :: r a -> (a -> a) -> m ()

以下のようにIOとIORefをMRefのインスタンスにすることができます。

instance MRef IO IORef where
  newRef    = newIORef
  readRef   = readIORef
  writeRef  = writeIORef
  modifyRef = modifyIORef

以下は、STとSTRefのMRefインスタンスです。
副作用のない純粋な関数で実現するためにSTモナドの実装があると便利です⁷。

instance MRef (ST s) (STRef s) where
  newRef    = newSTRef
  readRef   = readSTRef
  writeRef  = writeSTRef
  modifyRef = modifySTRef

MRefまでそろうと、以下のように書けるようになります。

generalMain :: forall m r. (GetPutInt m, MRef m r) => m ()
generalMain = do
 aRef <- newRef 0 :: m (r Int)
 bRef <- newRef 0 :: m (r Int)
 cRef <- newRef 0 :: m (r Int)
 ...

`MArray`でArrayを使う

MArrayは型クラスです。MArrayのインスタンスだと、newArrayとかreadArray, writeArrayなどが使えます。

これでgeneralMainは以下のようにかけます。

generalMain :: forall a m r. (MArray a Int m, GetPutInt m, MRef m r) => m ()
generalMain = do
 ...
 mem <- newArray (0, 16777215) 0 :: m (a Int Int)
 ...

Monad Transformerを使う

m ~ IOのときは大丈夫なのですが、m ~ StateT InOut (ST s)などモナド変換子をmとすることが、上記のままだとうまく行きません。
理由は、モナド変換子はMArrayがインスタンスではないからです。⁸　そして、インスタンスにしようとしても、定義しなくてはいけない関数が非公開でできません。
なので、手っ取り早くgeneralMainの型を以下のように変えます。

generalMain :: forall a t m r. (MonadTrans t, MArray.MArray a Int m, GetPutInt (t m), MRef m r) => t m ()

これによって、readArrayやnewRefがliftを必要とすることになります。
見た目は以下のようになりました。

generalMain :: forall a t m r. (MonadTrans t, MArray.MArray a Int m, GetPutInt (t m), MRef m r) => t m ()
generalMain = do
 exitsRef <- lift (newRef False) :: t m (r Bool)

 aRef <- lift (newRef 0) :: t m (r Int)
 bRef <- lift (newRef 0) :: t m (r Int)
 cRef <- lift (newRef 0) :: t m (r Int)
 dRef <- lift (newRef 0) :: t m (r Int)
 bpRef <- lift (newRef 0) :: t m (r Int)
 spRef <- lift (newRef 0) :: t m (r Int)
 pcRef <- lift (newRef 0) :: t m (r Int)
 mem  <- lift (MArray.newArray (0, 16777215) 0) :: t m (a Int Int)

 ...
 a <- getInt
 putInt a
 ...

これでgeneralMainの型が完成しました！

`main :: IO ()`の定義

generalMainを使って、main :: IO ()を定義する方法です。

IOするときは、モナド変換子は必要ないのでIdentityTを使います。あとは、使いたいArrayを指定したり、IORefを指定したりしてるだけです（たとえば、IOUArrayをIOArrayに変えたり好きにできますよ）。

main = runIdentityT (generalMain @IOUArray @IdentityT @IO @IORef)

（@XXXはTypeApplications拡張で記述できるようになります）

main :: IO ()が実装できたということで、一般化するまえとの互換性はちゃんと保てました。

`generalMain`は再利用性が高い！

以下は、
引数を[Int]として与えたら、
戻り値がInOutとして帰ってくる例です。

myPureFunc :: [Int] -> InOut
myPureFunc input = runST st
  where
    st :: forall s. (ST s) InOut
    st = execStateT (generalMain @(STArray s) @(StateT InOut) @(ST s) @(STRef s)) InOut{input=input, output=[]}

いままで、標準入力・出力しか使えなかったのが、引数の[Int]を変えれば好きなようにGETCに流し込めるようになりました！

C言語のナップサック問題を移植する

もっと具体的な例があったほうがいいですよね。
C言語で書かれたナップサック問題をHaskellで呼び出せる純粋関数⁹に変えて使います（もちろんFFIとか使いません）。

これが移植元のC言語です。Dynamic Programming | Set 10 ( 0-1 Knapsack Problem) - GeeksforGeeksのコードを少し変更しています。

変更したところは、
* 入力はgetcharを使って、文字としてではなく数値として扱う
* 結果はputcharで出力する

knapsack.ｃ

// [modified](from: https://www.geeksforgeeks.org/knapsack-problem/)

// A Dynamic Programming based solution for 0-1 Knapsack problem
#include <_builtin.h>

// Max number of items
#define MAX_N 100

// Max weight
#define MAX_W 10000

int putchar(int);
int getchar();


// DP Table
int K[MAX_N+1][MAX_W+1];

// Weights
int wt[MAX_N];

// Values
int val[MAX_N];

// A utility function that returns maximum of two integers
int max(int a, int b) { return (a > b)? a : b; }

// Returns the maximum value that can be put in a knapsack of capacity W
int knapsack(int W, int n) {
   int i, w;

   // Build table K[][] in bottom up manner
   for (i = 0; i <= n; i++) {
       for (w = 0; w <= W; w++) {
           if (i==0 || w==0)
               K[i][w] = 0;
           else if (wt[i-1] <= w)
                 K[i][w] = max(val[i-1] + K[i-1][w-wt[i-1]],  K[i-1][w]);
           else
                 K[i][w] = K[i-1][w];
       }
   }

   return K[n][W];
}

int main() {
    int i;
    int n;
    int w;

    // === Input ===
    n = getchar();
    w = getchar();
    for (i = 0; i < n ;i++){
        val[i] = getchar();
        wt[i]  = getchar();
    }

    // === Solve ===
    int max_value = knapsack(w, n);


    // == Output ===
    putchar(max_value);


    return 0;
}

プログラミングコンテストで頑張った人は、書いたC言語のコードが活かせるかもですね。

一般化したHaskell生成のELVMはプルリクエストをしないほうがいいかなって思ってしてないので、フォークしているリポジトリを使います。¹⁰
フォーク: nwtgck/elvm

以下のコマンドでknapsack.c => KnapsackElvm.hsを生成します。

# @nwtgckフォークのリポジトリをクローンする
git clone https://github.com/nwtgck/elvm.git
# 移動する
cd elvm/
# 現在の最新版にチェックアウト（今後変更する可能性があるので、環境でつまないように...）
git checkout 79fcd107d6962b0da9cbce9079841619f03e51ee
# makeする
make
# knapsack.c => knapsack.eir
./out/8cc -S -I. -Ilibc -I8cc/include -o knapsack.eir knapsack.c 
# knapsack.c => knapsack.hs
./out/elc -general_hs knapsack.eir > KnapsackElvm.hs

KnapsackElvm.hsをラップして、
商品や価値や重さが型付けされていて、純粋関数solveKnapsackを作ります。以下のような型を目指します。

solveKnapsack :: Weight -> [Item] -> Maybe Value

KnapsackElvm.hsのgeneralMainをラップした、Knapsackモージュールの全文が以下になります。

Knapack.hs

{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Knapsack where

import Data.Array.ST
import Data.STRef
import Control.Monad.Trans.State
import Control.Monad.ST

import ElvmUtil
import KnapsackElvm


-- | Value of item
newtype Value  = Value Int deriving (Show, Eq)

-- | Weight of item
newtype Weight = Weight Int deriving (Show, Eq)

-- | Item
data Item = Item {value :: Value, weight :: Weight} deriving (Show, Eq)

-- | Solve knapsack problem
solveKnapsack :: Weight -> [Item] -> Maybe Value
solveKnapsack (Weight maxW) items = 
  let -- Create input for ELVM-generated code
      input :: [Int]
      input = (length items):maxW: [e | Item {value=Value v, weight=Weight w} <- items, e <- [v, w]]

      -- ST monad from ELVM-generated general
      st :: forall s. (ST s) InOut
      st = execStateT (generalMain @(STArray s) @(StateT InOut) @(ST s) @(STRef s)) defaultInOut{input=input}

      -- Get output from ELVM-generated
      out = output (runST st) -- `output` function is in ElvmUtil
  in case out of
      -- Convert the output to Value
      []    -> Nothing
      (x:_) -> Just (Value x)

やっていることは、
引数(Weight maxW) itemsをinput :: [Int]に変換したり、
呼び出したあと、out :: [Int]をMaybe Valueにしているだけです。

実行してみます¹¹

module Main where

import Knapsack

main :: IO ()
main = do
  let maxWeight = Knapsack.Weight 5
      items     =
       [ Item {value=Value 4, weight=Weight 2}
       , Item {value=Value 5, weight=Weight 2}
       , Item {value=Value 2, weight=Weight 1}
       , Item {value=Value 8, weight=Weight 3}
       ]

  let maxValue = solveKnapsack maxWeight items  

  print maxValue

以下が出力です。

Just (Value 13)

solveKnapsackは普通に見れば、裏でC言語を元にELVMで自動生成したものだと分からないようになりました。ELVMで生成して、再利用しやすい形までたどり着きました。

ナップサック問題のリポジトリ

ナップサック問題のリポジトリもGitHubで公開しました。

nwtgck/knapsack-elvm-haskell
（めちゃくちゃコンパイルが遅いですが、動きます）

最後までありがとうざいました

8ccのオリジナルはELVM IRに変換するものではないはずですが、ELVMの開発者さんがフォークして、ELVM IRを吐き出すように実装してくれたのだと理解してます ↩
C言語からだけになってますが、ある言語をELVM IRに変換できれば、その言語をJavaにしたり、Pythonしたり、できちゃいます。LLVM => ELVMの話が、作者さんのブログで話題になっています(http://shinh.skr.jp/m/?date=20180313) ↩
普通の言語はaで変数aの値を読めるのに対し、IORefだとa <- readIORef aRefとかように一度取り出す文を書いたりして、普通の言語の倍以上の生成コードになってしまうのです ↩
誰でも思いつきそうですが... ↩
ELVMではintもcharも同じでsizeof(char)=sizeof(int)=1なので、Intを使ってます。 ↩
このパッケージでも同じようなことができそうです。https://hackage.haskell.org/package/ref-fd-0.4.0.1/docs/Control-Monad-Ref.html　今回はELVMの生成されるコードなので、baseパケージ以外はなるべく使わないようにしています。 ↩
もしかして、STモナドって副作用あると見かけたこともあるので、間違っているかもです ↩
ちゃんといえばinstance (MonadTrans t, MArray a e m, Monad (t m)) => MArray a e (t m)ではないです ↩
Data.Array.STのimportは{-# LANGUAGE Safe #-}にできないと言われたのですが、unsafeなんですか...？ ↩
GHC拡張とかをたくさん使っていて、GHCのバージョンで動きづらいコードが生成されるのは、どうなのかなって思ってしてません。なんとなくELVMのようなプロジェクトはなるべくどこでも動くようなコードを生成すべきかなと思ってます。 ↩
Mainモジュールで使われている価値や重さはAOJのナップザック問題 | 動的計画法 | Aizu Online Judgeのものを使わさせていただきました！ ↩

@nwtgck

先駆者さんたち
ELVMでできること
Haskellバックエンドの実装
バックエンドを動かしてみる
- 自動生成された　hello.hs
Haskell製のCコンパイラをつくる
- Haskell製C言語コンパイラのリポジトリ
再利用性を高める！
どうやって再利用性を高めるか？
"ELVM IRをそのままに、再利用できるようにHaskellコードを生成する"の実現
実際のコード生成で使われるコード
- GETCとPUTCの一般化
- IORefの一般化
MArrayでArrayを使う
Monad Transformerを使う
main :: IO ()の定義
generalMainは再利用性が高い！
C言語のナップサック問題を移植する
- ナップサック問題のリポジトリ

nwtgck

296contribution

2018-04-30 11:12

@waddlaw さん編集リクエストありがとございます！

If you already have a Qiita account log in.