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

Question

我已经有asked a question about how to parse the arrow type，这不是重复，而是对基于缩进的语法的改编。

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

myFunction :: atype

我的解析器对各种签名类型都非常有效，除了“单独”时的箭头类型：

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

"

得到的错误信息如下：

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

你能让我走对路吗？

编辑

这是“固定”代码（缺少函数签名解析器的使用+删除了不必要的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-family 解析器完全失败。）但是您的 opws 解析器将消耗空格，然后如果找不到正确的运算符则失败。因此，当您的 arrow_type 解析器解析字符串 a -> a 后跟换行符时，第一个 a 之后的箭头正确匹配，然后它会看到第二个 a，然后它会尝试找到另一个箭头。由于接下来是至少一个空格字符 (newlines count as whitespace)，opws "->" 解析器最终会在失败之前消耗一些输入。 （它失败了，因为在那个空格之后是文件的结尾，而不是另一个 -> 令牌）。这使得chainr1 组合器失败，所以arrow_type 失败并且您的a -> a 解析器最终被解析为单一类型a。 （此时箭头现在出乎意料）。

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