Hatena::ブログ(Diary)

cranebirdの日記 このページをアンテナに追加 RSSフィード

2015-09-10

Haskell で仮想マシンを書く fetch

07:35 |  Haskell で仮想マシンを書く fetchを含むブックマーク  Haskell で仮想マシンを書く fetchのブックマークコメント

仮想マシンなので命令はメモリから読もう。レジスタを2つ増やして、プログラムカウンタと計算結果を保存するレジスタを持つようにしてみる。命令は停止命令とACCレジスタをインクリメントする二つだけ用意しよう。

data Reg = PC | FP | ACC deriving (Eq, Ord, Show, Enum)
data Insn = INCR | STOP deriving (Eq, Ord, Show, Enum)

命令を PC から読み出す fetch と、それを decode する関数は、メモリアドレスとメモリの持つ値が両方とも同じ Int にしておくと簡単になる。

-- word = ptr
fetch :: (Ord x, Show x, MonadState (VM Reg x x) m) => m x
fetch = do
  pc <- loadReg PC
  load pc

decode :: Int -> Insn  
decode = toEnum

実行するのも簡単だ。fetch - decode と命令による分岐を書けば良い。とりあえずは ACC レジスタの値を返しておくことにする。ハンドアセンブルして命令列を作るほうが面倒なくらい。

exec ::  (MonadState (VM Reg Int Int) m) => m Int
exec = do
  op <- fetch
  case decode op of
    STOP -> do { loadReg ACC }
    INCR -> do { 
      acc <- loadReg ACC;
      storeReg ACC (acc + 1);
      pc <- loadReg PC;
      storeReg PC (pc + 1);
      exec }

適切なメモリとレジスタの状態を作って実行する。

&#42;Main> evalStateT exec (makeVm [STOP])
0
*Main> evalStateT exec (makeVm [INCR, STOP])
1
*Main> evalStateT exec (makeVm [INCR, INCR, INCR, STOP])
3

