CharParsers.fs - Copyright (c) Stephan Tolksdorf 2007-2009 …

/FParsec/CharParsers.fs

https://bitbucket.org/banshee/fparsec-samples · F# · 1309 lines · 1078 code · 187 blank · 44 comment · 351 complexity · 4b6e4ccea3f15f27074ae7f96d70c16a MD5 · raw file
Large files are truncated click here to view the full file

// Copyright (c) Stephan Tolksdorf 2007-2009

// License: Simplified BSD License. See accompanying documentation.



namespace FParsec



module CharParsers



open System.Diagnostics

open System.Text

open System.Text.RegularExpressions



open Microsoft.FSharp.NativeInterop



open FParsec.Internals

open FParsec.Error

open FParsec.Primitives



#nowarn "9" // "Uses of this construct may result in the generation of unverifiable .NET IL code."

#nowarn "51" // "The address-of operator may result in non-verifiable code."



// ================

// Helper functions

// ================



[<Literal>]

let EOS = CharStream.Iterator.EndOfStreamChar



let foldCase = CharStream.FoldCase

let normalizeNewlines = CharStream.NormalizeNewlines



let floatToHexString d = Helper.DoubleToHexString(d)

let floatOfHexString s = Helper.DoubleFromHexString(s)



let float32ToHexString d = Helper.SingleToHexString(d)

let float32OfHexString s = Helper.SingleFromHexString(s)



// ========================

// Running parsers on input

// ========================



[<StructuredFormatDisplay("{StructuredFormatDisplay}")>]

type ParserResult<'Result,'UserState> =

     | Success of 'Result * 'UserState * Pos

     | Failure of string * ParserError * 'UserState

     with

        member private t.StructuredFormatDisplay =

            match t with

            | Success(r,_,_) ->

                if typeof<'Result> = typeof<unit> then "Success: ()"

                else sprintf "Success: %A" r

            | Failure(msg,_,_) ->

                sprintf "Failure:\n%s" msg



