某高中生眼中入门级别的程序。

本文要点

你将收获

了解Parser Combinator的概念、特点以及使用方法。
学会用Haskell亲手构建简单却实用的Parser Combinator。
加深对Monad的理解。

所需基础

简单了解Haskell语法即可。

Parser Combinator 概念

什么是Parser：
简单地说：给定一个字符流，比如一个字符串、一段代码、一篇文章等，输入到Parser，会把原本平坦的结构改造成有层次有内涵的结构。

什么是Parser Combinator：
由于函数式语言里函数是头等公民，可以把一个函数作为另一个函数的参数，一个函数可以产生出另外一个函数。基于这样的特点，我们可以把一个Parser作为参数传给另外一个Parser，一个Parser也可以产生另外一个新的Parser。有了这样的结合性，我们就可以实现Parser Combinator。
它是一种基于递归下降原理的非常简洁的Parser实现方法。

为什么是Parser Combinator：
Parser Combinator在模块化、可读性、易维护等方面有着无可比拟的优势。
举个简单的例子：就像小孩子读文章，一开始他只认识一个一个字，拿着手指一个字一个字地点着读。接着他学会了把字结合起来变成词，认识词后又学会如何识别句子（很可能是因为学会了标点符号），慢慢长大后他便一目十行，脑中自然形成了文章的概念。Parser Combinator就很像这样一步一步组合的过程，非常符合人类直觉，所以编写起来相当容易。

编写语言：
Haskell，不想写C++找罪受。
注：演示代码将尽量详细，所以可能不够point-free。

数据类型

第一步，先定义Parser的数据类型。
还记得我上面说过，Parser是将字符流转换成一种结构，比如Tree。所以可以适当猜想一下数据类型的样子：

1	type Parser = String -> Tree

但显然不可能这样一步到位，一个Parser直接生成一棵树，那还谈什么结合。按道理，应该是一个Parser接受字符串，消耗一定字符，产生特定的结构，完成后把剩余的字符交给下一个Parser继续解析：

1	type Parser = String -> (Tree, String)

这个看起来还行，不过只能产生Tree这种数据结构。我们不应该给它这样的限制，而是允许使用者自由地决定解析什么数据结构，所以把Tree抽象成任意具体类型。
最后再加上代表解析失败的信号，就形成了一个可用的Parser类型。

1	newtype Parser a = Parser (String -> Maybe (a, String))

解析失败将返回Nothing。

热身

在最开始的地方，就让我们写个最简单的，能够解析一个特定字符的的Parser：

1	char :: Char -> Parser Char

接受一个字符，返回解析该字符的Parser：

char :: Char -> Parser Char
char c = Parser $ \str ->
  case str of
    "" -> Nothing
    (x:xs) -> if x == c 
                then Just (x, xs) 
                else Nothing

为了测试效果，还得实现一个运行函数：

1 2	runParse :: Parser a -> String -> Maybe (a, String) runParse (Parser psr) str = psr str

终端：

λ> runParse (char 'a') "abc"
Just ('a',"bc")
λ> runParse (char 'a') "b"
Nothing

解析 a 字符。给定 “abc” 字符串，字符串消耗一个 ‘a’ ，返回一个 ‘a’ ，剩余字符串为 “bc” 。
解析 a 字符。给定 “b” 字符串，解析失败，返回 Nothing 。

太好了，莫大的鼓励。

开始构建

satisfy

上面简单实现了char。不过，是否可以略微抽象一下呢。不一定要相等，只要满足给定的条件就算解析成功。
相信读者已经想到了，把Char改成函数Char -> Bool不就可以了吗，就取名作satisfy吧：

satisfy :: (Char -> Bool) -> Parser Char
satisfy prd = Parser $ \str ->
  case str of
    "" -> Nothing
    (x:xs) -> if prd x 
                then Just (x, xs) 
                else Nothing

对比上面的char，这里只是把if右边的判断语句改了一下，就实现了更丰富的功能。

既然satisfy是由char抽象而来的，那么char应该也可以由satisfy实现：

1 2	char :: Char -> Parser Char -- 改写char实现 char c = satisfy $ \x -> x == c

不仅如此，现在因为有了satisfy，从Data.Char包里找到一些Char -> Bool的函数，我们就又可以实现一大堆Parser了：

