flan/vendor/json/json.fln

805 lines
36 KiB
Plaintext

;;;; A JSON tokenizer, in Flan, over a [const 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.fln 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 vendor/edn/read.fln's dyn reader, which
;;;; settled the same question a different way: it takes no allocator at all,
;;;; because every string it produces is boxed onto the collector's heap on
;;;; the spot — read-value's "a document owns its strings" rule. This
;;;; package's split is the one to take when there is a context allocator to
;;;; put the copy in and a caller who may not want one for every string in the
;;;; document; the dyn reader's is the one to take when there is no allocator
;;;; in the picture at all. Either way, a Token's raw `text` is never what
;;;; outlives the read — only what string-of or the box copies out of it does.
;;;;
;;;; ── 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.fln, 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 is-space answers, so there is no
;;;; is-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.
;;;;
;;;; ── There is no json/read-file, and that is not an oversight ────────
;;;;
;;;; vendor/edn grew one and this did not, because the thing that made it safe
;;;; there is the thing this package does not have. `edn/read-file` can slurp a
;;;; buffer, read it, and free the buffer inside the one call only because
;;;; `edn/read` answers a Value whose every string is a copy — the source is
;;;; dead the moment the read returns. This package's whole surface is the
;;;; cursor, and a Token's `text` is a slice INTO the caller's buffer, which
;;;; the divergence section at the top of this file argues for at length. A
;;;; read-file here would hand back a cursor over memory it had just released.
;;;;
;;;; So the prerequisite is not two lines, it is a `json/read` answering a
;;;; self-contained document — and there is no Value type here to answer with.
;;;; Write that first and read-file follows it for free; until then the caller
;;;; holds the buffer, which is what the cursor's contract already says. What
;;;; DOES carry over is the prelude's or-else and is-some: string-of, int-of,
;;;; float-of and bool-of all answer an Option and all take them.
;;;;
;;;; ── 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 str) on the token's
;;;; kind alone and not on its bytes.
;; ── Token kinds ─────────────────────────────────────────────────────
;;
;; Plain i32 constants and not an `enum`, 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.
const tok-eof = 0 ; the input is exhausted; text is empty
const tok-error = 1 ; see json/error(c) and json/error-message(...)
const tok-null = 2 ; null
const tok-bool = 3 ; true / false — text is the word
const tok-int = 4 ; a number with no fraction and no exponent
const tok-float = 5 ; a number with either
const tok-string = 6 ; text is the RAW interior, without the quotes
const tok-array-open = 7 ; [
const tok-array-close = 8 ; ]
const tok-object-open = 9 ; {
const tok-object-close = 10 ; }
const tok-colon = 11 ; :
const tok-comma = 12 ; ,
;; ── Error codes ─────────────────────────────────────────────────────
const err-none = 0
const err-unexpected-byte = 1
const err-unterminated = 2
const err-control-char = 3 ; a raw byte below 0x20 inside a string
const err-bad-escape = 4 ; refusal: not one of JSON's nine
const err-bad-unicode = 5 ; \u without four hex digits after it
const err-lone-surrogate = 6
const err-comment = 7 ; refusal
const err-single-quote = 8 ; refusal
const err-leading-plus = 9 ; refusal
const err-leading-dot = 10 ; refusal
const err-trailing-dot = 11 ; refusal
const err-hex-number = 12 ; refusal
const err-leading-zero = 13 ; refusal
const err-nan-inf = 14 ; refusal
const err-bare-word = 15 ; refusal
const err-bad-number = 16
const err-unbalanced = 17 ; a closer that does not match what is open
const err-too-deep = 18
const err-unexpected-token = 19 ; raised by a caller, not by the tokenizer
const 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.
const 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.
struct Token(kind: i32, text: [const 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.
struct Cursor
src: [const u8]
pos: i32
err: i32
err-pos: i32
open: [max-depth i32]
depth: i32
;; ── Construction ────────────────────────────────────────────────────
fn cursor(src: [const u8]) -> Cursor
Cursor{.src src .pos 0 .err err-none .err-pos 0 .depth 0}
fn is-ok(c: Ptr(Cursor)) -> bool = c.err == err-none
fn error(c: Ptr(Cursor)) -> i32 = c.err
fn error-pos(c: Ptr(Cursor)) -> i32 = c.err-pos
;; 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.
fn error-message(code: i32) -> str
if code == err-none
"no error"
elif code == err-unexpected-byte
"unexpected byte: not the start of any JSON value"
elif code == err-unterminated
"unterminated string: end of input before the closing quote"
elif code == err-control-char
"a raw control byte inside a string: JSON requires anything below 0x20 to be written as an escape"
elif code == err-bad-escape
"unknown escape: JSON has \\\" \\\\ \\/ \\b \\f \\n \\r \\t and \\uXXXX, and nothing else"
elif code == err-bad-unicode
"bad \\u escape: four hexadecimal digits have to follow it"
elif code == err-lone-surrogate
"lone surrogate: \\uD800-\\uDFFF is half of a pair and encodes no character on its own"
elif code == err-comment
"comments are refused: // and /* are JSON5, and JSON has no comment syntax"
elif code == err-single-quote
"single-quoted strings are refused: they are JSON5, and JSON quotes with \""
elif code == err-leading-plus
"a leading + is refused: it is JSON5, and JSON writes a positive number without a sign"
elif code == err-leading-dot
"a number cannot begin with a decimal point: write 0.5 rather than .5"
elif code == err-trailing-dot
"a number cannot end with a decimal point: digits have to follow it"
elif code == err-hex-number
"hexadecimal numbers are refused: 0x is JSON5, and JSON has decimal only"
elif code == err-leading-zero
"a leading zero is refused: JSON allows 0 as a whole integer part and nothing in front of another digit"
elif code == err-nan-inf
"NaN and Infinity are refused: they are JSON5, and JSON has no spelling for either"
elif code == err-bare-word
"an unquoted name is refused: bare keys and identifiers are JSON5, and JSON quotes every string"
elif code == err-bad-number
"not a number: the token starts like one but does not match JSON's number grammar"
elif code == err-unbalanced
"unbalanced: this closing delimiter does not match the one that is open"
elif code == err-too-deep
"nesting is too deep: the balance stack is a fixed array and it is full"
elif code == err-unexpected-token
"unexpected token: not the kind the caller was reading"
elif 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.
fn fail(c: Ptr(Cursor), code: i32, pos: i32) -> ()
if c.err == err-none
c.err = code
c.err-pos = 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.
fn- is-delim(b: u8) -> bool
is-space(b) or b == \( or b == \) or b == \[ or b == \] or b == \{ or b == \} or b == \" or b == \' or b == \, or b == \: or b == \/
fn- is-alpha(b: u8) -> bool = (b >= \a and b <= \z) or (b >= \A and b <= \Z)
fn- is-hex(b: u8) -> bool
is-digit(b) or (b >= \a and b <= \f) or (b >= \A and b <= \F)
fn- hex-val(b: u8) -> i32
if is-digit(b)
i32(b) - i32(\0)
elif b >= \a and 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.
fn- is-at-end(c: Ptr(Cursor)) -> bool = c.pos >= length(c.src)
;; 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.
fn- empty-at(c: Ptr(Cursor), p: i32) -> [const u8] = slice(c.src, p, p)
fn- token(c: Ptr(Cursor), kind: i32, lo: i32, hi: i32, p: i32) -> Token
Token{.kind kind .text slice(c.src, lo, hi) .pos p}
fn- error-token(c: Ptr(Cursor)) -> Token
Token{.kind tok-error .text empty-at(c, c.err-pos) .pos c.err-pos}
;; 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.
fn- skip-trivia(c: Ptr(Cursor)) -> ()
while not is-at-end(c) and is-space(c.src[c.pos])
c.pos += 1
;; The end of the unquoted token starting at lo: the first delimiter, or the
;; end of input.
fn scan-atom(c: Ptr(Cursor), lo: i32) -> i32
let i = lo
while i < length(c.src) and not is-delim(c.src[i])
i += 1
i
fn push-open(c: Ptr(Cursor), closer: i32, p: i32) -> bool
if c.depth >= max-depth
fail(c, err-too-deep, p)
return false
c.open[c.depth] = closer
c.depth += 1
true
fn- pop-close(c: Ptr(Cursor), closer: i32, p: i32) -> bool
if c.depth == 0 or c.open[c.depth - 1] != closer
fail(c, err-unbalanced, p)
return false
c.depth -= 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.
fn- is-number-start(b: u8) -> bool
is-digit(b) or b == \- or b == \+ or 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.
fn- read-number(c: Ptr(Cursor), lo: i32) -> Token
let s = c.src
i = lo
is-float = false
if s[lo] == \+
c.pos = lo + 1
fail(c, err-leading-plus, lo)
return error-token(c)
if s[lo] == \.
c.pos = lo + 1
fail(c, err-leading-dot, lo)
return error-token(c)
if s[i] == \-
i += 1
if i >= length(s) or not is-digit(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.
c.pos = 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 s[i] == \0
i += 1
if i < length(s) and (s[i] == \x or s[i] == \X)
c.pos = scan-atom(c, lo)
fail(c, err-hex-number, lo)
return error-token(c)
if i < length(s) and is-digit(s[i])
c.pos = scan-atom(c, lo)
fail(c, err-leading-zero, lo)
return error-token(c)
else
while i < length(s) and is-digit(s[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.
if i < length(s) and s[i] == \.
is-float = true
i += 1
if i >= length(s) or not is-digit(s[i])
c.pos = scan-atom(c, lo)
fail(c, err-trailing-dot, lo)
return error-token(c)
while i < length(s) and is-digit(s[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.
if i < length(s) and (s[i] == \e or s[i] == \E)
is-float = true
i += 1
if i < length(s) and (s[i] == \+ or s[i] == \-)
i += 1
if i >= length(s) or not is-digit(s[i])
c.pos = scan-atom(c, lo)
fail(c, err-bad-number, lo)
return error-token(c)
while i < length(s) and is-digit(s[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.
if i < length(s) and not is-delim(s[i])
c.pos = scan-atom(c, lo)
fail(c, err-bad-number, lo)
return error-token(c)
c.pos = i
let text = slice(s, lo, i)
if not is-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.
if match(parse-i64(text), Some(_), true, None, false)
return token(c, tok-int, lo, i, lo)
if 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.
fn- hex4(c: Ptr(Cursor), i: i32) -> i32
let s = c.src
if i + 4 > length(s)
return -1
let v = 0
for k in range(4)
let b = s[i + k]
if not is-hex(b)
return -1
v = v * 16 + hex-val(b)
v
fn- is-high-surrogate(r: i32) -> bool = r >= 0xd800 and r <= 0xdbff
fn- is-low-surrogate(r: i32) -> bool = r >= 0xdc00 and 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.
fn- read-string(c: Ptr(Cursor), lo: i32) -> Token
let s = c.src
i = lo + 1
while i < length(s)
let b = s[i]
if b == \"
c.pos = 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.
elif b < 0x20
c.pos = i
fail(c, err-control-char, i)
return error-token(c)
elif b == \\
if i + 1 >= length(s)
c.pos = i + 1
fail(c, err-unterminated, lo)
return error-token(c)
let e = s[i + 1]
if e == \" or e == \\ or e == \/ or e == \b or e == \f or e == \n or e == \r or e == \t
i += 2
elif e == \u
let r = hex4(c, i + 2)
if r < 0
c.pos = i
fail(c, err-bad-unicode, i)
return error-token(c)
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.
if is-high-surrogate(r)
let ok = i + 1 < length(s) and s[i] == \\ and s[i + 1] == \u and is-low-surrogate(hex4(c, i + 2))
if not ok
c.pos = i
fail(c, err-lone-surrogate, i - 6)
return error-token(c)
i += 6
if is-low-surrogate(r)
c.pos = i
fail(c, err-lone-surrogate, i - 6)
return error-token(c)
else
c.pos = i
fail(c, err-bad-escape, i)
return error-token(c)
else
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.
c.pos = 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 t.kind != tok-eof ...` terminates on a
;; malformed document instead of spinning.
fn next(c: Ptr(Cursor)) -> Token
if not is-ok(c)
return error-token(c)
skip-trivia(c)
if is-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.
if c.depth > 0
fail(c, err-unbalanced, c.pos)
return error-token(c)
return Token{.kind tok-eof .text empty-at(c, c.pos) .pos c.pos}
let s = c.src
lo = c.pos
b = s[lo]
;; ── Delimiters, each of which moves the balance stack ──────────
if b == \[
c.pos = lo + 1
if push-open(c, tok-array-close, lo)
token(c, tok-array-open, lo, lo, lo)
else
error-token(c)
elif b == \]
c.pos = lo + 1
if pop-close(c, tok-array-close, lo)
token(c, tok-array-close, lo, lo, lo)
else
error-token(c)
elif b == \{
c.pos = lo + 1
if push-open(c, tok-object-close, lo)
token(c, tok-object-open, lo, lo, lo)
else
error-token(c)
elif b == \}
c.pos = lo + 1
if pop-close(c, tok-object-close, lo)
token(c, tok-object-close, lo, lo, lo)
else
error-token(c)
;; ── The separators, which are grammar and not trivia ───────────
elif b == \:
c.pos = lo + 1
token(c, tok-colon, lo, lo, lo)
elif b == \,
c.pos = lo + 1
token(c, tok-comma, lo, lo, lo)
elif b == \"
read-string(c, lo)
;; ── The refusals that have their own byte ──────────────────────
elif b == \'
c.pos = 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.
elif b == \/
c.pos = lo + 1
if lo + 1 < length(s) and (s[lo + 1] == \/ or s[lo + 1] == \*)
fail(c, err-comment, lo)
else
fail(c, err-unexpected-byte, lo)
error-token(c)
;; ── Numbers, then the three words, then everything else ────────
elif is-number-start(b)
read-number(c, lo)
elif is-alpha(b)
let hi = scan-atom(c, lo)
c.pos = hi
let text = slice(s, lo, hi)
if is-bytes-equal(text, bytes-view("null"))
token(c, tok-null, lo, hi, lo)
elif is-bytes-equal(text, bytes-view("true"))
token(c, tok-bool, lo, hi, lo)
elif is-bytes-equal(text, bytes-view("false"))
token(c, tok-bool, lo, hi, lo)
elif is-bytes-equal(text, bytes-view("NaN"))
fail(c, err-nan-inf, lo)
error-token(c)
elif is-bytes-equal(text, bytes-view("Infinity"))
fail(c, err-nan-inf, lo)
error-token(c)
else
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.
c.pos = 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.
fn int-of(t: Token) -> Option(i64)
if t.kind == tok-int then parse-i64(t.text) else 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.
fn float-of(t: Token) -> Option(f64)
if t.kind == tok-float or t.kind == tok-int then parse-f64(t.text) else None
fn bool-of(t: Token) -> Option(bool)
if t.kind == tok-bool
Some(is-bytes-equal(t.text, bytes-view("true")))
else
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 (str (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.
fn string-of(t: Token) -> Option(str)
if t.kind != tok-string
return None
let s = t.text
b = vec-new(u8)
i = 0
while i < length(s)
let ch = s[i]
if ch != \\
push(b, ch)
i += 1
else
let e = s[i + 1]
if e == \"
push(b, \")
i += 2
elif e == \\
push(b, \\)
i += 2
elif e == \/
push(b, \/)
i += 2
elif e == \b
push(b, u8(8))
i += 2
elif e == \f
push(b, u8(12))
i += 2
elif e == \n
push(b, \newline)
i += 2
elif e == \r
push(b, \return)
i += 2
elif e == \t
push(b, \tab)
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
for k in range(4)
r = r * 16 + hex-val(s[i + 2 + k])
i += 6
if is-high-surrogate(r)
let lo2 = 0
for k in range(4)
lo2 = lo2 * 16 + hex-val(s[i + 2 + k])
i += 6
r = 0x10000 + (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 -> ()
Some(str(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.
fn skip-value(c: Ptr(Cursor)) -> bool
let start = c.depth
t = next(c)
if not is-ok(c)
return false
if t.kind == tok-eof
fail(c, err-unexpected-token, t.pos)
return false
if c.depth <= start
return true
while c.depth > start
let u = next(c)
if not is-ok(c)
return false
if u.kind == tok-eof
;; next already failed on the open depth; this is belt and braces.
fail(c, err-unbalanced, u.pos)
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 is-ok still does not read a value out of the wrong kind — int-of and
;; string-of answer None for tok-error.
fn expect(c: Ptr(Cursor), kind: i32) -> Token
let t = next(c)
if is-ok(c) and t.kind != kind
fail(c, err-unexpected-token, t.pos)
return error-token(c)
t