let internal applyParser (parser: Parser<'Result,'UserState>) (state: State<'UserState>) =

    let reply = parser state

    if reply.Status = Ok then

        Success(reply.Result, reply.State.UserState, reply.State.Pos)

    else

        let error = ParserError(reply.State.Pos, reply.Error)

        Failure(error.ToString(reply.State.Stream), error, reply.State.UserState)



let runParser (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (name: string) (stream: CharStream) =

    let state0 = new State<'UserState>(stream, ustate, name)

    applyParser parser state0



let runParserOnString (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (streamName: string) (chars: string) =

    use stream = new CharStream(chars, 0, chars.Length)

    let state0 = new State<'UserState>(stream, ustate, streamName)

    applyParser parser state0



let runParserOnSubstring (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (streamName: string) (chars: string) (index: int) length =

    use stream = new CharStream(chars, index, length)

    let state0 = new State<'UserState>(stream, ustate, streamName)

    applyParser parser state0



let runParserOnStream (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (streamName: string) (byteStream: System.IO.Stream) (encoding: System.Text.Encoding) =

    use stream = new CharStream(byteStream, encoding)

    let state0 = new State<'UserState>(stream, ustate, streamName)

    applyParser parser state0



let runParserOnFile (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (path: string) (encoding: System.Text.Encoding) =

    use stream = new CharStream(path, encoding)

    let state0 = new State<'UserState>(stream, ustate, path)

    applyParser parser state0



let runParserOnSubstream (parser: Parser<'Result,'SubstreamUserState>) ustate (stateBeforeSubstream: State<'UserState>) stateAfterSubStream =

    Helper.RunParserOnSubstream(applyParser parser, ustate, stateBeforeSubstream, stateAfterSubStream)



let run parser (string: string) =

    runParserOnString parser () "" string



// some predefined error messages



let internal expectedEndOfFile            = expectedError "end of file"

let internal expectedAnyChar              = expectedError "any char"

let internal expectedWhitespace           = expectedError "whitespace"

let internal expectedAsciiUppercaseLetter = expectedError "Ascii uppercase letter"

let internal expectedAsciiLowercaseLetter = expectedError "Ascii lowercase letter"

let internal expectedAsciiLetter          = expectedError "Ascii letter"

let internal expectedUppercaseLetter      = expectedError "uppercase letter"

let internal expectedLowercaseLetter      = expectedError "lowercase letter"

let internal expectedLetter               = expectedError "letter"

let internal expectedBinaryDigit          = expectedError "binary digit"

let internal expectedOctalDigit           = expectedError "octal digit"

let internal expectedDecimalDigit         = expectedError "digit"

let internal expectedHexadecimalDigit     = expectedError "hexadecimal digit"

let internal expectedNewline              = expectedError "newline"

let internal expectedTab                  = expectedError "tab"

let internal expectedFloatingPointNumber  = expectedError "floating-point number"

let internal expectedInt64                = expectedError "integer number (64-bit, signed)"

let internal expectedInt32                = expectedError "integer number (32-bit, signed)"

let internal expectedInt16                = expectedError "integer number (16-bit, signed)"

let internal expectedInt8                 = expectedError "integer number (8-bit, signed)"

let internal expectedUInt64               = expectedError "integer number (64-bit, unsigned)"

let internal expectedUInt32               = expectedError "integer number (32-bit, unsigned)"

let internal expectedUInt16               = expectedError "integer number (16-bit, unsigned)"

let internal expectedUInt8                = expectedError "integer number (8-bit, unsigned)"



let internal unexpectedNewline            = unexpectedError "newline"

let internal unexpectedEndOfFile          = unexpectedError "end of file"



// =======

// Parsers

// =======



// ------------------------------------------------

// Reading the position and handling the user state

// ------------------------------------------------



let getPos : Parser<Pos,'u> =

    fun state -> Reply<_,_>(state.Pos, state)



let getUserState : Parser<'u,'u> =

    fun state -> Reply<_,_>(state.UserState, state)



let setUserState (newUserState: 'u) : Parser<unit,'u> =

    fun state -> Reply<_,_>((), state.WithUserState(newUserState))



let updateUserState (f: 'u -> 'u) : Parser<unit,'u> =

    fun state -> Reply<_,_>((), state.WithUserState(f state.UserState))



let userStateSatisfies f : Parser<unit,'u> =

    fun state ->

        Reply<unit,_>((if f state.UserState then Ok else Error), NoErrorMessages, state)



// --------------------

// Parsing single chars

// --------------------



// needs to be inline because of the value restriction

let inline internal inlineNewlineReturn result : Parser<_,'u> =

    fun state ->

        let newState = state.SkipNewline()

        if not (referenceEquals state newState) then

            Reply<_,_>(result, newState)

        else

            Reply<_,_>(Error, expectedNewline, newState)



let newlineReturn result = fun state -> inlineNewlineReturn result state

let newline              = fun state -> inlineNewlineReturn '\n' state

let skipNewline          = fun state -> inlineNewlineReturn () state



let charReturn c result : Parser<'a,'u> =

    if c <> '\r' && c <> '\n' then

        let error = expectedError (quoteChar c)

        fun state ->

            if state.Iter.Match(c) then Reply<_,_>(result, state.Next)

            else Reply<_,_>(Error, error, state)

    else newlineReturn result



let pchar    c = charReturn c c

let skipChar c = charReturn c ()





/// returns true for chars '\u000E' - '\ufffe'

let inline internal isCertainlyNoNLOrEOS (c: char) =

    // '\n' = '\u000A', '\r' = '\u000D'

    unativeint c - 0xEun < unativeint EOS - 0xEun



let anyChar : Parser<char,'u> =

    fun state ->

        let c  = state.Iter.Read()

        if isCertainlyNoNLOrEOS c then

            Reply<_,_>(c, state.Next)

        elif c = '\r' || c = '\n' then

            Reply<_,_>('\n', state.SkipNewline())

        elif c <> EOS then

            Reply<_,_>(c, state.Next)

        else

            Reply<_,_>(Error, expectedAnyChar, state)



let skipAnyChar : Parser<unit,'u> =

    fun state ->

        let newState = state.SkipCharOrNewline()

        if not (referenceEquals state newState) then

            Reply<_,_>((), newState)

        else

            Reply<_,_>(Error, expectedAnyChar, newState)





// doesn't check for newlines or EOS

let inline internal fastInlineSatisfyE f error : Parser<char,'u> =

    fun state ->

        let c = state.Iter.Read()

        if f c then Reply<_,_>(c, state.Next)

        else Reply<_,_>(Error, error, state)



let inline internal fastInlineSkipSatisfyE f error : Parser<unit,'u> =

    fun state ->

        let c = state.Iter.Read()

        if f c then Reply<_,_>((), state.Next)

        else Reply<_,_>(Error, error, state)



let inline internal inlineSatisfyE f error : Parser<char,'u> =

    fun state ->

        let c = state.Iter.Read()

        if isCertainlyNoNLOrEOS c then

            if f c then Reply<_,_>(c, state.Next)

            else Reply<_,_>(Error, error, state)

        elif c = '\r' || c = '\n' then

            if f '\n' then Reply<_,_>('\n', state.SkipNewline())

            else Reply<_,_>(Error, error, state)

        elif c <> EOS && f c then Reply<_,_>(c, state.Next)

        else Reply<_,_>(Error, error, state)



let inline internal inlineSkipSatisfyE f error : Parser<unit,'u> =

    fun state ->

        let c = state.Iter.Read()

        if isCertainlyNoNLOrEOS c then

            if f c then Reply<_,_>((), state.Next)

            else Reply<_,_>(Error, error, state)

        elif c = '\r' || c = '\n' then

            if f '\n' then Reply<_,_>((), state.SkipNewline())

            else Reply<_,_>(Error, error, state)

        elif c <> EOS && f c then Reply<_,_>((), state.Next)

        else Reply<_,_>(Error, error, state)



let internal satisfyE f error     = inlineSatisfyE f error

let internal skipSatisfyE f error = inlineSkipSatisfyE f error



let satisfy f        = satisfyE f NoErrorMessages

let satisfyL f label = satisfyE f (expectedError label)



let skipSatisfy f        = skipSatisfyE f NoErrorMessages

let skipSatisfyL f label = skipSatisfyE f (expectedError label)





let isAnyOf (chars: string) =

    let cs = new FParsec.Helper.CharSet(chars)

    fun c -> cs.Contains(c)



let isNoneOf (chars: string) =

    let cs = new FParsec.Helper.CharSet(chars)

    fun c -> not (cs.Contains(c))



let anyOf (chars: string) =

    let error = expectedError ("any char in " + quoteString chars)

    let cs = new FParsec.Helper.CharSet(chars)

    inlineSatisfyE (fun c -> cs.Contains(c)) error



let skipAnyOf (chars: string) =

    let error = expectedError ("any char in " + quoteString chars)

    let cs = new FParsec.Helper.CharSet(chars)

    inlineSkipSatisfyE (fun c -> cs.Contains(c)) error



let noneOf (chars: string) =

    let error = expectedError ("any char not in " + quoteString chars)

    let cs = new FParsec.Helper.CharSet(chars)

    inlineSatisfyE (fun c -> not (cs.Contains(c))) error



let skipNoneOf (chars: string) =

    let error = expectedError ("any char not in " + quoteString chars)

    let cs = new FParsec.Helper.CharSet(chars)

    inlineSkipSatisfyE (fun c -> not (cs.Contains(c))) error





let inline isAsciiUpper c  = c >= 'A' && c <= 'Z'

let inline isAsciiLower c  = c >= 'a' && c <= 'z'

let inline isAsciiLetter (c: char) = let c2 = int c ||| int ' '

                                     c2 >= int 'a' && c2 <= int 'z'



let inline isUpper c  =

    if c >= 'A' then

       c <= 'Z' || (c > '\u007F' && System.Char.IsUpper(c))

    else false



let inline isLower c  =

    if c >= 'a' then

       c <= 'z' || (c > '\u007F' && System.Char.IsLower(c))

    else false



let inline isLetter c =

    if c <= '\u007F' then

         let c2 = int c ||| int ' '

         c2 >= int 'a' && c2 <= int 'z'

    else System.Char.IsLetter(c)



let inline isDigit c  = c <= '9' && c >= '0'



let inline isHex c    =

    if   c <= '9' then c >= '0'

    else c <= 'f' && (c >= 'a' || (c >= 'A' && c <= 'F'))



let inline isOctal c  = c <= '7' && c >= '0'



let asciiUpper  state = fastInlineSatisfyE isAsciiUpper  expectedAsciiUppercaseLetter  state

let asciiLower  state = fastInlineSatisfyE isAsciiLower  expectedAsciiLowercaseLetter  state

let asciiLetter state = fastInlineSatisfyE isAsciiLetter expectedAsciiLetter           state



// unicode is the default for letters and ascii the default for numbers

let upper  state = fastInlineSatisfyE isUpper  expectedUppercaseLetter  state

let lower  state = fastInlineSatisfyE isLower  expectedLowercaseLetter  state

let letter state = fastInlineSatisfyE isLetter expectedLetter           state



let digit  state = fastInlineSatisfyE isDigit  expectedDecimalDigit     state

let hex    state = fastInlineSatisfyE isHex    expectedHexadecimalDigit state

let octal  state = fastInlineSatisfyE isOctal  expectedOctalDigit       state



let tab state = fastInlineSatisfyE ((=) '\t') expectedTab state



let unicodeNewline : Parser<_,'u> =

    fun state ->

        let c  = state.Iter.Read()

        if c < '\u0085' then

            if c = '\r' || c = '\n' then

                Reply<_,_>('\n', state.SkipNewline())

            elif c <> '\u000C' then

                Reply<_,_>(Error, expectedNewline, state)

            else // c = '\u000C'

                Reply<_,_>('\n', state.Advance(1, 1, 0))

        elif c <= '\u2029' && (c >= '\u2028' || c = '\u0085') then

            Reply<_,_>('\n', state.Advance(1, 1, 0))

        else

            Reply<_,_>(Error, expectedNewline, state)



let whitespace : Parser<char,'u> =

    fun state ->

        let c = state.Iter.Read()

        if c <= ' ' then

            match c with

            | ' '  | '\t' -> Reply<_,_>(c, state.Next)

            | '\r' | '\n' -> Reply<_,_>('\n', state.SkipNewline())

            | _           -> Reply<_,_>(Error, expectedWhitespace, state)

        else Reply<_,_>(Error, expectedWhitespace, state)



let unicodeWhitespace : Parser<char,'u> =

    fun state ->

        let c  = state.Iter.Read()

        if c = ' ' then Reply<_,_>(c, state.Next)

        elif System.Char.IsWhiteSpace(c) then

            match c with

            | '\r' | '\n' ->

               Reply<_,_>('\n', state.SkipNewline())

            | '\u000C' | '\u0085' | '\u2028' | '\u2029' ->

               Reply<_,_>('\n', state.Advance(1, 1, 0))

            | _ ->

               Reply<_,_>(c, state.Next)

        else Reply<_,_>(Error, expectedWhitespace, state)





let spaces : Parser<unit,'u> =

    fun state ->

        Reply<_,_>((), state.SkipWhitespace())



let spaces1 : Parser<unit,'u> =

    fun state ->

        let newState = state.SkipWhitespace()

        if not (referenceEquals newState state) then Reply<_,_>((), newState)

        else Reply<_,_>(Error, expectedWhitespace, newState)



let eof : Parser<unit,'u>=

    fun state ->

        if state.Iter.IsEndOfStream then Reply<_,_>((), state)

        else Reply<_,_>(Error, expectedEndOfFile, state)





// ------------------------

// Parsing strings directly

// ------------------------



let internal checkStringContainsNoNewlineChar s name =

    if containsNewlineChar s then

        raise (System.ArgumentException(concat3 "The string argument to " name " may not contain newline chars ('\r' or '\n')."))



let stringReturn s result : Parser<'a,'u> =

    checkStringContainsNoNewlineChar s "pstring/skipString/stringReturn"

    let error = expectedError (quoteString s)

    fun state ->

        if state.Iter.Match(s) then Reply<_,_>(result, state.Advance(s.Length))

        else Reply<_,_>(Error, error, state)

let pstring s    = stringReturn s s

let skipString s = stringReturn s ()





let pstringCI s : Parser<string,'u> =

    checkStringContainsNoNewlineChar s "pstringCI"

    let error = expectedError (quoteString s + " (case-insensitive)")

    let cfs = foldCase s

    fun state ->

        if state.Iter.MatchCaseFolded(cfs) then

             Reply<_,_>(state.Iter.Read(s.Length), state.Advance(s.Length))

        else Reply<_,_>(Error, error, state)



let stringCIReturn s result : Parser<'a,'u> =

    checkStringContainsNoNewlineChar s "skipStringCI/stringCIReturn"

    let error = expectedError (quoteString s + " (case-insensitive)")

    let cfs = foldCase s

    fun state ->

        if state.Iter.MatchCaseFolded(cfs) then

             Reply<_,_>(result, state.Advance(s.Length))

        else Reply<_,_>(Error, error, state)



let skipStringCI s = stringCIReturn s ()





let anyString n : Parser<string,'u> =

    let error = expectedError (concat3 "any sequence of " (string n) " chars")

    fun state ->

        let mutable str = null

        let newState = state.SkipCharsOrNewlines(n, &str)

        if str.Length = n then Reply<_,_>(str, newState)

        else Reply<_,_>(Error, error, state)



let skipAnyString n : Parser<unit,'u> =

    let error = expectedError (concat3 "any sequence of " (string n) " chars")

    fun state ->

        let mutable nSkipped = 0

        let newState = state.SkipCharsOrNewlines(n, &nSkipped)

        if n = nSkipped then Reply<_,_>((), newState)

        else Reply<_,_>(Error, error, state)



let restOfLine : Parser<_,_> =

    fun state ->

        let mutable str = null

        let newState = state.SkipRestOfLine(true, &str)

        Reply<_,_>(str, newState)



let skipRestOfLine : Parser<_,_> =

    fun state ->

         Reply<_,_>((), state.SkipRestOfLine(true))



let skipToEndOfLine : Parser<_,_> =

    fun state ->

        Reply<_,_>((), state.SkipRestOfLine(false))





let skipToString (s: string) maxChars : Parser<unit,'u> =

    checkStringContainsNoNewlineChar s "skipToString"

    if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))

    let error = messageError (concat3 "Could not find the string " (quoteString s) ".")

    fun state ->

        let mutable foundString = false

        let state2 = state.SkipToString(s, maxChars, &foundString)

        if foundString then Reply<_,_>((), state2)

        else Reply<_,_>(Error, error, state2)



let skipToStringCI (s: string) maxChars : Parser<unit,'u> =

    checkStringContainsNoNewlineChar s "skipToStringCI"

    if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))

    let cfs = foldCase s

    let error = messageError (concat3 "Could not find the case-insensitive string " (quoteString s) ".")

    fun state ->

        let mutable foundString = false

        let state2 = state.SkipToStringCI(cfs, maxChars, &foundString)

        if foundString then Reply<_,_>((), state2)

        else Reply<_,_>(Error, error, state2)



let charsTillString (s: string) maxChars : Parser<string,'u> =

    checkStringContainsNoNewlineChar s "charsTillString"

    if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))

    let error = messageError (concat3 "Could not find the string " (quoteString s) ".")

    fun state ->

        let mutable charsBeforeString = null

        let state2 = state.SkipToString(s, maxChars, &charsBeforeString)

        if isNotNull charsBeforeString then Reply<_,_>(charsBeforeString, state2.Advance(s.Length))

        else Reply<_,_>(Error, error, state2)



let charsTillStringCI (s: string) maxChars : Parser<string,'u> =

    checkStringContainsNoNewlineChar s "charsTillStringCI"

    if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))

    let cfs = foldCase s

    let error = messageError (concat3 "Could not find the case-insensitive string " (quoteString s) ".")

    fun state ->

        let mutable charsBeforeString = null

        let state2 = state.SkipToStringCI(cfs, maxChars, &charsBeforeString)

        if isNotNull charsBeforeString then Reply<_,_>(charsBeforeString, state2.Advance(s.Length))

        else Reply<_,_>(Error, error, state2)



