【Haskell】Parsecで構文解析して構文木を作る

2015-11-15
#haskell

Haskellで構文解析する方法として、Parsecを使って簡単な文法を解析できるパーサを作ってみる。構文木の構築だけで、構築した木の評価はここではしない。

1. 簡単な計算機を作る

まずは整数の四則演算ができるだけの、簡単な計算機を作ってみる。

buildExpressionParser を使うと演算子に優先順序のある中置記法の式をパースするパーサを簡単に作れる：

-- Parser1.hs
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Language
import qualified Text.ParserCombinators.Parsec.Token as P

lexer :: P.TokenParser ()
lexer = P.makeTokenParser (haskellDef { reservedOpNames = ["*", "/", "+", "-"] })

natural     = P.natural lexer
parens      = P.parens lexer
reservedOp  = P.reservedOp lexer

expr :: Parser Integer
expr = buildExpressionParser table term <?> "expression"
  where
    table = [[unary "-" negate],
             [binop "*" (*) AssocLeft, binop "/" div AssocLeft],
             [binop "+" (+) AssocLeft, binop "-" (-) AssocLeft]]
    binop s op assoc = Infix (do{ reservedOp s; return op } <?> "operator") assoc
    unary s op = Prefix (do{ reservedOp s; return op })

term :: Parser Integer
term =
  do {
    parens expr;
  } <|> do {
    n <- natural;
    return n
  } <?>
    "term"

stmt :: Parser Integer
stmt = do
  e <- expr
  eof
  return e

buildExpressionParser に演算子の優先順のテーブルと、項をパースするパーサを渡してやると、中置記法の式をパースするパーサができる（expr）。

項をパースするパーサ term では括弧で囲んだ式（parens expr）、または整数リテラル（natural）を受け付ける、という単純なもの。

文をパースする stmt は、パースに成功した後ろになんか変なものが残ってないか調べるだけ（eof）で、これが最上位のパーサとなる。

これを使ってghci上でテストしてやると：

$ ghci
GHCi, version 7.10.2: http://www.haskell.org/ghc/  :? for help
Prelude> :l Parser1.hs
[1 of 1] Compiling Main             ( Parser1.hs, interpreted )
Ok, modules loaded: Main.
*Main> parse stmt "" "-1 + 2 * 3"
Right 5
*Main> parse stmt "" "(-1 + 2) * 3"
Right 3

と、パースに成功して Right に包まれて計算結果が返ってくる

2. 構文木を構築する

構文解析して結果を直接計算するんじゃなくて構文木を構築してやる。

構文木のノードを現すデータ型：

-- Parser2.hs
data Expr = Natural Integer  -- 整数リテラル
          | BinOp String Expr Expr  -- ２項演算：演算子、左辺式、右辺式
  deriving (Show)

各パーサでIntegerを返す代わりに、上記の Exprを返すようにする：

-- Parser2.hs
expr :: Parser Expr
expr = buildExpressionParser table term <?> "expression"
  where
    table = [[unary "-" (BinOp "-" (Natural 0))],
             [binop "*" AssocLeft, binop "/" AssocLeft],
             [binop "+" AssocLeft, binop "-" AssocLeft]]
    binop op assoc = Infix (do{ reservedOp op; return (BinOp op) } <?> "operator") assoc
    unary s op = Prefix (do{ reservedOp s; return op })

term :: Parser Expr
term =
  do {
    parens expr;
  } <|> do {
    n <- natural;
    return $ Natural n
  } <?>
    "term"

stmt :: Parser Expr
-- stmtの定義自体は変更なし

この変更で、式の計算結果じゃなくてノードが返るようになる：

*Main> parse stmt "" "-1 + 2 * 3"
Right (BinOp "+" (BinOp "-" (Natural 0) (Natural 1)) (BinOp "*" (Natural 2) (Natural 3)))
*Main> parse stmt "" "(-1 + 2) * 3"
Right (BinOp "*" (BinOp "+" (BinOp "-" (Natural 0) (Natural 1)) (Natural 2)) (Natural 3))

3. 変数の参照を追加する

termで識別子をパースできるようにしてやる：

-- Parser3.hs
-- Exprに変数の参照を現すノードを追加
data Expr = ...
          | Var String  -- 変数参照：変数名

-- 識別子をパースするパーサ
identifier  = P.identifier lexer

term =
  ...
  } <|> do {
    var <- identifier;
    return $ Var var
  } <?>
    ...
*Main> parse stmt "" "-x + y"
Right (BinOp "+" (BinOp "-" (Natural 0) (Var "x")) (Var "y"))

4. 無名関数の構文を追加する

文法は \x -> e のような形で、引数は１個だけに制限されているものとする

-- Parser4.hs
-- Exprに（無名）関数リテラルを現すノードを追加
data Expr = ...
          | Fun String Expr  -- 無名関数：引数名、結果

lexeme      = P.lexeme lexer

-- exprで関数も扱えるようにする
expr = buildExpressionParser table term <|> fun <?> "expression"

