Skip to content

chooseMany implementation #100

@fwaris

Description

@fwaris

chooseMany (choose1Many): Potentially useful addition to the library. Choose from many where the terms may be out of order. Useful for parsing command line parameters and related.

let s1 = "b c a c c a d"
let s2 = "d a b c"

let pa = pstring "a" .>> spaces
let pb = pstring "b" .>> spaces
let pc = pstring "c" .>> spaces

run (chooseMany [pa; pb; pc]) s1
>>val it: ParserResult<string list,unit> = Success: ["a"; "c"; "b"]

run (chooseMany [pa; pb; pc]) s2
val it: ParserResult<string list,unit> = Success: []

run (choose1Many [pa; pb; pc]) s2
>>val it: ParserResult<string list,unit> =
  Failure:
Error in Ln: 1 Col: 1
d a b c
^
Expecting: 'a', 'b' or 'c'

With tail calls, the implementations should be fast. Not sure this code is at the level of production quality for FParsec so not creating a pull request.

module ParsecExtensions
open FParsec

let rec internal applyOnce rslts retry suc errors stream stateTag (ls:Parser<'a,'b> list) =
    match ls with
    | [] -> rslts,retry,suc,errors
    | x::rest -> 
        let reply = x stream
        if reply.Status <> Error && stateTag <> stream.StateTag then
            applyOnce (reply.Result::rslts) retry true errors stream stream.StateTag rest
        else
            applyOnce rslts (retry @ [x]) suc (mergeErrors errors reply.Error) stream stateTag rest

let internal applyChoose atLeastOne ls =
    fun stream -> 
        let rec loop rslts stateTag errors remLs =
            let accRlstls,retry,suc,errors = applyOnce rslts [] false errors stream stateTag remLs
            if not suc then 
                if atLeastOne && List.isEmpty accRlstls then
                    Reply(Error,[],errors)
                else
                    Reply(Ok,accRlstls,errors)
            else
                loop accRlstls stream.StateTag errors retry
        loop [] stream.StateTag NoErrorMessages ls

let chooseMany<'a,'b> (ps: Parser<'a,'b> list)   = applyChoose false ps
let choose1Many<'a,'b> (ps: Parser<'a,'b> list)  = applyChoose true ps

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions