Joseph Ferano
7a0b2b7803
Two things the motivating line wanted and could not have.
or-else and some? are the first prelude family over (Option $t), and the
first that declares no {:where} at all: they move the payload out or read
the tag, and neither is an operation a type variable has to be admitted
to. So they instantiate at every type, including the ones that own
storage — where the answer is a header onto one of the two buffers and
the branch not taken is still the caller's to free, which the comment
says because "or a default" reads like it consumes the default.
none? is declined as (not (some? o)), and an unwrap that signals on None
is declined for the reason file-size is an Option at all: absence is a
reply and not a fault, and whether an empty one is an error is the
caller's question.
edn/read-file is worth having for one fact the package already argued:
every string in a Value is a copy, so the source buffer is dead the
moment read returns and nothing outside the call can be holding it. It
slurps against the heap by name — the one allocator this package names,
because the buffer's life is inside the call and is not the caller's
tier to choose — defers the free for the transfer path, and passes
slurp's FileError straight through with both restarts armed. Folding a
missing file into None would collapse the very distinction the Option
exists for.
There is no json/read-file and json.flan now says why: a Token's text is
a slice into the caller's buffer, so the prerequisite is a json/read
answering a self-contained document, and there is no Value type there to
answer with.
The defvar initialiser in the motivating line is still refused as
computed, so edn-read.flan writes it as a defn and says so; everything
inside the with-allocator is verbatim.
764 lines
38 KiB
Plaintext
764 lines
38 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.
|
|
;;;;
|
|
;;;; ── 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))
|