プログラミング Haskell 第8章関数型パーサーその4

ずいぶん長く更新を休みました。この1週間生活リズムに大きな変化があったこともあって朝の読書時間はなしでしたが、合間にちょこちょこと読んで第8章の練習問題をやっていました。

後半には BNF による文法規則の表記と構文木を作って評価するパーサーの話がありましたが、その内容はパーサーの一般的な論点で、Haskell のコードにどう落とすかという点は練習問題に自然に出てくるので割愛します。

練習問題を解くにあたって、本文に出てくる関数を実装して動作確認もしたいと考えたのですが、do 記法に対応するためには、実際には本文中のサンプルコードのままではだめで、Parser を Monad のインスタンスとして定義しないといけませんでした。この記法は本書中ではまだ出てきていないですが、「ふつうの Haskell プログラミング」を見たり、公開されているコードから記述方法を調べてまず以下のソースを書きました。

module Parse where

import Char
import Monad

newtype Parser a = P (String -> [(a, String)])

instance Monad Parser where
  return v = P (\inp -> [(v, inp)])
  p >>= f = P (\inp -> case parse p inp of
                        [] -> []
                        [(v, out)] -> parse (f v) out)

failure :: Parser a
failure = P (\inp -> [])

item :: Parser Char
item = P (\inp -> case inp of
                   [] -> []
                   (x:xs) -> [(x, xs)])

parse :: Parser a -> String -> [(a, String)]
parse (P p) inp = p inp

(+++) :: Parser a -> Parser a -> Parser a
p +++ q = P (\inp -> case parse p inp of
                      [] -> parse q inp
                      [(v, out)] -> [(v, out)])

sat :: (Char -> Bool) -> Parser Char
sat p = do x <- item
           if p x then return x else failure

digit :: Parser Char
digit = sat isDigit

lower :: Parser Char
lower = sat isLower

upper :: Parser Char
upper = sat isUpper

letter :: Parser Char
letter = sat isAlpha

alphanum :: Parser Char
alphanum = sat isAlphaNum

char :: Char -> Parser Char
char x = sat (== x)

string :: String -> Parser String
string [] = return []
string (x:xs) = do char x
                   string xs
                   return (x:xs)

many :: Parser a -> Parser [a]
many p = many1 p +++ return []
many1 :: Parser a -> Parser [a]
many1 p = do v <- p
             vs <- many p
             return (v:vs)

ident :: Parser String
ident = do x <- lower
           xs <- many alphanum
           return (x:xs)

nat :: Parser Int
nat = do xs <- many1 digit
         return (read xs)

space :: Parser ()
space = do many (sat isSpace)
           return ()

token :: Parser a -> Parser a
token p = do space
             v <- p
             space
             return v

identifier :: Parser String
identifier = token ident

natural :: Parser Int
natural = token nat

symbol :: String -> Parser String
symbol xs = token (string xs)

expr :: Parser Int
expr = do t <- term
          do symbol "+"
             e <- expr
             return (t + e)
           +++ return t

term :: Parser Int
term = do f <- factor
          do symbol "*"
             t <- term
             return (f * t)
           +++ return f

factor :: Parser Int
factor = do symbol "("
            e <- expr
            symbol ")"
            return e
          +++ natural

eval :: String -> Int
eval xs = case parse expr xs of
            [(n, [])] -> n
            [(_,out)] -> error ("unused input " ++ out)
            [] -> error "invalid input"

これを元にして第8章の練習問題を解きました。

int :: Parser Int
int  = do sign <- (char '-') +++ return ' '
          xs <- many1 digit
          return (read (sign:xs))

comment :: Parser ()
comment = do string "--"
             many (sat (/= '\n'))
             char '\n'
             return ()

3. と 4. は構文木を書けという問題なので省略します

5. 構文規則の最後の簡略化をする前だと再帰しない規則にマッチする場合必ず無駄な再帰するほうの関数の適用と失敗によるバックトラックが発生するため

expr :: Parser Int
expr = do t <- term
          do symbol "+"
             e <- expr
             return (t + e)
           +++ do symbol "-"
                  e <- expr
                  return (t - e)
           +++ return t

term :: Parser Int
term = do f <- factor
          do symbol "*"
             t <- term
             return (f * t)
           +++ do symbol "/"
                  t <- term
                  return (f `div` t)
           +++ return f

expr :: Parser Int
expr = do t <- term
          do symbol "+"
             e <- expr
             return (t + e)
           +++ do symbol "-"
                  e <- expr
                  return (t - e)
           +++ return t

8. 問題文からははっきりしませんが、左結合の減算演算子「のみ」を扱うように制限した回答にしています
- a. expr := (expr '-' factor) | factor
- b. 表記をみやすくするため関数を分けています

expr_minus :: Parser Int
expr_minus = do e <- expr_minus
                symbol "-"
                f <- factor
                return (e - f)

expr :: Parser Int
expr = expr_minus +++ factor

- - c. 最初に左再帰するため無限再帰に陥って抜けてこれなくなる
  - d.

expr_minus :: Parser Int
expr_minus = do symbol "-"
                f <- factor
                return f

expr :: Parser Int
expr = do f <- factor
          xs <- many expr_minus
          return (foldl (-) f xs)

第8章はパーサーを書きつつ自然とモナドに触れることで「モナド怖くないよ」と思わせるための構成なのかなと感じました。しかしオフサイドルールのため空白の数が重要なのに等幅でなかったり(+++ 演算子の前のインデントの間違いでしばらく悩みました)、サンプルコードが特殊な記号のままなのはそろそろ不便のほうが勝ってきたように思います。
またモナドへの理解がぐっと腑に落ちたものの、まだコードを書いていて混乱する時もあるので、慣れるにはもう少しコード書きを繰り返す必要がありそうです。

次は第9章「対話プログラム」です。ついに IO が登場します。まだ生活が完全に落ち着いたわけでもないので、次の更新がいつになるかはわかりません。しかし合間をみて読み進めてまた更新します。