LoginSignup
3
3

More than 5 years have passed since last update.

@yumura_s

モナドスタックで正規表現 VM シミュレーション

Posted at

正規表現技術入門に出てきた Russ Cox の VM の動作を模倣して、下記のように動くrunVMと命令(char, match, jmp, split)を実装する。

RegExpr/main.hs
import RegExpr.VM(runVM, char, match, jmp, split)

-- | "a+b+"の正規表現
test1 = runVM do
  char 'a'  -- 0
  split 0 2 -- 1
  char 'b'  -- 2
  split 2 4 -- 3
  match     -- 4

-- | "aa*bb*"の正規表現
test2 = runVM do
  char 'a'  -- 0
  split 2 4 -- 1
  char 'a'  -- 2
  jmp 1     -- 3
  char 'b'  -- 4
  split 6 8 -- 5
  char 'b'  -- 6
  jmp 5     -- 7
  match     -- 8

main = do
  -- | "a+b+"
  print $ test1 "abb" -- True
  print $ test1 "aab" -- True
  print $ test1 "aaa" -- False
  print $ test1 "baa" -- False

  -- | "aa*bb*"
  print $ test2 "abb" -- True
  print $ test2 "aab" -- True
  print $ test2 "aaa" -- False
  print $ test2 "baa" -- False

VM用のプログラムが書けるようにする

命令の型、プログラムの型

Russ Cox の VM には４つの命令(char, match, jmp, split)があるので、（VMに対する）命令の型は次のように定義しておく。

RegExpr/VM/Program.hs
data Instruction a = Char a
                   | Match
                   | Jmp Int
                   | Split Int Int

プログラムは（VMに対する）命令のリストなので、ついでに次の型シノニムを定義しておく。

RegExpr/VM/Program.hs
type Program a = [Instruction a]

プログラミングという型

ProgrammingとはProgramをWriteすることである。1

RegExpr/VM/Program.hs
type Programming a = Writer (Program a) ()

do 記法からVM用プログラムを得る

単純にWriterモナドを使って命令を累積して、execWriterで累積結果をゲットすれば、プログラムを得られる。2

RegExpr/VM/Program.hs
getProgram :: Programming a -> Program a
getProgram = execWriter

char :: a -> Programming a
char x = tell [Char x]

match :: Programming a
match = tell [Match]

jmp :: Int -> Programming a
jmp x = tell [Jmp x]

split :: Int -> Int -> Programming a
split x y = tell [Split x y]

これによって、次のようなコードで、[Char 'a',Split 0 2,Char 'b',Split 2 4,Match]を得る。

getProgram $ do
    char 'a'
    split 0 2
    char 'b'
    split 2 4
    match

runVM の型

この時点でrunVMの型はわかる。3
とは言え、VMの動作がわからないと此処から先は実装できないので、VM（スレッド）の動作モデルを見ていくことにする。

runVM :: Eq a => Programming a -> [a] -> Bool

VMの動作（スレッドの実行）モデル

正規表現技術入門を引用すると、VMは次の３つから成るらしい。

  • ２つのレジスタ（Register）
    • PC(Program Counter、プログラムカウンタ)：次に実行するバイトコードの位置
    • SP(String Pointer、文字列ポインタ)：次にマッチを実行する文字の位置
  • スタック
    • マッチの実行単位であるスレッドの状態を保持しておく領域
  • マッチ実行部
    • PCが指す位置のバイトコードを取得し、それを解釈して入力文字列とのマッチを実行する。

スレッドの実態は、PCとSPの組です。

ここから次のことがわかる。

  • スレッドという実行単位がある
  • スレッドはPCとSPの組で、実行中にこれらの値は変化する
  • PCによって参照されるバイトコードがある
  • SPによって参照される文字列がある
  • 実行中に分岐したスレッドを積むスタックがある

必要なモナド

  • PCとSP(=スレッド)の状態を扱うStateモナド
  • 参照されるバイトコード（=本実装ではProgram a）と文字列を保持するReaderモナド
  • そして、実行中に分岐したスレッドを記録するWriterモナドがあれば良いように思える。4
  • だが、一応IndexOutOfBounds的なエラーも考慮してErrorモナドを積んでおく。

しからば、欲しいモナドスタックは次のようなもになる。

RegExpr/VM/MonadStack.hs
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

