JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A JSON document read into a value that outlives the bytes it came from

Browse Source 
vendor/json is vendor/edn's shape with one decision reversed. edn never
allocates, so its tokens are views into the source buffer and escaped
strings are refused for want of anywhere to put the unescaped copy. This
one has an allocator, so it unescapes, and to unescape it copies —
string-of is the only function in the package that allocates, and it
copies even when there was no escape to resolve, because a Value whose
lifetime depended on which bytes happened to be in it is not a contract
anyone can hold. Odin answered the same question the same way:
tokenizer.odin allocates nothing, parser.odin's unquote_string does the
copy, and it clones in the no-escape branch too.

What that buys is at the bottom of test/programs/json.flan, which is
programs/edn.flan and programs/arena-edn.flan in one file because for
JSON they are one claim. The source buffer is overwritten with `?` bytes
while the document is live and the strings read back afterwards are
still the strings. arena-edn's header has a section admitting it cannot
do that.

Strict JSON and not Odin's JSON5 default, and the difference is where
most of the refusals come from: comments, single quotes, +1, .5, 1.,
0x1f, 01, NaN, Infinity and unquoted keys each get a sentence naming the
dialect they belong to, rather than one shared unexpected-byte. A lone
surrogate is refused too, and that one is forced rather than chosen —
rune-size answers None for the whole D800-DFFF block, so encode-rune!
would write nothing and the character would vanish.
This commit is contained in:
Joseph Ferano 2026-09-18 23:03:29 +07:00
parent 233bb780b0
commit 6b668e7d9d
6 changed files with 1322 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
docs/REFERENCES.md
View File

@ -36,6 +36,15 @@ Most of what this repository copies. Places already cited in the notes:
the machinery the generics spike copied.
- `src/check_type.cpp:173-200` — `FieldFlag_using` and `FieldFlag_subtype`. Odin's answer to
"a function over anything with these fields": nominal embedding, not row polymorphism.
- `core/encoding/json/` — what `vendor/json` is written against. Three facts were read out of it
rather than recalled. `tokenizer.odin` allocates nothing and hands back the raw literal including
its quotes, while `parser.odin:320` `unquote_string` does the copy against an allocator — which is
the split `vendor/json` copies, and the reason its `string-of` is the only function in the package
that allocates. `parser.odin:388` clones even when the literal holds no escape at all, and
`types.odin:96` `destroy_value` frees every `String` it walks — together those settle that a
`Value` owns its strings unconditionally, which is what lets one `free-all` take a whole document.
And `types.odin:49` sets `DEFAULT_SPECIFICATION` to JSON5, not JSON: `vendor/json` deliberately
does not follow that one, and every refusal in it that names a dialect names this difference.
Two Odin facts worth keeping together, because conflating them has already caused one wrong note:
**`$T` procs are monomorphised, containers are type-erased.** Odin uses both and picks per case.

8
test/dune
View File

