Разбор подписи функции - Ошибка с типом стрелки - FParsec + отступ

Question

Я уже задал вопрос о том, как разобрать тип стрелки , это не дубликат, а адаптация с синтаксисом на основе отступов.

Действительно, я хотел бы иметь возможность анализировать синтаксис, близкий к синтаксису языков семейства 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, просто чтобы попытаться немного оценить. Отсюда , и вот необходимый и достаточный код модуля для вопроса:

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

"

Вот сообщение об ошибке:

Нет ссылки на отступ в сообщении об ошибке, это также беспокоит, потому что, если я реализую идентичный синтаксический анализатор, за исключением разбора отступа, он работает.

Не могли бы вы поставить меня на правильный путь?

EDIT

Вот «исправленный» код (использование парсера сигнатур функции отсутствовало + удаление ненужного 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 и затем пытается найти другую стрелу. Поскольку далее следует хотя бы один пробельный символ ( переводы строк считаются пробелами ), синтаксический анализатор opws "->" в конечном итоге потребляет некоторый ввод перед тем, как завершиться сбоем. (Сбой, потому что после этого пробела находится конец файла, а не другой -> токен). Это приводит к сбою комбинатора chainr1, поэтому происходит сбой arrow_type, и ваш синтаксический анализатор a -> a в конечном итоге анализируется как один тип a. (В этот момент стрелка теперь неожиданная).

Используя >>? в определении opws, вы гарантируете, что в случае сбоя второй части синтаксического анализатора он будет возвращен до того, как он совпадет с любым пробелом. Это гарантирует, что синтаксический анализатор разделителя не будет работать без соответствующего ввода и без продвижения позиции синтаксического анализа в потоке символов. Таким образом, синтаксический анализатор chainr1 успешно выполняется после анализа a -> a, и вы получите ожидаемые результаты.