Joseph Ferano
a0f37e72a2
The !-means-mutates convention distinguished nothing — there is no immutable counterpart to contrast with — so every mutating name drops the mark: sort, sort-by, sort-bytes, swap, reverse, append, append-i64, append-f64, encode-rune, split-next, map-remove, map-next, and the test helpers beside them. Two could not simply shed it: map! is map-in-place, because map is the into transform's word and means the non-mutating thing; put! is put-at, because put is the Map builtin. The ?-means-asks convention stays. Dated records keep the old spellings; watch.clj's reset-spies! and the other Clojure names are not ours to rename.
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)
|