F# 中的单子解析。

引言

本文是一篇简短的教程，介绍了如何使用 F# 中的单子编写可扩展的递归下降解析器，且不使用可变状态。使用本文所述技术构建的解析器能够接受歧义语法，并具有任意长度的前看。这些LL(*) (Parr 2007) 解析器不受限于任何有限数量的前看。虽然这可能会降低与机器生成的自底向上解析器相比的性能，但本文所述的技术将生成更简单、更优雅的解析器。此外，这些解析器还消除了对词法分析（标记化）的需求，因为词法分析是即时进行的。

解析器类型

我们首先定义解析器函数的签名。类型签名是

type Parser<'r> = Parser of (char list -> ('r*char list) list)

也就是说，解析器是一个函数，它接受一个字符列表并产生一个元组列表。元组由结果和（通常更新后的）待解析的剩余字符列表组成。将这些结果元组放在列表中使我们能够接受歧义语法。

解析器函数还需要被应用，所以我们为此定义一个偏函数

let parse (Parser p) = p

单子绑定组合子

单子绑定组合子 >>= 将运行一个解析器，并将这些结果（记住解析器返回一个结果列表）应用于下一个解析器。该组合子接受一个解析器和一个函数，该函数接收一个结果并返回一个新的解析器。将第二个解析器应用于结果列表的结果是结果列表的列表，在返回之前，这些列表将被连接起来。

let (>>=) p f = Parser(fun cs ->
    List.concat [for (r,cs') in parse p cs -> parse (f r) cs'])

解析器通常是通用格式

parser1 >>= fun r1 ->
parser2 >>= fun r2 ->
...
parsern >>= fun rn ->
mreturn (s r1 r2 ... rn)

其中 s 是应用于解析器结果的语义函数。我们可能不关心解析器的结果，而只关心它是否成功。所以，与其写

parser1 >>= fun _ ->
parser2 >>= fun _ ->
...

我们只想立即丢弃结果并写

parser1 >>
parser2 >>
...

组合子 >> 可以表示为 >>=

let (>>) p q = p >>= fun _ -> q

基本解析器

为了构造更复杂的、对语法通用和特定的解析器及组合子，我们定义了几个基本解析器。第一个只是将一个值注入结果而不消耗任何输入字符

let mreturn r = Parser(fun cs -> [(r,cs)])

下一个解析器返回一个空结果，通常表示为 λ、Λ 或 ϵ

let lambda = Parser(fun _ -> [])

接下来是 item 解析器。此解析器无条件消耗单个字符

let item = Parser(fun cs ->
    match cs with [] -> [] | c::cs' -> [(c,cs')])

使用这些基本解析器，我们可以定义另外两个基本解析器。第一个是条件解析器

let sat cond =
  item >>= fun c -> if cond c then mreturn c else lambda

它获取第一个字符并对其应用条件函数。如果条件评估为 true，则返回该字符，否则返回空结果。

char 解析器仅在字符匹配时消耗字符

let char c = sat ((=)c)

digit 解析器仅在字符范围 [0..9] 内时消耗字符

let digit = sat (fun c ->
  (List.tryFind ((=)c) ['0'..'9']).IsSome)

alpha 解析器类似于 digit

  let alpha = sat (fun c ->
    (List.tryFind ((=)c)(List.append
      ['a'..'z'] ['A'..'Z'])).IsSome)

选择组合子

我们经常需要在两个或多个不同的解析器之间进行选择。选择组合子正是为此目的而设计的

let (<|>) p q = Parser(fun cs ->
  match parse p cs with
  | [] -> parse q cs
  | rs -> rs)

选择组合子接受两个参数 p 和 q，它们都是解析器。它首先应用第一个解析器。如果成功，则返回该结果。如果结果是空列表，则表示失败，然后解析 q。请注意，q 也可能失败。还有一个同样重要的选择组合子：歧义选择组合子。它将每个解析器的结果连接到一起并将其作为结果返回。如果一个或另一个解析器因 [] 而失败，结果将是另一个解析器的结果。

let (++) p q = Parser(fun cs ->
    List.append (parse p cs) (parse q cs))

递归组合子

Kleene* 和 Kleene（分别表示解析器的 0 次或多次重复和 1 次或多次重复）组合子可以相互表示

let rec many0 p = many1 p <|> mreturn []
and many1 p = p >>= fun r -> many0 p >>= fun rs -> mreturn (r::rs)