これではハンドアセンブルがあまりに辛い。TMR-Issue6 (https://wiki.haskell.org/wikiupload/1/14/TMR-Issue6.pdf) を斜め読みすると、DSL としてアセンブラを書いている(ように見える)。同じことを目指してみよう。


たぶん続く。

トラックバック - http://d.hatena.ne.jp/cranebird/20150910

2015-09-09

Haskell で仮想マシンを書く

08:28 |  Haskell で仮想マシンを書くを含むブックマーク  Haskell で仮想マシンを書くのブックマークコメント

モナドの練習として仮想マシンを書く。レジスタとメモリを、キーをレジスタまたはアドレスとし値を保持できる Map で表すことにしよう。

type Regs r x = Map.Map r x
type Memory p x = Map.Map p x
data VM r p x = VM (Regs r x) (Memory p x) deriving (Eq, Show)

この仮想マシンを状態モナドにして、メモリとレジスタを更新/参照する関数 store, load, storeReg, loadReg を用意し、runStateT や evalStateT で実行することを考える。

利用しているメモリアドレスの上限をレジスタで管理することにすると、単純化したメモリアロケーションを行う関数 alloc が書ける。

alloc r = do
  fp <- loadReg r
  modifyReg (Map.insert r (succ fp))
  return $ succ fp

具体的にレジスタ FP をもった仮想マシン vm0 を考えることにする。

data Reg = FP deriving (Eq, Ord, Show, Enum)
vm0 :: VM Reg Int Int
vm0 = VM (Map.fromList $ zip (enumFrom FP) [0 .. ]) Map.empty

メモリをアロケートしてそこに値を書き込む処理 assign は以下のように書ける。

assign x = do
  p <- alloc FP
  store x p
  return p

これを使うと、以下のような手続き型言語のような処理が書ける。ここで var はアドレス値から値を取得する関数で、全体を計算の連鎖として書くために必要だった。

また plus は liftM2 (+) で定義されるモナドで、 m r -> m r -> m r の型を持つ。

test00 = do
  x <- assign 10
  y <- assign 3
  (plus (var x) (var y))

Main> run0 test00
(13,VM (fromList [(FP,2)]) (fromList [(1,10),(2,3)]))

続く。

以下、全コード。

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
import qualified Data.Map as Map
import Control.Monad.State
import Data.Maybe

type Regs r x = Map.Map r x
type Memory p x = Map.Map p x
data VM r p x = VM (Regs r x) (Memory p x) deriving (Eq, Show)

-- Register の更新
modifyReg :: MonadState (VM r p x) m => (Regs r x -> Regs r x) -> m ()
modifyReg f = modify $ \(VM rs ms) -> VM (f rs) ms
-- Memory の更新
modifyMem :: MonadState (VM r p x) m => (Memory p x -> Memory p x) -> m ()
modifyMem f = modify $ \(VM rs ms) -> VM rs (f ms)

-- load from Register
loadReg :: (Ord r, MonadState (VM r t x) m) => r -> m x
loadReg r = do
  VM rs _ <- get
  return $ fromMaybe (error "un-initialized reg") (Map.lookup r rs)
-- store to Register
storeReg :: (Ord r, MonadState (VM r p x) m) => r -> x -> m ()
storeReg r x = modifyReg (Map.insert r x)

-- load from memory
load :: (Ord p, MonadState (VM r p x) m) => p -> m x
load p = do
  VM _ ms <- get
  return $ fromMaybe (error "un-initialized memory") (Map.lookup p ms)
-- store to memory
store :: (Ord p, MonadState (VM r p x) m) => x -> p -> m ()  
store x p = modifyMem (Map.insert p x)

-- memory allocate use register r as free pointer.
alloc :: (Enum x, Ord r, MonadState (VM r p x) m) => r -> m x
alloc r = do
  fp <- loadReg r
  modifyReg (Map.insert r (succ fp))
  return $ succ fp

-- test machine with one register
data Reg = FP deriving (Eq, Ord, Show, Enum)
vm0 :: VM Reg Int Int
vm0 = VM (Map.fromList $ zip (enumFrom FP) [0 .. ]) Map.empty

-- 新規の領域に x を保存
assign x = do
  p <- alloc FP
  store x p
  return p

assign' p = do
  x <- p
  assign x

-- 変数 p を参照
var :: (Ord p, MonadState (VM r p x) m) => p -> m x
var = load

plus :: (Monad m, Num r) => m r -> m r -> m r
plus = liftM2 (+)
  
minus :: (Monad m, Num r) => m r -> m r -> m r
minus = liftM2 (-)

run0 f = runStateT f vm0

eval0 f = evalStateT f vm0

test00 :: Monad m => StateT (VM Reg Int Int) m Int
test00 = do
  x <- assign 10
  y <- assign 3
  (plus (var x) (var y))

test01 :: Monad m => StateT (VM Reg Int Int) m Int
test01 = do
  x <- assign 10                      -- x = 10
  y <- assign 3                       -- y = 3
  z <- assign' (plus (var x) (var x)) -- z = x + x
  (minus (var z) (var y))             -- return z - y

トラックバック - http://d.hatena.ne.jp/cranebird/20150909

2015-06-20

Template Haskell (TH) でデータ定義

12:02 |  Template Haskell (TH) でデータ定義を含むブックマーク  Template Haskell (TH) でデータ定義のブックマークコメント

列挙型とその文字表現を、データで定義できる TH を書いた。

-- モジュールA
defDataConstsType "T_Digit" (map (\x -> "T_" ++ [intToDigit x]) [0..10])

defShowType "T_Digit" (map (\x -> 
                             ("T_" ++ [intToDigit x],
                              "'" ++ [intToDigit x] ++ "'")) [0..10])

このように書くと、下と同じ意味になる(はず)。


data T_Digit = T_0 | T_1 ...
instance Show T_Digit where
  show T_0 = "'0'"
  show T_1 = "'1'"
  ...

TH のコード本体は利用する側と別モジュールに書かなくてはいけない(制限)。

-- モジュールB
defDataConstsType :: String -> [String] -> Q [Dec]
defDataConstsType name ns = return d
  where
    d = [DataD [] (mkName name) []
         (map (\n -> NormalC (mkName n) []) ns)
         [mkName "Eq", mkName "Enum"]]

defShowType :: String -> [(String, String)] -> Q [Dec]
defShowType name ht = return d
  where
    d = [InstanceD []
           (AppT (ConT (mkName "Show")) (ConT (mkName name))) 
           [FunD (mkName "show")
            [Clause [VarP x] 
             (NormalB (CaseE (VarE x) 
                       --
                       (map (\(n,s) ->
                              Match (ConP (mkName n) []) (NormalB (LitE (StringL s))) []) ht))) []]]]
      where x = mkName "x"
トラックバック - http://d.hatena.ne.jp/cranebird/20150620

2015-06-16

PEG

07:01 |  PEG を含むブックマーク  PEG のブックマークコメント

PEG モドキを Haskell で。データ構造を定義した。Show のインスタンスにする部分は省略。

data PExp nt = Eps -- epsilon
          | AtomT String -- Terminal symbol
          | AtomNT nt -- Non-Terminal symbol
          | PExp nt :. PExp nt -- e1 e2
          | PExp nt :/ PExp nt -- e1 / e2
          | Opt (PExp nt) -- e?
          | ZeroOrMore (PExp nt) -- e*
          | OneOrMore (PExp nt) -- e+
          | And (PExp nt) -- &e
          | Not (PExp nt) -- !e
          deriving Eq

data Rule nt = nt :<- (PExp nt) deriving Eq
data Grammer nt = Grammer [Rule nt] deriving Show

そして以下のようにサンプルのグラマーを定義してやる。

pp (Grammer rs) = mapM_ (putStrLn . show) rs

data NT01 = Underscore | Digit | LowerCase | UpperCase | Identifier 
          deriving (Eq, Show)  

g01 :: Grammer NT01
g01 = Grammer [ underScore, digit, lowerCase, upperCase, identifier ]
  where
    underScore = Underscore :<- AtomT "_"
    digit = Digit :<- e
      where f n = [intToDigit n]
            e = foldl1 (:/) $ map (AtomT . f) [0..9]
    lowerCase = LowerCase :<- foldl1 (:/) [AtomT [x] | x <- ['a'..'z']]
    upperCase = UpperCase :<- foldl1 (:/) [AtomT [x] | x <- ['A'..'Z']]
    identifier = Identifier :<- 
                 ((AtomNT LowerCase :/ AtomNT UpperCase :/ AtomNT Underscore) :. 
                  (Opt (AtomNT LowerCase :/ AtomNT UpperCase :/ AtomNT Underscore :/ AtomNT Digit)))

そうすると以下のように出力される。


Main> pp g01
Underscore <- _
Digit <- 0 / 1 / 2 / 3 / 4 / 5 / 6 / 7 / 8 / 9
LowerCase <- a / b / c / d / e / f / g / h / i / j / k / l / m / n / o / p / q / r / s / t / u / v / w / x / y / z
UpperCase <- A / B / C / D / E / F / G / H / I / J / K / L / M / N / O / P / Q / R / S / T / U / V / W / X / Y / Z
Identifier <- ( LowerCase / UpperCase / Underscore ) ( ( LowerCase / UpperCase / Underscore / Digit )? )
Main> 
トラックバック - http://d.hatena.ne.jp/cranebird/20150616

2015-04-16

Java コード生成へ向けて

08:14 |  Java コード生成へ向けてを含むブックマーク  Java コード生成へ向けてのブックマークコメント

lisp/scheme でS式からコード生成を行いたい。最終的なイメージは以下のような Java の S 式表現から Java コードを生成することだ。

gosh> (print (jise->java
	      '((System.out.println "Hello, Java!")
		(declare x 0)
		(assign x 3)
		(when (= x 3)
		  (System.out.println "oops")))))

System.out.println("Hello, Java!");
int x = 0;
x = 3;
if (x == 3) {
  System.out.println("oops");
}

Java の構文要素を調べれて、S 式表現を検討すれば、あとは util.match あたりを使って単なる静的な式変形をすればよい。

トラックバック - http://d.hatena.ne.jp/cranebird/20150416