-- 無名関数のパーサ
fun :: Parser Expr
fun = do
  lexeme $ char '\\'
  param <- identifier
  lexeme $ string "->"
  e <- expr
  return $ Fun param e
  • expr に組み込むのはなんか違う気がするが…
*Main> parse stmt "" "\\x -> x * x"
Right (Fun "x" (BinOp "*" (Var "x") (Var "x")))
  • 構築される構文木は引数１つとして、受け付ける文法は任意個の引数を取れるようにして自動的にカリー化してやるのは難しくないはず

5. 関数適用を追加する

  • 関数適用は f x の文法
  • 関数は必ず引数が１つなので、適用も引数は１つと決まっている
  • 今までtermとして扱っていたものをfactorに変更し、termで関数適用appとfactorをパースすることにする：
-- Parser5.hs
-- Exprに関数適用を現すノードを追加
data Expr = ...
          | App Expr Expr  -- 関数適用：関数、引数

-- factorがParser4.hsのtermとする

term :: Parser Expr
term = try(app) <|> try(factor)

-- 関数適用のパーサ
app :: Parser Expr
app = do
  f <- factor
  arg <- factor
  return $ App f arg
*Main> parse stmt "" "(\\x -> x * x) 111"
Right (App (Fun "x" (BinOp "*" (Var "x") (Var "x"))) (Natural 111))

6. ２項演算を関数適用に変更する

普通の関数と同様に扱えるようにするために、２項演算子で構築する構文木を特別扱いするのをやめて（BinOpを削除して）普通の関数適用（App）に変更する：

-- Parser6.hs
expr :: Parser Expr
expr = buildExpressionParser table term <|> fun <?> "expression"
  where
    table = [[unary "-" "negate"],
             [binop "*" AssocLeft, binop "/" AssocLeft],
             [binop "+" AssocLeft, binop "-" AssocLeft]]
    binop op assoc = Infix (do{ reservedOp op; return $ \x y -> App (App (Var op) x) y } <?> "operator") assoc
    unary s op = Prefix (do{ reservedOp s; return $ App (Var op) })
*Main> parse stmt "" "(\\x -> x * x) 111"
Right (App (Fun "x" (App (App (Var "*") (Var "x")) (Var "x"))) (Natural 111))

7. Applicativeスタイルに変更する

パーサコンビネータで小さなパーサを組み合わせてより大きなパーサを構築する際に、Applicativeスタイルというものが使うとコードがスッキリする（参考：Applicativeのススメ - あどけない話）

-- Parser7.hs
factor :: Parser Expr
factor = parens expr <|> (Natural <$> natural) <|> (Var <$> identifier) <?> "factor"

fun :: Parser Expr
fun = Fun <$> (lexeme (char '\\') *> identifier) <*> (lexeme (string "->") *> expr)

app :: Parser Expr
app = App <$> factor <*> factor

stmt :: Parser Expr
stmt = expr <* eof

最終的なソース

-- Parser.hs
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Language
import qualified Text.ParserCombinators.Parsec.Token as P

data Expr = Natural Integer
          | Var String
          | Fun String Expr
          | App Expr Expr
  deriving (Show)

lexer :: P.TokenParser ()
lexer = P.makeTokenParser (haskellDef { reservedOpNames = ["*", "/", "+", "-"] })

natural     = P.natural lexer
parens      = P.parens lexer
reservedOp  = P.reservedOp lexer
identifier  = P.identifier lexer
lexeme      = P.lexeme lexer

expr :: Parser Expr
expr = buildExpressionParser table term <|> fun <?> "expression"
  where
    table = [[unary "-" "negate"],
             [binop "*" AssocLeft, binop "/" AssocLeft],
             [binop "+" AssocLeft, binop "-" AssocLeft]]
    binop op assoc = Infix (do{ reservedOp op; return $ \x y -> App (App (Var op) x) y } <?> "operator") assoc
    unary s op = Prefix (do{ reservedOp s; return $ App (Var op) })

term :: Parser Expr
term = try(app) <|> try(factor)

factor :: Parser Expr
factor = parens expr <|> (Natural <$> natural) <|> (Var <$> identifier) <?> "factor"

fun :: Parser Expr
fun = Fun <$> (lexeme (char '\\') *> identifier) <*> (lexeme (string "->") *> expr)

app :: Parser Expr
app = App <$> factor <*> factor

stmt :: Parser Expr
stmt = expr <* eof

main = do
  print $ parse stmt "" "(\\x -> x * x) 111"
  print $ parse stmt "" "(\\square -> square 111) (\\x -> x * x)"
  print $ parse stmt "" "\\f -> \\x -> f x + 1"

構文木の形とか、なんとなくどっかで見たのが頭に残ってたのを参考にしたなーと思ってたら、関数型言語 - 関数型プログラミング言語の定義＆実装の仕方の例 - Qiita、「関数型プログラミング言語の定義＆実装の仕方の例」をHaskellで実装してみた - Qiitaがまさに同じ形式だった

関連記事

新着記事