let skipCharsTillString (s: string) maxChars : Parser<unit,'u> =

    checkStringContainsNoNewlineChar s "skipCharsTillString"

    if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))

    let error = messageError (concat3 "Could not find the string " (quoteString s) ".")

    fun state ->

        let mutable foundString = false

        let state2 = state.SkipToString(s, maxChars, &foundString)

        if foundString then Reply<_,_>((), state2.Advance(s.Length))

        else Reply<_,_>(Error, error, state2)



let skipCharsTillStringCI (s: string) maxChars : Parser<unit,'u> =

    checkStringContainsNoNewlineChar s "skipCharsTillStringCI"

    if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))

    let cfs = foldCase s

    let error = messageError (concat3 "Could not find the case-insensitive string " (quoteString s) ".")

    fun state ->

        let mutable foundString = false

        let state2 = state.SkipToStringCI(cfs, maxChars, &foundString)

        if foundString then Reply<_,_>((), state2.Advance(s.Length))

        else Reply<_,_>(Error, error, state2)





let inline internal manySatisfyImpl require1 f1 f error : Parser<string,'u> =

    fun state ->

        let mutable str = null

        let newState = state.SkipCharsOrNewlinesWhile(f1, f, &str)

        if not require1 || not (referenceEquals newState state) then Reply<_,_>(str, newState)

        else Reply<_,_>(Error, error, newState)