有时需要检查的不仅仅是单个字符，而是一个完整的字符串是否可以解析，例如在解析关键字时

let rec symbol cs =
  match cs with
  | [] -> mreturn []
  | c::cs' -> char c >> symbol cs' >> mreturn cs

歧义选择和 LL(*)

++ 组合子很重要，因为它允许我们解析歧义语法。假设我们有简单的语法

expr	→	number ′;′
number	→	integer | decimal
整数	→	digit+
decimal	→	digit+ ′.′ digit*

我们编写解析器的第一个尝试如下

let rec expr =
    number >>= fun n ->
    char ';' >>
    mreturn n
and number = integer <|> dec
and integer =
    many1 digit >>= fun digits ->
    mreturn <apply sematic function on digits>
and dec =
    many1 digit >>= fun digits ->
    char '.' >>
    many0 digit >>= fun decimals ->
    mreturn <apply sematic function on nums and decimals>

乍一看，这似乎没问题。在此示例中，我们期望解析一个数字后跟一个分号，然后就什么都没有了。但是，如果我们尝试解析字符串 "123.4;" 呢？number 解析器返回一个整数。expr 的其余部分失败，因为它期望一个分号却找到了一个句点。

如果我们用 ++ 替换 < - > 的使用，结果将不同

...
and number = integer ++ dec
...

++ 组合子同时应用两个解析器，并返回 [(123,['.';'4';';']);(123.4,[';'])] 作为结果。>>= 组合子获取此结果列表，并在两者上应用下一个解析器（此处为 char '.'...）。由于 123 之后的下一个字符不是 .，因此将其丢弃，只有 123.4 可用。

这个简单的例子演示了在无需显式实现前看解析器的情况下，编写具有任意长度前看的解析器的能力。

其他有用的解析器和函数

一些字符串帮助函数可能很方便，因为字符串和字符列表在 F# 中并不相同。因此，我们使用一元函数。

// convert a string to a list of characters
let (~&) (str:string) = str.ToCharArray() |> List.ofArray
// convert a list of characters to a string
let (~%) (chars:char list) = new String(Array.ofList chars)

还有一些相当有用的组合子

• 解析由解析器 sep 分隔的一系列解析器 p，并返回解析 p 的结果列表。例如，解析字符串 aba 或 abababa

let sepBy p sep =
    p >>= fun r ->
    many0 (sep >> p) >>= fun rs ->
    mreturn (r::rs)

• 解析解析器 p 后跟另一个解析器 e

let endBy p e =
    p >>= fun r ->
    e >>
    mreturn r

• 解析新行和行尾。请注意，在 Win32 系统中，"rn" 是一个新行。

let newline = symbol &"\r\n"
let endofline = many0 (char ' ') >> newline >> many0 (char ' ')

• 解析任意数量（≥1）的空格，此处定义为 '' 或 't'

let space = many1 (char ' ' <|> char '\t')

• 要么解析解析器 p，要么解析无。在语法术语中，它表示为 p - Λ，相当于成功应用 p 零次或一次。

let orLambda p = (p >>= fun v -> mreturn [v]) <|> mreturn []

当然，给定此处已提到的解析器和组合子，可以构造任意数量的解析器和组合子。这完全取决于实现给定语法解析器时的具体需求，本教程绝非详尽无遗。

错误消息

只返回成功结果或不返回任何结果的解析器并不特别有用；我们需要能够组合错误消息并将它们发送回链中，以便显示给程序员。我们希望能够写出类似 "错误发生在第 x 行，第 y 列。意外的文件结束。期望 '.', ';' 或 'n'" 的错误消息。为此，我们扩展了解析器定义如下

