fparsec - 组合器“许多”抱怨......为什么不解析这样的块评论？

Question

This question，首先，不是我的问题的重复。 其实我有 3 个问题。

在下面的代码中，我尝试创建一个解析器来解析可能嵌套的多行块 cmets。与引用的其他问题相比，我尝试以直接的方式解决问题，而不使用任何递归函数（请参阅其他帖子的已接受答案）。

我遇到的第一个问题是 FParsec 的 skipManyTill 解析器也使用流中的结束解析器。所以我创建了skipManyTillEx（Ex for ' exclude endp' ;)）。 skipManyTillEx 似乎工作 - 至少对于我也添加到 fsx 脚本的一个测试用例。

然而，在代码中，如图所示，现在我得到“组合子'many'被应用到一个成功但不消耗...的解析器”错误。我的理论是，commentContent 解析器是产生此错误的行。

在这里，我的问题：

1. 有什么原因，为什么我选择的方法不起作用？ 1 中的解决方案，不幸的是，它似乎无法在我的系统上编译，它为（嵌套的）多行 cmets 使用递归低级解析器。
2. 谁能看出我实现skipManyTillEx 的方式有问题？我实现它的方式与skipManyTill的实现方式有些不同，主要是在如何控制解析流方面。在原始skipManyTill 中，p 和endp 的Reply<_> 与stream.StateTag 一起被跟踪。在我的实现中，相比之下我没有看到需要使用stream.StateTag，只依赖Reply<_> 状态码。如果解析不成功，skipManyTillEx 会回溯到流初始状态并报告错误。回溯代码可能会导致“许多”错误吗？我应该怎么做？
3. （这是主要问题） - 有没有人看到，如何修复解析器，这样“许多...”错误消息消失了？

代码如下：

#r @"C:\hgprojects\fparsec\Build\VS11\bin\Debug\FParsecCS.dll"
#r @"C:\hgprojects\fparsec\Build\VS11\bin\Debug\FParsec.dll"

open FParsec

let testParser p input =
    match run p input with
    | Success(result, _, _) -> printfn "Success: %A" result
    | Failure(errorMsg, _, _) -> printfn "Failure %s" errorMsg
    input

let Show (s : string) : string =
    printfn "%s" s
    s

let test p i =
    i |> Show |> testParser p |> ignore

////////////////////////////////////////////////////////////////////////////////////////////////
let skipManyTillEx (p : Parser<_,_>) (endp : Parser<_,_>) : Parser<unit,unit> =
    fun stream ->
        let tryParse (p : Parser<_,_>) (stm : CharStream<unit>) : bool = 
            let spre = stm.State
            let reply = p stream
            match reply.Status with
            | ReplyStatus.Ok -> 
                stream.BacktrackTo spre
                true
            | _ -> 
                stream.BacktrackTo spre
                false
        let initialState = stream.State
        let mutable preply = preturn () stream
        let mutable looping = true
        while (not (tryParse endp stream)) && looping do
            preply <- p stream
            match preply.Status with
            | ReplyStatus.Ok -> ()
            | _ -> looping <- false
        match preply.Status with
            | ReplyStatus.Ok -> preply
            | _ ->
                let myReply = Reply(Error, mergeErrors preply.Error (messageError "skipManyTillEx failed") )
                stream.BacktrackTo initialState
                myReply



let ublockComment, ublockCommentImpl = createParserForwardedToRef()
let bcopenTag = "/*"
let bccloseTag = "*/"
let pbcopen = pstring bcopenTag
let pbcclose = pstring bccloseTag
let ignoreCommentContent : Parser<unit,unit> = skipManyTillEx (skipAnyChar)  (choice [pbcopen; pbcclose] |>> fun x -> ())
let ignoreSubComment : Parser<unit,unit> = ublockComment
let commentContent : Parser<unit,unit> = skipMany (choice [ignoreCommentContent; ignoreSubComment])
do ublockCommentImpl := between (pbcopen) (pbcclose) (commentContent) |>> fun c -> ()

do test (skipManyTillEx (pchar 'a' |>> fun c -> ()) (pchar 'b') >>. (restOfLine true)) "aaaabcccc"

// do test ublockComment "/**/"
//do test ublockComment "/* This is a comment \n With multiple lines. */"
do test ublockComment "/* Bla bla bla /* nested bla bla */ more outer bla bla */"

Answer 1

让我们看看你的问题...

1。有什么原因，为什么我选择的方法不起作用？

你的方法肯定行得通，你只需要清除错误。

---

2。任何人都可以看到我实现skipManyTillEx 的方式有问题吗？

没有。您的实现看起来不错。只是skipMany 和skipManyTillEx 的组合才是问题所在。

let ignoreCommentContent : Parser<unit,unit> = skipManyTillEx (skipAnyChar)  (choice [pbcopen; pbcclose] |>> fun x -> ())
let commentContent : Parser<unit,unit> = skipMany (choice [ignoreCommentContent; ignoreSubComment])