let inline internal skipManySatisfyImpl require1 f1 f error : Parser<unit,'u> =

    fun state ->

        let newState = state.SkipCharsOrNewlinesWhile(f1, f)

        if not require1 || not (referenceEquals newState state) then Reply<_,_>((), newState)

        else Reply<_,_>(Error, error, newState)



let manySatisfy2   f1 f       = manySatisfyImpl false f1 f NoErrorMessages

let many1Satisfy2  f1 f       = manySatisfyImpl true  f1 f NoErrorMessages

let many1Satisfy2L f1 f label = manySatisfyImpl true  f1 f (expectedError label)



let skipManySatisfy2   f1 f       = skipManySatisfyImpl false f1 f NoErrorMessages

let skipMany1Satisfy2  f1 f       = skipManySatisfyImpl true  f1 f NoErrorMessages

let skipMany1Satisfy2L f1 f label = skipManySatisfyImpl true  f1 f (expectedError label)



let manySatisfy   f       = manySatisfy2   f f

let many1Satisfy  f       = many1Satisfy2  f f

let many1SatisfyL f label = many1Satisfy2L f f label



let skipManySatisfy   f       = skipManySatisfy2   f f

let skipMany1Satisfy  f       = skipMany1Satisfy2  f f

let skipMany1SatisfyL f label = skipMany1Satisfy2L f f label





let internal manyMinMaxSatisfy2E minChars maxChars f1 f error : Parser<string,'u> =

    if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))

    if minChars > 0 then

        fun state ->

            let mutable str = null

            let newState = state.SkipCharsOrNewlinesWhile(f1, f, minChars, maxChars, &str)

            if not (referenceEquals newState state) then Reply<_,_>(str, newState)

            else Reply<_,_>(Error, error, newState)

    else

        fun state ->

            let mutable str = null

            let newState = state.SkipCharsOrNewlinesWhile(f1, f, 0, maxChars, &str)

            Reply<_,_>(str, newState)



let internal skipManyMinMaxSatisfy2E minChars maxChars f1 f error : Parser<unit,'u> =

    if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))

    if minChars > 0 then

        fun state ->

            let newState = state.SkipCharsOrNewlinesWhile(f1, f, minChars, maxChars)

            if not (referenceEquals newState state) then Reply<_,_>((), newState)

            else Reply<_,_>(Error, error, newState)

    else

        fun state ->

            let mutable str = null

            let newState = state.SkipCharsOrNewlinesWhile(f1, f, 0, maxChars)

            Reply<_,_>((), newState)



let manyMinMaxSatisfy   minChars maxChars    f       = manyMinMaxSatisfy2E minChars maxChars f  f NoErrorMessages