type Parser<'r> = Parser of (char list ->
    (('r*char list) list*string list*string*int))

也就是说，解析器是一个函数，它接受一个字符列表并返回一个包含 4 个值的元组。它们的含义是

• ('r*char list) list：解析结果。解析失败时为空列表。
• string list：解析器期望的内容列表（在解析失败时）。
• string：对意外内容的描述，例如 "文件结束" 或 "';'"。
• int：指向错误位置的指针。这里我们使用未解析的字符数。这个数字可以很容易地转换为原始输入中的行号和列号。

单子绑定组合子仍然需要运行一个解析器并将结果应用于下一个解析器。结果仍将被连接。每个结果列表后面跟着一个描述解析器期望内容的字符串列表，这些也必须被连接起来。绑定组合子如下所示

let (>>=) p f = Parser(fun cs ->
    match parse p cs with
    | ([],exs,unex,pos) -> ([],exs,unex,pos)
    | (rs,_,_,_) ->
      List.map (fun (r,cs') -> parse (f r) cs') rs
      |> List.fold (fun (rs,exs,_,_) (rs',exs',unex,pos) ->
      (List.append rs' rs,List.append exs' exs,unex,pos))
        ([],[],"",len cs))

>> 组合子与之前相同。

选择运算符也需要处理新的解析器类型

let (++) p q = Parser(fun cs ->
    let (prs,pexs,punex,ppos) = parse p cs
    let (qrs,qexs,qunex,qpos) = parse q cs
    (  List.append prs qrs,
      List.append pexs qexs,
      (if ppos<qpos then punex else qunex),
      min ppos qpos))

let (<|>) p q = Parser(fun cs ->
    match parse p cs with
    | ([],exs,_,_) ->
      let (rs,exs',unex,pos) = parse q cs
      (rs,List.append exs exs',unex,pos)
    | other -> other)

mreturn 和 lambda 基本解析器也同样如此

let mreturn r = Parser(fun cs -> ([(r,cs)],[],"",len cs))
let lambda = Parser(fun cs -> ([],[],"",len cs))

其中 len 是一个调用 List.length 的偏函数。此外，我们需要一个 err 解析器，它接受一个描述意外内容的字符串

let err unex = Parser(fun cs -> ([],[],unex,len cs))

不总是希望返回一个很长的预期列表（想想：当期望一个数字时返回整个字母表），因此需要一个替换预期错误运算符 >>@

let (>>@) p exp = Parser(fun cs ->
    match parse p cs with
    | ([],_,unex,pos) -> ([],[exp],unex,pos)
    | other -> other)

item 解析器已更改，以便在应用于空输入时返回错误消息

let item = Parser(fun cs ->
    match cs with
    | [] -> ([],[],"end-of-file",0)
    | c::cs' -> ([(c,cs')],[],"",0))

sat 解析器已增强，可以接受一个字符串。如果条件不满足，此字符串将描述预期内容，并使用 >>@ 运算符注入到结果中

let sat cond exp =
    (item >>= fun c -> if cond c then mreturn c else err %[c])
    >>@ exp

char 解析器使用 sat，因此现在如下所示

let char c = sat ((=)c) %[c]

这样，如果输入不满足条件，char 解析器将在预期列表中返回该字符。

digit 和 alpha 解析器使用 sat，因此在失败时也必须提供错误消息

let digit = sat (fun c ->
    (List.tryFind ((=)c) ['0'..'9']).IsSome) "a digit"

let alpha = sat (fun c ->
    (List.tryFind ((=)c) (List.append
      ['a'..'z'] ['A'..'Z'])).IsSome) "a letter"

symbol 解析器接受一个字符列表，并递归地将 char 解析器应用于输入。在失败时，使用 >>@ 解析器进行了增强

let rec symbol cs =
    (match cs with
    | [] -> mreturn []
    | c::cs' -> char c >> symbol cs' >> mreturn cs)
    >>@ %cs

endBy 解析器必须获取 p 的最后一个错误消息，并使用 ++ 组合子将其与 e 的错误消息连接起来

let endBy p e =
    p >>= fun r ->
    (p ++ e) >>
    mreturn r

为了测试我们是否已到达输入末尾，我们有 endoffile 解析器

let endoffile = Parser(fun cs ->
    match cs with
    | [] -> ([([],[])],[],"",0)
    | _ -> ([],["end-of-file"],%[List.head cs],len cs))

一个示例

让我们使用我们已经编写的内容来实现一个解析器，该解析器接受以下简单语法的语言 (Scott 2006)

program	→	stmt_list
stmt_list	→	stmt stmt_list | Λ
stmt	→	identifier ":=" expr | "read" identifier | "write" expr
expr	→	term term_tail
term_tail	→	add_op term term_tail | Λ
term	→	factor factor_tail
factor_tail	→	mul_op factor factor_tail | Λ
factor	→	′(′ expr ′)′ | identifier | number
add_op	→	′+′ | ′−′
mul_op	→	′*′ | ′/′

首先要确定解析器将返回什么。我们希望解析器返回一个表达式列表，我们稍后可以对其进行求值。求值可以是解释器执行程序，或者某种形式的编译，生成机器码、字节码、IL 代码或其他内容。在此示例中，我们通过解释来求值，解析器将返回表达式列表，该列表在以下区分联合中指定

type Expr =
    | Number of decimal
    | Identifier of string
    | Assignment of string*Expr
    | Read of string
    | Write of Expr
    | AddOp of Expr*Expr
    | SubOp of Expr*Expr
    | MulOp of Expr*Expr
    | DivOp of Expr*Expr

这个区分联合的值成为我们产生式规则中的语义函数。产生式规则可以使用组合子实现如下

let rec program = endBy (sepBy stmt endofline) endoffile
and stmt = read <|> write <|> assignment
and read =
    ( symbol &"read" >>
      many1 (char ' ') >>
      many1 alpha >>= fun identifier ->
      Read (%identifier) |> mreturn) >>@ "Read <var-name>"
and write =
    ( symbol &"write" >>
      many1 (char ' ') >>
      expr >>= fun e ->
      Write e |> mreturn) >>@ "Write <expression>"
and assignment =
    ( many1 alpha >>= fun identifier ->
      symbol &":=" >>
      expr >>= fun e ->
      Assignment(%identifier,e) |> mreturn)
     >>@ "<var-name>:=<expression>"
and expr =
    term >>= fun t ->
    (term_tail >>= fun (op,b) -> mreturn (op t b)) <|> mreturn t
and term_tail =
    addop >>= fun op ->
    expr >>= fun b ->
    mreturn (op,b)
and term =
    factor >>= fun f ->
    (factor_tail >>= fun (op,b) -> mreturn (op f b)) <|> mreturn f
and factor_tail =
    mulop >>= fun op ->
    term >>= fun b ->
    mreturn (op,b)
and factor =
    ( char '(' >>= fun _ ->
      expr >>= fun e ->
      char ')' >>
      mreturn e)
    <|> number
    <|> (many1 alpha >>= fun identifier ->
        Identifier(%identifier) |> mreturn)
and addop =
    (char '+' >> mreturn (fun a b -> AddOp(a,b))) <|>
    (char '-' >> mreturn (fun a b -> SubOp(a,b)))
and mulop =
    (char '*' >> mreturn (fun a b -> MulOp(a,b))) <|>
    (char '/' >> mreturn (fun a b -> DivOp(a,b)))
and number = integer ++ decimal
and integer =
    many1 digit >>= fun digits ->
    Decimal.Parse(%digits+",0") |> Number |> mreturn
and decimal =
    many1 digit >>= fun nums ->
    char '.' >>
    many1 digit >>= fun decimals ->
      Decimal.Parse(%nums + "," + %decimals)
      |> Number
      |> mreturn

此解析器能够解析如下程序

let prog =
    "read a
    read b
    sum:=a+b
    prod:=a*b
    c:=b
    write sum
    write prod
    write c
    write ((43.2*a)+(2*b))/32.45"

最后，可以通过调用 parse program &prog 并将结果传递给下面非常简单的求值示例代码中的 evaluate 函数来求值程序

let vars = new Dictionary<string,decimal>()

let rec eval stmt =
    match stmt with
    | Number d -> d
    | Identifier id ->
      if vars.ContainsKey(id) then vars.[id]
      else new Exception(sprintf "Unknown variable '%s'" id) |> raise
    | Assignment (id,exp) ->
      let v = eval exp
      vars.Add(id,v)
      v
    | Read id ->
      Console.Write (sprintf "%s > " id)
      let v = Console.ReadLine() |> Decimal.Parse
      vars.Add(id,v)
      v
    | Write exp ->
      let v = eval exp
      Console.WriteLine v
      v
    | AddOp (e1,e2) -> (eval e1) + (eval e2)
    | SubOp (e1,e2) -> (eval e1) - (eval e2)
    | MulOp (e1,e2) -> (eval e1) * (eval e2)
    | DivOp (e1,e2) -> (eval e1) / (eval e2)

let rec evaluate stmts =
    match stmts with
    | [] -> ()
    | stmt::stmts' ->
      eval stmt |> ignore
      evaluate stmts'

正如我所展示的，使用单子定义可读、优雅的解析器非常容易。此外，利用现有的组合子和解析器编写新的解析器也很容易。