fparseC语言 组合器"many"抱怨和...为什么不解析这样的块注释？

Question

首先，这个问题与我的问题不重复。实际上我有三个问题。

在下面的代码中，我尝试创建一个解析器，用于解析可能嵌套的多行块注释。与引用的另一个问题相反，我试图以一种简单的方式解决这个问题，而不使用任何递归函数(请参阅另一篇文章的公认答案(。

我遇到的第一个问题是FParsec的skipManyTill解析器也会消耗流中的结束解析器。所以我创建了skipManyTillEx(Ex表示"exclude-endp"；(。skipManyTillEx似乎可以工作——至少对于我也添加到fsx脚本中的一个测试用例来说是这样。

然而，在所示的代码中，现在我得到了"组合子'many'被应用于一个成功而不消耗…"的错误。我的理论是，commentContent解析器就是产生这个错误的线路。

这里，我的问题：

1. 有什么原因，为什么我选择的方法不能奏效？不幸的是，1中的解决方案似乎没有在我的系统上编译，它为(嵌套的(多行注释使用了递归的低级解析器
2. 有人能看到我实现skipManyTillEx的方式有问题吗？我实现它的方式与skipManyTill的实现方式有一定的不同，主要是在如何控制解析流方面。在原始skipManyTill中，p和endp的Reply<_>与stream.StateTag一起被跟踪。相比之下，在我的实现中，我不认为有必要使用stream.StateTag，只依赖于Reply<_>状态代码。在解析失败的情况下，skipManyTillEx返回流的初始状态并报告错误。回溯代码可能会导致"many"错误吗？我该怎么办
3. (这是主要问题(-有没有人看到，如何修复解析器，使这个"许多…"错误消息消失

这是代码：

#r @"C:hgprojectsfparsecBuildVS11binDebugFParsecCS.dll"
#r @"C:hgprojectsfparsecBuildVS11binDebugFParsec.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.我选择的方法不起作用有什么原因吗？

你的方法肯定能奏效，你只需要清除bug。

---

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])

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

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

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

---

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: %An"
)
printfn "Press any key to exit..."
Console.ReadKey true |> ignore

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

希望这有帮助：(

Answer 2

终于找到了解决many问题的方法。用另一个名为skipManyTill1Ex的自定义函数替换了我的自定义skipManyTillEx。与之前的skipManyTillEx相比，skipManyTill1Ex仅在成功解析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 */"