let manyMinMaxSatisfyL  minChars maxChars    f label = manyMinMaxSatisfy2E minChars maxChars f  f (expectedError label)

let manyMinMaxSatisfy2  minChars maxChars f1 f       = manyMinMaxSatisfy2E minChars maxChars f1 f NoErrorMessages

let manyMinMaxSatisfy2L minChars maxChars f1 f label = manyMinMaxSatisfy2E minChars maxChars f1 f (expectedError label)



let skipManyMinMaxSatisfy   minChars maxChars    f       = skipManyMinMaxSatisfy2E minChars maxChars f  f NoErrorMessages

let skipManyMinMaxSatisfyL  minChars maxChars    f label = skipManyMinMaxSatisfy2E minChars maxChars f  f (expectedError label)

let skipManyMinMaxSatisfy2  minChars maxChars f1 f       = skipManyMinMaxSatisfy2E minChars maxChars f1 f NoErrorMessages

let skipManyMinMaxSatisfy2L minChars maxChars f1 f label = skipManyMinMaxSatisfy2E minChars maxChars f1 f (expectedError label)





let internal regexE pattern error : Parser<string,'u> =

    let regex = new Regex("\A" + pattern, RegexOptions.Multiline |||

                                          RegexOptions.ExplicitCapture)

    fun state ->

        let m = state.Iter.Match(regex)

        if m.Success then

            let s = m.Value

            if not (containsNewlineChar s) then Reply<_,_>(s, if s.Length > 0 then state.Advance(s.Length) else state)

            else

                let s2 = normalizeNewlines s

                let mutable nSkippedChars = 0

                let newState = state.SkipCharsOrNewlines(s2.Length, &nSkippedChars)

                if nSkippedChars = s2.Length then Reply<_,_>(s2, newState)

                else Reply<_,_>(FatalError, messageError "Internal error in the regex parser. Please report this error to fparsec@quanttec.com.", newState)

        else Reply<_,_>(Error, error, state)



let regex  pattern       = regexE pattern (expectedError ("string matching the regex " + quoteString pattern))

let regexL pattern label = regexE pattern (expectedError label)



// ----------------------------------------------

// Parsing strings with the help of other parsers

// ----------------------------------------------



type internal StructCharList = struct

    val mutable buffer_ui64_0: uint64

    val mutable buffer_ui64_1: uint64

    val mutable buffer_ui64_2: uint64

    val mutable buffer_ui64_3: uint64



    val mutable chars: char[]

    val mutable count: int



    member inline t.BufferPtr =

        NativePtr.of_nativeint<char> (NativePtr.to_nativeint (&&t.buffer_ui64_0))



    /// an optimized version of Append(c) for the first char

    member inline t.AppendFirst(c) =

        Debug.Assert(t.count = 0)

        let p = t.BufferPtr

        NativePtr.set p 0 c

        t.count <- 1



    member inline t.Append(c) =

        let i = t.count &&& 0xf

        t.count <- t.count + 1

        if i <> 0 then

            let p = t.BufferPtr

            NativePtr.set p i c

        else

            t._AppendContinue(c)



    /// append char with index%16 = 0

    member t._AppendContinue(c) =

        let p = t.BufferPtr

        let count = t.count - 1

        Debug.Assert(count%16 = 0 || count = -1)

        let mutable chars = t.chars

        if isNotNull chars then

            if count = chars.Length then

                let newChars = Array.zeroCreate (count*2)

                System.Buffer.BlockCopy(chars, 0, newChars, 0, (count - 16)*sizeof<char>)

                t.chars <- newChars

                chars   <- newChars

            for i = 0 to 15 do

                chars.[count - 16 + i] <- NativePtr.get p i

        elif count <> 0 then

            chars   <- Array.zeroCreate 48

            t.chars <- chars

            for i = 0 to 15 do

                chars.[i] <- NativePtr.get p i

        NativePtr.set p 0 c



    override t.ToString() =

        let p = t.BufferPtr

        let count = t.count

        if count <= 16 then new string(p, 0, count)

        else

            let chars = t.chars

            for i = (count - 1) &&& 0x7ffffff0 to count - 1 do

                chars.[i] <- NativePtr.get p (i &&& 0xf)

            new string(chars, 0, count)

end





let inline internal manyCharsImpl require1 (p1: Parser<char,'u>) (p: Parser<char,'u>) : Parser<string,'u> =

    fun state ->

        let mutable reply = p1 state

        if reply.Status = Ok then

            let mutable cl = new StructCharList()

            cl.AppendFirst(reply.Result)

            let mutable state = reply.State

            reply <- p state

            while reply.Status = Ok do

                if referenceEquals reply.State state then

                    _raiseInfiniteLoopException "manyChars" state

                cl.Append(reply.Result)

                state <- reply.State

                reply <- p state

            let error = if reply.State == state then reply.Error

                        else backtrackError reply.State reply.Error

            Reply<_,_>(Ok, cl.ToString(), error, state)

        else

            let error = if reply.State == state then reply.Error

                        else backtrackError reply.State reply.Error

            if require1 then Reply<_,_>(Error, error, state)

            else Reply<_,_>(Ok, "", error, state)



let inline internal skipManyCharsImpl require1 (p1: Parser<'a,'u>) (p: Parser<'a,'u>) : Parser<unit,'u> =

    fun state ->

        let mutable reply = p1 state

        if reply.Status = Ok then

            let mutable state = reply.State

            reply <- p state

            while reply.Status = Ok do

                if referenceEquals reply.State state then

                    _raiseInfiniteLoopException "skipManyChars" state

                state <- reply.State

                reply <- p state

            let error = if reply.State == state then reply.Error

                        else backtrackError reply.State reply.Error

            Reply<_,_>(Ok, (), error, state)

         else

            let error = if reply.State == state then reply.Error

                        else backtrackError reply.State reply.Error

            if require1 then Reply<_,_>(Error, error, state)

            else Reply<_,_>(Ok, (), error, state)





let manyChars2 p1 p = manyCharsImpl false p1 p

let manyChars p = manyChars2 p p



