解析函数的签名 - 箭头类型错误 - FParsec + 缩进

Question

我已经，这不是重复，而是基于缩进语法的改编。

的确，我希望能够分析出接近 ML 家族语言的语法。我还在Haskell中介绍了一个函数的类型签名的语法，所以这个：

myFunction :: atype

我的解析器适用于所有类型的签名，除了箭头类型 "alone"：

foo :: a // ok
foo :: [a] // ok
foo :: (a, a) // ok
foo :: [a -> a] // ok
foo :: (a -> a, a) // ok
foo :: a -> a // error

函数的创建也是如此（为简单起见，我只希望一个数字作为值）：

foo: a = 0 // ok
foo: [a] = 0 // ok
foo: (a, a) = 0 // ok
foo: [a -> a] = 0 // ok
foo: (a -> a, a) = 0 // ok
foo: a -> a = 0 // error

如果没有缩进，所有这些情况都是先验的。

我尝试了一个模块来解析缩进，而不是 FParsec wiki，只是为了尝试和评估一下。 It comes from there，这里是问题的必要和充分的模块代码：

module IndentParser =
  type Indentation = 
      | Fail
      | Any
      | Greater of Position 
      | Exact of Position 
      | AtLeast of Position 
      | StartIndent of Position
      with
        member this.Position = match this with
                                | Any | Fail -> None
                                | Greater p -> Some p
                                | Exact p -> Some p
                                | AtLeast p -> Some p
                                | StartIndent p -> Some p

  type IndentState<'T> = { Indent : Indentation; UserState : 'T }
  type CharStream<'T> = FParsec.CharStream<IndentState<'T>>
  type IndentParser<'T, 'UserState> = Parser<'T, IndentState<'UserState>>

  let indentState u = {Indent = Any; UserState = u}
  let runParser p u s = runParserOnString p (indentState u) "" s
  let runParserOnFile p u path = runParserOnFile p (indentState u) path System.Text.Encoding.UTF8

  let getIndentation : IndentParser<_,_> =
    fun stream -> match stream.UserState with
                  | {Indent = i} -> Reply i
  let getUserState : IndentParser<_,_> =
    fun stream -> match stream.UserState with
                  | {UserState = u} -> Reply u

  let putIndentation newi : IndentParser<unit, _> =
    fun stream ->
      stream.UserState <- {stream.UserState with Indent = newi}
      Reply(Unchecked.defaultof<unit>)

  let failf fmt = fail << sprintf fmt

  let acceptable i (pos : Position) =
    match i with
    | Any _ -> true
    | Fail -> false
    | Greater bp -> bp.Column < pos.Column
    | Exact ep -> ep.Column = pos.Column
    | AtLeast ap -> ap.Column <= pos.Column
    | StartIndent _ -> true

  let tokeniser p = parse {
    let! pos = getPosition
    let! i = getIndentation
    if acceptable i pos then return! p
    else return! failf "incorrect indentation at %A" pos
  }

  let indented<'a,'u> i (p : Parser<'a,_>) : IndentParser<_, 'u> = parse {
    do! putIndentation i
    do! spaces
    return! tokeniser p
  }

  /// Allows to check if the position of the parser currently being analyzed (`p`)
  /// is on the same line as the defined position (`pos`).
  let exact<'a,'u> pos p: IndentParser<'a, 'u> = indented (Exact pos) p
  /// Allows to check if the position of the parser currently being analyzed (`p`)
  /// is further away than the defined position (`pos`).
  let greater<'a,'u> pos p: IndentParser<'a, 'u> = indented (Greater pos) p
  /// Allows to check if the position of the parser currently being analyzed (`p`)
  /// is on the same OR line further than the defined position (`pos`).
  let atLeast<'a,'u> pos p: IndentParser<'a, 'u> = indented (AtLeast pos) p
  /// Simply check if the parser (`p`) exists, regardless of its position in the text to be analyzed.
  let any<'a,'u> pos p: IndentParser<'a, 'u> = indented Any p

  let newline<'u> : IndentParser<unit, 'u> = many (skipAnyOf " \t" <?> "whitespace") >>. newline |>> ignore

  let rec blockOf p = parse {
    do! spaces
    let! pos = getPosition    
    let! x = exact pos p
    let! xs = attempt (exact pos <| blockOf p) <|> preturn []
    return x::xs
  }

现在，这是我尝试修复我遇到的问题的代码：

module Parser =
    open IndentParser

    type Identifier = string

    type Type =
        | Typename of Identifier
        | Tuple of Type list
        | List of Type
        | Arrow of Type * Type
        | Infered

    type Expression =
        | Let of Identifier * Type * int
        | Signature of Identifier * Type

    type Program = Program of Expression list

// Utils -----------------------------------------------------------------

    let private ws = spaces

    /// All symbols granted for the "opws" parser
    let private allowedSymbols =
        ['!'; '@'; '#'; '$'; '%'; '+'; '&'; '*'; '('; ')'; '-'; '+'; '='; '?'; '/'; '>'; '<'; '|']

    /// Parse an operator and white spaces around it: `ws >>. p .>> ws`
    let inline private opws str =
        ws >>.
        (tokeniser (pstring str >>?
            (nextCharSatisfiesNot
                (isAnyOf (allowedSymbols @ ['"'; '''])) <?> str))) .>> ws

    let private identifier =
        (many1Satisfy2L isLetter
            (fun c -> isLetter c || isDigit c) "identifier")

// Types -----------------------------------------------------------------

    let rec typename = parse {
            let! name = ws >>. identifier
            return Type.Typename name
        }

    and tuple_type = parse {
            let! types = between (opws "(") (opws ")") (sepBy (ws >>. type') (opws ","))
            return Type.Tuple types
        }

    and list_type = parse {
            let! ty = between (opws "[") (opws "]") type'
            return Type.List ty
        }

    and arrow_type =
        chainr1 (typename <|> tuple_type <|> list_type) (opws "->" >>% fun t1 t2 -> Arrow(t1, t2))

    and type' =
        attempt arrow_type <|>
        attempt typename <|>
        attempt tuple_type <|>
        attempt list_type

// Expressions -----------------------------------------------------------------

    let rec private let' = parse {
            let! pos = getPosition
            let! id = exact pos identifier
            do! greater pos (opws ":")
            let! ty = greater pos type'
            do! greater pos (opws "=")
            let! value = greater pos pint32
            return Expression.Let(id, ty, value)
        }

    and private signature = parse {
            let! pos = getPosition
            let! id = exact pos identifier
            do! greater pos (opws "::")
            let! ty = greater pos type'
            return Expression.Signature(id, ty)
        }

    and private expression =
        attempt let'

    and private expressions = blockOf expression <?> "expressions"

    let private document = ws >>. expressions .>> ws .>> eof |>> Program

    let private testType = ws >>. type' .>> ws .>> eof

    let rec parse code =
        runParser document () code
        |> printfn "%A"

open Parser

parse @"

foo :: a -> a

"

得到的错误信息如下：

错误消息中没有提及缩进，这也很麻烦，因为如果我实现一个相同的解析器，除了缩进解析外，它就可以工作。

你能告诉我正确的方法吗？

编辑

这是 "fixed" 代码（缺少函数签名解析器的使用 + 删除了不必要的 attempt）：

open FParsec

// module IndentParser

module Parser =
    open IndentParser

    type Identifier = string

    type Type =
        | Typename of Identifier
        | Tuple of Type list
        | List of Type
        | Arrow of Type * Type
        | Infered

    type Expression =
        | Let of Identifier * Type * int
        | Signature of Identifier * Type

    type Program = Program of Expression list

// Utils -----------------------------------------------------------------

    let private ws = spaces

    /// All symbols granted for the "opws" parser
    let private allowedSymbols =
        ['!'; '@'; '#'; '$'; '%'; '+'; '&'; '*'; '('; ')'; '-'; '+'; '='; '?'; '/'; '>'; '<'; '|']

    /// Parse an operator and white spaces around it: `ws >>. p .>> ws`
    let inline private opws str =
        ws >>.
        (tokeniser (pstring str >>?
            (nextCharSatisfiesNot
                (isAnyOf (allowedSymbols @ ['"'; '''])) <?> str))) .>> ws

    let private identifier =
        (many1Satisfy2L isLetter
            (fun c -> isLetter c || isDigit c) "identifier")

// Types -----------------------------------------------------------------

    let rec typename = parse {
            let! name = ws >>. identifier
            return Type.Typename name
        }

    and tuple_type = parse {
            let! types = between (opws "(") (opws ")") (sepBy (ws >>. type') (opws ","))
            return Type.Tuple types
        }

    and list_type = parse {
            let! ty = between (opws "[") (opws "]") type'
            return Type.List ty
        }

    and arrow_type =
        chainr1 (typename <|> tuple_type <|> list_type) (opws "->" >>% fun t1 t2 -> Arrow(t1, t2))

    and type' =
        attempt arrow_type <|>
        typename <|>
        tuple_type <|>
        list_type

// Expressions -----------------------------------------------------------------

    let rec private let' = parse {
            let! pos = getPosition
            let! id = exact pos identifier
            do! greater pos (opws ":")
            let! ty = greater pos type'
            do! greater pos (opws "=")
            let! value = greater pos pint32
            return Expression.Let(id, ty, value)
        }

    and private signature = parse {
            let! pos = getPosition
            let! id = exact pos identifier
            do! greater pos (opws "::")
            let! ty = greater pos type'
            return Expression.Signature(id, ty)
        }

    and private expression =
        attempt let' <|>
        signature

    and private expressions = blockOf expression <?> "expressions"

    let private document = ws >>. expressions .>> ws .>> eof |>> Program

    let private testType = ws >>. type' .>> ws .>> eof

    let rec parse code =
        runParser document () code
        |> printfn "%A"

open Parser

System.Console.Clear()

parse @"

foo :: a -> a

"

因此，这是新的错误消息：

和

Answer 1

目前，您的代码在 :: 签名上失败，因为您实际上没有在任何地方使用过 signature 解析器。您已将 expression 定义为 attempt let'，但我认为您的意思是写 attempt signature <|> attempt let'。这就是为什么您的测试在 :: 的第二个冒号上失败的原因，因为它匹配 let' 的单个冒号，然后不期望第二个冒号。

此外，我认为您将多个 attempt 组合器链接在一起，例如 attempt a <|> attempt b <|> attempt c 会给您带来问题，您应该删除最后的 attempt，例如 attempt a <|> attempt b <|> c。如果您在所有可能的选择中使用 attempt，您最终会得到一个可以通过不解析任何内容而成功的解析器，这通常不是您想要的。

更新：我想我已经找到原因和解决方案了。

总结： 在您的 opws 解析器中，将行 ws >>. 替换为 ws >>?。

解释： 在所有 sepBy 变体中（并且 chainr1 是一个 sepBy 变体），FParsec 期望分隔符解析器将要么成功，要么失败而不消耗输入。（如果分隔符在消耗输入后失败，FParsec 认为整个 sepBy 系列解析器完全失败。）但是您的 opws 解析器将消耗空格，然后如果找不到正确的操作员。因此，当您的 arrow_type 解析器解析字符串 a -> a 后跟换行符 时，第一个 a 之后的箭头正确匹配，然后它会看到第二个 a，然后它试图找到另一个箭头。由于接下来是至少一个空白字符 (newlines count as whitespace)，因此 opws "->" 解析器在失败之前会消耗一些输入。（它失败了，因为在那个空格之后是文件的结尾，而不是另一个 -> 标记）。这使得 chainr1 组合器失败，所以 arrow_type 失败并且你的 a -> a 解析器最终被解析为单一类型 a。（此时箭头现在出乎意料）。

通过在 opws 的定义中使用 >>?，您可以确保如果解析器的第二部分失败，它将回溯到匹配任何空格之前。这确保了分隔符解析器将失败而不匹配输入并且不会推进字符流中的解析位置。因此，chainr1 解析器在解析 a -> a 后成功，您将获得预期的结果。

解析函数的签名 - 箭头类型错误 - FParsec + 缩进

Parsing the signature of a function - Error with the arrow type - FParsec + indentation

f#

indentation

fparsec