stephan-tolksdorf / fparsec

A parser combinator library for F#
523 stars 45 forks source link

chooseMany implementation #100

Open fwaris opened 1 year ago

fwaris commented 1 year ago

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