let many1Chars2 p1 p = manyCharsImpl true p1 p

let many1Chars p = many1Chars2 p p



let skipManyChars2 (p1: Parser<'a,'u>) (p: Parser<'a,'u>) = skipManyCharsImpl false p1 p

let skipManyChars p = skipManyChars2 p p



let skipMany1Chars2 (p1: Parser<'a,'u>) (p: Parser<'a,'u>) = skipManyCharsImpl true p1 p

let skipMany1Chars p = skipMany1Chars2 p p





let inline inlineManyCharsTillApply (p: Parser<char,'u>) (endp: Parser<'b,'u>) (f: string -> 'b -> 'c) =

    fun state ->

        let mutable state  = state

        let mutable reply2 = endp state

        if reply2.Status <> Ok then

            let mutable reply1 = p state

            let mutable cl = new StructCharList()

            if reply1.Status = Ok then

                cl.AppendFirst(reply1.Result)

                state <- reply1.State

                reply2 <- endp state

                while reply2.Status <> Ok && (reply1 <- p state; reply1.Status = Ok) do

                    if referenceEquals reply1.State state then

                        _raiseInfiniteLoopException "manyCharsTill" state

                    cl.Append(reply1.Result)

                    state  <- reply1.State

                    reply2 <- endp state

            if reply2.Status = Ok then

                let error = if not (referenceEquals reply2.State state) then reply2.Error

                            else mergeErrors reply1.Error reply2.Error

                Reply<_,_>(Ok, f (cl.ToString()) reply2.Result, error, reply2.State)

            elif reply1.Status = Error && reply1.State == state then

                let error = if reply2.State != state then reply2.Error

                            else mergeErrors reply1.Error reply2.Error

                Reply<_,_>(reply2.Status, error, reply2.State)

            else

                Reply<_,_>(reply1.Status, reply1.Error, reply1.State)

        else

            Reply<_,_>(Ok, f "" reply2.Result, reply2.Error, reply2.State)



let inline inlineMany1CharsTill2Apply (p1: Parser<char,'u>) (p: Parser<char,'u>) (endp: Parser<'b,'u>) (f: string -> 'b -> 'c) =

    fun state ->

        let mutable reply1 = p1 state

        if reply1.Status = Ok then

            let mutable cl = new StructCharList()

            cl.AppendFirst(reply1.Result)

            let mutable state = reply1.State

            let mutable reply2 = endp state

            while reply2.Status <> Ok && (reply1 <- p state; reply1.Status = Ok) do

                if referenceEquals reply1.State state then

                    _raiseInfiniteLoopException "manyCharsTill" state

                cl.Append(reply1.Result)

                state  <- reply1.State

                reply2 <- endp state

            if reply2.Status = Ok then

                let error = if not (referenceEquals reply2.State state) then reply2.Error

                            else mergeErrors reply1.Error reply2.Error

                Reply<_,_>(Ok, f (cl.ToString()) reply2.Result, error, reply2.State)

            elif reply1.Status = Error && reply1.State == state then

                let error = if reply2.State != state then reply2.Error

                            else mergeErrors reply1.Error reply2.Error

                Reply<_,_>(reply2.Status, error, reply2.State)

            else

                Reply<_,_>(reply1.Status, reply1.Error, reply1.State)

        else

            Reply<_,_>(reply1.Status, reply1.Error, reply1.State)





let manyCharsTill      p endp   = inlineManyCharsTillApply p endp (fun str _ -> str)

let manyCharsTillApply p endp f = let optF = OptimizedClosures.FastFunc2.Adapt(f)

                                  inlineManyCharsTillApply p endp (fun str x -> optF.Invoke(str, x))

let skipManyCharsTill  p endp   = skipManyTill p endp



let many1CharsTill2      p1 p endp   = inlineMany1CharsTill2Apply p1 p endp (fun str _ -> str)

let many1CharsTillApply2 p1 p endp f = let optF = OptimizedClosures.FastFunc2.Adapt(f)

                                       inlineMany1CharsTill2Apply p1 p endp (fun str x -> optF.Invoke(str, x))

let many1CharsTill          p endp   = many1CharsTill2 p p endp

let many1CharsTillApply     p endp f = many1CharsTillApply2 p p endp f



let skipMany1CharsTill2  (p1: Parser<'a,'u>) (p: Parser<'a,'u>) endp   = p1 >>. skipManyTill p endp

let skipMany1CharsTill   p    endp   = skipMany1CharsTill2 p p endp





let inline manyStringsImpl require1 (p1: Parser<string,'u>) (p: Parser<string,'u>) : Parser<string,'u> =

    fun state ->

        let mutable reply = p1 state

        if reply.Status = Ok then

            let result1 = reply.Result

            let mutable error  = reply.Error

            let mutable state  = reply.State

            reply <- p state

            if reply.Status <> Ok then reply.Result <- result1

            else

                let result2 = reply.Result

                error <- reply.Error

                state <- reply.State

                reply <- p state

                if reply.Status <> Ok then reply.Result <- result1 + result2

                else

                    let result3 = reply.Result

                    error <- reply.Error

                    state <- reply.State

                    reply <- p state

                    if reply.Status <> Ok then reply.Result <- concat3 result1 result2 result3

                    else

                        let result4 = reply.Result

                        error <- reply.Error

                        state <- reply.State

                        reply <- p state

                        if reply.Status <> Ok then reply.Result <- concat4 result1 result2 result3 result4

                        else

                            let n = 2*(result1.Length + result2.Length + result3.Length + result4.Length) + reply.Result.Length

                            let sb = new StringBuilder(n)

                            sb.Append(result1).Append(result2).Append(result3).Append(result4).Append(reply.Result) |> ignore

                            error <- reply.Error

                            state <- reply.State

                            reply <- p state

                            while reply.Status = Ok do

                                if reply.State == state then

                                    _raiseInfiniteLoopException "manyStrings" state

                                error <- reply.Error

                                sb.Append(reply.Result) |> ignore

                                state <- reply.State

                                reply <- p state

                            reply.Result <- sb.ToString()

            // we assume that the string parser changes the state when it succeeds, so we don't need to merge more than one error

            if reply.Status = Error then

                if reply.State == state then

                    reply.Status <- Ok

                    if isNotNull error then

                        reply.Error <- concatErrorMessages error reply.Error

            else

                reply.Error <- mergeErrorsIfNeeded state error reply.State reply.Error

        elif not require1 && reply.Status = Error && reply.State == state then

            reply.Status <- Ok

            reply.Result <- ""

        reply



let manyStrings2 p1 p = manyStringsImpl false p1 p

let manyStrings p = manyStrings2 p p

let many1Strings2 p1 p = manyStringsImpl true p1 p

let many1Strings p = many1Strings2 p p





let skipped (p: Parser<unit,'u>) : Parser<string,'u> =

    fun state ->

        let reply = p state

        let result = if reply.Status = Ok then state.ReadUntil(reply.State)  else ""

        Reply<_,_>(reply.Status, result, reply.Error, reply.State)



let withSkippedString (f: string -> 'a -> 'b) (p: Parser<'a,'u>) : Parser<'b,'u> =

    let optF = OptimizedClosures.FastFunc2<_,_,_>.Adapt(f)

    fun state ->

        let reply = p state

        let result = if reply.Status = Ok then

                         optF.Invoke(state.ReadUntil(reply.State), reply.Result)

                     else Unchecked.defaultof<_>

        Reply<_,_>(reply.Status, result, reply.Error, reply.State)





// ---------------

// Parsing numbers

// ---------------



[<System.Flags>]

type NumberLiteralOptions =

     | None                             = 0

     | AllowSuffix                      = 0b000000000001

     | AllowMinusSign                   = 0b000000000010

     | AllowPlusSign                    = 0b000000000100

     | AllowFraction                    = 0b000000001000

     | AllowFractionWOIntegerPart       = 0b000000010000

     | AllowExponent                    = 0b000000100000

     | AllowHexadecimal                 = 0b000001000000

     | AllowBinary                      = 0b000010000000

     | AllowOctal                       = 0b000100000000

     | AllowInfinity                    = 0b001000000000

     | AllowNaN                         = 0b010000000000



     | DefaultInteger                   = 0b000111000110

     | DefaultUnsignedInteger           = 0b000111000000

     | DefaultFloat                     = 0b011001101110



type internal NLO = NumberLiteralOptions



[<System.Flags>]

type NumberLiteralResultFlags =

     | None             = 0

     | SuffixLengthMask = 0b0000000000001111

     | HasMinusSign     = 0b0000000000010000

     | HasPlusSign      = 0b0000000000100000

     | HasIntegerPart   = 0b0000000001000000

     | HasFraction      = 0b0000000010000000

     | HasExponent      = 0b0000000100000000

     | IsDecimal        = 0b0000001000000000

     | IsHexadecimal    = 0b0000010000000000

     | IsBinary         = 0b0000100000000000

     | IsOctal          = 0b0001000000000000

     | BaseMask         = 0b0001111000000000

     | IsInfinity       = 0b0010000000000000

     | IsNaN            = 0b0100000000000000



type internal NLF = NumberLiteralResultFlags



type NumberLiteral(string, info, suffixChar1, suffixChar2, suffixChar3, suffixChar4) = struct

    member t.String = string



    member t.SuffixLength = int (info &&& NLF.SuffixLengthMask)

    member t.SuffixChar1  = suffixChar1

    member t.SuffixChar2  = suffixChar2

    member t.SuffixChar3  = suffixChar3

    member t.SuffixChar4  = suffixChar4



    member t.Info = info



    member t.HasMinusSign   = int (info &&& NLF.HasMinusSign) <> 0

    member t.HasPlusSign    = int (info &&& NLF.HasPlusSign) <> 0

    member t.HasIntegerPart = int (info &&& NLF.HasIntegerPart) <> 0

    member t.HasFraction    = int (info &&& NLF.HasFraction) <> 0

    member t.HasExponent    = int (info &&& NLF.HasExponent) <> 0

    member t.IsInteger      = info &&& (NLF.HasIntegerPart ||| NLF.HasFraction ||| NLF.HasExponent) = NLF.HasIntegerPart

    member t.IsDecimal      = int (info &&& NLF.IsDecimal) <> 0

    member t.IsHexadecimal  = int (info &&& NLF.IsHexadecimal) <> 0

    member t.IsBinary       = int (info &&& NLF.IsBinary) <> 0

    member t.IsOctal        = int (info &&& NLF.IsOctal) <> 0

    member t.IsNaN          = int (info &&& NLF.IsNaN) <> 0

    member t.IsInfinity     = int (info &&& NLF.IsInfinity) <> 0

end







let numberLiteralE (opt: NumberLiteralOptions) (errorInCaseNoLiteralFound: ErrorMessageList) (state: State<'u>) =

    let mutable iter = state.Iter

    let mutable c = iter.Read()

    let mutable error = NoErrorMessages

    let mutable flags = NLF.None



    if c = '-' && int (opt &&& NLO.AllowMinusSign) <> 0 then

        flags <- NLF.HasMinusSign

        c <- iter._Increment()

    elif c = '+' && int (opt &&& NLO.AllowPlusSign) <> 0 then

        flags <- NLF.HasPlusSign

        c <- iter._Increment()



    let allowStartingPoint = NLO.AllowFraction ||| NLO.AllowFractionWOIntegerPart // for starting point both flags are required



    if isDigit c || (c = '.' && (opt &&& allowStartingPoint = allowStartingPoint)) then

        if    int (opt &&& (NLO.AllowBinary ||| NLO.AllowOctal ||| NLO.AllowHexadecimal)) <> 0

           && c = '0'

        then

            match iter.Peek() with

            | 'b' | 'B' ->

                if int (opt &&& NLO.AllowBinary) <> 0 then

                    flags <- flags ||| NLF.IsBinary

                    c <- iter._Increment(2u)

                    if c = '0' || c = '1' then

                        flags <- flags ||| NLF.HasIntegerPart

                        c <- iter._Increment()

                    else

                        error <- expectedBinaryDigit

                    while c = '0' || c = '1' do

                        c <- iter._Increment()

            | 'o' | 'O' ->

                if int (opt &&& NLO.AllowOctal) <> 0 then

                    flags <- flags ||| NLF.IsOctal

                    c <- iter._Increment(2u)

                    if isOctal c then

                        flags <- flags ||| NLF.HasIntegerPart

                        c <- iter._Increment()

                    else

                        error <- expectedOctalDigit

                    while isOctal c do

                        c <- iter._Increment()

            | 'x' | 'X' ->

                if int (opt &&& NLO.AllowHexadecimal) <> 0 then

                    flags <- flags ||| NLF.IsHexadecimal

                    c <- iter._Increment(2u)

                    if isHex c then

                        flags <- flags ||| NLF.HasIntegerPart

                        c <- iter._Increment()

                    elif int (opt &&& NLO.AllowFractionWOIntegerPart) = 0 then

                        // integer part required

                        error <- expectedHexadecimalDigit

                    while isHex c do

                        c <- iter._Increment()

                    if c = '.' && isNull error && int (opt &&& NLO.AllowFraction) <> 0 then

                        flags <- flags ||| NLF.HasFraction

                        c <- iter._Increment()

                        if isHex c then

                            c <- iter._Increment()

                        elif int (flags &&& NLF.HasIntegerPart) = 0 then

                            // at least one digit before or after the . is required

                            error <- expectedHexadecimalDigit

                        while isHex c do

                            c <- iter._Increment()

                    elif int (flags &&& NLF.HasIntegerPart) = 0 then

                        // we neither have an integer part nor a fraction

                        error <- expectedHexadecimalDigit

                    if (c = 'p' || c = 'P') && isNull error && int (opt &&& NLO.AllowExponent) <> 0  then

                        flags <- flags ||| NLF.HasExponent

                        c <- iter._Increment()

                        if c = '-' || c = '+' then

                            c <- iter._Increment()

                        if not (isDigit c) then

                            error <- expectedDecimalDigit

                        while isDigit c do

                            c <- iter._Increment()

            | _ -> ()



        if int (flags &&& (NLF.IsBinary ||| NLF.IsOctal ||| NLF.IsHexadecimal)) = 0 then

            flags <- flags ||| NLF.IsDecimal

            if c <> '.' then

                flags <- flags ||| NLF.HasIntegerPart

                c <- iter._Increment()

                while isDigit c do

                    c <- iter._Increment()

            if c = '.' && int (opt &&& NLO.AllowFraction) <> 0 then

                flags <- flags ||| NLF.HasFraction

                c <- iter._Increment()

                if isDigit c then

                    c <- iter._Increment()

                elif int (flags &&& NLF.HasIntegerPart) = 0 then

                    // at least one digit before or after the . is required

                    error <- expectedDecimalDigit

                while isDigit c do

                    c <- iter._Increment()

            if (c = 'e' || c = 'E') && isNull error && int (opt &&& NLO.AllowExponent) <> 0 then

                flags <- flags ||| NLF.HasExponent

                c <- iter._Increment()

                if c = '-' || c = '+' then

                    c <- iter._Increment()

                if not (isDigit c) then

                    error <- expectedDecimalDigit

                while isDigit c do

                    c <- iter._Increment()



        if isNull error then

            let str = state.Iter.ReadUntil(iter)

            let mutable nSuffix = 0

            let mutable s1 = EOS

            let mutable s2 = EOS

            let mutable s3 = EOS

            let mutable s4 = EOS

            if int (opt &&& NLO.AllowSuffix) <> 0 && isNull error then

                if isAsciiLetter c then

                    nSuffix <- 1

                    s1 <- c

                    c <- iter._Increment()

                    if isAsciiLetter c then

                        nSuffix <- nSuffix + 1

                        s2 <- c

                        c <- iter._Increment()

                        if isAsciiLetter c then

                            nSuffix <- nSuffix + 1

                            s3 <- c

                            c <- iter._Increment()

                            if isAsciiLetter c then

                                nSuffix <- nSuffix + 1

                                s4 <- c

                                c <- iter._Increment()

                    flags <- flags ||| (enum) nSuffix

            let nl = NumberLiteral(str, flags, s1, s2, s3, s4)

            Reply<_,_>(nl, state.AdvanceTo(iter))

        else

            Reply<_,_>(Error, error, state.AdvanceTo(iter))

    else

        if int (opt &&& (NLO.AllowInfinity ||| NLO.AllowNaN)) <> 0 then

            if c = 'i' || c = 'I' then

                if int (opt &&& NLO.AllowInfinity) <> 0 then

                    c <- iter.Peek(1u)

                    if c = 'n' || c = 'N' then

                        c <- iter.Peek(2u)

                        if c = 'f' || c = 'F' then

                            flags <- flags ||| NLF.IsInfinity

                            c <- iter._Increment(3u)

                            if c = 'i' || c = 'I' then

                                c <- iter.Peek(1u)

                                if c = 'n' || c = 'N' then

                                    c <- iter.Peek(2u)

                                    if c = 'i' || c = 'I' then

                                        c <- iter.Peek(3u)

                                        if c = 't' || c = 'T' then

                                            c <- iter.Peek(4u)

                                            if c = 'y' || c = 'Y' then

                                                iter._Increment(5u) |> ignore



            elif (c = 'n' || c = 'N') && int (opt &&& NLO.AllowNaN) <> 0 then

                c <- iter.Peek(1u)

                if c = 'a' || c = 'A' then

                    c <- iter.Peek(2u)

                    if c = 'n' || c = 'N' then

                        flags <- flags ||| NLF.IsNaN

                        iter._Increment(3u) |> ignore



        if int (flags &&& (NLF.IsInfinity ||| NLF.IsNaN)) <> 0 then

            Reply<_,_>(NumberLiteral(state.Iter.ReadUntil(iter), flags, EOS, EOS, EOS, EOS), state.AdvanceTo(iter))

        else…
Alerts (16)

Complexity hotspot; lines 217 to 224 (total complexity: 8)
217 218 219 220 221 222 223 224
Complexity hotspot; lines 229 to 236 (total complexity: 8)
229 230 231 232 233 234 235 236