@ -24,8 +24,10 @@
(glob_files %{workspace_root}/vendor/raylib/*)
; The dev agent package: its Flan declarations and the C that implements them.
(glob_files %{workspace_root}/vendor/agent/*)
; The EDN tokenizer, which programs/edn.flan imports.
; The EDN tokenizer, which programs/edn.flan imports, and the JSON one,
; which programs/json.flan does.
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
; The ported raylib examples. Only one of them has a headless acceptance
; case, but it imports its example as a package and that example imports
; examples/digits.flan, so the directory has to be here whole.
@ -119,6 +121,7 @@
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/vendor/agent/*)
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
(glob_files %{workspace_root}/examples/*)
(glob_files programs/*.flan)
(glob_files programs/assets/*))
@ -153,6 +156,7 @@
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/vendor/agent/*)
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
(glob_files %{workspace_root}/examples/*)
(glob_files programs/*.flan)
(glob_files programs/assets/*)
@ -208,6 +212,7 @@
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/vendor/agent/*)
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
(glob_files %{workspace_root}/examples/*)
(glob_files programs/*.flan)
(glob_files programs/assets/*)
@ -368,6 +373,7 @@
(glob_files %{workspace_root}/vendor/raylib/*)
(glob_files %{workspace_root}/vendor/agent/*)
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
(glob_files %{workspace_root}/examples/*)
(glob_files programs/*.flan)
(glob_files programs/assets/*)

435
test/programs/json.flan Normal file
View File

@ -0,0 +1,435 @@
;;;; The JSON tokenizer, and a document read into a dynamic value in an arena.
;;;;
;;;; This is programs/edn.flan and programs/arena-edn.flan in one file, because
;;;; for JSON they are one claim. edn needed two programs: the tokenizer there
;;;; allocates nothing and hands back views, so the struct reader and the arena
;;;; reader are separate lanes over the same cursor. vendor/json copies its
;;;; strings into the allocator, so the cursor and the allocator cannot be
;;;; demonstrated apart — the interesting thing about a token is what
;;;; (json/string-of t) makes of it.
;;;;
;;;; The typed half — (read-json Enemy bytes), the compiler emitting a parser
;;;; from a compile-time walk over a struct's fields — does not exist and is
;;;; not attempted here. What is here is what a reader handed *no* target type
;;;; has to answer with: a Value naming itself through a (Vec Value) and a
;;;; (Map string Value).
;;;;
;;;; ── The one thing this proves that arena-edn.flan cannot ─────────────
;;;;
;;;; arena-edn's header has a section admitting that its strings are views into
;;;; the source buffer and outlive the region rather than dying with it. This
;;;; document does not have that hole, and the proof is at the bottom of main:
;;;; the source buffer is overwritten with `?` bytes while the Value is still
;;;; live, and the strings read back afterwards are still the strings. An
;;;; implementation that aliased the buffer — which is free, and which edn does
;;;; on purpose — prints question marks there.
;;;;
;;;; Everything else is the shape arena-edn already argued for: no teardown
;;;; anywhere, one (free-all frame) at the bottom, and read-value taking no
;;;; allocator because with-allocator around the call is what binds one.
;;;;
;;;; Every case below is one a plausible wrong version fails. Named where that
;;;; is not obvious.
(import json "vendor:json")
(defvar frame Allocator)
;; ── A dump of the token stream ──────────────────────────────────────
;;
;; One letter per kind, then the text in brackets, so both halves of every
;; token are asserted. A tokenizer that got the kinds right and the slices
;; wrong — off by the opening quote — would pass on the letters alone. The
;; text of a string token is the RAW interior, so an escape shows up here with
;; its backslash still on it; that is the divergence between the tokenizer and
;; string-of, and this is where it is visible.
(defn kind-letter [k i32] string
(cond
(= k json/tok-eof) "."
(= k json/tok-error) "!"
(= k json/tok-null) "n"
(= k json/tok-bool) "b"
(= k json/tok-int) "i"
(= k json/tok-float) "f"
(= k json/tok-string) "s"
(= k json/tok-array-open) "["
(= k json/tok-array-close) "]"
(= k json/tok-object-open) "{"
(= k json/tok-object-close) "}"
(= k json/tok-colon) ":"
(= k json/tok-comma) ","
:else "?"))
(defn dump [src string] ()
(let [b (bytes src)
c (json/cursor b)
t (json/next (addr c))]
(while (and (json/ok? (addr c)) (!= (.kind t) json/tok-eof))
(print (kind-letter (.kind t)))
(print "<")
(print (.text t))
(print ">")
(set t (json/next (addr c))))
(when (not (json/ok? (addr c)))
(print "ERR@")
(print (json/error-pos (addr c))))
(println "")))
;; The refusals. Asserted on the *reason* and not on the fact of failing: a
;; tokenizer answering one generic error for all of these would pass a test
;; that only checked that it stopped.
(defn refusal [src string] ()
(let [b (bytes src)
c (json/cursor b)]
(while (and (json/ok? (addr c))
(!= (.kind (json/next (addr c))) json/tok-eof)))
(print (json/error-pos (addr c)))
(print " ")
(print (json/error-message (json/error (addr c))))
(println "")))
;; ── The dynamic value ───────────────────────────────────────────────
(defdata Value
[(Null [])
(Bool [b bool])
(Int [n i64])
(Float [x f64])
(Text [s string])
(Array [items (Vec Value)])
(Object [entries (Map string Value)])])
;; One token in hand, and the cursor for whatever the token opens. An array and
;; an object recurse; everything else is a leaf.
;;
;; The two collection arms are longer than arena-edn's because JSON's commas
;; are grammar and EDN's are whitespace: after every element there has to be a
;; separator or a closer, and nothing else. A reader that skipped that check
;; would accept [1 2] and a trailing comma, which are the two things a file
;; written for JSON5 actually contains — so they are refused here, by name,
;; through json/fail on the cursor. Errors accumulate there rather than being
;; returned, which is why these can be straight loops with one test at the end.
;;
;; Written with a `more` flag rather than early returns because every arm has
;; to answer the partially built collection: a document that fails halfway is
;; still a Value, the cursor is what says it is not trustworthy, and a `return`
;; out of a cond arm would have to repeat the constructor at each of them.
(defn read-value [c (Ptr json/Cursor) t json/Token] Value
(cond
(= (.kind t) json/tok-bool)
(Value.Bool {.b (match (json/bool-of t) (Some v) v None false)})
(= (.kind t) json/tok-int)
(Value.Int {.n (match (json/int-of t) (Some v) v None (i64 0))})
(= (.kind t) json/tok-float)
(Value.Float {.x (match (json/float-of t) (Some v) v None 0.0)})
(= (.kind t) json/tok-string)
(Value.Text {.s (match (json/string-of t) (Some s) s None "")})
(= (.kind t) json/tok-array-open)
(let [items (vec-new Value)
u (json/next c)
more (and (json/ok? c) (!= (.kind u) json/tok-array-close))]
(while more
(push items (read-value c u))
(let [sep (json/next c)]
(cond
(not (json/ok? c)) (set more false)
(= (.kind sep) json/tok-array-close) (set more false)
(!= (.kind sep) json/tok-comma)
(do (json/fail c json/err-unexpected-token (.pos sep))
(set more false))
:else
(do (set u (json/next c))
;; A comma and then the closer. Named, because a trailing
;; comma is legal JSON5 and a reader that quietly allowed
;; it would be reading a different format than it claims.
;;
;; The fail is what ends the loop, through the ok? test
;; below it and not on its own — so these two are in this
;; order on purpose, and swapping them spins.
(when (= (.kind u) json/tok-array-close)
(json/fail c json/err-trailing-comma (.pos u)))
(when (not (json/ok? c))
(set more false))))))
(Value.Array {.items items}))
;; An object key is a quoted string and nothing else — an unquoted one was
;; already refused by the tokenizer as a bare word, so what reaches here is
;; a number or a bracket where a key was wanted. The key is copied by the
;; same string-of the values use, so the map owns its keys and the source
;; buffer is not in the picture.
(= (.kind t) json/tok-object-open)
(let [entries (map-new string Value)
k (json/next c)
more (and (json/ok? c) (!= (.kind k) json/tok-object-close))]
(while more
(if (!= (.kind k) json/tok-string)
(do (json/fail c json/err-unexpected-token (.pos k))
(set more false))
(let [key (match (json/string-of k) (Some s) s None "")]
(json/expect c json/tok-colon)
(if (not (json/ok? c))
(set more false)
(let [v (json/next c)]
(if (not (json/ok? c))
(set more false)
(do
(put entries key (read-value c v))
(let [sep (json/next c)]
(cond
(not (json/ok? c)) (set more false)
(= (.kind sep) json/tok-object-close) (set more false)
(!= (.kind sep) json/tok-comma)
(do (json/fail c json/err-unexpected-token (.pos sep))
(set more false))
:else
;; Same two steps, same order, same reason as the
;; array arm: the fail ends the loop through the
;; ok? test under it, and it has to, because the
;; next pass would otherwise ask string-of for the
;; text of a closing brace.
(do (set k (json/next c))
(when (= (.kind k) json/tok-object-close)
(json/fail c json/err-trailing-comma (.pos k)))
(when (not (json/ok? c))
(set more false))))))))))))
(Value.Object {.entries entries}))
:else Value.Null))
;; Walking it back. (at v i) addresses an element in place and (get m k)
;; answers a copy of the value's bytes; in a region the two are the same thing,
;; an alias into storage nobody individually owns.
(defn count-leaves [v Value] i32
(match v
(Array items)
(let [n 0]
(dotimes [i (len items)]
(set n (+ n (count-leaves (at items i)))))
n)
;; map-next! fills an out-parameter with a copy of the value's bytes, which
;; for a Value holding a container is a second header over the same block.
;; In a region that is an alias and not a second owner, so walking a map is
;; the ordinary iteration and needs no accessor of its own.
(Object entries)
(let [n 0
cur (i64 0)
k ""
e Value.Null]
(while (map-next! entries (addr cur) (addr k) (addr e))
(set n (+ n (count-leaves e))))
n)
_ 1))
(defn sum-ints [v Value] i64
(match v
(Int n) n
(Array items)
(let [t (i64 0)]
(dotimes [i (len items)]
(set t (+ t (sum-ints (at items i)))))
t)
(Object entries)
(match (get entries "xs") (Some x) (sum-ints x) None (i64 0))
_ (i64 0)))
(defn describe [v Value] string
(match v
Null "null" (Bool _b) "bool" (Int _n) "int" (Float _x) "float"
(Text _s) "string" (Array _i) "array" (Object _e) "object"))
;; The text at a top-level key, or a marker. Used after the source buffer has
;; been scribbled over, which is the whole reason it exists.
(defn text-at [v Value key string] string
(match v
(Object entries)
(match (get entries key)
(Some x) (match x (Text s) s _ "<not a string>")
None "<missing>")
_ "<not an object>"))
(defn read-doc [src [u8]] Value
(let [c (json/cursor src)
t (json/next (addr c))]
(read-value (addr c) t)))
;; A reader's own refusals, driven end to end: read the whole document and then
;; report what the cursor says. The position matters as much as the message —
;; a trailing comma reported at the opening brace would be useless.
(defn reject [src string] ()
(let [b (bytes src)
c (json/cursor b)
t (json/next (addr c))]
(read-value (addr c) t)
(if (json/ok? (addr c))
(print "accepted")
(do (print "ERR@")
(print (json/error-pos (addr c)))
(print " ")
(print (json/error-message (json/error (addr c))))))
(println "")))
;; Four levels deep, and every level allocates. \" is the escape a tokenizer
;; that handed back raw bytes would get visibly wrong; é is the two-byte
;; case and the 😀 pair is the four-byte one, which is the only place
;; the surrogate arithmetic runs.
;;
;; "esc" holds all eight of JSON's one-character escapes and is asserted by its
;; LENGTH rather than by its text, because six of the eight are control bytes
;; and a test file with a raw tab and a raw form feed sitting in an expected
;; string is a test nobody can edit. Eight escapes have to come out as eight
;; bytes; a version that passed one of them through unresolved would be nine.
(defconst doc
"{\"name\": \"level \\\"1\\\"\",
\"xs\": [1, 2, 3],
\"spawns\": [{\"kind\": \"grunt\", \"at\": [10, 20]},
{\"kind\": \"boss\", \"at\": [30, 40]}],
\"gravity\": 9.8,
\"looping\": true,
\"nothing\": null,
\"esc\": \"\\\"\\\\\\/\\b\\f\\n\\r\\t\",
\"note\": \"\\u00e9 \\uD83D\\uDE00 \\/\"}")
(defn main [] i32
;; ── Scalars, and the boundaries between them ──────────────────────
(dump "1") ; i<1>
(dump "-1 0 0.0") ; a leading minus is part of the number
(dump "1.5 -2.5e3 1e+3 1E-3") ; f — an exponent makes a float of a whole
(dump "true false null") ; b b n, and not three bare words
(println "")
;; A number followed immediately by a delimiter, with no space. A scanner
;; that only stopped on whitespace reads "1]" or "1," as one atom and then
;; fails to parse it.
(dump "[1]")
(dump "[1,2]")
(dump "{\"a\":1}")
(dump "[1][2]")
(println "")
;; Empty collections, and nesting. An empty object is the case a reader that
;; assumes at least one member gets wrong.
(dump "{}")
(dump "[]")
(dump "[[1],[2,[3]]]")
(dump "{\"a\":{\"b\":[]}}")
(println "")
;; Strings, raw. The interior is what comes back, so the escapes are still
;; escapes here and the second case shows a bracket and a colon inside a
;; literal not opening anything.
(dump "\"hi\"")
(dump "\"a[b:c,d\" 1")
(dump "\"\" 1") ; the empty string is a token with empty text
(dump "\"a\\nb\" \"\\u00e9\"")
(println "")
;; ── The refusals, each asserted on its own reason ─────────────────
;;
;; The JSON5-isms first, in the order the header lists them. Every one of
;; these parses somewhere, which is why each gets a sentence naming the
;; dialect rather than a shared "unexpected byte".
(refusal "[1] // trailing") ; a line comment
(refusal "/* lead */ [1]") ; a block comment
(refusal "1 / 2") ; a slash that begins neither — not a comment
(refusal "'single'")
(refusal "+1")
(refusal ".5") ; edn.flan reads this as a float on purpose
(refusal "1.")
(refusal "1.e3") ; the same rule, one byte later
(refusal "0x1f")
(refusal "01")
(refusal "NaN")
(refusal "Infinity")
(refusal "{name: 1}") ; an unquoted key
(println "")
;; Strings: the escape grammar, and the two surrogate halves. A lone
;; surrogate is refused because rune-size answers None for the whole
;; D800-DFFF block, so encode-rune! would write nothing and the character
;; would vanish — the refusal is forced by the prelude rather than chosen.
(refusal "\"a\\vb\"") ; \v is JSON5's
(refusal "\"a\\x41b\"") ; so is \x
(refusal "\"a\\u12\"") ; four hex digits, not two
(refusal "\"\\uD800x\"") ; a high surrogate with no pair after it
(refusal "\"\\uDC00\"") ; a low one on its own
(refusal "\"\\uD800\\uD800\"") ; a high one followed by another high one
(refusal "\"a\tb\"") ; a raw tab, which JSON says to escape
(refusal "\"unterminated")
(refusal "\"trailing escape\\") ; the backslash is the last byte in the file
(println "")
;; Structure, and the number grammar's own failures.
(refusal "[1 2}") ; the wrong closer
(refusal "]") ; a closer with nothing open
(refusal "[1") ; end of input with something still open
(refusal "12x") ; starts like a number, is not one
(refusal "-") ; a sign with no digits
(refusal "1e") ; an exponent with no digits
(refusal "@") ; not the start of any JSON value
;; 33 opening brackets against a 32-deep stack. The message is the least of
;; what this checks: a `>` where the guard needs `>=` writes one past the end
;; of a fixed array, and the answer is a bounds trap rather than a wrong
;; message. The offset is the 33rd bracket.
(refusal "[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[")
(println "")
;; ── The reader's own refusals ─────────────────────────────────────
;;
;; Inside the region, because read-value builds a (Vec Value) and a Value
;; holds containers: spec-memory.md's rule traps that construction against
;; any allocator that can free one block, and a malformed document builds
;; exactly as much of one as a well-formed document does. The refusals being
;; checked here are the reader's, not the allocator's.
(set frame (arena-new 65536))
(with-allocator frame
(do
(reject "[1, 2]") ; accepted — the control
(reject "{\"a\": 1}") ; accepted
(reject "[1 2]") ; a missing comma, which EDN would allow
(reject "[1, 2,]") ; a trailing comma
(reject "{\"a\": 1,}") ; and in an object
(reject "{\"a\" 1}") ; a missing colon
(reject "{1: 2}") ; a key that is not a string
(println "")))
;; Released before the document below is read into the same region, so that
;; the read starts from a reset arena rather than from whatever the refusals
;; left behind. free-all is retain-capacity, so this keeps the pages.
(free-all frame)
;; ── The document, in an arena, outliving its source ───────────────
;;
;; The source buffer is built BEFORE with-allocator, so it belongs to the
;; heap and not to the region. That is the point of the whole section: the
;; two lifetimes have to be separable for the scribble below to mean
;; anything.
(let [buf (vec-new u8)]
(append! (addr buf) (bytes doc))
(with-allocator frame
(let [v (read-doc (as-slice buf))]
(println (describe v)) ; object
(println (count-leaves v)) ; every leaf in the graph
(println (sum-ints v)) ; [1 2 3]
(println (describe (match v (Object e) (match (get e "gravity")
(Some g) g None Value.Null)
_ Value.Null)))
;; The escapes, resolved. The quotes in `name` never existed as bytes
;; in the source; é is two bytes out of six and the emoji is four out
;; of twelve; and the eight one-character escapes are eight bytes.
(println (text-at v "name"))
(println (text-at v "note"))
(println (len (text-at v "note")))
(println (len (text-at v "esc")))
;; And now the source buffer is destroyed under the live document. An
;; implementation that aliased it prints question marks from here on.
(dotimes [i (len buf)]
(set (at buf i) \?))
(println (text-at v "name"))
(println (text-at v "nothing"))
(println (text-at v "absent"))))
;; The whole document, in one operation and with no per-element teardown.
(free-all frame)
(arena-destroy frame)
(free buf))
0)

