Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

chooseMany implementation #100

Open
fwaris opened this issue Feb 7, 2023 · 0 comments
Open

chooseMany implementation #100

fwaris opened this issue Feb 7, 2023 · 0 comments

Comments

@fwaris
Copy link

fwaris commented Feb 7, 2023

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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant