Joseph Ferano
6b668e7d9d
vendor/json is vendor/edn's shape with one decision reversed. edn never allocates, so its tokens are views into the source buffer and escaped strings are refused for want of anywhere to put the unescaped copy. This one has an allocator, so it unescapes, and to unescape it copies — string-of is the only function in the package that allocates, and it copies even when there was no escape to resolve, because a Value whose lifetime depended on which bytes happened to be in it is not a contract anyone can hold. Odin answered the same question the same way: tokenizer.odin allocates nothing, parser.odin's unquote_string does the copy, and it clones in the no-escape branch too. What that buys is at the bottom of test/programs/json.flan, which is programs/edn.flan and programs/arena-edn.flan in one file because for JSON they are one claim. The source buffer is overwritten with `?` bytes while the document is live and the strings read back afterwards are still the strings. arena-edn's header has a section admitting it cannot do that. Strict JSON and not Odin's JSON5 default, and the difference is where most of the refusals come from: comments, single quotes, +1, .5, 1., 0x1f, 01, NaN, Infinity and unquoted keys each get a sentence naming the dialect they belong to, rather than one shared unexpected-byte. A lone surrogate is refused too, and that one is forced rather than chosen — rune-size answers None for the whole D800-DFFF block, so encode-rune! would write nothing and the character would vanish.
436 lines
19 KiB
Plaintext
436 lines
19 KiB
Plaintext
;;;; 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)
|