120
test/test_acceptance.ml
View File

@ -2211,6 +2211,126 @@ ERR@7 unexpected token: not the kind the caller was reading
outputs "edn tokenizer" "programs/edn.flan" edn_out;
outputs ~opt:"-O0" "edn tokenizer, -O0" "programs/edn.flan" edn_out;
(* The JSON tokenizer, and a document read into a dynamic value in an
arena (vendor/json, test/programs/json.flan). The expected output is a
raw literal for the reason the EDN one is: it is full of brackets and
quotes, and escaping them here would put a second reader between the
test and what the program printed.
This is edn.flan and arena-edn.flan in one case because for JSON they
are one claim. vendor/edn never allocates and refuses escaped strings
for want of anywhere to put the unescaped copy; vendor/json has an
allocator, so it unescapes, and to unescape it copies - which means the
cursor cannot be exercised without the allocator behind it.
What the sections assert, in order. The token dump prints the kind
letter and the text in <>, so a tokenizer with the right kinds and the
wrong slices fails even having agreed about every kind; a string
token's text is the RAW interior, which is why "a\nb" comes back with
its backslash still on it. Then the refusals, each on its *reason* with
the byte offset first, because this reads strict JSON where its Odin
reference defaults to JSON5 and a generic error for all of them would
tell nobody which dialect they wrote. Then the reader's own two - a
missing comma and a trailing one, neither of which EDN has an opinion
about - raised through json/fail on the cursor, so a caller's grammar
errors carry a position the same way the tokenizer's do.
The last block is the one that could not be written against vendor/edn
at all. arena-edn.flan's header admits its Values are views into the
source buffer and outlive the region; here the source buffer is
overwritten with `?` while the document is live, and `level "1"` prints
again afterwards. An implementation that aliased the buffer - which is
free, and which edn does on purpose - prints question marks there. 15
is every leaf, 6 is [1 2 3] summed, 9 and 8 are byte counts: nine for
an e-acute and an emoji resolved out of \u escapes and a surrogate
pair, eight for JSON's eight one-character escapes, which are asserted
by length because six of them are control bytes and an expected string
with a raw tab in it is one nobody can edit.
At -O0 as well, for edn.flan's reason: a Token is a two-word slice
inside a struct returned by value and a Cursor is passed by pointer
with a fixed array in it, and mem2reg is what launders a struct being
copied where it should be shared. *)
let json_out =
{json|i<1>
i<-1>i<0>f<0.0>
f<1.5>f<-2.5e3>f<1e+3>f<1E-3>
b<true>b<false>n<null>
[<>i<1>]<>
[<>i<1>,<>i<2>]<>
{<>s<a>:<>i<1>}<>
[<>i<1>]<>[<>i<2>]<>
{<>}<>
[<>]<>
[<>[<>i<1>]<>,<>[<>i<2>,<>[<>i<3>]<>]<>]<>
{<>s<a>:<>{<>s<b>:<>[<>]<>}<>}<>
s<hi>
s<a[b:c,d>i<1>
s<>i<1>
s<a\nb>s<\u00e9>
4 comments are refused: // and /* are JSON5, and JSON has no comment syntax
0 comments are refused: // and /* are JSON5, and JSON has no comment syntax
2 unexpected byte: not the start of any JSON value
0 single-quoted strings are refused: they are JSON5, and JSON quotes with "
0 a leading + is refused: it is JSON5, and JSON writes a positive number without a sign
0 a number cannot begin with a decimal point: write 0.5 rather than .5
0 a number cannot end with a decimal point: digits have to follow it
0 a number cannot end with a decimal point: digits have to follow it
0 hexadecimal numbers are refused: 0x is JSON5, and JSON has decimal only
0 a leading zero is refused: JSON allows 0 as a whole integer part and nothing in front of another digit
0 NaN and Infinity are refused: they are JSON5, and JSON has no spelling for either
0 NaN and Infinity are refused: they are JSON5, and JSON has no spelling for either
1 an unquoted name is refused: bare keys and identifiers are JSON5, and JSON quotes every string
2 unknown escape: JSON has \" \\ \/ \b \f \n \r \t and \uXXXX, and nothing else
2 unknown escape: JSON has \" \\ \/ \b \f \n \r \t and \uXXXX, and nothing else
2 bad \u escape: four hexadecimal digits have to follow it
1 lone surrogate: \uD800-\uDFFF is half of a pair and encodes no character on its own
1 lone surrogate: \uD800-\uDFFF is half of a pair and encodes no character on its own
1 lone surrogate: \uD800-\uDFFF is half of a pair and encodes no character on its own
2 a raw control byte inside a string: JSON requires anything below 0x20 to be written as an escape
0 unterminated string: end of input before the closing quote
0 unterminated string: end of input before the closing quote
4 unbalanced: this closing delimiter does not match the one that is open
0 unbalanced: this closing delimiter does not match the one that is open
2 unbalanced: this closing delimiter does not match the one that is open
0 not a number: the token starts like one but does not match JSON's number grammar
0 not a number: the token starts like one but does not match JSON's number grammar
0 not a number: the token starts like one but does not match JSON's number grammar
0 unexpected byte: not the start of any JSON value
32 nesting is too deep: the balance stack is a fixed array and it is full
accepted
accepted
ERR@3 unexpected token: not the kind the caller was reading
ERR@6 trailing comma: it is JSON5, and JSON has no separator before a closing bracket
ERR@8 trailing comma: it is JSON5, and JSON has no separator before a closing bracket
ERR@5 unexpected token: not the kind the caller was reading
ERR@1 unexpected token: not the kind the caller was reading
object
15
6
float
level "1"
é 😀 /
9
8
level "1"
<not a string>
<missing>
|json}
in
outputs "json tokenizer and reader" "programs/json.flan" json_out;
outputs ~opt:"-O0" "json tokenizer and reader, -O0" "programs/json.flan"
json_out;
(* Comparing enums, found by auditing emit.ml's failwith sites. It type
checked and then died in the backend with no source location, which is
the project's worst failure shape. All six operators, a negative member

6
test/test_sanitize.ml
View File

@ -132,6 +132,12 @@ let corpus =
"programs/debug-permuted.flan", [];
"programs/destructure.flan", [];
"programs/edn.flan", [];
(* The JSON reader, which is the corpus's densest allocator: every string
in the document is a (Vec u8) grown a byte at a time and then handed
out as a view of its own block, and the block is never freed because
the view IS the answer. ASan is what says the view still points at the
block after the growth that moved it. *)
"programs/json.flan", [];
"programs/enum-compare.flan", [];
"programs/error.flan", [];
(* Makes and removes its own tree, so the two runs of the sweep see the

745
vendor/json/json.flan vendored Normal file
View File

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