commentContent 中的skipMany 运行直到ignoreCommentContent 和ignoreSubComment 都失败。但是ignoreCommentContent 是使用您的skipManyTillEx 实现的，它的实现方式可以在不消耗输入的情况下成功。这意味着外部的skipMany 将无法确定何时停止，因为如果没有消耗任何输入，它不知道后续解析器是否失败或根本没有消耗任何东西。

这就是为什么要求many 解析器下的每个解析器都必须使用输入的原因。您的 skipManyTillEx 可能不会，这就是错误消息试图告诉您的内容。

要修复它，您必须实现一个skipMany1TillEx，它本身至少消耗一个元素。

---

3。有谁看到，如何修复解析器，使这个“许多...”错误消息消失？

这种方法怎么样？

open FParsec
open System

/// Type abbreviation for parsers without user state.
type Parser<'a> = Parser<'a, Unit>

/// Skips C-style multiline comment /*...*/ with arbitrary nesting depth.
let (comment : Parser<_>), commentRef = createParserForwardedToRef ()

/// Skips any character not beginning of comment end marker */.
let skipCommentChar : Parser<_> = 
    notFollowedBy (skipString "*/") >>. skipAnyChar

/// Skips anx mix of nested comments or comment characters.
let commentContent : Parser<_> =
    skipMany (choice [ comment; skipCommentChar ])

// Skips C-style multiline comment /*...*/ with arbitrary nesting depth.
do commentRef := between (skipString "/*") (skipString "*/") commentContent


/// Prints the strings p skipped over on the console.
let printSkipped p = 
    p |> withSkippedString (printfn "Skipped: \"%s\" Matched: \"%A\"")

[
    "/*simple comment*/"
    "/** special / * / case **/"
    "/*testing /*multiple*/ /*nested*/ comments*/ not comment anymore"
    "/*not closed properly/**/"
]
|> List.iter (fun s ->
    printfn "Test Case: \"%s\"" s
    run (printSkipped comment) s |> printfn "Result: %A\n"
)

printfn "Press any key to exit..."
Console.ReadKey true |> ignore

通过使用 notFollowedBy 仅跳过不属于注释结束标记 (*/) 的字符，不需要嵌套的 many 解析器。

希望这会有所帮助:)

Answer 2

终于找到了解决many问题的方法。 用我称为skipManyTill1Ex 的另一个自定义函数替换了我的自定义skipManyTillEx。 skipManyTill1Ex，与之前的skipManyTillEx不同，只有成功解析1个或多个p才会成功。

我预计此版本的空注释 /**/ 测试会失败，但它可以工作。

...
let skipManyTill1Ex (p : Parser<_,_>) (endp : Parser<_,_>) : Parser<unit,unit> =
    fun stream ->
        let tryParse (p : Parser<_,_>) (stm : CharStream<unit>) : bool = 
            let spre = stm.State
            let reply = p stm
            match reply.Status with
            | ReplyStatus.Ok -> 
                stream.BacktrackTo spre
                true
            | _ -> 
                stream.BacktrackTo spre
                false
        let initialState = stream.State
        let mutable preply = preturn () stream
        let mutable looping = true
        let mutable matchCounter = 0
        while (not (tryParse endp stream)) && looping do
            preply <- p stream
            match preply.Status with
            | ReplyStatus.Ok -> 
                matchCounter <- matchCounter + 1
                ()
            | _ -> looping <- false
        match (preply.Status, matchCounter) with
            | (ReplyStatus.Ok, c) when (c > 0) -> preply
            | (_,_) ->
                let myReply = Reply(Error, mergeErrors preply.Error (messageError "skipManyTill1Ex failed") )
                stream.BacktrackTo initialState
                myReply


let ublockComment, ublockCommentImpl = createParserForwardedToRef()
let bcopenTag = "/*"
let bccloseTag = "*/"
let pbcopen = pstring bcopenTag
let pbcclose = pstring bccloseTag
let ignoreCommentContent : Parser<unit,unit> = skipManyTill1Ex (skipAnyChar)  (choice [pbcopen; pbcclose] |>> fun x -> ())
let ignoreSubComment : Parser<unit,unit> = ublockComment
let commentContent : Parser<unit,unit> = skipMany (choice [ignoreCommentContent; ignoreSubComment])
do ublockCommentImpl := between (pbcopen) (pbcclose) (commentContent) |>> fun c -> ()

do test (skipManyTillEx (pchar 'a' |>> fun c -> ()) (pchar 'b') >>. (restOfLine true)) "aaaabcccc"

do test ublockComment "/**/"
do test ublockComment "/* This is a comment \n With multiple lines. */"
do test ublockComment "/* Bla bla bla /* nested bla bla */ more outer bla bla */"