newtype MonadStack e s r a = MonadStack {runMS' :: ErrorT e (StateT s (Reader r)) a}
   deriving(Functor, Monad, MonadError e, MonadState s, MonadReader r)

runMS :: MonadStack e s r a -> s -> r -> (Either e a)
runMS m s r = (`runReader` r) . (`evalStateT` s) . runErrorT $ runMS' m

スレッドの実行を表す型

は、先ほど作ったモナドスタックを使って下記のように書ける。

RegExpr/VM.hs
type RunThread a b = MonadStack ErrThread Thread (EnvVM a) b

ここで、ErrThread等は次のように定義しておく。

RegExpr/VM.hs
data ErrThread = PCOutOfBounds
               | SPOutOfBounds
               | Err String

instance Error ErrThread where
  noMsg  = Err "Thread Error"
  strMsg = Err

data Thread = Thread { pc :: Int
                     , sp :: Int
                     }

data EnvVM a = EnvVM { program :: Program a
                     , string  :: [a]
                     }

命令を実行した結果の戻り値の型

４つの命令(char, match, jmp, split)をそれぞれ実行した場合、スレッドは文字列を受理する（Accept）か、しないか（Reject）、プログラムの実行を継続する（Continue）かの３通りなので、それを表す型を用意しておく。

RegExpr/VM.hs
data Result = Accept | Reject | Continue deriving Eq

これで型の準備は十分にできた。

実装

命令サイクル

ここまでの型の定義から、runVMの実装は概ね次のようにすれば良さそうである。

runVM :: Eq a => Programming a -> [a] -> Bool
runVM m xs = runMS ic s env == Right Accept
  where
    ic  = undefined
    s   = Thread 0 0
    env = EnvVM (getProgram m) xs

上記では、ic :: RunThread a Resultが定義されていない。ここには何を実装すれば良いだろうか？
と言ってもVMなので命令サイクルを表す再帰関数instructionCycleを実装する他ない。

  • 命令をフェッチし
  • 命令を評価、実行し
  • 次の命令を実行するべきか判断する
RegExpr/VM.hs
runVM :: Eq a => Programming a -> [a] -> Bool
runVM m xs = runMS ic s env == Right Accept
  where
    ic  = instructionCycle Continue
    s   = Thread 0 0
    env = EnvVM (getProgram m) xs

instructionCycle :: Eq a => Result -> RunThread a Result
instructionCycle x
  | x /= Continue = return x
  | otherwise     = fetchIns >>= eval >>= instructionCycle

eval

実装の肝は命令を解釈するevalなので、fetchInsよりも先にこちらを片付ける。

RegExpr/VM.hs
eval :: Eq a => Instruction a -> RunThread a Result

Char a

コメントの部分は正規表現技術入門の引用。実装はコメントのまんま。

RegExpr/VM.hs
-- | 現在の sp が指す文字と x を比較し、
-- | 一致していれば次の命令（pc） と次の文字（sp）に進む
-- | 一致していなければ現在のThreadを終了する（マッチ失敗）
eval (Char x) = do
  y <- fetchChar
  if x /= y then
    return Reject
  else do
    s <- get
    put $ s {pc = pc s + 1, sp = sp s + 1}
    return Continue

Match

コメントの部分は正規表現技術入門の引（以下略

RegExpr/VM.hs
-- | 現在のThreadを終了する（マッチ成功）
eval Match = return Accept

Jmp x

コメ（以下略

RegExpr/VM.hs
-- | x の位置の命令にジャンプする
eval (Jmp x) = do
  s <- get
  put $ s {pc = x}
  return Continue

Split x y

やや、やっかいなのがこのSplit。下記では、それぞれの状態を引き継いだVMを新たに立ち上げる方法で実装している。なお、コメントの部分は正規表現技術入門の引用。

RegExpr/VM.hs
-- | ２つのThreadに分岐する、
-- | 一方のThreadは x から実行を開始し、
-- | もう一方は y から実行を開始する。
-- | どちらのThreadも sp は現在の値を引き継ぐ
eval (Split x y) = do
  env <- ask
  s   <- get
  let accx = runVM' (s {pc = x}) env
  let accy = runVM' (s {pc = y}) env
  return $ if accx || accy then Accept else Reject
      where
        runVM' s env = runMS ic s env == Right Accept
        ic = instructionCycle Continue

fetchInsとfetchChar

下記の通り、ほぼ同じ実装。変な位置を参照するとOutOfBoundsなエラーを投げる。

RegExpr/VM.hs
-- | pcが指す命令の読み込み
fetchIns :: RunThread a (Instruction a)
fetchIns = do
  r <- ask
  s <- get
  program r `indexPC` pc s

indexPC :: Program a -> Int -> RunThread a (Instruction a)
indexPC = index PCOutOfBounds

-- | 現在の sp が指す文字を取ってくる
fetchChar :: RunThread a a
fetchChar = do
  r <- ask
  s <- get
  string r `indexSP` sp s

indexSP :: [a] -> Int -> RunThread a a
indexSP = index SPOutOfBounds

-- | リスト xs から指定された位置 i の要素を返す
-- | ただし、指定された位置に要素がなければ、err をエラーとして返す
index :: ErrThread -> [b] -> Int -> RunThread a b
index err xs i | i < 0 = throwError err
index err [] i         = throwError err
index err (x: _) 0     = return x
index err (_:xs) i     = index err xs $ i - 1

感想

  • 実装している途中で、このVMが前方一致であることに気づいた。
  • 思いつきで実装してコードが無駄に長くなるこの症状、なにか名前ついてないのかな。

  1. ルー語 ↩

  2. do記法の無駄遣い ↩

  3. 命令Char aで値の等価判定をするため、Eq aの型クラス制約が付く。 ↩

  4. スタックは明示的に実装せずHaskellのスタックを使うことにした。スタックオーバーフロー起こすかも？ ↩

3
3
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
3
3