PageRenderTime 1335ms CodeModel.GetById 23ms RepoModel.GetById 12ms app.codeStats 1ms

/FParsec/CharParsers.fs

https://bitbucket.org/banshee/fparsec-samples
F# | 1309 lines | 1078 code | 187 blank | 44 comment | 351 complexity | 4b6e4ccea3f15f27074ae7f96d70c16a MD5 | raw file
Possible License(s): BSD-2-Clause
  1. // Copyright (c) Stephan Tolksdorf 2007-2009
  2. // License: Simplified BSD License. See accompanying documentation.
  3. namespace FParsec
  4. module CharParsers
  5. open System.Diagnostics
  6. open System.Text
  7. open System.Text.RegularExpressions
  8. open Microsoft.FSharp.NativeInterop
  9. open FParsec.Internals
  10. open FParsec.Error
  11. open FParsec.Primitives
  12. #nowarn "9" // "Uses of this construct may result in the generation of unverifiable .NET IL code."
  13. #nowarn "51" // "The address-of operator may result in non-verifiable code."
  14. // ================
  15. // Helper functions
  16. // ================
  17. [<Literal>]
  18. let EOS = CharStream.Iterator.EndOfStreamChar
  19. let foldCase = CharStream.FoldCase
  20. let normalizeNewlines = CharStream.NormalizeNewlines
  21. let floatToHexString d = Helper.DoubleToHexString(d)
  22. let floatOfHexString s = Helper.DoubleFromHexString(s)
  23. let float32ToHexString d = Helper.SingleToHexString(d)
  24. let float32OfHexString s = Helper.SingleFromHexString(s)
  25. // ========================
  26. // Running parsers on input
  27. // ========================
  28. [<StructuredFormatDisplay("{StructuredFormatDisplay}")>]
  29. type ParserResult<'Result,'UserState> =
  30. | Success of 'Result * 'UserState * Pos
  31. | Failure of string * ParserError * 'UserState
  32. with
  33. member private t.StructuredFormatDisplay =
  34. match t with
  35. | Success(r,_,_) ->
  36. if typeof<'Result> = typeof<unit> then "Success: ()"
  37. else sprintf "Success: %A" r
  38. | Failure(msg,_,_) ->
  39. sprintf "Failure:\n%s" msg
  40. let internal applyParser (parser: Parser<'Result,'UserState>) (state: State<'UserState>) =
  41. let reply = parser state
  42. if reply.Status = Ok then
  43. Success(reply.Result, reply.State.UserState, reply.State.Pos)
  44. else
  45. let error = ParserError(reply.State.Pos, reply.Error)
  46. Failure(error.ToString(reply.State.Stream), error, reply.State.UserState)
  47. let runParser (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (name: string) (stream: CharStream) =
  48. let state0 = new State<'UserState>(stream, ustate, name)
  49. applyParser parser state0
  50. let runParserOnString (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (streamName: string) (chars: string) =
  51. use stream = new CharStream(chars, 0, chars.Length)
  52. let state0 = new State<'UserState>(stream, ustate, streamName)
  53. applyParser parser state0
  54. let runParserOnSubstring (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (streamName: string) (chars: string) (index: int) length =
  55. use stream = new CharStream(chars, index, length)
  56. let state0 = new State<'UserState>(stream, ustate, streamName)
  57. applyParser parser state0
  58. let runParserOnStream (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (streamName: string) (byteStream: System.IO.Stream) (encoding: System.Text.Encoding) =
  59. use stream = new CharStream(byteStream, encoding)
  60. let state0 = new State<'UserState>(stream, ustate, streamName)
  61. applyParser parser state0
  62. let runParserOnFile (parser: Parser<'Result,'UserState>) (ustate: 'UserState) (path: string) (encoding: System.Text.Encoding) =
  63. use stream = new CharStream(path, encoding)
  64. let state0 = new State<'UserState>(stream, ustate, path)
  65. applyParser parser state0
  66. let runParserOnSubstream (parser: Parser<'Result,'SubstreamUserState>) ustate (stateBeforeSubstream: State<'UserState>) stateAfterSubStream =
  67. Helper.RunParserOnSubstream(applyParser parser, ustate, stateBeforeSubstream, stateAfterSubStream)
  68. let run parser (string: string) =
  69. runParserOnString parser () "" string
  70. // some predefined error messages
  71. let internal expectedEndOfFile = expectedError "end of file"
  72. let internal expectedAnyChar = expectedError "any char"
  73. let internal expectedWhitespace = expectedError "whitespace"
  74. let internal expectedAsciiUppercaseLetter = expectedError "Ascii uppercase letter"
  75. let internal expectedAsciiLowercaseLetter = expectedError "Ascii lowercase letter"
  76. let internal expectedAsciiLetter = expectedError "Ascii letter"
  77. let internal expectedUppercaseLetter = expectedError "uppercase letter"
  78. let internal expectedLowercaseLetter = expectedError "lowercase letter"
  79. let internal expectedLetter = expectedError "letter"
  80. let internal expectedBinaryDigit = expectedError "binary digit"
  81. let internal expectedOctalDigit = expectedError "octal digit"
  82. let internal expectedDecimalDigit = expectedError "digit"
  83. let internal expectedHexadecimalDigit = expectedError "hexadecimal digit"
  84. let internal expectedNewline = expectedError "newline"
  85. let internal expectedTab = expectedError "tab"
  86. let internal expectedFloatingPointNumber = expectedError "floating-point number"
  87. let internal expectedInt64 = expectedError "integer number (64-bit, signed)"
  88. let internal expectedInt32 = expectedError "integer number (32-bit, signed)"
  89. let internal expectedInt16 = expectedError "integer number (16-bit, signed)"
  90. let internal expectedInt8 = expectedError "integer number (8-bit, signed)"
  91. let internal expectedUInt64 = expectedError "integer number (64-bit, unsigned)"
  92. let internal expectedUInt32 = expectedError "integer number (32-bit, unsigned)"
  93. let internal expectedUInt16 = expectedError "integer number (16-bit, unsigned)"
  94. let internal expectedUInt8 = expectedError "integer number (8-bit, unsigned)"
  95. let internal unexpectedNewline = unexpectedError "newline"
  96. let internal unexpectedEndOfFile = unexpectedError "end of file"
  97. // =======
  98. // Parsers
  99. // =======
  100. // ------------------------------------------------
  101. // Reading the position and handling the user state
  102. // ------------------------------------------------
  103. let getPos : Parser<Pos,'u> =
  104. fun state -> Reply<_,_>(state.Pos, state)
  105. let getUserState : Parser<'u,'u> =
  106. fun state -> Reply<_,_>(state.UserState, state)
  107. let setUserState (newUserState: 'u) : Parser<unit,'u> =
  108. fun state -> Reply<_,_>((), state.WithUserState(newUserState))
  109. let updateUserState (f: 'u -> 'u) : Parser<unit,'u> =
  110. fun state -> Reply<_,_>((), state.WithUserState(f state.UserState))
  111. let userStateSatisfies f : Parser<unit,'u> =
  112. fun state ->
  113. Reply<unit,_>((if f state.UserState then Ok else Error), NoErrorMessages, state)
  114. // --------------------
  115. // Parsing single chars
  116. // --------------------
  117. // needs to be inline because of the value restriction
  118. let inline internal inlineNewlineReturn result : Parser<_,'u> =
  119. fun state ->
  120. let newState = state.SkipNewline()
  121. if not (referenceEquals state newState) then
  122. Reply<_,_>(result, newState)
  123. else
  124. Reply<_,_>(Error, expectedNewline, newState)
  125. let newlineReturn result = fun state -> inlineNewlineReturn result state
  126. let newline = fun state -> inlineNewlineReturn '\n' state
  127. let skipNewline = fun state -> inlineNewlineReturn () state
  128. let charReturn c result : Parser<'a,'u> =
  129. if c <> '\r' && c <> '\n' then
  130. let error = expectedError (quoteChar c)
  131. fun state ->
  132. if state.Iter.Match(c) then Reply<_,_>(result, state.Next)
  133. else Reply<_,_>(Error, error, state)
  134. else newlineReturn result
  135. let pchar c = charReturn c c
  136. let skipChar c = charReturn c ()
  137. /// returns true for chars '\u000E' - '\ufffe'
  138. let inline internal isCertainlyNoNLOrEOS (c: char) =
  139. // '\n' = '\u000A', '\r' = '\u000D'
  140. unativeint c - 0xEun < unativeint EOS - 0xEun
  141. let anyChar : Parser<char,'u> =
  142. fun state ->
  143. let c = state.Iter.Read()
  144. if isCertainlyNoNLOrEOS c then
  145. Reply<_,_>(c, state.Next)
  146. elif c = '\r' || c = '\n' then
  147. Reply<_,_>('\n', state.SkipNewline())
  148. elif c <> EOS then
  149. Reply<_,_>(c, state.Next)
  150. else
  151. Reply<_,_>(Error, expectedAnyChar, state)
  152. let skipAnyChar : Parser<unit,'u> =
  153. fun state ->
  154. let newState = state.SkipCharOrNewline()
  155. if not (referenceEquals state newState) then
  156. Reply<_,_>((), newState)
  157. else
  158. Reply<_,_>(Error, expectedAnyChar, newState)
  159. // doesn't check for newlines or EOS
  160. let inline internal fastInlineSatisfyE f error : Parser<char,'u> =
  161. fun state ->
  162. let c = state.Iter.Read()
  163. if f c then Reply<_,_>(c, state.Next)
  164. else Reply<_,_>(Error, error, state)
  165. let inline internal fastInlineSkipSatisfyE f error : Parser<unit,'u> =
  166. fun state ->
  167. let c = state.Iter.Read()
  168. if f c then Reply<_,_>((), state.Next)
  169. else Reply<_,_>(Error, error, state)
  170. let inline internal inlineSatisfyE f error : Parser<char,'u> =
  171. fun state ->
  172. let c = state.Iter.Read()
  173. if isCertainlyNoNLOrEOS c then
  174. if f c then Reply<_,_>(c, state.Next)
  175. else Reply<_,_>(Error, error, state)
  176. elif c = '\r' || c = '\n' then
  177. if f '\n' then Reply<_,_>('\n', state.SkipNewline())
  178. else Reply<_,_>(Error, error, state)
  179. elif c <> EOS && f c then Reply<_,_>(c, state.Next)
  180. else Reply<_,_>(Error, error, state)
  181. let inline internal inlineSkipSatisfyE f error : Parser<unit,'u> =
  182. fun state ->
  183. let c = state.Iter.Read()
  184. if isCertainlyNoNLOrEOS c then
  185. if f c then Reply<_,_>((), state.Next)
  186. else Reply<_,_>(Error, error, state)
  187. elif c = '\r' || c = '\n' then
  188. if f '\n' then Reply<_,_>((), state.SkipNewline())
  189. else Reply<_,_>(Error, error, state)
  190. elif c <> EOS && f c then Reply<_,_>((), state.Next)
  191. else Reply<_,_>(Error, error, state)
  192. let internal satisfyE f error = inlineSatisfyE f error
  193. let internal skipSatisfyE f error = inlineSkipSatisfyE f error
  194. let satisfy f = satisfyE f NoErrorMessages
  195. let satisfyL f label = satisfyE f (expectedError label)
  196. let skipSatisfy f = skipSatisfyE f NoErrorMessages
  197. let skipSatisfyL f label = skipSatisfyE f (expectedError label)
  198. let isAnyOf (chars: string) =
  199. let cs = new FParsec.Helper.CharSet(chars)
  200. fun c -> cs.Contains(c)
  201. let isNoneOf (chars: string) =
  202. let cs = new FParsec.Helper.CharSet(chars)
  203. fun c -> not (cs.Contains(c))
  204. let anyOf (chars: string) =
  205. let error = expectedError ("any char in " + quoteString chars)
  206. let cs = new FParsec.Helper.CharSet(chars)
  207. inlineSatisfyE (fun c -> cs.Contains(c)) error
  208. let skipAnyOf (chars: string) =
  209. let error = expectedError ("any char in " + quoteString chars)
  210. let cs = new FParsec.Helper.CharSet(chars)
  211. inlineSkipSatisfyE (fun c -> cs.Contains(c)) error
  212. let noneOf (chars: string) =
  213. let error = expectedError ("any char not in " + quoteString chars)
  214. let cs = new FParsec.Helper.CharSet(chars)
  215. inlineSatisfyE (fun c -> not (cs.Contains(c))) error
  216. let skipNoneOf (chars: string) =
  217. let error = expectedError ("any char not in " + quoteString chars)
  218. let cs = new FParsec.Helper.CharSet(chars)
  219. inlineSkipSatisfyE (fun c -> not (cs.Contains(c))) error
  220. let inline isAsciiUpper c = c >= 'A' && c <= 'Z'
  221. let inline isAsciiLower c = c >= 'a' && c <= 'z'
  222. let inline isAsciiLetter (c: char) = let c2 = int c ||| int ' '
  223. c2 >= int 'a' && c2 <= int 'z'
  224. let inline isUpper c =
  225. if c >= 'A' then
  226. c <= 'Z' || (c > '\u007F' && System.Char.IsUpper(c))
  227. else false
  228. let inline isLower c =
  229. if c >= 'a' then
  230. c <= 'z' || (c > '\u007F' && System.Char.IsLower(c))
  231. else false
  232. let inline isLetter c =
  233. if c <= '\u007F' then
  234. let c2 = int c ||| int ' '
  235. c2 >= int 'a' && c2 <= int 'z'
  236. else System.Char.IsLetter(c)
  237. let inline isDigit c = c <= '9' && c >= '0'
  238. let inline isHex c =
  239. if c <= '9' then c >= '0'
  240. else c <= 'f' && (c >= 'a' || (c >= 'A' && c <= 'F'))
  241. let inline isOctal c = c <= '7' && c >= '0'
  242. let asciiUpper state = fastInlineSatisfyE isAsciiUpper expectedAsciiUppercaseLetter state
  243. let asciiLower state = fastInlineSatisfyE isAsciiLower expectedAsciiLowercaseLetter state
  244. let asciiLetter state = fastInlineSatisfyE isAsciiLetter expectedAsciiLetter state
  245. // unicode is the default for letters and ascii the default for numbers
  246. let upper state = fastInlineSatisfyE isUpper expectedUppercaseLetter state
  247. let lower state = fastInlineSatisfyE isLower expectedLowercaseLetter state
  248. let letter state = fastInlineSatisfyE isLetter expectedLetter state
  249. let digit state = fastInlineSatisfyE isDigit expectedDecimalDigit state
  250. let hex state = fastInlineSatisfyE isHex expectedHexadecimalDigit state
  251. let octal state = fastInlineSatisfyE isOctal expectedOctalDigit state
  252. let tab state = fastInlineSatisfyE ((=) '\t') expectedTab state
  253. let unicodeNewline : Parser<_,'u> =
  254. fun state ->
  255. let c = state.Iter.Read()
  256. if c < '\u0085' then
  257. if c = '\r' || c = '\n' then
  258. Reply<_,_>('\n', state.SkipNewline())
  259. elif c <> '\u000C' then
  260. Reply<_,_>(Error, expectedNewline, state)
  261. else // c = '\u000C'
  262. Reply<_,_>('\n', state.Advance(1, 1, 0))
  263. elif c <= '\u2029' && (c >= '\u2028' || c = '\u0085') then
  264. Reply<_,_>('\n', state.Advance(1, 1, 0))
  265. else
  266. Reply<_,_>(Error, expectedNewline, state)
  267. let whitespace : Parser<char,'u> =
  268. fun state ->
  269. let c = state.Iter.Read()
  270. if c <= ' ' then
  271. match c with
  272. | ' ' | '\t' -> Reply<_,_>(c, state.Next)
  273. | '\r' | '\n' -> Reply<_,_>('\n', state.SkipNewline())
  274. | _ -> Reply<_,_>(Error, expectedWhitespace, state)
  275. else Reply<_,_>(Error, expectedWhitespace, state)
  276. let unicodeWhitespace : Parser<char,'u> =
  277. fun state ->
  278. let c = state.Iter.Read()
  279. if c = ' ' then Reply<_,_>(c, state.Next)
  280. elif System.Char.IsWhiteSpace(c) then
  281. match c with
  282. | '\r' | '\n' ->
  283. Reply<_,_>('\n', state.SkipNewline())
  284. | '\u000C' | '\u0085' | '\u2028' | '\u2029' ->
  285. Reply<_,_>('\n', state.Advance(1, 1, 0))
  286. | _ ->
  287. Reply<_,_>(c, state.Next)
  288. else Reply<_,_>(Error, expectedWhitespace, state)
  289. let spaces : Parser<unit,'u> =
  290. fun state ->
  291. Reply<_,_>((), state.SkipWhitespace())
  292. let spaces1 : Parser<unit,'u> =
  293. fun state ->
  294. let newState = state.SkipWhitespace()
  295. if not (referenceEquals newState state) then Reply<_,_>((), newState)
  296. else Reply<_,_>(Error, expectedWhitespace, newState)
  297. let eof : Parser<unit,'u>=
  298. fun state ->
  299. if state.Iter.IsEndOfStream then Reply<_,_>((), state)
  300. else Reply<_,_>(Error, expectedEndOfFile, state)
  301. // ------------------------
  302. // Parsing strings directly
  303. // ------------------------
  304. let internal checkStringContainsNoNewlineChar s name =
  305. if containsNewlineChar s then
  306. raise (System.ArgumentException(concat3 "The string argument to " name " may not contain newline chars ('\r' or '\n')."))
  307. let stringReturn s result : Parser<'a,'u> =
  308. checkStringContainsNoNewlineChar s "pstring/skipString/stringReturn"
  309. let error = expectedError (quoteString s)
  310. fun state ->
  311. if state.Iter.Match(s) then Reply<_,_>(result, state.Advance(s.Length))
  312. else Reply<_,_>(Error, error, state)
  313. let pstring s = stringReturn s s
  314. let skipString s = stringReturn s ()
  315. let pstringCI s : Parser<string,'u> =
  316. checkStringContainsNoNewlineChar s "pstringCI"
  317. let error = expectedError (quoteString s + " (case-insensitive)")
  318. let cfs = foldCase s
  319. fun state ->
  320. if state.Iter.MatchCaseFolded(cfs) then
  321. Reply<_,_>(state.Iter.Read(s.Length), state.Advance(s.Length))
  322. else Reply<_,_>(Error, error, state)
  323. let stringCIReturn s result : Parser<'a,'u> =
  324. checkStringContainsNoNewlineChar s "skipStringCI/stringCIReturn"
  325. let error = expectedError (quoteString s + " (case-insensitive)")
  326. let cfs = foldCase s
  327. fun state ->
  328. if state.Iter.MatchCaseFolded(cfs) then
  329. Reply<_,_>(result, state.Advance(s.Length))
  330. else Reply<_,_>(Error, error, state)
  331. let skipStringCI s = stringCIReturn s ()
  332. let anyString n : Parser<string,'u> =
  333. let error = expectedError (concat3 "any sequence of " (string n) " chars")
  334. fun state ->
  335. let mutable str = null
  336. let newState = state.SkipCharsOrNewlines(n, &str)
  337. if str.Length = n then Reply<_,_>(str, newState)
  338. else Reply<_,_>(Error, error, state)
  339. let skipAnyString n : Parser<unit,'u> =
  340. let error = expectedError (concat3 "any sequence of " (string n) " chars")
  341. fun state ->
  342. let mutable nSkipped = 0
  343. let newState = state.SkipCharsOrNewlines(n, &nSkipped)
  344. if n = nSkipped then Reply<_,_>((), newState)
  345. else Reply<_,_>(Error, error, state)
  346. let restOfLine : Parser<_,_> =
  347. fun state ->
  348. let mutable str = null
  349. let newState = state.SkipRestOfLine(true, &str)
  350. Reply<_,_>(str, newState)
  351. let skipRestOfLine : Parser<_,_> =
  352. fun state ->
  353. Reply<_,_>((), state.SkipRestOfLine(true))
  354. let skipToEndOfLine : Parser<_,_> =
  355. fun state ->
  356. Reply<_,_>((), state.SkipRestOfLine(false))
  357. let skipToString (s: string) maxChars : Parser<unit,'u> =
  358. checkStringContainsNoNewlineChar s "skipToString"
  359. if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))
  360. let error = messageError (concat3 "Could not find the string " (quoteString s) ".")
  361. fun state ->
  362. let mutable foundString = false
  363. let state2 = state.SkipToString(s, maxChars, &foundString)
  364. if foundString then Reply<_,_>((), state2)
  365. else Reply<_,_>(Error, error, state2)
  366. let skipToStringCI (s: string) maxChars : Parser<unit,'u> =
  367. checkStringContainsNoNewlineChar s "skipToStringCI"
  368. if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))
  369. let cfs = foldCase s
  370. let error = messageError (concat3 "Could not find the case-insensitive string " (quoteString s) ".")
  371. fun state ->
  372. let mutable foundString = false
  373. let state2 = state.SkipToStringCI(cfs, maxChars, &foundString)
  374. if foundString then Reply<_,_>((), state2)
  375. else Reply<_,_>(Error, error, state2)
  376. let charsTillString (s: string) maxChars : Parser<string,'u> =
  377. checkStringContainsNoNewlineChar s "charsTillString"
  378. if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))
  379. let error = messageError (concat3 "Could not find the string " (quoteString s) ".")
  380. fun state ->
  381. let mutable charsBeforeString = null
  382. let state2 = state.SkipToString(s, maxChars, &charsBeforeString)
  383. if isNotNull charsBeforeString then Reply<_,_>(charsBeforeString, state2.Advance(s.Length))
  384. else Reply<_,_>(Error, error, state2)
  385. let charsTillStringCI (s: string) maxChars : Parser<string,'u> =
  386. checkStringContainsNoNewlineChar s "charsTillStringCI"
  387. if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))
  388. let cfs = foldCase s
  389. let error = messageError (concat3 "Could not find the case-insensitive string " (quoteString s) ".")
  390. fun state ->
  391. let mutable charsBeforeString = null
  392. let state2 = state.SkipToStringCI(cfs, maxChars, &charsBeforeString)
  393. if isNotNull charsBeforeString then Reply<_,_>(charsBeforeString, state2.Advance(s.Length))
  394. else Reply<_,_>(Error, error, state2)
  395. let skipCharsTillString (s: string) maxChars : Parser<unit,'u> =
  396. checkStringContainsNoNewlineChar s "skipCharsTillString"
  397. if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))
  398. let error = messageError (concat3 "Could not find the string " (quoteString s) ".")
  399. fun state ->
  400. let mutable foundString = false
  401. let state2 = state.SkipToString(s, maxChars, &foundString)
  402. if foundString then Reply<_,_>((), state2.Advance(s.Length))
  403. else Reply<_,_>(Error, error, state2)
  404. let skipCharsTillStringCI (s: string) maxChars : Parser<unit,'u> =
  405. checkStringContainsNoNewlineChar s "skipCharsTillStringCI"
  406. if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))
  407. let cfs = foldCase s
  408. let error = messageError (concat3 "Could not find the case-insensitive string " (quoteString s) ".")
  409. fun state ->
  410. let mutable foundString = false
  411. let state2 = state.SkipToStringCI(cfs, maxChars, &foundString)
  412. if foundString then Reply<_,_>((), state2.Advance(s.Length))
  413. else Reply<_,_>(Error, error, state2)
  414. let inline internal manySatisfyImpl require1 f1 f error : Parser<string,'u> =
  415. fun state ->
  416. let mutable str = null
  417. let newState = state.SkipCharsOrNewlinesWhile(f1, f, &str)
  418. if not require1 || not (referenceEquals newState state) then Reply<_,_>(str, newState)
  419. else Reply<_,_>(Error, error, newState)
  420. let inline internal skipManySatisfyImpl require1 f1 f error : Parser<unit,'u> =
  421. fun state ->
  422. let newState = state.SkipCharsOrNewlinesWhile(f1, f)
  423. if not require1 || not (referenceEquals newState state) then Reply<_,_>((), newState)
  424. else Reply<_,_>(Error, error, newState)
  425. let manySatisfy2 f1 f = manySatisfyImpl false f1 f NoErrorMessages
  426. let many1Satisfy2 f1 f = manySatisfyImpl true f1 f NoErrorMessages
  427. let many1Satisfy2L f1 f label = manySatisfyImpl true f1 f (expectedError label)
  428. let skipManySatisfy2 f1 f = skipManySatisfyImpl false f1 f NoErrorMessages
  429. let skipMany1Satisfy2 f1 f = skipManySatisfyImpl true f1 f NoErrorMessages
  430. let skipMany1Satisfy2L f1 f label = skipManySatisfyImpl true f1 f (expectedError label)
  431. let manySatisfy f = manySatisfy2 f f
  432. let many1Satisfy f = many1Satisfy2 f f
  433. let many1SatisfyL f label = many1Satisfy2L f f label
  434. let skipManySatisfy f = skipManySatisfy2 f f
  435. let skipMany1Satisfy f = skipMany1Satisfy2 f f
  436. let skipMany1SatisfyL f label = skipMany1Satisfy2L f f label
  437. let internal manyMinMaxSatisfy2E minChars maxChars f1 f error : Parser<string,'u> =
  438. if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))
  439. if minChars > 0 then
  440. fun state ->
  441. let mutable str = null
  442. let newState = state.SkipCharsOrNewlinesWhile(f1, f, minChars, maxChars, &str)
  443. if not (referenceEquals newState state) then Reply<_,_>(str, newState)
  444. else Reply<_,_>(Error, error, newState)
  445. else
  446. fun state ->
  447. let mutable str = null
  448. let newState = state.SkipCharsOrNewlinesWhile(f1, f, 0, maxChars, &str)
  449. Reply<_,_>(str, newState)
  450. let internal skipManyMinMaxSatisfy2E minChars maxChars f1 f error : Parser<unit,'u> =
  451. if maxChars < 0 then raise (System.ArgumentOutOfRangeException("maxChars", "maxChars is negative."))
  452. if minChars > 0 then
  453. fun state ->
  454. let newState = state.SkipCharsOrNewlinesWhile(f1, f, minChars, maxChars)
  455. if not (referenceEquals newState state) then Reply<_,_>((), newState)
  456. else Reply<_,_>(Error, error, newState)
  457. else
  458. fun state ->
  459. let mutable str = null
  460. let newState = state.SkipCharsOrNewlinesWhile(f1, f, 0, maxChars)
  461. Reply<_,_>((), newState)
  462. let manyMinMaxSatisfy minChars maxChars f = manyMinMaxSatisfy2E minChars maxChars f f NoErrorMessages
  463. let manyMinMaxSatisfyL minChars maxChars f label = manyMinMaxSatisfy2E minChars maxChars f f (expectedError label)
  464. let manyMinMaxSatisfy2 minChars maxChars f1 f = manyMinMaxSatisfy2E minChars maxChars f1 f NoErrorMessages
  465. let manyMinMaxSatisfy2L minChars maxChars f1 f label = manyMinMaxSatisfy2E minChars maxChars f1 f (expectedError label)
  466. let skipManyMinMaxSatisfy minChars maxChars f = skipManyMinMaxSatisfy2E minChars maxChars f f NoErrorMessages
  467. let skipManyMinMaxSatisfyL minChars maxChars f label = skipManyMinMaxSatisfy2E minChars maxChars f f (expectedError label)
  468. let skipManyMinMaxSatisfy2 minChars maxChars f1 f = skipManyMinMaxSatisfy2E minChars maxChars f1 f NoErrorMessages
  469. let skipManyMinMaxSatisfy2L minChars maxChars f1 f label = skipManyMinMaxSatisfy2E minChars maxChars f1 f (expectedError label)
  470. let internal regexE pattern error : Parser<string,'u> =
  471. let regex = new Regex("\A" + pattern, RegexOptions.Multiline |||
  472. RegexOptions.ExplicitCapture)
  473. fun state ->
  474. let m = state.Iter.Match(regex)
  475. if m.Success then
  476. let s = m.Value
  477. if not (containsNewlineChar s) then Reply<_,_>(s, if s.Length > 0 then state.Advance(s.Length) else state)
  478. else
  479. let s2 = normalizeNewlines s
  480. let mutable nSkippedChars = 0
  481. let newState = state.SkipCharsOrNewlines(s2.Length, &nSkippedChars)
  482. if nSkippedChars = s2.Length then Reply<_,_>(s2, newState)
  483. else Reply<_,_>(FatalError, messageError "Internal error in the regex parser. Please report this error to fparsec@quanttec.com.", newState)
  484. else Reply<_,_>(Error, error, state)
  485. let regex pattern = regexE pattern (expectedError ("string matching the regex " + quoteString pattern))
  486. let regexL pattern label = regexE pattern (expectedError label)
  487. // ----------------------------------------------
  488. // Parsing strings with the help of other parsers
  489. // ----------------------------------------------
  490. type internal StructCharList = struct
  491. val mutable buffer_ui64_0: uint64
  492. val mutable buffer_ui64_1: uint64
  493. val mutable buffer_ui64_2: uint64
  494. val mutable buffer_ui64_3: uint64
  495. val mutable chars: char[]
  496. val mutable count: int
  497. member inline t.BufferPtr =
  498. NativePtr.of_nativeint<char> (NativePtr.to_nativeint (&&t.buffer_ui64_0))
  499. /// an optimized version of Append(c) for the first char
  500. member inline t.AppendFirst(c) =
  501. Debug.Assert(t.count = 0)
  502. let p = t.BufferPtr
  503. NativePtr.set p 0 c
  504. t.count <- 1
  505. member inline t.Append(c) =
  506. let i = t.count &&& 0xf
  507. t.count <- t.count + 1
  508. if i <> 0 then
  509. let p = t.BufferPtr
  510. NativePtr.set p i c
  511. else
  512. t._AppendContinue(c)
  513. /// append char with index%16 = 0
  514. member t._AppendContinue(c) =
  515. let p = t.BufferPtr
  516. let count = t.count - 1
  517. Debug.Assert(count%16 = 0 || count = -1)
  518. let mutable chars = t.chars
  519. if isNotNull chars then
  520. if count = chars.Length then
  521. let newChars = Array.zeroCreate (count*2)
  522. System.Buffer.BlockCopy(chars, 0, newChars, 0, (count - 16)*sizeof<char>)
  523. t.chars <- newChars
  524. chars <- newChars
  525. for i = 0 to 15 do
  526. chars.[count - 16 + i] <- NativePtr.get p i
  527. elif count <> 0 then
  528. chars <- Array.zeroCreate 48
  529. t.chars <- chars
  530. for i = 0 to 15 do
  531. chars.[i] <- NativePtr.get p i
  532. NativePtr.set p 0 c
  533. override t.ToString() =
  534. let p = t.BufferPtr
  535. let count = t.count
  536. if count <= 16 then new string(p, 0, count)
  537. else
  538. let chars = t.chars
  539. for i = (count - 1) &&& 0x7ffffff0 to count - 1 do
  540. chars.[i] <- NativePtr.get p (i &&& 0xf)
  541. new string(chars, 0, count)
  542. end
  543. let inline internal manyCharsImpl require1 (p1: Parser<char,'u>) (p: Parser<char,'u>) : Parser<string,'u> =
  544. fun state ->
  545. let mutable reply = p1 state
  546. if reply.Status = Ok then
  547. let mutable cl = new StructCharList()
  548. cl.AppendFirst(reply.Result)
  549. let mutable state = reply.State
  550. reply <- p state
  551. while reply.Status = Ok do
  552. if referenceEquals reply.State state then
  553. _raiseInfiniteLoopException "manyChars" state
  554. cl.Append(reply.Result)
  555. state <- reply.State
  556. reply <- p state
  557. let error = if reply.State == state then reply.Error
  558. else backtrackError reply.State reply.Error
  559. Reply<_,_>(Ok, cl.ToString(), error, state)
  560. else
  561. let error = if reply.State == state then reply.Error
  562. else backtrackError reply.State reply.Error
  563. if require1 then Reply<_,_>(Error, error, state)
  564. else Reply<_,_>(Ok, "", error, state)
  565. let inline internal skipManyCharsImpl require1 (p1: Parser<'a,'u>) (p: Parser<'a,'u>) : Parser<unit,'u> =
  566. fun state ->
  567. let mutable reply = p1 state
  568. if reply.Status = Ok then
  569. let mutable state = reply.State
  570. reply <- p state
  571. while reply.Status = Ok do
  572. if referenceEquals reply.State state then
  573. _raiseInfiniteLoopException "skipManyChars" state
  574. state <- reply.State
  575. reply <- p state
  576. let error = if reply.State == state then reply.Error
  577. else backtrackError reply.State reply.Error
  578. Reply<_,_>(Ok, (), error, state)
  579. else
  580. let error = if reply.State == state then reply.Error
  581. else backtrackError reply.State reply.Error
  582. if require1 then Reply<_,_>(Error, error, state)
  583. else Reply<_,_>(Ok, (), error, state)
  584. let manyChars2 p1 p = manyCharsImpl false p1 p
  585. let manyChars p = manyChars2 p p
  586. let many1Chars2 p1 p = manyCharsImpl true p1 p
  587. let many1Chars p = many1Chars2 p p
  588. let skipManyChars2 (p1: Parser<'a,'u>) (p: Parser<'a,'u>) = skipManyCharsImpl false p1 p
  589. let skipManyChars p = skipManyChars2 p p
  590. let skipMany1Chars2 (p1: Parser<'a,'u>) (p: Parser<'a,'u>) = skipManyCharsImpl true p1 p
  591. let skipMany1Chars p = skipMany1Chars2 p p
  592. let inline inlineManyCharsTillApply (p: Parser<char,'u>) (endp: Parser<'b,'u>) (f: string -> 'b -> 'c) =
  593. fun state ->
  594. let mutable state = state
  595. let mutable reply2 = endp state
  596. if reply2.Status <> Ok then
  597. let mutable reply1 = p state
  598. let mutable cl = new StructCharList()
  599. if reply1.Status = Ok then
  600. cl.AppendFirst(reply1.Result)
  601. state <- reply1.State
  602. reply2 <- endp state
  603. while reply2.Status <> Ok && (reply1 <- p state; reply1.Status = Ok) do
  604. if referenceEquals reply1.State state then
  605. _raiseInfiniteLoopException "manyCharsTill" state
  606. cl.Append(reply1.Result)
  607. state <- reply1.State
  608. reply2 <- endp state
  609. if reply2.Status = Ok then
  610. let error = if not (referenceEquals reply2.State state) then reply2.Error
  611. else mergeErrors reply1.Error reply2.Error
  612. Reply<_,_>(Ok, f (cl.ToString()) reply2.Result, error, reply2.State)
  613. elif reply1.Status = Error && reply1.State == state then
  614. let error = if reply2.State != state then reply2.Error
  615. else mergeErrors reply1.Error reply2.Error
  616. Reply<_,_>(reply2.Status, error, reply2.State)
  617. else
  618. Reply<_,_>(reply1.Status, reply1.Error, reply1.State)
  619. else
  620. Reply<_,_>(Ok, f "" reply2.Result, reply2.Error, reply2.State)
  621. let inline inlineMany1CharsTill2Apply (p1: Parser<char,'u>) (p: Parser<char,'u>) (endp: Parser<'b,'u>) (f: string -> 'b -> 'c) =
  622. fun state ->
  623. let mutable reply1 = p1 state
  624. if reply1.Status = Ok then
  625. let mutable cl = new StructCharList()
  626. cl.AppendFirst(reply1.Result)
  627. let mutable state = reply1.State
  628. let mutable reply2 = endp state
  629. while reply2.Status <> Ok && (reply1 <- p state; reply1.Status = Ok) do
  630. if referenceEquals reply1.State state then
  631. _raiseInfiniteLoopException "manyCharsTill" state
  632. cl.Append(reply1.Result)
  633. state <- reply1.State
  634. reply2 <- endp state
  635. if reply2.Status = Ok then
  636. let error = if not (referenceEquals reply2.State state) then reply2.Error
  637. else mergeErrors reply1.Error reply2.Error
  638. Reply<_,_>(Ok, f (cl.ToString()) reply2.Result, error, reply2.State)
  639. elif reply1.Status = Error && reply1.State == state then
  640. let error = if reply2.State != state then reply2.Error
  641. else mergeErrors reply1.Error reply2.Error
  642. Reply<_,_>(reply2.Status, error, reply2.State)
  643. else
  644. Reply<_,_>(reply1.Status, reply1.Error, reply1.State)
  645. else
  646. Reply<_,_>(reply1.Status, reply1.Error, reply1.State)
  647. let manyCharsTill p endp = inlineManyCharsTillApply p endp (fun str _ -> str)
  648. let manyCharsTillApply p endp f = let optF = OptimizedClosures.FastFunc2.Adapt(f)
  649. inlineManyCharsTillApply p endp (fun str x -> optF.Invoke(str, x))
  650. let skipManyCharsTill p endp = skipManyTill p endp
  651. let many1CharsTill2 p1 p endp = inlineMany1CharsTill2Apply p1 p endp (fun str _ -> str)
  652. let many1CharsTillApply2 p1 p endp f = let optF = OptimizedClosures.FastFunc2.Adapt(f)
  653. inlineMany1CharsTill2Apply p1 p endp (fun str x -> optF.Invoke(str, x))
  654. let many1CharsTill p endp = many1CharsTill2 p p endp
  655. let many1CharsTillApply p endp f = many1CharsTillApply2 p p endp f
  656. let skipMany1CharsTill2 (p1: Parser<'a,'u>) (p: Parser<'a,'u>) endp = p1 >>. skipManyTill p endp
  657. let skipMany1CharsTill p endp = skipMany1CharsTill2 p p endp
  658. let inline manyStringsImpl require1 (p1: Parser<string,'u>) (p: Parser<string,'u>) : Parser<string,'u> =
  659. fun state ->
  660. let mutable reply = p1 state
  661. if reply.Status = Ok then
  662. let result1 = reply.Result
  663. let mutable error = reply.Error
  664. let mutable state = reply.State
  665. reply <- p state
  666. if reply.Status <> Ok then reply.Result <- result1
  667. else
  668. let result2 = reply.Result
  669. error <- reply.Error
  670. state <- reply.State
  671. reply <- p state
  672. if reply.Status <> Ok then reply.Result <- result1 + result2
  673. else
  674. let result3 = reply.Result
  675. error <- reply.Error
  676. state <- reply.State
  677. reply <- p state
  678. if reply.Status <> Ok then reply.Result <- concat3 result1 result2 result3
  679. else
  680. let result4 = reply.Result
  681. error <- reply.Error
  682. state <- reply.State
  683. reply <- p state
  684. if reply.Status <> Ok then reply.Result <- concat4 result1 result2 result3 result4
  685. else
  686. let n = 2*(result1.Length + result2.Length + result3.Length + result4.Length) + reply.Result.Length
  687. let sb = new StringBuilder(n)
  688. sb.Append(result1).Append(result2).Append(result3).Append(result4).Append(reply.Result) |> ignore
  689. error <- reply.Error
  690. state <- reply.State
  691. reply <- p state
  692. while reply.Status = Ok do
  693. if reply.State == state then
  694. _raiseInfiniteLoopException "manyStrings" state
  695. error <- reply.Error
  696. sb.Append(reply.Result) |> ignore
  697. state <- reply.State
  698. reply <- p state
  699. reply.Result <- sb.ToString()
  700. // we assume that the string parser changes the state when it succeeds, so we don't need to merge more than one error
  701. if reply.Status = Error then
  702. if reply.State == state then
  703. reply.Status <- Ok
  704. if isNotNull error then
  705. reply.Error <- concatErrorMessages error reply.Error
  706. else
  707. reply.Error <- mergeErrorsIfNeeded state error reply.State reply.Error
  708. elif not require1 && reply.Status = Error && reply.State == state then
  709. reply.Status <- Ok
  710. reply.Result <- ""
  711. reply
  712. let manyStrings2 p1 p = manyStringsImpl false p1 p
  713. let manyStrings p = manyStrings2 p p
  714. let many1Strings2 p1 p = manyStringsImpl true p1 p
  715. let many1Strings p = many1Strings2 p p
  716. let skipped (p: Parser<unit,'u>) : Parser<string,'u> =
  717. fun state ->
  718. let reply = p state
  719. let result = if reply.Status = Ok then state.ReadUntil(reply.State) else ""
  720. Reply<_,_>(reply.Status, result, reply.Error, reply.State)
  721. let withSkippedString (f: string -> 'a -> 'b) (p: Parser<'a,'u>) : Parser<'b,'u> =
  722. let optF = OptimizedClosures.FastFunc2<_,_,_>.Adapt(f)
  723. fun state ->
  724. let reply = p state
  725. let result = if reply.Status = Ok then
  726. optF.Invoke(state.ReadUntil(reply.State), reply.Result)
  727. else Unchecked.defaultof<_>
  728. Reply<_,_>(reply.Status, result, reply.Error, reply.State)
  729. // ---------------
  730. // Parsing numbers
  731. // ---------------
  732. [<System.Flags>]
  733. type NumberLiteralOptions =
  734. | None = 0
  735. | AllowSuffix = 0b000000000001
  736. | AllowMinusSign = 0b000000000010
  737. | AllowPlusSign = 0b000000000100
  738. | AllowFraction = 0b000000001000
  739. | AllowFractionWOIntegerPart = 0b000000010000
  740. | AllowExponent = 0b000000100000
  741. | AllowHexadecimal = 0b000001000000
  742. | AllowBinary = 0b000010000000
  743. | AllowOctal = 0b000100000000
  744. | AllowInfinity = 0b001000000000
  745. | AllowNaN = 0b010000000000
  746. | DefaultInteger = 0b000111000110
  747. | DefaultUnsignedInteger = 0b000111000000
  748. | DefaultFloat = 0b011001101110
  749. type internal NLO = NumberLiteralOptions
  750. [<System.Flags>]
  751. type NumberLiteralResultFlags =
  752. | None = 0
  753. | SuffixLengthMask = 0b0000000000001111
  754. | HasMinusSign = 0b0000000000010000
  755. | HasPlusSign = 0b0000000000100000
  756. | HasIntegerPart = 0b0000000001000000
  757. | HasFraction = 0b0000000010000000
  758. | HasExponent = 0b0000000100000000
  759. | IsDecimal = 0b0000001000000000
  760. | IsHexadecimal = 0b0000010000000000
  761. | IsBinary = 0b0000100000000000
  762. | IsOctal = 0b0001000000000000
  763. | BaseMask = 0b0001111000000000
  764. | IsInfinity = 0b0010000000000000
  765. | IsNaN = 0b0100000000000000
  766. type internal NLF = NumberLiteralResultFlags
  767. type NumberLiteral(string, info, suffixChar1, suffixChar2, suffixChar3, suffixChar4) = struct
  768. member t.String = string
  769. member t.SuffixLength = int (info &&& NLF.SuffixLengthMask)
  770. member t.SuffixChar1 = suffixChar1
  771. member t.SuffixChar2 = suffixChar2
  772. member t.SuffixChar3 = suffixChar3
  773. member t.SuffixChar4 = suffixChar4
  774. member t.Info = info
  775. member t.HasMinusSign = int (info &&& NLF.HasMinusSign) <> 0
  776. member t.HasPlusSign = int (info &&& NLF.HasPlusSign) <> 0
  777. member t.HasIntegerPart = int (info &&& NLF.HasIntegerPart) <> 0
  778. member t.HasFraction = int (info &&& NLF.HasFraction) <> 0
  779. member t.HasExponent = int (info &&& NLF.HasExponent) <> 0
  780. member t.IsInteger = info &&& (NLF.HasIntegerPart ||| NLF.HasFraction ||| NLF.HasExponent) = NLF.HasIntegerPart
  781. member t.IsDecimal = int (info &&& NLF.IsDecimal) <> 0
  782. member t.IsHexadecimal = int (info &&& NLF.IsHexadecimal) <> 0
  783. member t.IsBinary = int (info &&& NLF.IsBinary) <> 0
  784. member t.IsOctal = int (info &&& NLF.IsOctal) <> 0
  785. member t.IsNaN = int (info &&& NLF.IsNaN) <> 0
  786. member t.IsInfinity = int (info &&& NLF.IsInfinity) <> 0
  787. end
  788. let numberLiteralE (opt: NumberLiteralOptions) (errorInCaseNoLiteralFound: ErrorMessageList) (state: State<'u>) =
  789. let mutable iter = state.Iter
  790. let mutable c = iter.Read()
  791. let mutable error = NoErrorMessages
  792. let mutable flags = NLF.None
  793. if c = '-' && int (opt &&& NLO.AllowMinusSign) <> 0 then
  794. flags <- NLF.HasMinusSign
  795. c <- iter._Increment()
  796. elif c = '+' && int (opt &&& NLO.AllowPlusSign) <> 0 then
  797. flags <- NLF.HasPlusSign
  798. c <- iter._Increment()
  799. let allowStartingPoint = NLO.AllowFraction ||| NLO.AllowFractionWOIntegerPart // for starting point both flags are required
  800. if isDigit c || (c = '.' && (opt &&& allowStartingPoint = allowStartingPoint)) then
  801. if int (opt &&& (NLO.AllowBinary ||| NLO.AllowOctal ||| NLO.AllowHexadecimal)) <> 0
  802. && c = '0'
  803. then
  804. match iter.Peek() with
  805. | 'b' | 'B' ->
  806. if int (opt &&& NLO.AllowBinary) <> 0 then
  807. flags <- flags ||| NLF.IsBinary
  808. c <- iter._Increment(2u)
  809. if c = '0' || c = '1' then
  810. flags <- flags ||| NLF.HasIntegerPart
  811. c <- iter._Increment()
  812. else
  813. error <- expectedBinaryDigit
  814. while c = '0' || c = '1' do
  815. c <- iter._Increment()
  816. | 'o' | 'O' ->
  817. if int (opt &&& NLO.AllowOctal) <> 0 then
  818. flags <- flags ||| NLF.IsOctal
  819. c <- iter._Increment(2u)
  820. if isOctal c then
  821. flags <- flags ||| NLF.HasIntegerPart
  822. c <- iter._Increment()
  823. else
  824. error <- expectedOctalDigit
  825. while isOctal c do
  826. c <- iter._Increment()
  827. | 'x' | 'X' ->
  828. if int (opt &&& NLO.AllowHexadecimal) <> 0 then
  829. flags <- flags ||| NLF.IsHexadecimal
  830. c <- iter._Increment(2u)
  831. if isHex c then
  832. flags <- flags ||| NLF.HasIntegerPart
  833. c <- iter._Increment()
  834. elif int (opt &&& NLO.AllowFractionWOIntegerPart) = 0 then
  835. // integer part required
  836. error <- expectedHexadecimalDigit
  837. while isHex c do
  838. c <- iter._Increment()
  839. if c = '.' && isNull error && int (opt &&& NLO.AllowFraction) <> 0 then
  840. flags <- flags ||| NLF.HasFraction
  841. c <- iter._Increment()
  842. if isHex c then
  843. c <- iter._Increment()
  844. elif int (flags &&& NLF.HasIntegerPart) = 0 then
  845. // at least one digit before or after the . is required
  846. error <- expectedHexadecimalDigit
  847. while isHex c do
  848. c <- iter._Increment()
  849. elif int (flags &&& NLF.HasIntegerPart) = 0 then
  850. // we neither have an integer part nor a fraction
  851. error <- expectedHexadecimalDigit
  852. if (c = 'p' || c = 'P') && isNull error && int (opt &&& NLO.AllowExponent) <> 0 then
  853. flags <- flags ||| NLF.HasExponent
  854. c <- iter._Increment()
  855. if c = '-' || c = '+' then
  856. c <- iter._Increment()
  857. if not (isDigit c) then
  858. error <- expectedDecimalDigit
  859. while isDigit c do
  860. c <- iter._Increment()
  861. | _ -> ()
  862. if int (flags &&& (NLF.IsBinary ||| NLF.IsOctal ||| NLF.IsHexadecimal)) = 0 then
  863. flags <- flags ||| NLF.IsDecimal
  864. if c <> '.' then
  865. flags <- flags ||| NLF.HasIntegerPart
  866. c <- iter._Increment()
  867. while isDigit c do
  868. c <- iter._Increment()
  869. if c = '.' && int (opt &&& NLO.AllowFraction) <> 0 then
  870. flags <- flags ||| NLF.HasFraction
  871. c <- iter._Increment()
  872. if isDigit c then
  873. c <- iter._Increment()
  874. elif int (flags &&& NLF.HasIntegerPart) = 0 then
  875. // at least one digit before or after the . is required
  876. error <- expectedDecimalDigit
  877. while isDigit c do
  878. c <- iter._Increment()
  879. if (c = 'e' || c = 'E') && isNull error && int (opt &&& NLO.AllowExponent) <> 0 then
  880. flags <- flags ||| NLF.HasExponent
  881. c <- iter._Increment()
  882. if c = '-' || c = '+' then
  883. c <- iter._Increment()
  884. if not (isDigit c) then
  885. error <- expectedDecimalDigit
  886. while isDigit c do
  887. c <- iter._Increment()
  888. if isNull error then
  889. let str = state.Iter.ReadUntil(iter)
  890. let mutable nSuffix = 0
  891. let mutable s1 = EOS
  892. let mutable s2 = EOS
  893. let mutable s3 = EOS
  894. let mutable s4 = EOS
  895. if int (opt &&& NLO.AllowSuffix) <> 0 && isNull error then
  896. if isAsciiLetter c then
  897. nSuffix <- 1
  898. s1 <- c
  899. c <- iter._Increment()
  900. if isAsciiLetter c then
  901. nSuffix <- nSuffix + 1
  902. s2 <- c
  903. c <- iter._Increment()
  904. if isAsciiLetter c then
  905. nSuffix <- nSuffix + 1
  906. s3 <- c
  907. c <- iter._Increment()
  908. if isAsciiLetter c then
  909. nSuffix <- nSuffix + 1
  910. s4 <- c
  911. c <- iter._Increment()
  912. flags <- flags ||| (enum) nSuffix
  913. let nl = NumberLiteral(str, flags, s1, s2, s3, s4)
  914. Reply<_,_>(nl, state.AdvanceTo(iter))
  915. else
  916. Reply<_,_>(Error, error, state.AdvanceTo(iter))
  917. else
  918. if int (opt &&& (NLO.AllowInfinity ||| NLO.AllowNaN)) <> 0 then
  919. if c = 'i' || c = 'I' then
  920. if int (opt &&& NLO.AllowInfinity) <> 0 then
  921. c <- iter.Peek(1u)
  922. if c = 'n' || c = 'N' then
  923. c <- iter.Peek(2u)
  924. if c = 'f' || c = 'F' then
  925. flags <- flags ||| NLF.IsInfinity
  926. c <- iter._Increment(3u)
  927. if c = 'i' || c = 'I' then
  928. c <- iter.Peek(1u)
  929. if c = 'n' || c = 'N' then
  930. c <- iter.Peek(2u)
  931. if c = 'i' || c = 'I' then
  932. c <- iter.Peek(3u)
  933. if c = 't' || c = 'T' then
  934. c <- iter.Peek(4u)
  935. if c = 'y' || c = 'Y' then
  936. iter._Increment(5u) |> ignore
  937. elif (c = 'n' || c = 'N') && int (opt &&& NLO.AllowNaN) <> 0 then
  938. c <- iter.Peek(1u)
  939. if c = 'a' || c = 'A' then
  940. c <- iter.Peek(2u)
  941. if c = 'n' || c = 'N' then
  942. flags <- flags ||| NLF.IsNaN
  943. iter._Increment(3u) |> ignore
  944. if int (flags &&& (NLF.IsInfinity ||| NLF.IsNaN)) <> 0 then
  945. Reply<_,_>(NumberLiteral(state.Iter.ReadUntil(iter), flags, EOS, EOS, EOS, EOS), state.AdvanceTo(iter))
  946. else
  947. Reply<_,_>(Error, errorInCaseNoLiteralFound, state)
  948. let pfloat : Parser<float,'u> =
  949. fun state ->
  950. // reply is mutable to prevent fsc from splitting up the function
  951. let mutable reply = numberLiteralE NLO.DefaultFloat expectedFloatingPointNumber state
  952. if reply.Status = Ok then
  953. let nl = reply.Result
  954. try
  955. let d = if nl.IsDecimal then
  956. System.Double.Parse(nl.String, System.Globalization.CultureInfo.InvariantCulture)
  957. elif nl.IsHexadecimal then
  958. floatOfHexString nl.String
  959. elif nl.IsInfinity then
  960. if nl.HasMinusSign then System.Double.NegativeInfinity else System.Double.PositiveInfinity
  961. else
  962. System.Double.NaN
  963. Reply<_,_>(d, reply.State)
  964. with e ->
  965. let msg = if (e :? System.OverflowException) then "This number is outside the allowable range for double precision floating-pointer numbers."
  966. elif (e :? System.FormatException) then "The floating-point number has an invalid format (this error is unexpected, please report this error message to fparsec@quanttec.com)."
  967. else rethrow()
  968. Reply<_,_>(FatalError, messageError msg, state)
  969. else Reply<_,_>(reply.Status, reply.Error, reply.State)
  970. let numberLiteral opt label = numberLiteralE opt (expectedError label)
  971. let internal raiseIntegerLiteralOutOfRange() =
  972. raise (System.OverflowException("integer number is either too large or too small"))
  973. // Does no argument checking and skips any sign.
  974. let internal integerNumberLiteralToUInt64 (s: string) (flags: NLF) =
  975. let mutable start =
  976. if int (flags &&& (NLF.HasMinusSign ||| NLF.HasPlusSign)) <> 0 then 1 else 0 // skip sign
  977. if int (flags &&& NLF.IsDecimal) = 0 then
  978. start <- start + 2 // skip base prefix
  979. while start < s.Length && s.[start] = '0' do
  980. start <- start + 1 // skip initial zeros
  981. let mutable n = 0UL
  982. match flags &&& NLF.BaseMask with
  983. | NLF.IsDecimal ->
  984. let nDigits = s.Length - start
  985. if nDigits > 20 || (nDigits = 20 && System.String.CompareOrdinal(s, start, "18446744073709551615", 0, 20) > 0) then
  986. raiseIntegerLiteralOutOfRange()
  987. for i = start to s.Length - 1 do
  988. let d = int s.[i] - int '0'
  989. n <- n*10UL + uint64 d
  990. | NLF.IsHexadecimal ->
  991. if s.Length - start > 16 then
  992. raiseIntegerLiteralOutOfRange()
  993. for i = start to s.Length - 1 do
  994. let c = int s.[i]
  995. let h = (c &&& 15) + (c >>> 6)*9 // converts hex char to int
  996. n <- (n <<< 4) + uint64 h
  997. | NLF.IsOctal ->
  998. let nOctal = s.Length - start
  999. if nOctal > 22 || nOctal = 22 && s.[start] > '1' then
  1000. raiseIntegerLiteralOutOfRange()
  1001. for i = start to s.Length - 1 do
  1002. let o = int s.[i] - int '0'
  1003. n <- (n <<< 3) + uint64 o
  1004. | _ (* NLF.IsBinary *) ->
  1005. if s.Length - start > 64 then
  1006. raiseIntegerLiteralOutOfRange()
  1007. for i = start to s.Length - 1 do
  1008. let b = int s.[i] - int '0'
  1009. n <- (n <<< 1) + uint64 b
  1010. n
  1011. let inline internal integerNumberLiteralToInt maxInt convert s flags =
  1012. let u = integerNumberLiteralToUInt64 s flags
  1013. if int (flags &&& NLF.HasMinusSign) = 0 then
  1014. if u > uint64 maxInt then raiseIntegerLiteralOutOfRange()
  1015. convert u
  1016. else
  1017. if u > uint64 maxInt + 1UL then raiseIntegerLiteralOutOfRange()
  1018. -(convert u)
  1019. let inline internal integerNumberLiteralToUInt maxUInt convert s flags =
  1020. let u = integerNumberLiteralToUInt64 s flags
  1021. if u > uint64 maxUInt then raiseIntegerLiteralOutOfRange()
  1022. convert u
  1023. let internal integerNumberLiteralToInt64 s flags = integerNumberLiteralToInt System.Int64.MaxValue int64 s flags
  1024. let internal integerNumberLiteralToInt32 s flags = integerNumberLiteralToInt System.Int32.MaxValue int32 s flags
  1025. let internal integerNumberLiteralToInt16 s flags = integerNumberLiteralToInt System.Int16.MaxValue int16 s flags
  1026. let internal integerNumberLiteralToInt8 s flags = integerNumberLiteralToInt System.SByte.MaxValue sbyte s flags
  1027. let internal integerNumberLiteralToUInt32 s flags = integerNumberLiteralToUInt System.UInt32.MaxValue uint32 s flags
  1028. let internal integerNumberLiteralToUInt16 s flags = integerNumberLiteralToUInt System.UInt16.MaxValue uint16 s flags
  1029. let internal integerNumberLiteralToUInt8 s flags = integerNumberLiteralToUInt System.Byte.MaxValue byte s flags
  1030. let inline internal pint flags numberLiteralToInt error overflowMessage =
  1031. fun state ->
  1032. let reply = numberLiteralE flags error state
  1033. if reply.Status = Ok then
  1034. try Reply<_,_>(numberLiteralToInt reply.Result.String reply.Result.Info, reply.State)
  1035. with :? System.OverflowException ->
  1036. Reply<_,_>(FatalError, messageError overflowMessage, state)
  1037. else Reply<_,_>(reply.Status, reply.Error, reply.State)
  1038. let pint64 = fun state -> pint NLO.DefaultInteger integerNumberLiteralToInt64 expectedInt64 "This number is outside the allowable range for 64-bit signed integers." state
  1039. let pint32 = fun state -> pint NLO.DefaultInteger integerNumberLiteralToInt32 expectedInt32 "This number is outside the allowable range for 32-bit signed integers." state
  1040. let pint16 = fun state -> pint NLO.DefaultInteger integerNumberLiteralToInt16 expectedInt16 "This number is outside the allowable range for 16-bit signed integers." state
  1041. let pint8 = fun state -> pint NLO.DefaultInteger integerNumberLiteralToInt8 expectedInt8 "This number is outside the allowable range for 8-bit signed integers." state
  1042. let puint64 = fun state -> pint NLO.DefaultUnsignedInteger integerNumberLiteralToUInt64 expectedUInt64 "This number is outside the allowable range for 64-bit unsigned integers." state
  1043. let puint32 = fun state -> pint NLO.DefaultUnsignedInteger integerNumberLiteralToUInt32 expectedUInt32 "This number is outside the allowable range for 32-bit unsigned integers." state
  1044. let puint16 = fun state -> pint NLO.DefaultUnsignedInteger integerNumberLiteralToUInt16 expectedUInt16 "This number is outside the allowable range for 16-bit unsigned integers." state
  1045. let puint8 = fun state -> pint NLO.DefaultUnsignedInteger integerNumberLiteralToUInt8 expectedUInt8 "This number is outside the allowable range for 8-bit unsigned integers." state
  1046. // -------------------
  1047. // Conditional parsing
  1048. // -------------------
  1049. let followedByChar c : Parser<unit,'u> =
  1050. if c <> '\r' && c <> '\n' then
  1051. let error = expectedError (quoteChar c)
  1052. fun state ->
  1053. if state.Iter.Match(c) then Reply<_,_>((), state)
  1054. else Reply<_,_>(Error, error, state)
  1055. else
  1056. let error = expectedNewline
  1057. fun state ->
  1058. let c = state.Iter.Read()
  1059. if c = '\r' || c = '\n' then Reply<_,_>((), state)
  1060. else Reply<_,_>(Error, error, state)
  1061. let notFollowedByChar c : Parser<unit,'u> =
  1062. if c <> '\r' && c <> '\n' then
  1063. let error = unexpectedError (quoteChar c)
  1064. fun state ->
  1065. if not (state.Iter.Match(c)) then Reply<_,_>((), state)
  1066. else Reply<_,_>(Error, error, state)
  1067. else
  1068. let error = unexpectedNewline
  1069. fun state ->
  1070. let c = state.Iter.Read()
  1071. if c <> '\r' && c <> '\n' then Reply<_,_>((), state)
  1072. else Reply<_,_>(Error, error, state)
  1073. let followedByString s : Parser<unit,'u> =
  1074. checkStringContainsNoNewlineChar s "followedByString"
  1075. let error = expectedError (quoteString s)
  1076. fun state ->
  1077. if state.Iter.Match(s) then Reply<_,_>((), state)
  1078. else Reply<_,_>(Error, error, state)
  1079. let notFollowedByString s : Parser<unit,'u> =
  1080. checkStringContainsNoNewlineChar s "notFollowedByString"
  1081. let error = unexpectedError (quoteString s)
  1082. fun state ->
  1083. if not (state.Iter.Match(s)) then Reply<_,_>((), state)
  1084. else Reply<_,_>(Error, error, state)
  1085. let inline charSatisfies c f =
  1086. if isCertainlyNoNLOrEOS c then
  1087. if f c then Ok else Error
  1088. elif c = '\r' || c = '\n' then
  1089. if f '\n' then Ok else Error
  1090. else
  1091. if c <> EOS && f c then Ok else Error
  1092. let inline charSatisfiesNot c f =
  1093. if isCertainlyNoNLOrEOS c then
  1094. if not (f c) then Ok else Error
  1095. elif c = '\r' || c = '\n' then
  1096. if not (f '\n') then Ok else Error
  1097. else
  1098. if c = EOS || not (f c) then Ok else Error
  1099. let nextCharSatisfies f : Parser<unit,'u> =
  1100. fun state ->
  1101. let c = state.Iter.Peek()
  1102. Reply<unit,_>(charSatisfies c f, NoErrorMessages, state)
  1103. let nextCharSatisfiesNot f : Parser<unit,'u> =
  1104. fun state ->
  1105. let c = state.Iter.Peek()
  1106. Reply<unit,_>(charSatisfiesNot c f, NoErrorMessages, state)
  1107. let previousCharSatisfies f : Parser<unit,'u> =
  1108. fun state ->
  1109. let c = state.Iter.Peek(-1)
  1110. Reply<unit,_>(charSatisfies c f, NoErrorMessages, state)
  1111. let previousCharSatisfiesNot f : Parser<unit,'u> =
  1112. fun state ->
  1113. let c = state.Iter.Peek(-1)
  1114. Reply<unit,_>(charSatisfiesNot c f, NoErrorMessages, state)
  1115. let currentCharSatisfies f : Parser<unit,'u> =
  1116. fun state ->
  1117. let c = state.Iter.Read()
  1118. Reply<unit,_>(charSatisfies c f, NoErrorMessages, state)
  1119. let currentCharSatisfiesNot f : Parser<unit,'u> =
  1120. fun state ->
  1121. let c = state.Iter.Read()
  1122. Reply<unit,_>(charSatisfiesNot c f, NoErrorMessages, state)