Joseph Ferano
6b668e7d9d
vendor/json is vendor/edn's shape with one decision reversed. edn never allocates, so its tokens are views into the source buffer and escaped strings are refused for want of anywhere to put the unescaped copy. This one has an allocator, so it unescapes, and to unescape it copies — string-of is the only function in the package that allocates, and it copies even when there was no escape to resolve, because a Value whose lifetime depended on which bytes happened to be in it is not a contract anyone can hold. Odin answered the same question the same way: tokenizer.odin allocates nothing, parser.odin's unquote_string does the copy, and it clones in the no-escape branch too. What that buys is at the bottom of test/programs/json.flan, which is programs/edn.flan and programs/arena-edn.flan in one file because for JSON they are one claim. The source buffer is overwritten with `?` bytes while the document is live and the strings read back afterwards are still the strings. arena-edn's header has a section admitting it cannot do that. Strict JSON and not Odin's JSON5 default, and the difference is where most of the refusals come from: comments, single quotes, +1, .5, 1., 0x1f, 01, NaN, Infinity and unquoted keys each get a sentence naming the dialect they belong to, rather than one shared unexpected-byte. A lone surrogate is refused too, and that one is forced rather than chosen — rune-size answers None for the whole D800-DFFF block, so encode-rune! would write nothing and the character would vanish.
746 lines
36 KiB
Plaintext
746 lines
36 KiB
Plaintext
;;;; A JSON tokenizer, in Flan, over a [u8].
|
|
;;;;
|
|
;;;; The shape is vendor/edn's, deliberately: a Cursor over a caller's buffer,
|
|
;;;; one `next` that answers a Token, errors accumulated on the cursor with the
|
|
;;;; byte offset they were found at, and every refusal named and given a reason
|
|
;;;; reachable as (json/error-message code). Read vendor/edn/edn.flan first if
|
|
;;;; you have not; everything that file argues for is argued for there and only
|
|
;;;; the differences are argued for here.
|
|
;;;;
|
|
;;;; The differences are the whole of what is interesting, so they are first.
|
|
;;;;
|
|
;;;; ── Where this DIVERGES from vendor/edn: strings are copied ──────────
|
|
;;;;
|
|
;;;; edn's tokens are views and the package never allocates. That is a real
|
|
;;;; decision there and it does not carry over, because it forced a second one:
|
|
;;;; edn refuses escaped strings outright, since unescaping "a\nb" needs three
|
|
;;;; bytes that exist nowhere in the input and there was no allocator to put
|
|
;;;; them in. JSON without escapes is not JSON — \n and \uXXXX are how the
|
|
;;;; format writes a newline and a non-ASCII character at all — so this package
|
|
;;;; unescapes, and to unescape it allocates.
|
|
;;;;
|
|
;;;; The split follows Odin's, which faced the same question and answered it in
|
|
;;;; two files: core/encoding/json/tokenizer.odin allocates nothing and hands
|
|
;;;; back the raw literal including its quotes, and parser.odin's
|
|
;;;; unquote_string does the copy against an allocator. So here too:
|
|
;;;;
|
|
;;;; * a Token's `text` is a slice INTO the buffer, exactly as edn's is, and
|
|
;;;; for a string token it is the RAW interior — backslashes and all;
|
|
;;;; * (json/string-of t) is the one call that allocates. It answers a
|
|
;;;; string whose bytes are a fresh copy in the context's allocator, with
|
|
;;;; every escape resolved.
|
|
;;;;
|
|
;;;; string-of copies even when there is no escape to resolve, where handing
|
|
;;;; back the view would have been free. That is Odin's call too — parser.odin
|
|
;;;; clones in the no-escape branch (:388) and types.odin's destroy_value frees
|
|
;;;; every String it finds (:96) — and the reason is that the alternative is a
|
|
;;;; value whose lifetime depends on which bytes happened to be in it. A
|
|
;;;; document read into an arena and then released by one free-all has to take
|
|
;;;; its strings with it; one that sometimes aliased the source buffer would
|
|
;;;; survive the free-all in the cases that had no escapes and not in the
|
|
;;;; others, which is the kind of contract nobody can hold in their head.
|
|
;;;;
|
|
;;;; Note what that buys against test/programs/arena-edn.flan, whose header has
|
|
;;;; a section called "One lifetime that is not the region's" for exactly this:
|
|
;;;; its Values point back at `src` and outlive the arena. A Value built out of
|
|
;;;; string-of does not. The source buffer is dead the moment the read returns.
|
|
;;;;
|
|
;;;; ── The allocator ───────────────────────────────────────────────────
|
|
;;;;
|
|
;;;; string-of names no allocator and takes no parameter. spec-memory.md puts
|
|
;;;; the allocator in the calling convention, so the (vec-new u8) inside it
|
|
;;;; takes the context's, and (with-allocator frame (json/string-of t)) is the
|
|
;;;; whole of "reading against an arena". An explicit allocator at the
|
|
;;;; construction site would override that, which is how this would take one if
|
|
;;;; the idiom could not express it. It can.
|
|
;;;;
|
|
;;;; ── Strict JSON, on the record ──────────────────────────────────────
|
|
;;;;
|
|
;;;; Odin's DEFAULT_SPECIFICATION is JSON5, and its tokenizer carries a `spec`
|
|
;;;; field to switch between three dialects. This one has no such field and
|
|
;;;; reads strict JSON only. A dialect parameter is a run-time branch in every
|
|
;;;; byte class, and the caller who wants JSON5 wants a different file.
|
|
;;;;
|
|
;;;; So this is STRICTER than its reference, and the strictness is where the
|
|
;;;; refusals come from. Each one below is a thing a hand-written file really
|
|
;;;; contains, named separately so the message says what to remove:
|
|
;;;;
|
|
;;;; comments // and /* — legal in JSON5, not in JSON. The single
|
|
;;;; most common reason a config file fails to parse.
|
|
;;;; single quotes 'x' — legal in JSON5.
|
|
;;;; +1 — a leading plus is JSON5's.
|
|
;;;; .5 and 1. — JSON5 allows a bare leading or trailing
|
|
;;;; decimal point. Worth contrasting with edn.flan, which
|
|
;;;; goes the other way and reads `.5` as a float on
|
|
;;;; purpose; here it is an error, and named.
|
|
;;;; 0x1f — hexadecimal is JSON5's.
|
|
;;;; 01 — JSON's number grammar allows a leading
|
|
;;;; zero only when the zero is the whole integer part.
|
|
;;;; NaN, Infinity — JSON5 has both and JSON has neither, and
|
|
;;;; there is no spelling of either in the format.
|
|
;;;; bare words {name: 1} — an unquoted object key is JSON5's. Named
|
|
;;;; rather than folded into "unexpected byte" because the
|
|
;;;; byte is a perfectly ordinary letter and the message
|
|
;;;; has to say what is wrong with it.
|
|
;;;; \v \0 \x41 \' — JSON has exactly nine escapes and these
|
|
;;;; are not among them.
|
|
;;;; a raw control byte inside a string — JSON requires anything below 0x20
|
|
;;;; to be escaped. A literal tab inside a literal is the
|
|
;;;; one a file written by hand actually hits.
|
|
;;;;
|
|
;;;; Whitespace is space, tab, newline and carriage return, which is exactly
|
|
;;;; JSON's set and exactly what the prelude's space? answers, so there is no
|
|
;;;; ws? of its own here. A vertical tab or a form feed between values is an
|
|
;;;; unexpected byte, which is correct and worth knowing before it surprises
|
|
;;;; someone: JSON5 allows both.
|
|
;;;;
|
|
;;;; ── Separators are tokens ───────────────────────────────────────────
|
|
;;;;
|
|
;;;; `,` and `:` come back as tok-comma and tok-colon rather than being skipped
|
|
;;;; as trivia, which is the other visible difference from edn — where a comma
|
|
;;;; IS whitespace and is not a token at all. JSON's commas are grammar: [1 2]
|
|
;;;; is malformed and a tokenizer that swallowed the separator would hand a
|
|
;;;; reader no way to notice. Placement is the reader's to check, the way
|
|
;;;; balance is not: the cursor tracks what is open because it has the position
|
|
;;;; for the closer, and it does not track what a comma may follow because that
|
|
;;;; is a grammar with a stack of its own.
|
|
;;;;
|
|
;;;; ── Errors ──────────────────────────────────────────────────────────
|
|
;;;;
|
|
;;;; On the cursor, not in the return type — edn's argument, unchanged: an
|
|
;;;; editor underlines a byte range and an Option has nowhere to put one. A
|
|
;;;; failed cursor is poisoned and keeps answering the same error token without
|
|
;;;; advancing, so a `while` over a malformed document terminates.
|
|
;;;;
|
|
;;;; Escapes are validated where they are SCANNED and not where they are
|
|
;;;; unescaped. read-string walks every byte of the literal already, so it is
|
|
;;;; the only place that still knows the offset of the offending backslash;
|
|
;;;; string-of works over a literal the cursor has already accepted and cannot
|
|
;;;; fail on its contents. That is also Odin's split — its scan_escape runs in
|
|
;;;; get_token — and it is why string-of is an (Option string) on the token's
|
|
;;;; kind alone and not on its bytes.
|
|
|
|
;; ── Token kinds ─────────────────────────────────────────────────────
|
|
;;
|
|
;; Plain i32 constants and not a `defenum`, for the reason vendor/edn gives:
|
|
;; `=` on an Enum value fails in emit and a keyword is not a pattern, so an
|
|
;; enum here would be a token kind a caller could not branch on.
|
|
|
|
(defconst tok-eof 0) ; the input is exhausted; text is empty
|
|
(defconst tok-error 1) ; see (json/error c) and (json/error-message ...)
|
|
(defconst tok-null 2) ; null
|
|
(defconst tok-bool 3) ; true / false — text is the word
|
|
(defconst tok-int 4) ; a number with no fraction and no exponent
|
|
(defconst tok-float 5) ; a number with either
|
|
(defconst tok-string 6) ; text is the RAW interior, without the quotes
|
|
(defconst tok-array-open 7) ; [
|
|
(defconst tok-array-close 8) ; ]
|
|
(defconst tok-object-open 9) ; {
|
|
(defconst tok-object-close 10) ; }
|
|
(defconst tok-colon 11) ; :
|
|
(defconst tok-comma 12) ; ,
|
|
|
|
;; ── Error codes ─────────────────────────────────────────────────────
|
|
|
|
(defconst err-none 0)
|
|
(defconst err-unexpected-byte 1)
|
|
(defconst err-unterminated 2)
|
|
(defconst err-control-char 3) ; a raw byte below 0x20 inside a string
|
|
(defconst err-bad-escape 4) ; refusal: not one of JSON's nine
|
|
(defconst err-bad-unicode 5) ; \u without four hex digits after it
|
|
(defconst err-lone-surrogate 6)
|
|
(defconst err-comment 7) ; refusal
|
|
(defconst err-single-quote 8) ; refusal
|
|
(defconst err-leading-plus 9) ; refusal
|
|
(defconst err-leading-dot 10) ; refusal
|
|
(defconst err-trailing-dot 11) ; refusal
|
|
(defconst err-hex-number 12) ; refusal
|
|
(defconst err-leading-zero 13) ; refusal
|
|
(defconst err-nan-inf 14) ; refusal
|
|
(defconst err-bare-word 15) ; refusal
|
|
(defconst err-bad-number 16)
|
|
(defconst err-unbalanced 17) ; a closer that does not match what is open
|
|
(defconst err-too-deep 18)
|
|
(defconst err-unexpected-token 19) ; raised by a caller, not by the tokenizer
|
|
(defconst err-trailing-comma 20) ; raised by a caller; refusal
|
|
|
|
;; How deep a nesting the balance check can follow. A fixed array in the Cursor
|
|
;; and not a growable stack: the cursor is the half of this package that does
|
|
;; not allocate, and keeping it that way is what lets a caller tokenize with no
|
|
;; allocator bound at all. 32 is past anything hand-written, and past it the
|
|
;; answer is err-too-deep rather than a silently unchecked closer.
|
|
(defconst max-depth 32)
|
|
|
|
;; ── The types ───────────────────────────────────────────────────────
|
|
|
|
;; `text` is a slice of the Cursor's `src`, and for tok-string it is the raw
|
|
;; interior: the bytes between the quotes, escapes unresolved. (string-of t) is
|
|
;; what turns that into text you can keep.
|
|
;;
|
|
;; `pos` is the offset of the token's first byte in the ORIGINAL buffer — of
|
|
;; the opening quote for a string, not of its contents — so it stays a usable
|
|
;; underline position even where `text` is narrower than the token.
|
|
(defstruct Token
|
|
[kind i32
|
|
text [u8]
|
|
pos i32])
|
|
|
|
;; The cursor owns no storage: `src` is the caller's buffer.
|
|
;;
|
|
;; `open` is the stack of delimiters still open, holding the tok-*-close kind
|
|
;; each one waits for, so that {"a": [1} fails at the brace with a position
|
|
;; rather than confusing a reader two levels up.
|
|
(defstruct Cursor
|
|
[src [u8]
|
|
pos i32
|
|
err i32
|
|
err-pos i32
|
|
open [max-depth i32]
|
|
depth i32])
|
|
|
|
;; ── Construction ────────────────────────────────────────────────────
|
|
|
|
(defn cursor [src [u8]] Cursor
|
|
(Cursor {.src src .pos 0 .err err-none .err-pos 0 .depth 0}))
|
|
|
|
(defn ok? [c (Ptr Cursor)] bool
|
|
(= (.err c) err-none))
|
|
|
|
(defn error [c (Ptr Cursor)] i32
|
|
(.err c))
|
|
|
|
(defn error-pos [c (Ptr Cursor)] i32
|
|
(.err-pos c))
|
|
|
|
;; Each refusal names itself and says why, so a document that uses one fails
|
|
;; with the sentence explaining what to do about it rather than with a code.
|
|
;; Most of these say "JSON5" somewhere, because most of them are a thing that
|
|
;; is legal in the dialect the file was probably written for.
|
|
(defn error-message [code i32] string
|
|
(cond
|
|
(= code err-none) "no error"
|
|
(= code err-unexpected-byte) "unexpected byte: not the start of any JSON value"
|
|
(= code err-unterminated) "unterminated string: end of input before the closing quote"
|
|
(= code err-control-char) "a raw control byte inside a string: JSON requires anything below 0x20 to be written as an escape"
|
|
(= code err-bad-escape) "unknown escape: JSON has \\\" \\\\ \\/ \\b \\f \\n \\r \\t and \\uXXXX, and nothing else"
|
|
(= code err-bad-unicode) "bad \\u escape: four hexadecimal digits have to follow it"
|
|
(= code err-lone-surrogate) "lone surrogate: \\uD800-\\uDFFF is half of a pair and encodes no character on its own"
|
|
(= code err-comment) "comments are refused: // and /* are JSON5, and JSON has no comment syntax"
|
|
(= code err-single-quote) "single-quoted strings are refused: they are JSON5, and JSON quotes with \""
|
|
(= code err-leading-plus) "a leading + is refused: it is JSON5, and JSON writes a positive number without a sign"
|
|
(= code err-leading-dot) "a number cannot begin with a decimal point: write 0.5 rather than .5"
|
|
(= code err-trailing-dot) "a number cannot end with a decimal point: digits have to follow it"
|
|
(= code err-hex-number) "hexadecimal numbers are refused: 0x is JSON5, and JSON has decimal only"
|
|
(= code err-leading-zero) "a leading zero is refused: JSON allows 0 as a whole integer part and nothing in front of another digit"
|
|
(= code err-nan-inf) "NaN and Infinity are refused: they are JSON5, and JSON has no spelling for either"
|
|
(= code err-bare-word) "an unquoted name is refused: bare keys and identifiers are JSON5, and JSON quotes every string"
|
|
(= code err-bad-number) "not a number: the token starts like one but does not match JSON's number grammar"
|
|
(= code err-unbalanced) "unbalanced: this closing delimiter does not match the one that is open"
|
|
(= code err-too-deep) "nesting is too deep: the balance stack is a fixed array and it is full"
|
|
(= code err-unexpected-token) "unexpected token: not the kind the caller was reading"
|
|
(= code err-trailing-comma) "trailing comma: it is JSON5, and JSON has no separator before a closing bracket"
|
|
:else "unknown error code"))
|
|
|
|
;; Marks the cursor failed. Public, because a caller's own reader has to report
|
|
;; "expected a colon here" with a position the same way this file does, and
|
|
;; there is nowhere else the position would come from.
|
|
;;
|
|
;; The first failure wins: a later one would overwrite the offset that explains
|
|
;; the document with an offset that is merely downstream of it.
|
|
(defn fail [c (Ptr Cursor) code i32 pos i32] ()
|
|
(when (= (.err c) err-none)
|
|
(set (.err c) code)
|
|
(set (.err-pos c) pos)))
|
|
|
|
;; ── Byte classes ────────────────────────────────────────────────────
|
|
|
|
;; Everything that ends an unquoted token. `/` is in here because a comment can
|
|
;; start against the byte before it — `1//x` — and a scanner that stopped only
|
|
;; on whitespace and brackets would read `1//x` as one atom and then report a
|
|
;; bad number instead of a comment.
|
|
(defn delim? [b u8] bool
|
|
(or (space? b)
|
|
(= b \() (= b \)) (= b \[) (= b \]) (= b \{) (= b \})
|
|
(= b \") (= b \') (= b \,) (= b \:) (= b \/)))
|
|
|
|
(defn alpha? [b u8] bool
|
|
(or (and (>= b \a) (<= b \z))
|
|
(and (>= b \A) (<= b \Z))))
|
|
|
|
(defn hex? [b u8] bool
|
|
(or (digit? b)
|
|
(and (>= b \a) (<= b \f))
|
|
(and (>= b \A) (<= b \F))))
|
|
|
|
(defn hex-val [b u8] i32
|
|
(cond
|
|
(digit? b) (- (i32 b) (i32 \0))
|
|
(and (>= b \a) (<= b \f)) (+ 10 (- (i32 b) (i32 \a)))
|
|
:else (+ 10 (- (i32 b) (i32 \A)))))
|
|
|
|
;; ── Internal helpers ────────────────────────────────────────────────
|
|
;;
|
|
;; "Internal" by intent and not by enforcement: a package has no visibility
|
|
;; yet, so json/scan-atom and json/push-open are as callable as json/next is.
|
|
;; Nothing below is part of the API and none of it will keep its shape.
|
|
|
|
(defn at-end? [c (Ptr Cursor)] bool
|
|
(>= (.pos c) (len (.src c))))
|
|
|
|
;; An empty slice of src, positioned at p. Used for the tokens that have no
|
|
;; text of their own — eof, error, and every delimiter — so that `text` has one
|
|
;; meaning for every token kind and not two.
|
|
(defn empty-at [c (Ptr Cursor) p i32] [u8]
|
|
(slice (.src c) p p))
|
|
|
|
(defn token [c (Ptr Cursor) kind i32 lo i32 hi i32 p i32] Token
|
|
(Token {.kind kind .text (slice (.src c) lo hi) .pos p}))
|
|
|
|
(defn error-token [c (Ptr Cursor)] Token
|
|
(Token {.kind tok-error .text (empty-at c (.err-pos c)) .pos (.err-pos c)}))
|
|
|
|
;; Whitespace only. There is no comment case here and there is deliberately no
|
|
;; comment case anywhere: a `/` reaches the dispatch and is refused by name.
|
|
(defn skip-trivia [c (Ptr Cursor)] ()
|
|
(while (and (not (at-end? c)) (space? (at (.src c) (.pos c))))
|
|
(set (.pos c) (+ (.pos c) 1))))
|
|
|
|
;; The end of the unquoted token starting at lo: the first delimiter, or the
|
|
;; end of input.
|
|
(defn scan-atom [c (Ptr Cursor) lo i32] i32
|
|
(let [i lo]
|
|
(while (and (< i (len (.src c))) (not (delim? (at (.src c) i))))
|
|
(set i (+ i 1)))
|
|
i))
|
|
|
|
(defn push-open [c (Ptr Cursor) closer i32 p i32] bool
|
|
(when (>= (.depth c) max-depth)
|
|
(fail c err-too-deep p)
|
|
(return false))
|
|
(set (at (.open c) (.depth c)) closer)
|
|
(set (.depth c) (+ (.depth c) 1))
|
|
true)
|
|
|
|
(defn pop-close [c (Ptr Cursor) closer i32 p i32] bool
|
|
(when (or (= (.depth c) 0)
|
|
(!= (at (.open c) (- (.depth c) 1)) closer))
|
|
(fail c err-unbalanced p)
|
|
(return false))
|
|
(set (.depth c) (- (.depth c) 1))
|
|
true)
|
|
|
|
;; ── Numbers ─────────────────────────────────────────────────────────
|
|
|
|
;; What enters read-number. A digit or a `-` is JSON's own rule; `+` and `.`
|
|
;; are here so that they reach the scanner and get the refusal that names them,
|
|
;; instead of falling through to "unexpected byte" — which would be true and
|
|
;; would not tell anyone that the fix is to write 0.5.
|
|
(defn number-start? [b u8] bool
|
|
(or (digit? b) (= b \-) (= b \+) (= b \.)))
|
|
|
|
;; JSON's number grammar, written out rather than left to parse-i64: -?(0 |
|
|
;; [1-9][0-9]*)(.[0-9]+)?([eE][+-]?[0-9]+)?. Every one of the named refusals
|
|
;; below is a production this grammar does not have and JSON5's does, and each
|
|
;; is caught at the byte where the two diverge — so `0x1f` is reported as
|
|
;; hexadecimal and not as "12x"-style garbage, which is what a parse-first
|
|
;; scanner would have to call it.
|
|
;;
|
|
;; A number with neither a fraction nor an exponent is tok-int and anything
|
|
;; else is tok-float, so 1e3 is a float even though its value is whole. That is
|
|
;; the grammar's own split and not a guess about the caller's field.
|
|
(defn read-number [c (Ptr Cursor) lo i32] Token
|
|
(let [s (.src c)
|
|
i lo
|
|
float? false]
|
|
(when (= (at s lo) \+)
|
|
(set (.pos c) (+ lo 1)) (fail c err-leading-plus lo) (return (error-token c)))
|
|
(when (= (at s lo) \.)
|
|
(set (.pos c) (+ lo 1)) (fail c err-leading-dot lo) (return (error-token c)))
|
|
(when (= (at s i) \-)
|
|
(set i (+ i 1))
|
|
(when (or (>= i (len s)) (not (digit? (at s i))))
|
|
;; `-` with nothing usable after it. The scan-atom is only so that the
|
|
;; cursor lands past the whole bad token and not in the middle of it.
|
|
(set (.pos c) (scan-atom c lo))
|
|
(fail c err-bad-number lo)
|
|
(return (error-token c))))
|
|
|
|
;; The integer part, and the two shapes that are JSON5's.
|
|
(if (= (at s i) \0)
|
|
(do
|
|
(set i (+ i 1))
|
|
(when (and (< i (len s)) (or (= (at s i) \x) (= (at s i) \X)))
|
|
(set (.pos c) (scan-atom c lo)) (fail c err-hex-number lo) (return (error-token c)))
|
|
(when (and (< i (len s)) (digit? (at s i)))
|
|
(set (.pos c) (scan-atom c lo)) (fail c err-leading-zero lo) (return (error-token c))))
|
|
(while (and (< i (len s)) (digit? (at s i)))
|
|
(set i (+ i 1))))
|
|
|
|
;; The fraction. A dot with no digit after it is `1.` or `1.e3`, both of
|
|
;; which JSON5 accepts and JSON does not.
|
|
(when (and (< i (len s)) (= (at s i) \.))
|
|
(set float? true)
|
|
(set i (+ i 1))
|
|
(when (or (>= i (len s)) (not (digit? (at s i))))
|
|
(set (.pos c) (scan-atom c lo)) (fail c err-trailing-dot lo) (return (error-token c)))
|
|
(while (and (< i (len s)) (digit? (at s i)))
|
|
(set i (+ i 1))))
|
|
|
|
;; The exponent. Its sign is allowed where the number's own leading + was
|
|
;; not, which is JSON's rule and reads like an inconsistency until you have
|
|
;; seen 1e+3 in a file written by a serialiser.
|
|
(when (and (< i (len s)) (or (= (at s i) \e) (= (at s i) \E)))
|
|
(set float? true)
|
|
(set i (+ i 1))
|
|
(when (and (< i (len s)) (or (= (at s i) \+) (= (at s i) \-)))
|
|
(set i (+ i 1)))
|
|
(when (or (>= i (len s)) (not (digit? (at s i))))
|
|
(set (.pos c) (scan-atom c lo)) (fail c err-bad-number lo) (return (error-token c)))
|
|
(while (and (< i (len s)) (digit? (at s i)))
|
|
(set i (+ i 1))))
|
|
|
|
;; Whatever is left has to end the token. Without this `12x` and `1.5.5`
|
|
;; would be accepted as their own prefixes and the junk would be read as
|
|
;; the next value.
|
|
(when (and (< i (len s)) (not (delim? (at s i))))
|
|
(set (.pos c) (scan-atom c lo)) (fail c err-bad-number lo) (return (error-token c)))
|
|
|
|
(set (.pos c) i)
|
|
(let [text (slice s lo i)]
|
|
(when (not float?)
|
|
;; Grammar-legal and still not representable: an i64 has 19 digits and
|
|
;; JSON's integers have no bound. It is a number, so it becomes a float
|
|
;; rather than an error — which loses precision and says so here, since
|
|
;; the alternative is refusing a document over a field nobody reads.
|
|
(when (match (parse-i64 text) (Some _) true None false)
|
|
(return (token c tok-int lo i lo))))
|
|
(when (match (parse-f64 text) (Some _) true None false)
|
|
(return (token c tok-float lo i lo)))
|
|
(fail c err-bad-number lo)
|
|
(error-token c))))
|
|
|
|
;; ── Strings ─────────────────────────────────────────────────────────
|
|
|
|
;; Four hex digits starting at i, as a code point, or -1. Used twice — for an
|
|
;; escape and for the low half of a surrogate pair — which is the whole reason
|
|
;; it is a function.
|
|
(defn hex4 [c (Ptr Cursor) i i32] i32
|
|
(let [s (.src c)]
|
|
(when (> (+ i 4) (len s))
|
|
(return -1))
|
|
(let [v 0]
|
|
(dotimes [k 4]
|
|
(let [b (at s (+ i k))]
|
|
(when (not (hex? b))
|
|
(return -1))
|
|
(set v (+ (* v 16) (hex-val b)))))
|
|
v)))
|
|
|
|
(defn high-surrogate? [r i32] bool (and (>= r 0xd800) (<= r 0xdbff)))
|
|
(defn low-surrogate? [r i32] bool (and (>= r 0xdc00) (<= r 0xdfff)))
|
|
|
|
;; The whole reason this is not three lines. `text` is the interior, between
|
|
;; the quotes and RAW; `pos` is the opening quote, so an editor underlines the
|
|
;; literal and not its contents.
|
|
;;
|
|
;; Every escape is validated here, at the byte it starts on, because this is
|
|
;; the last place that knows that offset — string-of runs over a literal this
|
|
;; has already accepted, and an error out of it would have to point at the
|
|
;; token rather than at the backslash. Surrogate PAIRING is checked here too,
|
|
;; and not only escape syntax, so that string-of's encode-rune! can never be
|
|
;; handed a code point the prelude refuses.
|
|
(defn read-string [c (Ptr Cursor) lo i32] Token
|
|
(let [s (.src c)
|
|
i (+ lo 1)]
|
|
(while (< i (len s))
|
|
(let [b (at s i)]
|
|
(cond
|
|
(= b \")
|
|
(do (set (.pos c) (+ i 1))
|
|
(return (token c tok-string (+ lo 1) i lo)))
|
|
|
|
;; A literal tab or newline inside a literal. JSON says escape it;
|
|
;; this is the refusal a hand-written file actually meets.
|
|
(< b 0x20)
|
|
(do (set (.pos c) i) (fail c err-control-char i) (return (error-token c)))
|
|
|
|
(= b \\)
|
|
(do
|
|
(when (>= (+ i 1) (len s))
|
|
(set (.pos c) (+ i 1)) (fail c err-unterminated lo) (return (error-token c)))
|
|
(let [e (at s (+ i 1))]
|
|
(cond
|
|
(or (= e \") (= e \\) (= e \/) (= e \b)
|
|
(= e \f) (= e \n) (= e \r) (= e \t))
|
|
(set i (+ i 2))
|
|
|
|
(= e \u)
|
|
(let [r (hex4 c (+ i 2))]
|
|
(when (< r 0)
|
|
(set (.pos c) i) (fail c err-bad-unicode i) (return (error-token c)))
|
|
(set i (+ i 6))
|
|
;; A high surrogate has to be followed by \u and a low one.
|
|
;; A low one on its own, or a high one followed by anything
|
|
;; else, encodes no character: rune-size answers None for the
|
|
;; whole D800-DFFF block and encode-rune! writes nothing, so
|
|
;; the alternative to refusing here is a silently dropped
|
|
;; character later. That refusal is forced by the prelude
|
|
;; rather than chosen, and it is the reason the pairing rule
|
|
;; is in the tokenizer at all.
|
|
(when (high-surrogate? r)
|
|
(let [ok (and (< (+ i 1) (len s))
|
|
(= (at s i) \\)
|
|
(= (at s (+ i 1)) \u)
|
|
(low-surrogate? (hex4 c (+ i 2))))]
|
|
(when (not ok)
|
|
(set (.pos c) i) (fail c err-lone-surrogate (- i 6)) (return (error-token c)))
|
|
(set i (+ i 6))))
|
|
(when (low-surrogate? r)
|
|
(set (.pos c) i) (fail c err-lone-surrogate (- i 6)) (return (error-token c))))
|
|
|
|
:else
|
|
(do (set (.pos c) i) (fail c err-bad-escape i) (return (error-token c))))))
|
|
|
|
:else
|
|
(set i (+ i 1)))))
|
|
;; Ran off the end with the literal still open. Reported at the opening
|
|
;; quote: that is the byte a caller has to look at, not the end of the file.
|
|
(set (.pos c) i)
|
|
(fail c err-unterminated lo)
|
|
(error-token c)))
|
|
|
|
;; ── The dispatch ────────────────────────────────────────────────────
|
|
|
|
;; The one call a caller makes. Advances the cursor past the token it returns.
|
|
;;
|
|
;; A cursor that has already failed keeps answering the same error token and
|
|
;; does not advance, so `(while (!= (.kind t) tok-eof) ...)` terminates on a
|
|
;; malformed document instead of spinning.
|
|
(defn next [c (Ptr Cursor)] Token
|
|
(when (not (ok? c))
|
|
(return (error-token c)))
|
|
(skip-trivia c)
|
|
(when (at-end? c)
|
|
;; Something still open at the end of input is malformed, and the position
|
|
;; that helps is the end — the document stopped, not the value.
|
|
(when (> (.depth c) 0)
|
|
(fail c err-unbalanced (.pos c))
|
|
(return (error-token c)))
|
|
(return (Token {.kind tok-eof .text (empty-at c (.pos c)) .pos (.pos c)})))
|
|
|
|
(let [s (.src c)
|
|
lo (.pos c)
|
|
b (at s lo)]
|
|
(cond
|
|
;; ── Delimiters, each of which moves the balance stack ──────────
|
|
(= b \[)
|
|
(do (set (.pos c) (+ lo 1))
|
|
(if (push-open c tok-array-close lo)
|
|
(token c tok-array-open lo lo lo)
|
|
(error-token c)))
|
|
|
|
(= b \])
|
|
(do (set (.pos c) (+ lo 1))
|
|
(if (pop-close c tok-array-close lo)
|
|
(token c tok-array-close lo lo lo)
|
|
(error-token c)))
|
|
|
|
(= b \{)
|
|
(do (set (.pos c) (+ lo 1))
|
|
(if (push-open c tok-object-close lo)
|
|
(token c tok-object-open lo lo lo)
|
|
(error-token c)))
|
|
|
|
(= b \})
|
|
(do (set (.pos c) (+ lo 1))
|
|
(if (pop-close c tok-object-close lo)
|
|
(token c tok-object-close lo lo lo)
|
|
(error-token c)))
|
|
|
|
;; ── The separators, which are grammar and not trivia ───────────
|
|
(= b \:)
|
|
(do (set (.pos c) (+ lo 1)) (token c tok-colon lo lo lo))
|
|
|
|
(= b \,)
|
|
(do (set (.pos c) (+ lo 1)) (token c tok-comma lo lo lo))
|
|
|
|
(= b \")
|
|
(read-string c lo)
|
|
|
|
;; ── The refusals that have their own byte ──────────────────────
|
|
(= b \')
|
|
(do (set (.pos c) (+ lo 1)) (fail c err-single-quote lo) (error-token c))
|
|
|
|
;; Both comment forms, and a `/` that begins neither. The last is an
|
|
;; unexpected byte and not a comment, because saying "comments are
|
|
;; refused" about a stray slash would send someone looking for a comment
|
|
;; that is not there.
|
|
(= b \/)
|
|
(do (set (.pos c) (+ lo 1))
|
|
(if (and (< (+ lo 1) (len s))
|
|
(or (= (at s (+ lo 1)) \/) (= (at s (+ lo 1)) \*)))
|
|
(fail c err-comment lo)
|
|
(fail c err-unexpected-byte lo))
|
|
(error-token c))
|
|
|
|
;; ── Numbers, then the three words, then everything else ────────
|
|
(number-start? b)
|
|
(read-number c lo)
|
|
|
|
(alpha? b)
|
|
(let [hi (scan-atom c lo)]
|
|
(set (.pos c) hi)
|
|
(let [text (slice s lo hi)]
|
|
(cond
|
|
(bytes=? text (bytes "null")) (token c tok-null lo hi lo)
|
|
(bytes=? text (bytes "true")) (token c tok-bool lo hi lo)
|
|
(bytes=? text (bytes "false")) (token c tok-bool lo hi lo)
|
|
(bytes=? text (bytes "NaN")) (do (fail c err-nan-inf lo) (error-token c))
|
|
(bytes=? text (bytes "Infinity")) (do (fail c err-nan-inf lo) (error-token c))
|
|
:else (do (fail c err-bare-word lo) (error-token c)))))
|
|
|
|
:else
|
|
;; One byte forward before failing, so the offset is the offending byte
|
|
;; and a caller's loop cannot spin on it.
|
|
(do (set (.pos c) (+ lo 1))
|
|
(fail c err-unexpected-byte lo)
|
|
(error-token c)))))
|
|
|
|
;; ── Reading values out of a token ───────────────────────────────────
|
|
;;
|
|
;; Each checks the kind first. None for the wrong kind rather than a parse of
|
|
;; whatever bytes happened to be there.
|
|
|
|
(defn int-of [t Token] (Option i64)
|
|
(if (= (.kind t) tok-int) (parse-i64 (.text t)) None))
|
|
|
|
;; Accepts an integer token too: 1 and 1.0 are the same number, and a document
|
|
;; that writes 2 for a float field is not making a mistake.
|
|
(defn float-of [t Token] (Option f64)
|
|
(if (or (= (.kind t) tok-float) (= (.kind t) tok-int))
|
|
(parse-f64 (.text t))
|
|
None))
|
|
|
|
(defn bool-of [t Token] (Option bool)
|
|
(if (= (.kind t) tok-bool)
|
|
(Some (bytes=? (.text t) (bytes "true")))
|
|
None))
|
|
|
|
;; ── The one call that allocates ─────────────────────────────────────
|
|
|
|
;; A string token's text, unescaped, COPIED into the context's allocator. Read
|
|
;; the header before using it; the two rules that matter are:
|
|
;;
|
|
;; * the result does not point into the source buffer, so it outlives it —
|
|
;; which is the opposite of edn's contract and the whole reason this
|
|
;; function exists;
|
|
;; * it points into the allocator instead, so under an arena it dies with a
|
|
;; free-all and under the heap it is a block nobody has freed. There is no
|
|
;; third owner.
|
|
;;
|
|
;; The builder is a (Vec u8) and the answer is (string (as-slice b)) taken ONCE
|
|
;; at the end. That ordering is load-bearing rather than stylistic: a push
|
|
;; after the slice has been taken can grow the Vec into a new block, and in an
|
|
;; arena the old block is still mapped, so the already-taken string would go on
|
|
;; reading bytes that are no longer the answer. There is no (free b) either,
|
|
;; for the same reason — the returned string is that block.
|
|
;;
|
|
;; None only for a token that is not a string. Every way the bytes themselves
|
|
;; could be wrong was already refused by read-string, which is why this cannot
|
|
;; fail halfway through and leave a half-built answer behind.
|
|
(defn string-of [t Token] (Option string)
|
|
(when (!= (.kind t) tok-string)
|
|
(return None))
|
|
(let [s (.text t)
|
|
b (vec-new u8)
|
|
i 0]
|
|
(while (< i (len s))
|
|
(let [ch (at s i)]
|
|
(if (!= ch \\)
|
|
(do (push b ch) (set i (+ i 1)))
|
|
(let [e (at s (+ i 1))]
|
|
(cond
|
|
(= e \") (do (push b \") (set i (+ i 2)))
|
|
(= e \\) (do (push b \\) (set i (+ i 2)))
|
|
(= e \/) (do (push b \/) (set i (+ i 2)))
|
|
(= e \b) (do (push b (u8 8)) (set i (+ i 2)))
|
|
(= e \f) (do (push b (u8 12)) (set i (+ i 2)))
|
|
(= e \n) (do (push b \newline) (set i (+ i 2)))
|
|
(= e \r) (do (push b \return) (set i (+ i 2)))
|
|
(= e \t) (do (push b \tab) (set i (+ i 2)))
|
|
:else
|
|
;; \uXXXX, and the surrogate pair read-string has already proved
|
|
;; is there. The arithmetic is UTF-16's: the high half carries the
|
|
;; top ten bits of a code point above 0xffff and the low half the
|
|
;; bottom ten.
|
|
(let [r 0]
|
|
(dotimes [k 4]
|
|
(set r (+ (* r 16) (hex-val (at s (+ i 2 k))))))
|
|
(set i (+ i 6))
|
|
(when (high-surrogate? r)
|
|
(let [lo2 0]
|
|
(dotimes [k 4]
|
|
(set lo2 (+ (* lo2 16) (hex-val (at s (+ i 2 k))))))
|
|
(set i (+ i 6))
|
|
(set r (+ 0x10000
|
|
(bit-or (<< (- r 0xd800) 10) (- lo2 0xdc00))))))
|
|
;; A four-byte buffer and not a push per byte, because
|
|
;; encode-rune! is the prelude's answer for this and writing
|
|
;; the shifts again here would be a second copy of UTF-8.
|
|
(let [buf (array 4 u8)]
|
|
(match (encode-rune! (slice buf 0 4) r)
|
|
(Some w) (append! (addr b) (slice buf 0 w))
|
|
;; Unreachable: read-string refuses every code point
|
|
;; rune-size refuses. Written as a no-op rather than a trap
|
|
;; because a dropped character is not worth a crash and the
|
|
;; tokenizer is the place that already said no.
|
|
None (do)))))))))
|
|
(Some (string (as-slice b)))))
|
|
|
|
;; ── Reading past a value ────────────────────────────────────────────
|
|
|
|
;; Consumes exactly one value — a scalar, or a whole array or object with
|
|
;; everything nested inside it. This is what a reader calls on an object key it
|
|
;; does not know, so an extra field in a document is ignored rather than fatal.
|
|
;;
|
|
;; Iterative on the cursor's own balance depth and not recursive: the depth is
|
|
;; already tracked, and a recursive skip would put the nesting on the C stack
|
|
;; where a deep document is a crash rather than err-too-deep.
|
|
;;
|
|
;; The separators inside the skipped value are swallowed by the depth loop and
|
|
;; are not checked, which is the honest reading of "skip": a caller that wanted
|
|
;; the commas inside an unknown field validated wanted to read it.
|
|
(defn skip-value [c (Ptr Cursor)] bool
|
|
(let [start (.depth c)
|
|
t (next c)]
|
|
(when (not (ok? c))
|
|
(return false))
|
|
(when (= (.kind t) tok-eof)
|
|
(fail c err-unexpected-token (.pos t))
|
|
(return false))
|
|
(when (<= (.depth c) start)
|
|
(return true))
|
|
(while (> (.depth c) start)
|
|
(let [u (next c)]
|
|
(when (not (ok? c))
|
|
(return false))
|
|
(when (= (.kind u) tok-eof)
|
|
;; next already failed on the open depth; this is belt and braces.
|
|
(fail c err-unbalanced (.pos u))
|
|
(return false))))
|
|
true))
|
|
|
|
;; ── Expecting a kind ────────────────────────────────────────────────
|
|
|
|
;; The shape a reader is built out of: take the next token, and if it is not
|
|
;; the kind wanted, fail the cursor at that token's position with a reason. The
|
|
;; returned token is the error token in that case, so a caller that forgets to
|
|
;; test ok? still does not read a value out of the wrong kind — int-of and
|
|
;; string-of answer None for tok-error.
|
|
(defn expect [c (Ptr Cursor) kind i32] Token
|
|
(let [t (next c)]
|
|
(when (and (ok? c) (!= (.kind t) kind))
|
|
(fail c err-unexpected-token (.pos t))
|
|
(return (error-token c)))
|
|
t))
|