[譯] 用 Haskell 寫簡單的 Monadic Parser

原文:

Simple Monadic Parser in Haskell
http://michal.muskala.eu/2015/09/23/simple-monadic-parser-in-haskell.html

---

最近我開始學習 Haskell, 同時很享受 Haskel 提供的視野. 可能之後會再寫一篇.
今天我分享我用 Haskell 寫的第一個比較大的程序.

Real World Haskell 的錯誤處理章節 激發了這篇文章的
也是這篇文章和代碼想法背後最初的來源
書的做者是 Bryan O'Sullivan, Don Stewart, 和 John Goerzen
我推薦全部想要學習 Haskell 的人看這本書

Brainfuck 語言

學 Haskell 的時候我給本身定了一個目標 -- 寫一個 Brainfuck 的優化編譯器
若是你不熟悉 Brainfuck -- 它是一門極爲簡單的 toy 語言
它在一個內存單元的隊列上進行操做, 每一個初始值都是 0
存在一個指針, 初始狀態下指向第一個內存單元
你能夠經過下面 8 個操做來操做指針和內存單元

符號	含義
>	指針右移一位
<	指針左移一位
+	當前內存單元數值增大
-	當前內存單元數值減少
.	輸出當前指針表示的字符
',`	輸入一個字符, 存儲在當前指針的內存單元
[	若是當前指針對應內存單元是 0, 跳過匹配的 ]
]	若是當前指針對應內存單元非 0, 跳回匹配的 [

全部其餘符號被認爲是註釋

若是你對語言奇怪的名字有疑問 -- 我能夠給你看下 Brainfuck 的 "Hello World"
我以爲這讓名字慘痛並且明顯

++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>
---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.

由於語言簡單, 因此存在大量能夠由編譯器優化的地方
也是學習他們的一個好機會

基本的 Parser

不過仍是回到 parser 自己上
我知道 Haskell 已經有很棒的 parser, 特別是 Parsec 和 Attoparsec
不過我要本身寫一個, 爲了多學一點 Monad, 以及怎麼用 Haskell

首先我定義兩個類型: AST 是咱們的目標,
而後 ParseError 用來區別錯誤的結果:

data ParseError = Unexpected Char
                | UnexpectedEof
                | Unknown
                deriving (Eq, Show)

data AST = PtrMove Int
         | MemMove Int
         | Output
         | Input
         | Loop [AST]
         deriving (Eq, Show)

Monad 部分我用 mtl 包
咱們的 Parser Monad 會複合一個內部的 State Monad 保存正在 parse 的字符串
以及 ExceptT Monad Transformer 用來處理解析錯誤
爲了可以簡單地 derive 所需的 Monad Typeclass
咱們須要激活 GeneralizedNewtypeDeriving 語言擴展

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

newtype Parser a = P { runP :: ExceptT ParseError (State String) a
                     } deriving ( Monad
                                , MonadError ParseError
                                , MonadState String
                                )

而後來定義咱們用來運行 Monad 的函數, 它只是解開不一樣的層次, 梳理出結果

runParser :: Parser a -> String -> Either ParseError (a, String)
runParser parser str =
  case (runState . runExceptT . runP) parser str of
    (Left err, _)   -> Left err
    (Right r, rest) -> Right (r, rest)

而後定義基礎的 parser -- satisfy 用來 parse 知足一個斷言的字符:

satisfy :: (Char -> Bool) -> Parser Char
satisfy predicate = do
  s <- get
  case s of
    x:xs | predicate x -> do
             put xs
             return x
    x:_ -> throwError (Unexpected x)
    []  -> throwError UnexpectedEof

咱們從內部的 State Monad 中拿到 Parser State (也就是正在解析的字符串)
而後檢查字符串中的第一個是否匹配
匹配的時候, 咱們更新一遍 State, 返回匹配的結果 Char
咱們運行 Parser 的時候它會被包裹在一個 Right Char 的值當中
若是斷言不知足, 那麼咱們跑出一個 Unexpected Char 的錯誤
藉助於 ExceptT Monad transformer 咱們能夠拋出錯誤
分支被觸發的話, 它會使得 Parser 返回 Left (Unexpected Char)
若是沒有輸入的內容能夠處理, 咱們拋出一個 UnexpectedEof 錯誤

Parser combinators

準備好了這些基本的模塊, 咱們能夠開始考慮組合多個 Parser 的辦法
用來處理更大塊的輸入內容

須要從兩個 Parser 之中選擇的辦法
咱們須要讓 Parser 能嘗試運行一個 Parser, 在失敗時運行另外一個
要定義一個 option 函數, 專門用來作這個事情
能夠認爲這是一個把兩個 Parser 組合成一個的辦法

option :: Parser a -> Parser a -> Parser a
option parser1 parser2 = do
  s <- get
  parser1 `catchError` \_ -> do
    put s
    parser2

這一次也是, 咱們從新獲得 State. 而後嘗試用第一個 Parser 來解析
catchError 函數是藉助於 ExceptT transformer 提供的
它會嘗試左邊的代碼, 失敗的話, 它會處理右邊的函數, 同時傳入錯誤做爲參數
咱們實際上不關心錯誤內容, 因此這裏咱們直接重置初始狀態而後繼續
(由於咱們須要再一次解析一樣的輸入內容), 而後運行另外一個 Parser

這樣咱們也很容易定義函數接收一列 Parser 而後逐個應用, 返回一個成功的 Parser
定義函數名是 choice, 由於這是從多個 parser 當中作選擇:

choice :: [Parser a] -> Parser a
choice = foldr option (throwError Unknown)

這個函數中惟一不直接展現的是函數的初始值
默認狀況下咱們認爲 Parser 會隨着一個 Unknown 錯誤執行失敗
咱們把 Parser 隊列逐個 fold 過去, 直到有一個執行成功
藉助於惰性計算, 咱們不用擔憂後面的可能運行成功的 Parser
在進行 fold 而沒有足夠的 Parser 時, option 會獲得一個 Unknown 錯誤
若是你傳入一個空列表, 沒有 Parser 能夠執行, 咱們返回一個 Unknown 錯誤
由於咱們在不執行的狀況下不知道是什麼錯誤

而後我想到會須要執行一個 Parser 不少次
因而定義是個 many 函數, 它接收一個 Parser 而後儘量屢次嘗試執行
最後返回解析成功的數據的列表
它看起來可能短, 不過我以爲這是這篇博客中最複雜的一個函數
我嘗試一下完全解釋一遍:

many :: Parser a -> Parser [a]
many parser = recurse `catchError` \_ -> return []
  where recurse = do
          result <- parser
          rest   <- many parser
          return (result:rest)

複雜的緣由是其中包含了一些奇特的人工的遞歸. 發生了什麼呢?
首先咱們嘗試用 recurse(不用管什麼意思 -- 先無論它)
若是執行失敗, 咱們直接返回一個空的列表, 用前面的 catchError 函數忽略報錯
那麼遞歸過程中發生了什麼?
首先, 執行一次 Parser, 展開其中的數據
而後, 遞歸執行 Parser 不少次, 獲得其他的能夠解析的輸入內容
最後, 把第一次解析的結果和其他內解析的結果用 cons 拼接在一塊兒

具體來講是怎麼運行的呢? 來看一個例子, 一步一步看下去
好比咱們從字符串 "aab" 解析字符 'a'
運行到 many 函數, 立刻進度 recurse 輔助函數
這裏會執行一個解析, 獲得 'a' 做爲結果
在最後獲得的結果會是 'a':rest, 其中 rest 是後面遞歸調用自身的結果
繼續, 再一次遞歸進入函數, 此次輸入內容只有 "ab" 了
再一次會獲得另外一個 'a'. 大概就像是獲得一個 'a':'a':rest 的結果
而後又一次遞歸進入函數, 這一次只有 "b" 做爲輸入了
這樣的話, 顯然嘗試去解析 'a' 會獲得一個錯誤
那麼, 就進入處處理錯誤的代碼了, 直接返回一個空的列表
如今能夠回到遞歸調用而後獲得最終結果 'a':'a':[], 實際上就是 ['a', 'a']
輸入內容當中還剩下一個 "b". 就是這樣

怪複雜的. 還好這些已經如今咱們須要的所有的組合子

解析一下 Brainfuck

目前爲止咱們已經寫好了基礎的模塊, 看一下怎麼解析 Brainfuck 程序
咱們須要一個基礎的 Parser 用來處理單一的 Brainfuck 指令, 好比 parseOne:

parseOne :: Parser AST
parseOne = choice [ transform '>' (PtrMove 1)
                  , transform '<' (PtrMove (-1))
                  , transform '+' (MemMove 1)
                  , transform '-' (MemMove (-1))
                  , transform ',' Output
                  , transform '.' Input
                  , parseLoop
                  ]
  where transform char ast = expect char >> return ast
        expect char = satisfy (== char)

代碼定義了兩個輔助函數:
expect 經過前面的 satisfy 函數直接指望找到特定的字符
transform 用來處理給出的字符, 匹配成功時返回 AST 塊
用這些輔助函數就定義好多有 Brainfuck 基本的指令了
而後用前面定義的 choice 組合子運行他們的總體的列表
一直到其中一個可以解析出輸入內容

這裏還有一個 parseLoop Parser(猜一下)用來解析循環, 如今來定義:

parseLoop :: Parser AST
parseLoop = do
  consume '['
  steps <- many parseOne
  consume ']'
  return (Loop steps)
  where consume char = satisfy (== char) >> return ()

我以爲這個比較直接 -- 首先處理左括號,
而後用 many 組合子儘量多地解析元素(用前面的 parseOne Parser)
而後指望找到一個右括號. 最後返回 AST 到循環當中
其中 consume 輔助函數也很簡單, 它嘗試解析提供的字符,
若是解析成功, 返回 unit (), 由於咱們不須要這裏實際的結果

注意這兩個函數人爲地遞歸了 parseLoop 會調用 parseOne
而 parseOne 會調用 parseLoop. 以此來處理嵌套的循環

咱們還須要一個函數來 Parser 整個程序 -- 一個表示解析完成的辦法
爲此定義一個是 eof 函數:

eof :: Parser ()
eof = do
  s <- get
  case s of
    [] -> return ()
    _  -> throwError UnexpectedEof

這也很簡單. 先觀察 Parser 的當前狀態,
若是是空字符串了就是到達結尾了, 返回一個 unit, 不須要任何有意義的返回值
若有還有內容能夠解析, 就拋出一個 UnexpectedEof 錯誤
你可能以爲這個選擇有點繞 -- 爲何還有東西解析時候拋出 UnexpectedEof?
想一下咱們爲何要寫到這部分的代碼, 你會以爲清晰一些
比方說要解析不正常的循環 "[.+-", 用 parseLoop 解析時會發生什麼?
在查找右括號時會失敗, 剩下就是一段不能解析的內容
若是這裏用的用的是 eof Parser 但願解析結束, 很明顯要拋 UnexpectedEof 錯誤

最終定之後一個 Brainfuck 的 Parser:

parseAll :: Parser [AST]
parseAll = do
  exprs <- many parseOne
  eof
  return exprs

咱們解析掉了全部的簡單指令
最後咱們解析完了須要先解析的內容, 也就遇到的 EOF.

用這個 Parser 就能夠組裝一個 parse 函數解析 Brainfuck 的字符程序
最後返回解析完成的 AST 或者一個錯誤:

parse :: String -> Either ParseError [AST]
parse = fmap fst . runParser parseAll . filter isMeaningful
  where isMeaningful = (`elem` "><+-,.[]")

咱們首先過濾掉輸入字符串剩下有意義的 Brainfuck 指令(其他都是註釋)
接着運行 Parser, 最後展開結果

結論

Haskell 以其優秀的 Parser 聞名, 如今能夠看到爲何了
不到 100 行代碼, 就定義了一個功能完整的 Parser,
以及錯誤處理, 並且用起來簡單和直觀
這些代碼有不少地方能夠被優化, 或者用更多的範疇論調味
(好比用 Control.Applicative 裏的 Alternative class 定義 many
這樣 Parser 就是這些 class 的成員了
或者把在 Parser 類型裏把 choice 函數縮減爲簡單的 asum)
不過我以爲這套代碼實現比較清晰, 並且關注了最重要的部分
而不是關注了 Haskell typeclass 的複雜之處
就算那頗有意思也不是本篇文章的重點了

能夠在這裏看到本文使用的代碼