;;;; 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. ;;;; ;;;; ── 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 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 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))