[译] 用 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 的复杂之处
就算那颇有意思也不是本篇文章的重点了

能够在这里看到本文使用的代码