as-slice was a warning, not an operation. The input type already decides which of the two things happens — a Vec can only be borrowed, an array or a string can only be viewed, and no call site picks between them — so the second name expressed no choice a reader could make. And it warned at the moment the view is taken, which is the one moment nothing is wrong; the danger arrives later, at the push. slice now takes a Vec at all three arities and as-slice is gone. (slice v lo) was free, and is the arity the Vec never had: the runtime already reads a hi of -1 as "to the end", so the tail form passes the caller's lo and the same -1 — no slot, no length read, no second evaluation. The merge is entirely in the checker; the Vec path builds the flan_vec_as_slice call it always built and neither backend has a line about any of it. A Vec a call returned is refused at every arity, and not for the array's reason. (slice (mk)) over an array dangles. (slice (make-vec)) does not — the storage outlives the expression — but the header is a temporary, so nothing can ever free the block. The refusal says that and names the let. The name's own refusal sits in ordinary_call after every table, so a program that defines an as-slice still reaches its own. It reads for somebody who has never heard of the old name and writes the call back out, spelling each argument that is a name or a number. The warning moved to where it bites: BUILT.md gains a section beside the Vec table and the push row points at it, spec-memory.md's Borrowing says the same. Investigated and deliberately not built — a diagnostic for a live view at the push. (reserve v 100) then a slice, a push and a read is correct code under the contract the spec chose, so any flag on it is a false positive by the language's own semantics rather than by an approximation. FIX.org has the finding and the syntactic sketch that does not work.
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 the tokenizer walk and the arena-held document in one file,
|
|
;;;; because for JSON they are one claim. EDN's tokenizer
|
|
;;;; allocates nothing and hands back views, so a reader over it is a separate
|
|
;;;; lane 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 a view-holding reader cannot ──────
|
|
;;;;
|
|
;;;; A reader whose strings are views into the source buffer has them 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 arena shape arena-value.flan argues 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")
|
|
|
|
(defonce 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-view 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-view 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 edn/read-value'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-view 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-view doc))
|
|
(with-allocator frame
|
|
(let [v (read-doc (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)
|