import Data.Char
...
...
space :: Parser Char -- 解析空格
space = satisfy isSpace
digit :: Parser Char -- 解析十进制数字
digit = satisfy isDigit
lower :: Parser Char -- 解析小写字母
lower = satisfy isLower
upper :: Parser Char -- 解析大写字母
upper = satisfy isUpper
letter :: Parser Char -- 解析字母
letter = satisfy isLetter
alphanum :: Parser Char -- 解析字母和数字
alphanum = satisfy isAlphaNum
hexDigit :: Parser Char -- 解析十六进制数字
hexDigit = satisfy isHexDigit
octDigit :: Parser Char -- 解析八进制数字
octDigit = satisfy isOctDigit

赚大了，简直是买一送十，实现个satisfy白拿这么多Parser。

测试：

λ> runParse letter "bc"
Just ('b',"c")
λ> runParse digit "123"
Just ('1',"23")
λ> runParse digit "abc"
Nothing

还有这两个相当有用的Parser：

oneOf :: String -> Parser Char
oneOf cs = satisfy (`elem` cs) -- 解析给定字符串里的其中一个Char
noneOf :: String -> Parser Char
noneOf cs = satisfy (not . (`elem` cs)) -- 解析给定字符串以外的任何Char

测试：

λ> runParse (oneOf "abc") "biiii"
Just ('b',"iiii")
λ> runParse (noneOf "abc") "iiii"
Just ('i',"iii")

string

尽管上面已经实现了很多Parser，但我们发现它们都是解析Char类型的，不能就此停下脚步。
现在尝试一下实现解析多个Char的Parser，也就是String：

string :: String -> Parser String
string "" = Parser $ \s -> Just ("", s) -- 空字符串，解析成功
string (x:xs) = Parser $ \inp ->
  case runParse (char x) inp of -- 解析第一个字符
    Nothing -> Nothing
    Just (r, rest) -> case runParse (string xs) rest of -- 解析剩余字符串
                        Nothing -> Nothing
                        Just (rs, outp) -> Just (r:rs, outp) -- 连接字符和字符串

测试：

λ> runParse (string "abc") "abc"
Just ("abc","")
λ> runParse (string "abc") "ab"
Nothing

这里使用了递归，看起来似乎有点复杂，嵌套了两层case，但在注释的帮助下，相信读者能够轻松理解。

Combinator

也许会有读者问到，我们仅仅是解析一串字符串，都要嵌套来嵌套去，这就是所谓的可读性和易构建吗？
这个问题问得非常好。假设我们要连续解析多个类型，如果继续按照上面的做法，很可能会产生一大串case链，这是非常难写和难懂的。
这个问题的解决，还是只有那个办法 —— 抽象。

要在旧的Parser产生的结果的基础上构造新的另外一种类型的Parser，可以这样做：

bind :: Parser a -> (a -> Parser b) -> Parser b
pa `bind` apb = Parser $ \inp ->
  case runParse pa inp of
    Nothing -> Nothing
    Just (a, rest) -> let (Parser pb) = apb a
                      in pb rest

第二个参数a -> Parser b实际上只是一个幌子，它最大的作用是把第一个Parser a的结果a「骗」出来。平时使用时通常写成一个lambda表达式，然后在这个lambda里专注于Parser b的实现。
若一头雾水，请留意接下来的演示。

用它来重新写string：

string :: String -> Parser String
string "" = lift ""
string (x:xs) = char x `bind` \s ->       -- 「骗」出char的结果s
                string xs `bind` \ss ->   -- 「骗」出剩余string的结果ss
                lift (s:ss)               -- 返回结构Parser
lift :: a -> Parser a
lift x = Parser $ \inp -> Just (x, inp)

lift函数不消耗字符串，只为把Parser结构补上。

如此奇妙的思路，如此精巧的实现，当然这不是我这种普通人能够「显而易见」的。
在此致敬相关数学家。

Monad

躲不过的，躲不过的。写Haskell无论如何都是是躲不过Monad的。

Haskell上bind语法的简化版：

string :: String -> Parser String
string "" = return ""
string (x:xs) = do
  s  <- char x     -- char x解析结果绑定到s上
  ss <- string xs  -- string xs解析结果绑定到ss上
  return (s:ss)    -- 返回结构Parser

看起来更加清晰自然，这才是Combinator应有的样子。
想要得到这种do语法，只需要将Parser类型实现Monad。

λ> :t (>>=)
(>>=) :: Monad m => m a -> (a -> m b) -> m b
λ> :t bind
bind :: Parser a -> (a -> Parser b) -> Parser b
λ> :t return
return :: Monad m => a -> m a
λ> :t lift
lift :: a -> Parser a

