Haskell: Forthインタプリタの実装

完全ではないもののForthパーサが動作するようになったので、次にForthインタプリタの実装を行ってみました。Harrothチュートリアルの説明を読みながら実装すると、それほど大きな問題もなくインタプリタが動作するようになりました。ForthのコードをASTに変換できるだけでも感動しますが、さらにインタプリタまで動作してしまうと、かなり興奮しますよw。興味のある方は是非チャレンジしてみて下さい。Audrey Tangさん、まじ凄いです。

今回はhttp://feather.perl6.nl/~nothingmuch/harrorth/doc/04.kwidのチュートリアルを読みながら実装を進めました。現段階のForthインタプリタでも、Harrothチュートリアルで説明されるような挙動が得られます。

% ./myforth
1 3 . 4 . 5
3
4
Interp {stack = [5,1]}

ソースコードはこんな感じです。今回実装したコードは、「-- Eval」と書かれているコメント行以降です。

% vim MyForth.hs
{-
MyForth - An Implementation of Forth using Haskell

This code is based on the Harroth tutorial. You can find that tutorial:
http://www.perlcabal.org/~nothingmuch/harrorth/doc/

* Usage
    ## Testing MyForth parser ##
    % ghci MyForth.hs
    *MyForth> parseTest forthProgram "2 foo : bar 4 blah ; ding"
    [Push 2,Invoke "foo",NewWord "bar" [Push 4,Invoke "blah"],Invoke "ding"]

    ## Making an executable program ##
    % ghc --make -o myforth MyForth.hs
    % ./myforth
    1 3 . 4 . 5
    3
    4
    Interp {stack = [5,1]}
-}

module Main where -- modified

import Text.ParserCombinators.Parsec

-- AST
type Forth = [Exp] 

data Exp
    = Push Literal 
    | Invoke Word
    | NewWord Word Forth
    deriving Show

type Literal = Integer
type Word    = String

-- Parser
forthProgram :: Parser Forth
forthProgram = do
    ast <- forth
    eof
    return ast

forth :: Parser Forth
forth = sepEndBy forthExp sep

forthExp :: Parser Exp
forthExp =   do {lit <- literal; return $ lit}
         <|> do {nw  <- newWord; return $ nw}
         <|> do {w   <- word   ; return $ w}

literal :: Parser Exp
literal = do
    lit <- many1 digit
    return $ Push (read lit)

newWord :: Parser Exp
newWord = do
    char ':'
    maybeSep
    name <- wordName
    sep
    body <- forth
    maybeSep
    char ';'
    return $ NewWord name body

word :: Parser Exp
word = do
    name <- wordName
    return $ Invoke name

wordName :: Parser String
wordName = do
    name <- many1 (letter <|> char '.') -- modified
    return name

sep :: Parser ()
sep = skipMany1 space

maybeSep :: Parser ()
maybeSep = skipMany space

-- Eval
data Interp = Interp { stack::[Literal] } deriving Show

interpret :: Interp -> Forth -> IO Interp
interpret i [] = return i
interpret i (exp:exps) = do
    i' <- doExp i exp
    interpret i' exps

doExp :: Interp -> Exp -> IO Interp
doExp i (Push lit) = return $ pushStack i lit
doExp i (Invoke ".") = do
    let (stackHead, i') = popStack i
    print stackHead
    return i'

pushStack :: Interp -> Literal -> Interp
pushStack i@Interp{ stack = stack } lit = i{ stack = (:) lit stack }

popStack :: Interp -> (Literal, Interp)
popStack i@Interp{ stack = x:xs } = (x, i{ stack = xs })

-- Shell
main :: IO ()
main = do
    src <- getLine
    case (parse forthProgram "" src) of
        Left err -> do
            putStr "parse error at "
            print err
        Right x -> dumpInterp x

dumpInterp :: Forth -> IO ()
dumpInterp ast = do
    finished <- interpret Interp { stack = [] } ast
    print finished

Harrothチュートリアルを通してForthパーサやインタプリタを実装してみた感想をちょっと。Haskellの持つ表現力の高さがなんとなくわかるようになりました。「パーサやインタプリタを書こうとしている人はHaskellを使いましょう」という時代はもうすぐそこに来ている気がします。それにしてもHaskellでPugsのパーサやインタプリタを実装しようと決心したAudrey Tangさんは、抜群のセンスですね。(今さら言うことじゃないですけど) YAPC::Asia 2006 Tokyo楽しみだなぁ。