phorth---（その1.3）オペレータ定義の仕様変更1

Parserの改造

新しいオペレータを定義する際に

/a { 1 2 } def

という構文を使って，これをパースして

[NewWord "a" [Push 1 ,Push 2]]

というASTを構築しました．これを評価すると

Interp {stack = [], dict = fromList [("a",[Push 1,Push 2])]}

という状態のインタプリータができます．しかし，これではちょっとオペレータdefが特別扱いされすぎです．オペレータはスタックを消費して何かの変化を起こすものと統一したいです．

ということで，まずExp型を変更します．今までは

data Exp =   Push Literal
           | Invoke Word 
           | NewWord Name AST
           deriving Show
type Literal = Integer
type Word = String
type Name = String

でした．これを

data Exp =   Push Literal
           | Invoke Word 
           | Name Word
           | Block AST
           deriving Show
type Literal = Integer
type Word = String

とすることにします．NewWordを外して新しくName Word，Block ASTを作ります．これは「新しいオペレータの名前」と「コードのブロック」（新しいオペレータの内容）を表します．

これに対応して，パーサも変更します．

phorthExp::Parser Exp
-- phorthExp = literal <|> word <|> newWord
phorthExp = literal <|> word <|> name <|> block 

newWordパーサをなくして，name，blockパーサを考えます．

nameパーサ

/aをパースして， Name "a"を作るパーサです．

name::Parser Exp
name =do char '/'
         name <- many1 letter
         return $ Name name

blockパーサ

{ }をパースして，Block ASTを作るパーサです．部分はphorthの任意のコードなので，再帰的なパーサになります．

block::Parser Exp
block = do char '{'
           ast <- phorth
           char '}'
           return $ Block ast

パーサを実行すると

Prelude> :l parsetest.hs
[1 of 1] Compiling Main             ( parsetest.hs, interpreted )
Ok, modules loaded: Main.
*Main> parseTest phorthProg "" "1 2 /a {1 2 /b {3 2} def } def"
[Push 1,Push 2,Name "a",Block [Push 1,Push 2,Name "b",Block [Push 3,Push 2],Invoke "def"],Invoke "def"]

これは問題ないですが，

*Main> parseTest phorthProg "1 2 /a{1 2 /b {3 2} def } def"
parse error at (line 1, column 7):
unexpected "{"
expecting letter, space or end of input

*Main> parseTest phorthProg "" "1 2 /a {1 2 /b {3 2} def }def"
parse error at (line 1, column 27):
unexpected "d"
expecting space or end of input

・・・問題ありです．「{」の前，「}」の後は空白がなくてもきちんと区切られるべきです．これを修正するには

phorth::Parser AST
phorth = do skipMany space
--            sepEndBy1 phorthExp (skipMany1 space)
            sepEndBy1 phorthExp (skipMany space)

とすればよいでしょう．ついでにオペレータの名前の文字種として数字も許可します．ただし，オペレータの最初の文字はアルファベットだけに制限します．これにともない，wordパーサも変更します．オペレータの名前を構成する文字列をパースする部分は共通なので一個のパーサopnameにまとめました．

opname::Parser String
opname = do first  <- letter 
            others <- many (letter <|> digit)
            return $ first:others

word::Parser Exp
word = opname >>= \x ->  return $ Invoke x

name::Parser Exp
name = char '/' >> opname >>= \x ->  return $ Name x


word::Parser Exp
-- word = many1 letter >>= \x ->return (Invoke x)
word = do first  <- letter 
          others <- many (letter <|> digit)
          return $ first:others

これで

*Main> parseTest phorthProg "1 2 /a{1 2 /b12 {3 2 }def }def"
[Push 1,Push 2,Name "a",Block [Push 1,Push 2,Name "b12",Block [Push 3,Push 2],Invoke "def"],Invoke "def"]

とできます．

まとめると・・

import Text.ParserCombinators.Parsec

-- AST
type AST = [Exp]

data Exp =   Push Literal
           | Invoke Word 
           | Name Word
           | Block AST
           deriving Show
type Literal = Integer
type Word = String


-- Parser
phorthProg::Parser AST
phorthProg = do ast <- phorth
                eof
                return ast

phorth::Parser AST
phorth = do skipMany space
            sepEndBy1 phorthExp (skipMany space)

phorthExp::Parser Exp
phorthExp = literal <|> word <|> name <|> block 

literal::Parser Exp
literal = (many1 digit) >>= \x ->return (Push (read x))

opname::Parser String
opname = do first  <- letter 
            others <- many (letter <|> digit)
            return $ first:others

word::Parser Exp
word = opname >>= \x ->  return $ Invoke x


name::Parser Exp
name = char '/' >> opname >>= \x ->  return $ Name x

block::Parser Exp
block = do char '{'
           ast <- phorth
           char '}'
           return $ Block ast