2

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

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

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

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

在这里，我的问题：

  1. 有什么理由，为什么我选择的方法行不通？1中的解决方案，不幸的是，它似乎无法在我的系统上编译，它使用递归低级解析器来处理（嵌套）多行注释。
  2. 任何人都可以看到我实施方式的问题skipManyTillEx吗？我实现的方式和实现的方式有一定的区别skipManyTill，主要是在如何控制解析流程方面。在 originalskipManyTill中，Reply<_>p 和 endp 的 与 一起被跟踪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 */"
4

2 回答 2

2

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

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

skipMany在commentContent运行中，直到ignoreCommentContent两者ignoreSubComment都失败。但是ignoreCommentContent是使用 your 实现的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解析器。

希望这可以帮助 ：）

于 2014-06-06T02:04:28.070 回答
1

终于找到了解决many问题的方法。skipManyTillEx用我调用的另一个自定义函数替换了我的自定义skipManyTill1Ex。 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 */"
于 2014-06-06T01:42:08.267 回答