其实我们已经实现了Monad需要的(>>=)和return函数，但由于还未实现Monad的前置范畴Functor和Applicative，所以暂时还不能instance Monad。Functor和Applicative也是很有用的范畴，下面就来实现一下。

Functor

λ> :i Functor
class Functor (f :: * -> *) where
  fmap :: (a -> b) -> f a -> f b
  (<$) :: a -> f b -> f a
  {-# MINIMAL fmap #-}

最少实现：fmap :: (a -> b) -> f a -> f b
下面来尝试一下：

instance Functor Parser where
  fmap f pa = Parser $ \inp ->
    case runParse pa inp of
      Nothing -> Nothing
      Just (x, rest) -> Just (f x, rest)

fmap需要提供一个函数a -> b和一个Parser a，然后就可以产生另外一个Parser b。

Applicative

λ> :i Applicative
class Functor f => Applicative (f :: * -> *) where
  pure :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b
  GHC.Base.liftA2 :: (a -> b -> c) -> f a -> f b -> f c
  (*>) :: f a -> f b -> f b
  (<*) :: f a -> f b -> f a
  {-# MINIMAL pure, ((<*>) | liftA2) #-}

最少实现：pure :: a -> f a、(<*>) :: f (a -> b) -> f a -> f b

pure已经实现过了，就是上面的lift：
1
pure x = Parser $ \inp -> Just (x, inp)

lift：

pab <*> pa = Parser $ \inp ->
  case runParse pab inp of
    Nothing -> Nothing
    Just (fab, rest) -> runParse (fmap fab pa) rest

合起来：

instance Applicative Parser where
pure x = Parser $ \inp -> Just (x, inp)
pab <*> pa = Parser $ \inp ->
  case runParse pab inp of
    Nothing -> Nothing
    Just (fab, rest) -> runParse (fmap fab pa) rest

Monad

λ> :i Monad
class Applicative m => Monad (m :: * -> *) where
  (>>=) :: m a -> (a -> m b) -> m b
  (>>) :: m a -> m b -> m b
  return :: a -> m a
  fail :: String -> m a
  {-# MINIMAL (>>=) #-}

最少实现：(>>=) :: m a -> (a -> m b) -> m b

直接复制上面的bind

instance Monad Parser where
  pa >>= apb = Parser $ \inp ->
    case runParse pa inp of
      Nothing -> Nothing
      Just (a, rest) -> runParse (apb a) rest

用Monad改写string：

string :: String -> Parser String
string "" = return ""
string (x:xs) = do
  s  <- char x 
  ss <- string xs
  return (s:ss)

测试：

λ> runParse (string "abc") "abcd"
Just ("abc","d")
λ> runParse (string "abcde") "abcd"
Nothing

用Functor和Applicative改写string：

1
2
3

string :: String -> Parser String
string ""     = return ""
string (x:xs) = (:) <$> char x <*> string xs

测试：

λ> runParse (string "abc") "abcd"
Just ("abc","d")
λ> runParse (string "abcde") "abcd"
Nothing

选择与回溯

尽管有上面的Monad，我们已经可以构建绝大多数的Parser了。
但当我们常常希望解析同样的值多次，或是尝试解析a失败后继续解析b。
幸运的是，只要instance Alternative，就能一次性获得以上好处。

首先需要import：

1	import Control.Applicative

λ> :i Alternative
class Applicative f => Alternative (f :: * -> *) where
  empty :: f a
  (<|>) :: f a -> f a -> f a
  some :: f a -> f [a]
  many :: f a -> f [a]
  {-# MINIMAL empty, (<|>) #-}

只要实现empty和<|>：

instance Alternative Parser where
  empty = Parser $ const Nothing
  pa <|> pb = Parser $ \inp ->
    case runParse pa inp of
      Nothing -> runParse pb inp
      x -> x

注：这里发生了件很微妙的事情 —— 这里的<|>实现是必回溯的，也就是说，如果左边的pa失败了，则pb会从头开始解析。

现在我们有了some、many、<|>，可以用来做一些更酷的事情。

skipMany :: Parser a -> Parser ()
skipMany p = many p >> return ()
skipMany1 :: Parser a -> Parser ()
skipMany1 p = some p >> return ()

注：>>是>>=的丢弃结果版本，a >> b相当于a >>= \_ -> b。带1的函数代表至少解析一个值，对应some。

测试：

1 2	λ> runParse (skipMany space >> char 'a') " a" Just ('a',"")

其他函数

between

通常用来解析括号之间的值，利用Applicative。

1 2	between :: Parser open -> Parser a -> Parser close -> Parser a between o a c = o > a < c

1 2	λ> runParse (between (char '(') digit (char ')')) "(2)" Just ('2',"")

sepBy

通常用来解析列表形式的值，每个值之间用特定分隔符隔开，解析成功则返回值的列表。

sepBy1 :: Parser a -> Parser sep -> Parser [a]
sepBy1 p sep = do
  a <- p
  as <- many (sep >> p)
  return $ a:as
sepBy :: Parser a -> Parser sep -> Parser [a]
sepBy p sep = sepBy1 p sep <|> return []

1 2	λ> runParse (sepBy (many letter) (oneOf " ")) "abc def fg b" Just (["abc","def","fg","b"],"")

endBy

和sepBy的区别是，endBy末尾还有分隔符。

endBy :: Parser a -> Parser sep -> Parser [a]
endBy p sep = many (p <* sep)
endBy1 :: Parser a -> Parser sep -> Parser [a]
endBy1 p sep = some (p <* sep)

1 2	λ> runParse (endBy (many letter) (oneOf " ")) "abc def fg b " Just (["abc","def","fg","b"],"")

chainl

左结合，需要提供结合两个值的函数。

chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
chainl1 p op = do
  x <- p
  trav x
  where trav x_ = try (do f <- op
                          y <- p
                          trav (f x_ y)) <|> return x_
chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainl p op x = chainl1 p op <|> return x

chainr

右结合，需要提供结合两个值的函数。

chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
chainr1 p op = do
  x <- p
  try (do f <- op
          rest <- chainr1 p op
          return (f x rest)) <|> return x
chainr :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
chainr p op x = chainr1 p op <|> return x

实例：构造四则运算语法树

语法树数据结构

1
2
3

data Op = Add | Sub | Mul | Div deriving (Eq)
data ExprTree = Number Int
              | Node Op ExprTree ExprTree deriving (Eq)

顺便instance Show，按S-表达式语法：

instance Show Op where
  show Add = "+"
  show Sub = "-"
  show Mul = "*"
  show Div = "/"
instance Show ExprTree where
  show (Number x) = show x
  show (Node op l r) = "(" ++ show op ++ " " ++ show l ++ " " ++ show r ++ ")"

1 2	λ> Node Add (Number 1) (Number 2) (+ 1 2)

解析数字

1 2	nature :: Parser Int nature = read <$> some digit

1 2	λ> runParse nature "10086" Just (10086,"")

Term Factor Expression

读者可以参考中缀表达式转化前后缀引发的思考。

由于四则运算的结合性都是左结合，需要一个Parser (a -> a -> a)类型的结合函数：

1 2	pNode :: Op -> Parser (ExprTree -> ExprTree -> ExprTree) pNode = return . Node

Exp = Factor (( ‘+’ | ‘-‘ ) Factor)*

1 2	expression :: Parser ExprTree expression = chainl1 factor ((char '+' >> pNode Add) <\|> (char '-' >> pNode Sub))

Factor = Term (( ‘‘ | ‘/‘ ) Term)

1 2	factor :: Parser ExprTree factor = chainl1 term ((char '*' >> pNode Mul) <\|> (char '/' >> pNode Div))

Term = <数字> | ‘(‘ Exp ‘)’

1 2	term :: Parser ExprTree term = Number <$> nature <\|> between (char '(') expression (char ')')

测试

1 2	λ> runParse expression "2+57/(39+54)-7/6" Just ((- (+ 2 (/ ( 5 7) (+ 39 54))) (/ 7 6)),"")

注意到，这里的原始式不能带空格。

练习：请读者自行实现一个允许带空格的四则运算Parser。

下一步

本文实现的Parser Combinator的缺陷：不包含错误信息提示、<|>强制回溯等，将在下篇文章解决。
将带来更多的实例。

参考

Monadic Parser Combinators
https://en.wikipedia.org/wiki/Parser_combinator

本文要点

你将收获

所需基础

Parser Combinator 概念

数据类型

热身

开始构建

satisfy

string

Combinator

Monad

Functor

Applicative

Monad

选择与回溯

其他函数

between

sepBy

endBy

chainl

chainr

实例：构造四则运算语法树

语法树数据结构

解析数字

Term Factor Expression

Exp = Factor (( ‘+’ | ‘-‘ ) Factor)*

Factor = Term (( ‘*‘ | ‘/‘ ) Term)*

Term = <数字> | ‘(‘ Exp ‘)’

测试

下一步

参考

Factor = Term (( ‘‘ | ‘/‘ ) Term)