Parsecで少しだけ使えそうな電卓を作ってみた

Parsecの練習でよくある電卓を「演算子を拡張可能」と「内部では有理数として扱う」ことを念頭にこちらを参考にして作ってみました。コード全文はgithubにおいてあります。作成時に使用しただけの関数もインポートしている可能性があるのでコード全文を読むときは注意してください。

どんな電卓か

まず最初に電卓のASTですがこちらになります。

src/Lib.hs

data CalcAST =
          Number Rational
        | BinaryOp String CalcAST CalcAST
        | UnaryOp String CalcAST
        | Paren CalcAST

木構造なので説明しなくてもわかると思います。ここで数値型としてRationalを使っています。
次に、使える二項演算子は次となります。

src/Lib.hs

bop0Map = [
      ("*", (*))
    , ("/", (/))
    ]
bop1Map = [
      ("+", (+))
    , ("-", (-))
    ]

一つ目は掛け算と同じ優先順位、二つ目は足し算と同じ優先順位の演算子との対応が用意されています。この辞書に追加するとパースしてもらえるようになります。
次に、単項演算子は次となります。考え方は二項演算子と同じ辞書形式になるので説明は省略します。

src/Lib.hs

uopMap = [
      ("-", ((-) 0))
    , ("abs", abs)
    , ("sign", signum)
    ]

それぞれのパーサー

数字用

src/Lib.hs

ratio :: Parser Rational
ratio = do
    xs <- many1 digit
    ys <-  optionMaybe (char '.' *> many1 digit)
    return $ convert xs ys
    where
        convert :: String -> Maybe String -> Rational
        convert xs Nothing = toRational $ (read :: String -> Integer) xs
        convert xs (Just ys) = (convert xs Nothing) + (toRational $ (read :: String -> Double) $ "0." ++ ys)

num :: Parser CalcAST
num = Number <$> ratio <* spaces

数字はratioで読み取り、numはcalcAST型に包むだけです。
ratioは"123"や"123.4"のどちらも読み取るように制作しています。

記号関係用

src/Lib.hs

symbol :: String -> Parser String
symbol xs = do
    res <- string xs
    spaces
    return res

paren :: Parser CalcAST
paren = do
    symbol "("
    res <- expr
    symbol ")"
    return $ Paren res

unary :: String -> Parser (CalcAST -> CalcAST)
unary s = do
        symbol s
        return $ UnaryOp s

binary :: String -> Parser (CalcAST -> CalcAST -> CalcAST)
binary s = do
        symbol s
        return $ BinaryOp s

役目は関数名を見るとわかると思います。parenで出てくるexprは次で出てきます。

式用

src/Lib.hs

term :: Parser CalcAST
term = try paren <|> num <|> withUop
    where
        uops = map unary (map fst uopMap)
        withUop = do
            uop <- choice uops
            n <- term
            return $ uop n

expr :: Parser CalcAST
expr = term `chainl1` (choice bop0) `chainl1` (choice bop1)
    where
        bop0 = map binary (map fst bop0Map)
        bop1 = map binary (map fst bop1Map)

それぞれのパーサの説明を簡単にしますとtermは単項用、exprは複数項用となります。
まずtermは括弧、数字、単項演算子から始まる単項のどれかをパースします。これは"--6"もパースできることを意味します。
次にexprはbop1Mapの二項演算子でつながった「bop0Mapでつながった単項」をパースします。

利用用

src/Lib.hs

mainParser = expr <* eof

式は余分なものがなくて最後にパースするのは終端(つまりEOF)で終わるということとしてパースします。
こうして出来上がったパーサーをMain関数で引数を読み取って計算させます。それが次となります。

app/Main.hs

main :: IO ()
main = do
    arg <- head <$> getArgs
    let parseRes = parseCalcAST mainParser arg
    case parseRes of
        Right r -> do
            putStrLn $ "calculateAST from\n" ++ show r
            let (Right calcRes) = fromRational <$> (calc r)
            putStrLn $ "to " ++ show calcRes
        Left e -> print e

試しに実行してみると

*Main Lib> :main "abs -3 * 4 + 3"
calculateAST from
BinaryOp "+" (BinaryOp "*" (UnaryOp "abs" (UnaryOp "-" (Number (3 % 1)))) (Number (4 % 1))) (Number (3 % 1))
to 15.0
*Main Lib> :main "abs -3 * -4 + 3"
calculateAST from
BinaryOp "+" (BinaryOp "*" (UnaryOp "abs" (UnaryOp "-" (Number (3 % 1)))) (UnaryOp "-" (Number (4 % 1)))) (Number (3 % 1))
to -9.0

といった感じになります。

まとめ

Parsecを学ぶ人にとって電卓は最初の壁のようなものなのでParsecの練習がてら作成してみました。最初はただ書き写そうと思っていたのですが、それでは少しつまらないなと思ったので改造してみました。Haskell、Parsecともに初心者なので、良くない書き方があるかと思います。もし間違いがあったら指摘してくれるとありがたいです。そしてlexemeを使ってパーサーを自動生成する方法があるよと言う方もいると思います。そういう方はqiitaにlexeme版を投稿してください。お願いします。（情報が探しにくいおかげで勉強したいのになかなか自分の中で情報がまとまらない為。）
簡潔すぎる記事ですがこれで終わりにさせていただきます。最後まで読んでいただきありがとうございました。