An EDN tokenizer, as a package
vendor/edn rather than the prelude: the prelude is prepended to every program and everything in it is emitted, so a reader nobody imports would be a cost every build pays. The tokenizer only. A type-directed reader - the compiler emitting a parser from a walk over a struct's fields, the dual of the printer C-x C-e already has - lands in check.ml and emit.ml and is not this. What a caller writes today is a struct reader by hand against the cursor, and the acceptance program carries one, because that is what proves the API is usable rather than present. Every token is a slice into the source, so nothing allocates and the buffer has to outlive the tokens. That contract is stated at the top of the package, because it is the kind of thing found the hard way. Escaped strings are refused rather than half-supported: unescaping needs a copy and there is nowhere to put one, and handing back the raw bytes would return a three-byte string as four with a backslash in it. Each other refusal carries its own sentence - #inst and #uuid separately from tagged literals, because a file is most likely to contain those two and being told tagged literals are refused would not say that the timestamp is the thing to delete. Errors live on the cursor, a code and a byte offset, not in the return type: an Option loses the position, which is the whole point for an editor. A failed cursor is poisoned so a caller's loop terminates on a malformed file rather than spinning. # Conflicts: # test/test_acceptance.ml
This commit is contained in:
commit
da38a3db5f
@ -12,6 +12,8 @@
|
||||
(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.
|
||||
(glob_files %{workspace_root}/vendor/edn/*)
|
||||
(glob_files programs/*.flan)
|
||||
; The reload primitive's host: a C main that dlopens what Build.shared made.
|
||||
(file reload_host.c)
|
||||
|
||||
239
test/programs/edn.flan
Normal file
239
test/programs/edn.flan
Normal file
@ -0,0 +1,239 @@
|
||||
;;;; The EDN tokenizer, and a struct reader written by hand against it.
|
||||
;;;;
|
||||
;;;; The second half is the point. `(read-edn Enemy bytes)` — the compiler
|
||||
;;;; emitting a parser from a walk over Enemy's fields — is not built yet, so
|
||||
;;;; what this file proves is that the cursor is usable *without* it: read-enemy
|
||||
;;;; below is what that emitted code will look like, written out by hand. An API
|
||||
;;;; that only a compiler could call would be present rather than usable.
|
||||
;;;;
|
||||
;;;; Every case here is one a plausible wrong version fails. Named where it is
|
||||
;;;; not obvious.
|
||||
|
||||
(import edn "vendor:edn")
|
||||
|
||||
;; ── 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 quote, off by the colon — would pass on the letters
|
||||
;; alone.
|
||||
|
||||
(defn kind-letter [k i32] string
|
||||
(cond
|
||||
(= k edn/tok-eof) "."
|
||||
(= k edn/tok-error) "!"
|
||||
(= k edn/tok-nil) "n"
|
||||
(= k edn/tok-bool) "b"
|
||||
(= k edn/tok-int) "i"
|
||||
(= k edn/tok-float) "f"
|
||||
(= k edn/tok-string) "s"
|
||||
(= k edn/tok-keyword) "k"
|
||||
(= k edn/tok-symbol) "y"
|
||||
(= k edn/tok-vec-open) "["
|
||||
(= k edn/tok-vec-close) "]"
|
||||
(= k edn/tok-map-open) "{"
|
||||
(= k edn/tok-map-close) "}"
|
||||
(= k edn/tok-list-open) "("
|
||||
(= k edn/tok-list-close) ")"
|
||||
:else "?"))
|
||||
|
||||
(defn dump [src string]
|
||||
(let [b (bytes src)
|
||||
c (edn/cursor b)
|
||||
t (edn/next (addr c))]
|
||||
(while (and (edn/ok? (addr c)) (!= (.kind t) edn/tok-eof))
|
||||
(print-str (kind-letter (.kind t)))
|
||||
(print-str "<")
|
||||
(print-bytes (.text t))
|
||||
(print-str ">")
|
||||
(set t (edn/next (addr c))))
|
||||
(when (not (edn/ok? (addr c)))
|
||||
(print-str "ERR@")
|
||||
(print-i64 (i64 (edn/error-pos (addr c)))))
|
||||
(newline)))
|
||||
|
||||
;; The refusals. Asserted on the *reason*, not on the fact of failing: a
|
||||
;; tokenizer that answered err-unexpected-byte for every one of these would
|
||||
;; pass a test that only checked that it failed.
|
||||
(defn refusal [src string]
|
||||
(let [b (bytes src)
|
||||
c (edn/cursor b)]
|
||||
(while (and (edn/ok? (addr c))
|
||||
(!= (.kind (edn/next (addr c))) edn/tok-eof)))
|
||||
(print-i64 (i64 (edn/error-pos (addr c))))
|
||||
(print-str " ")
|
||||
(print-str (edn/error-message (edn/error (addr c))))
|
||||
(newline)))
|
||||
|
||||
;; ── The worked example: a struct read by hand ───────────────────────
|
||||
|
||||
;; `name` is a [u8] and not a copy of one, so an Enemy is only valid while the
|
||||
;; buffer it was read out of is. That is the lifetime contract from the package
|
||||
;; header, and it is what a struct reader inherits by using slices.
|
||||
(defstruct Enemy
|
||||
[name [u8]
|
||||
hp i32
|
||||
speed f32
|
||||
boss? bool])
|
||||
|
||||
;; The shape the compiler-emitted version will have: open the map, loop on the
|
||||
;; keys, dispatch each known one onto its field, and skip whatever is left over
|
||||
;; so an extra key in a data file is not fatal. Errors accumulate on the cursor
|
||||
;; rather than being returned, which is why this can be a straight line of
|
||||
;; assignments with one test at the end.
|
||||
(defn read-enemy [c (Ptr edn/Cursor)] Enemy
|
||||
(let [e (Enemy {:hp 0 :speed 0.0 :boss? false})]
|
||||
(edn/expect c edn/tok-map-open)
|
||||
(while (edn/ok? c)
|
||||
(let [k (edn/next c)]
|
||||
(when (or (not (edn/ok? c)) (= (.kind k) edn/tok-map-close))
|
||||
(return e))
|
||||
(when (!= (.kind k) edn/tok-keyword)
|
||||
(edn/fail c edn/err-unexpected-token (.pos k))
|
||||
(return e))
|
||||
(cond
|
||||
(edn/keyword=? k "name")
|
||||
(set (.name e) (.text (edn/expect c edn/tok-string)))
|
||||
|
||||
(edn/keyword=? k "hp")
|
||||
(set (.hp e) (i32 (match (edn/int-of (edn/expect c edn/tok-int))
|
||||
(Some v) v None 0)))
|
||||
|
||||
;; The one field read with `next` rather than `expect`, because two
|
||||
;; kinds are acceptable for it. The None arm is what keeps that from
|
||||
;; being a hole: a string here fails rather than defaulting to 0.0.
|
||||
(edn/keyword=? k "speed")
|
||||
(let [v (edn/next c)]
|
||||
(match (edn/float-of v)
|
||||
(Some x) (set (.speed e) (f32 x))
|
||||
None (edn/fail c edn/err-unexpected-token (.pos v))))
|
||||
|
||||
(edn/keyword=? k "boss?")
|
||||
(set (.boss? e) (match (edn/bool-of (edn/expect c edn/tok-bool))
|
||||
(Some v) v None false))
|
||||
|
||||
;; An unknown key: read past its value, however big it is.
|
||||
:else
|
||||
(when (not (edn/skip-value c))
|
||||
(return e)))))
|
||||
e))
|
||||
|
||||
(defn show-enemy [src string]
|
||||
(let [b (bytes src)
|
||||
c (edn/cursor b)
|
||||
e (read-enemy (addr c))]
|
||||
(if (edn/ok? (addr c))
|
||||
(do
|
||||
(print-str "[")
|
||||
(print-bytes (.name e))
|
||||
(print-str "] hp=")
|
||||
(print-i64 (i64 (.hp e)))
|
||||
(print-str " speed=")
|
||||
(print-f64 (f64 (.speed e)))
|
||||
(print-str " boss=")
|
||||
(print-str (if (.boss? e) "yes" "no")))
|
||||
(do
|
||||
(print-str "ERR@")
|
||||
(print-i64 (i64 (edn/error-pos (addr c))))
|
||||
(print-str " ")
|
||||
(print-str (edn/error-message (edn/error (addr c))))))
|
||||
(newline)))
|
||||
|
||||
(defn main [] i32
|
||||
;; ── Scalars, and the boundaries between them ──────────────────────
|
||||
(dump "1") ; i<1>
|
||||
(dump "-1 +2 0") ; the signs are part of the number
|
||||
(dump "1.5 -2.5e3 .5") ; f, and a leading dot is a float
|
||||
(dump "true false nil") ; b b n — and not three symbols
|
||||
;; `-` alone is a symbol, `foo/bar` is NOT a ratio, and the uppercase half
|
||||
;; of the alphabet test is only exercised by a name that has one in it.
|
||||
(dump "foo Enemy/Goblin -")
|
||||
(dump ":a :foo/bar") ; k, text without the colon
|
||||
(newline)
|
||||
|
||||
;; A number followed immediately by a delimiter, with no space. A scanner
|
||||
;; that only stopped on whitespace reads "1]" or "1;x" as one atom and then
|
||||
;; fails to parse it.
|
||||
(dump "[1]")
|
||||
(dump "[1 2][3]") ; two tokens with no space between them
|
||||
(dump "{:a 1}")
|
||||
(dump "1;c") ; a comment starting against the number
|
||||
(dump ":a;c") ; a keyword ending at a comment
|
||||
(newline)
|
||||
|
||||
;; Empty collections, and nesting. An empty map is the case a reader that
|
||||
;; assumes at least one key-value pair gets wrong.
|
||||
(dump "{}")
|
||||
(dump "[]")
|
||||
(dump "()")
|
||||
(dump "[[1] [2 [3]]]")
|
||||
(dump "{:a {:b []}}")
|
||||
(newline)
|
||||
|
||||
;; A keyword at the very end of input — the loop has to test the length
|
||||
;; before reading the byte, or this walks off the end.
|
||||
(dump ":a")
|
||||
(dump "1")
|
||||
(dump "\"x\"")
|
||||
(newline)
|
||||
|
||||
;; Comments. The last one has no trailing newline, which is the case that
|
||||
;; separates a scan-to-newline from a scan-to-newline-or-end.
|
||||
(dump "; only a comment\n1")
|
||||
(dump "1 ; trailing\n2")
|
||||
(dump "1 ; no newline at the end")
|
||||
(dump ";") ; a bare comment marker, nothing after it
|
||||
(newline)
|
||||
|
||||
;; Commas are whitespace in EDN, and are not tokens.
|
||||
(dump "[1, 2 ,3]")
|
||||
(newline)
|
||||
|
||||
;; Strings. The second is the one that matters: a `[` and a `;` inside a
|
||||
;; string must not open a vector or start a comment.
|
||||
(dump "\"hi\"")
|
||||
(dump "\"a[b;c\" 1")
|
||||
(dump "\"\" 1") ; the empty string is a token with empty text
|
||||
(dump "\"a b\"")
|
||||
(newline)
|
||||
|
||||
;; ── The refusals, each asserted on its own reason ─────────────────
|
||||
(refusal "\"a\\nb\"") ; an escape inside a string
|
||||
(refusal "\"a\\\"b\"") ; an escaped quote — the case where a wrong
|
||||
; version returns `a\` and leaves `b"` behind
|
||||
(refusal "\"unterminated") ; not a refusal, but the other string failure
|
||||
(refusal "#{1 2}") ; a set
|
||||
(refusal "#foo {}") ; a tagged literal
|
||||
(refusal "#inst \"2024\"") ; named separately
|
||||
(refusal "#uuid \"x\"")
|
||||
(refusal "^{:a 1} [1]") ; metadata
|
||||
(refusal "22/7") ; a ratio
|
||||
(refusal "\\a") ; a character literal
|
||||
(refusal "12x") ; starts like a number, is not one
|
||||
(refusal "[1 :]") ; a colon with no name
|
||||
(refusal "@") ; not the start of any value — and the case a
|
||||
; scan-to-delimiter reads as a one-byte symbol
|
||||
(refusal "`x") ; a Clojure reader macro, not EDN
|
||||
(refusal "[1 2}") ; the wrong closer
|
||||
(refusal "]") ; a closer with nothing open
|
||||
(refusal "[1 2") ; end of input with something still open
|
||||
;; 33 opening brackets against a 32-deep stack. The error 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 "[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[")
|
||||
(newline)
|
||||
|
||||
;; ── The struct reader ─────────────────────────────────────────────
|
||||
(show-enemy "{:name \"goblin\" :hp 12 :speed 1.5 :boss? false}")
|
||||
;; Fields in a different order, one missing (zeroed), one unknown key whose
|
||||
;; value is a whole nested collection that skip-value has to walk past.
|
||||
(show-enemy "{:boss? true :loot [:gold {:n 3} [[]]] :hp 40 :name \"dragon\"}")
|
||||
;; :speed given as an integer — 2 and 2.0 are the same number.
|
||||
(show-enemy "{:name \"imp\" :hp 1 :speed 2}")
|
||||
(show-enemy "{}")
|
||||
;; Wrong type for a field: the reader stops and names the position.
|
||||
(show-enemy "{:name 7}")
|
||||
;; A comment inside the map, and commas.
|
||||
(show-enemy "{:name \"orc\", ; a note\n :hp 9}")
|
||||
0)
|
||||
@ -542,6 +542,101 @@ let () =
|
||||
wasm_case "calc-me, wasm32" "../calc-me.flan"
|
||||
~arg:"1 + 2 * (3 - 0.5) / 2" "3.5\n"));
|
||||
|
||||
(* The EDN tokenizer, and the struct reader written by hand against it
|
||||
(vendor/edn, test/programs/edn.flan). The expected output is a raw
|
||||
literal because the token dump is full of brackets and quotes, and
|
||||
escaping them here would put a second reader between the test and what
|
||||
the program actually printed.
|
||||
|
||||
Every line is one a plausible wrong version fails. The dump prints both
|
||||
the kind letter and the text in <>, so a tokenizer with the right kinds
|
||||
and the wrong slices - off by the opening quote, off by the keyword's
|
||||
colon - fails even though it agreed about every kind. The cases that
|
||||
are not obvious: a number followed straight by a delimiter ("[1]",
|
||||
"1;c") separates a scan-to-delimiter from a scan-to-whitespace; foo/bar
|
||||
must stay a namespaced symbol where a "contains a slash" ratio rule
|
||||
makes it an error; a string holding a bracket and a semicolon must not
|
||||
open a vector or start a comment; "1 ; no newline at the end" is the
|
||||
comment a scan-to-newline loop runs off the end of; and an empty map is
|
||||
what a reader assuming at least one key-value pair gets wrong.
|
||||
|
||||
The refusals are asserted on their *reason* and not on the fact of
|
||||
failing, with the byte offset first - a tokenizer answering one generic
|
||||
error for all of them would pass a test that only checked that it
|
||||
stopped. Both string cases are here because they fail differently: an
|
||||
escaped quote is the one where a wrong version returns a backslash as
|
||||
part of the text and leaves the rest of the literal behind as garbage.
|
||||
|
||||
At -O0 as well. 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;
|
||||
mem2reg is exactly what launders a struct being copied where it should
|
||||
be shared. *)
|
||||
let edn_out =
|
||||
{edn|i<1>
|
||||
i<-1>i<+2>i<0>
|
||||
f<1.5>f<-2.5e3>f<.5>
|
||||
b<true>b<false>n<nil>
|
||||
y<foo>y<Enemy/Goblin>y<->
|
||||
k<a>k<foo/bar>
|
||||
|
||||
[<>i<1>]<>
|
||||
[<>i<1>i<2>]<>[<>i<3>]<>
|
||||
{<>k<a>i<1>}<>
|
||||
i<1>
|
||||
k<a>
|
||||
|
||||
{<>}<>
|
||||
[<>]<>
|
||||
(<>)<>
|
||||
[<>[<>i<1>]<>[<>i<2>[<>i<3>]<>]<>]<>
|
||||
{<>k<a>{<>k<b>[<>]<>}<>}<>
|
||||
|
||||
k<a>
|
||||
i<1>
|
||||
s<x>
|
||||
|
||||
i<1>
|
||||
i<1>i<2>
|
||||
i<1>
|
||||
|
||||
|
||||
[<>i<1>i<2>i<3>]<>
|
||||
|
||||
s<hi>
|
||||
s<a[b;c>i<1>
|
||||
s<>i<1>
|
||||
s<a b>
|
||||
|
||||
2 escaped strings are refused: unescaping needs a copy of the bytes, and there is no allocator to put one in
|
||||
2 escaped strings are refused: unescaping needs a copy of the bytes, and there is no allocator to put one in
|
||||
0 unterminated string: end of input before the closing quote
|
||||
0 sets #{} are refused: there is no hash set, and no allocator to build one in
|
||||
0 tagged literals #tag are refused: the tag would pick the type at run time, which is what a type-directed reader exists to avoid
|
||||
0 #inst is refused: it is a tagged literal, and there is no timestamp type to read it into
|
||||
0 #uuid is refused: it is a tagged literal, and there is no uuid type to read it into
|
||||
0 metadata ^ is refused: it attaches to the value after it, and a flat token stream has nowhere to attach it
|
||||
0 ratios are refused: there is no rational type, and rounding one to a float would change the value
|
||||
0 character literals are refused: a character is not a byte once it is not ASCII, and there is no code point type
|
||||
0 not a number: the token starts like one but does not parse as an integer or a float
|
||||
3 empty keyword: a colon with no name after it
|
||||
0 unexpected byte: not the start of any EDN value
|
||||
0 unexpected byte: not the start of any EDN value
|
||||
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
|
||||
4 unbalanced: this closing delimiter does not match the one that is open
|
||||
32 nesting is too deep: the balance stack is a fixed array and it is full
|
||||
|
||||
[goblin] hp=12 speed=1.5 boss=no
|
||||
[dragon] hp=40 speed=0 boss=yes
|
||||
[imp] hp=1 speed=2 boss=no
|
||||
[] hp=0 speed=0 boss=no
|
||||
ERR@7 unexpected token: not the kind the caller was reading
|
||||
[orc] hp=9 speed=0 boss=no
|
||||
|edn}
|
||||
in
|
||||
outputs "edn tokenizer" "programs/edn.flan" edn_out;
|
||||
outputs ~opt:"-O0" "edn tokenizer, -O0" "programs/edn.flan" edn_out;
|
||||
|
||||
if !failures = 0 then print_endline "acceptance: all tests passed"
|
||||
else begin
|
||||
Printf.printf "\n%d failure(s)\n" !failures;
|
||||
|
||||
561
vendor/edn/edn.flan
vendored
Normal file
561
vendor/edn/edn.flan
vendored
Normal file
@ -0,0 +1,561 @@
|
||||
;;;; An EDN tokenizer, in Flan, over a [u8].
|
||||
;;;;
|
||||
;;;; This is half of a reader. It answers one question — "what is the next
|
||||
;;;; token, and where" — and it answers it without allocating anything: every
|
||||
;;;; token's text is a `slice` of the input buffer, not a copy of it. The other
|
||||
;;;; half, `(read-edn Enemy bytes)` emitting a parser from a compile-time walk
|
||||
;;;; over a struct's fields, belongs to the compiler and is not here. Until it
|
||||
;;;; exists a caller writes the struct reader by hand against this cursor;
|
||||
;;;; test/programs/edn.flan is a worked example of doing exactly that.
|
||||
;;;;
|
||||
;;;; ── The lifetime contract, which the type system does not state ─────
|
||||
;;;;
|
||||
;;;; A Token's `text` is a slice INTO the buffer the Cursor was built over.
|
||||
;;;; It is ptr+len and it owns nothing. Therefore:
|
||||
;;;;
|
||||
;;;; * the input buffer must outlive every Token taken from it, and every
|
||||
;;;; Cursor over it;
|
||||
;;;; * mutating the input while tokens are live changes their text under
|
||||
;;;; them, because they are views and not copies;
|
||||
;;;; * a Token returned out of the function that owns the buffer is a
|
||||
;;;; dangling pointer, and nothing in the language will say so.
|
||||
;;;;
|
||||
;;;; That is the price of not allocating, and it is written here because it is
|
||||
;;;; the kind of contract that otherwise gets discovered from a corrupted
|
||||
;;;; string three frames later.
|
||||
;;;;
|
||||
;;;; ── What is refused, and why ────────────────────────────────────────
|
||||
;;;;
|
||||
;;;; Every refusal below is a *named* one with a reason attached, reachable as
|
||||
;;;; (edn/error-message code). A tokenizer that quietly skipped what it did not
|
||||
;;;; understand would hand a caller a value that is not the one in the file.
|
||||
;;;;
|
||||
;;;; escaped strings "a\nb", "a\"b" — the important one. Unescaping needs
|
||||
;;;; somewhere to put the unescaped copy, and there is no
|
||||
;;;; allocator, so there is nowhere. Returning the raw
|
||||
;;;; bytes including the backslash would be quietly wrong:
|
||||
;;;; a caller comparing against "a\nb" would get a 4-byte
|
||||
;;;; answer where it expected 3, and a caller printing it
|
||||
;;;; would print a backslash. So a backslash inside a
|
||||
;;;; string is an error at the byte it appears on.
|
||||
;;;; sets #{1 2} — needs a hash set to even represent.
|
||||
;;;; tagged literals #foo {} — the tag decides the type, and dispatching on
|
||||
;;;; a tag at run time is what a type-directed reader
|
||||
;;;; exists to avoid.
|
||||
;;;; #inst, #uuid named separately from tagged literals because they are
|
||||
;;;; the two a real file is most likely to contain, and
|
||||
;;;; "tagged literals are refused" would not tell a caller
|
||||
;;;; that a timestamp is the thing to remove.
|
||||
;;;; ratios 22/7 — there is no rational type.
|
||||
;;;; metadata ^{:a 1} — it attaches to the value after it, and a
|
||||
;;;; flat token stream has nowhere to attach anything.
|
||||
;;;; characters \a — outside the requested subset; a char is not
|
||||
;;;; a byte once anything is non-ASCII, and there is no
|
||||
;;;; code point type.
|
||||
;;;;
|
||||
;;;; ── One place this is not EDN, on the record ────────────────────────
|
||||
;;;;
|
||||
;;;; `.5` is a float here. In EDN a number must begin with a digit and `.` is
|
||||
;;;; a legal symbol-start byte, so strictly `.5` is the *symbol* `.5` — which
|
||||
;;;; makes this a reinterpretation of a legal token and not an extension, and
|
||||
;;;; therefore the kind of thing that gets written down rather than discovered.
|
||||
;;;; It is this way because number-start? runs before the symbol case and
|
||||
;;;; parse-f64 accepts a leading dot; a caller who needs the symbol reading
|
||||
;;;; should not be writing `.5` at all. `-`, by contrast, is a symbol, because
|
||||
;;;; number-start? requires a digit after the sign.
|
||||
;;;;
|
||||
;;;; ── Errors ──────────────────────────────────────────────────────────
|
||||
;;;;
|
||||
;;;; On the cursor, not in the return type. `next` answers a Token whose kind
|
||||
;;;; is tok-error, and the cursor carries the code and the byte offset it was
|
||||
;;;; found at; (edn/error-message code) turns the code into the sentence. The
|
||||
;;;; offset is the point: an editor underlines a byte range, and an Option with
|
||||
;;;; no position could not tell it where. An (Option Token) was the alternative
|
||||
;;;; and it loses exactly that — None says something went wrong, and a second
|
||||
;;;; out-parameter for the position is the same two fields with a worse shape.
|
||||
;;;;
|
||||
;;;; A failed cursor is poisoned: every later `next` answers the same error
|
||||
;;;; token without advancing. That is what stops a caller's `while` loop from
|
||||
;;;; spinning on a malformed file forever.
|
||||
|
||||
;; ── Token kinds ─────────────────────────────────────────────────────
|
||||
;;
|
||||
;; Plain i32 constants and not a `defenum`, which is the shape that wants
|
||||
;; explaining. An enum here is FFI-only: `=` on an Enum value fails in emit,
|
||||
;; and a keyword is not a pattern, so `match` cannot see one either. Both fixes
|
||||
;; live in check.ml and emit.ml, which this lane does not touch. An i32 loses
|
||||
;; the compile-time typo check on a keyword and gains a token kind a caller can
|
||||
;; actually branch on, which is the whole job.
|
||||
|
||||
(defconst tok-eof 0) ; the input is exhausted; text is empty
|
||||
(defconst tok-error 1) ; see (edn/error c) and (edn/error-message ...)
|
||||
(defconst tok-nil 2) ; nil
|
||||
(defconst tok-bool 3) ; true / false — text is the word
|
||||
(defconst tok-int 4) ; text parses as i64
|
||||
(defconst tok-float 5) ; text parses as f64
|
||||
(defconst tok-string 6) ; text is the CONTENTS, without the quotes
|
||||
(defconst tok-keyword 7) ; text is WITHOUT the leading colon
|
||||
(defconst tok-symbol 8) ; text is the symbol, namespace and all
|
||||
(defconst tok-vec-open 9) ; [
|
||||
(defconst tok-vec-close 10) ; ]
|
||||
(defconst tok-map-open 11) ; {
|
||||
(defconst tok-map-close 12) ; }
|
||||
(defconst tok-list-open 13) ; (
|
||||
(defconst tok-list-close 14) ; )
|
||||
|
||||
;; ── Error codes ─────────────────────────────────────────────────────
|
||||
|
||||
(defconst err-none 0)
|
||||
(defconst err-unexpected-byte 1)
|
||||
(defconst err-unterminated 2)
|
||||
(defconst err-string-escape 3) ; refusal
|
||||
(defconst err-set 4) ; refusal
|
||||
(defconst err-tagged 5) ; refusal
|
||||
(defconst err-inst 6) ; refusal
|
||||
(defconst err-uuid 7) ; refusal
|
||||
(defconst err-metadata 8) ; refusal
|
||||
(defconst err-ratio 9) ; refusal
|
||||
(defconst err-char 10) ; refusal
|
||||
(defconst err-bad-number 11)
|
||||
(defconst err-empty-keyword 12)
|
||||
(defconst err-unbalanced 13) ; a closer that does not match what is open
|
||||
(defconst err-too-deep 14)
|
||||
(defconst err-unexpected-token 15) ; raised by a caller, not by the tokenizer
|
||||
|
||||
;; How deep a nesting the balance check can follow. A fixed array in the
|
||||
;; Cursor and not a growable stack, because there is no allocator; 32 is far
|
||||
;; past anything a hand-written config file contains, 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`. Read the lifetime contract at the
|
||||
;; top of this file before storing one anywhere.
|
||||
;;
|
||||
;; `pos` is the offset of the token's first byte in the ORIGINAL buffer — of
|
||||
;; the opening quote for a string, of the colon for a keyword — so it stays a
|
||||
;; usable underline position even though `text` is narrower than the token.
|
||||
(defstruct Token
|
||||
[kind i32
|
||||
text [u8]
|
||||
pos i32])
|
||||
|
||||
;; The cursor owns no storage either: `src` is the caller's buffer.
|
||||
;;
|
||||
;; `open` is the stack of delimiters still open, holding the tok-*-close kind
|
||||
;; each one is waiting for. Balance is checked in `next` itself rather than
|
||||
;; left to a parser, because `[1 2}` is malformed in a way only the tokenizer
|
||||
;; has the position for.
|
||||
(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 file that uses one fails with
|
||||
;; the sentence explaining what to do about it rather than with a code.
|
||||
(defn error-message [code i32] string
|
||||
(cond
|
||||
(= code err-none) "no error"
|
||||
(= code err-unexpected-byte) "unexpected byte: not the start of any EDN value"
|
||||
(= code err-unterminated) "unterminated string: end of input before the closing quote"
|
||||
(= code err-string-escape) "escaped strings are refused: unescaping needs a copy of the bytes, and there is no allocator to put one in"
|
||||
(= code err-set) "sets #{} are refused: there is no hash set, and no allocator to build one in"
|
||||
(= code err-tagged) "tagged literals #tag are refused: the tag would pick the type at run time, which is what a type-directed reader exists to avoid"
|
||||
(= code err-inst) "#inst is refused: it is a tagged literal, and there is no timestamp type to read it into"
|
||||
(= code err-uuid) "#uuid is refused: it is a tagged literal, and there is no uuid type to read it into"
|
||||
(= code err-metadata) "metadata ^ is refused: it attaches to the value after it, and a flat token stream has nowhere to attach it"
|
||||
(= code err-ratio) "ratios are refused: there is no rational type, and rounding one to a float would change the value"
|
||||
(= code err-char) "character literals are refused: a character is not a byte once it is not ASCII, and there is no code point type"
|
||||
(= code err-bad-number) "not a number: the token starts like one but does not parse as an integer or a float"
|
||||
(= code err-empty-keyword) "empty keyword: a colon with no name after it"
|
||||
(= 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"
|
||||
:else "unknown error code"))
|
||||
|
||||
;; Marks the cursor failed. Public, because a caller's own reader needs to
|
||||
;; report "expected an integer 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 file, 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 ────────────────────────────────────────────────────
|
||||
|
||||
;; A comma is whitespace in EDN, which is the rule most hand-written readers
|
||||
;; get wrong: {:a 1, :b 2} is one map and the comma is not a token.
|
||||
(defn ws? [b u8] bool
|
||||
(or (space? b) (= b \,)))
|
||||
|
||||
;; Everything that ends an unquoted token. Note `;` is here: `[1;c` has the
|
||||
;; comment start immediately after the 1, with no space, and a scanner that
|
||||
;; only stopped on whitespace and brackets would read "1;c" as one number.
|
||||
(defn delim? [b u8] bool
|
||||
(or (ws? 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))))
|
||||
|
||||
;; What EDN lets a symbol begin with. It matters that this is a list and not
|
||||
;; "anything that is not a delimiter": without it every stray byte becomes a
|
||||
;; one-character symbol, and `@` or a backtick — a Clojure reader macro, not
|
||||
;; EDN — reads as a name instead of being reported at the byte it is on.
|
||||
(defn sym-start? [b u8] bool
|
||||
(or (alpha? b)
|
||||
(= b \.) (= b \*) (= b \+) (= b \!) (= b \-) (= b \_)
|
||||
(= b \?) (= b \$) (= b \%) (= b \&) (= b \=) (= b \<) (= b \>)
|
||||
(= b \/)))
|
||||
|
||||
;; ── Internal helpers ────────────────────────────────────────────────
|
||||
;;
|
||||
;; "Internal" by intent and not by enforcement: a package has no visibility
|
||||
;; yet, so edn/scan-atom and edn/push-open are as callable as edn/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. It is still a slice of
|
||||
;; the input rather than a slice of nothing, so `text` has one meaning for all
|
||||
;; token kinds.
|
||||
(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, commas, and `;` comments, which run to the newline or to the end
|
||||
;; of input — a comment on the last line of a file with no trailing newline is
|
||||
;; the case that decides whether the loop tests the length before the byte.
|
||||
(defn skip-trivia [c (Ptr Cursor)]
|
||||
(while (not (at-end? c))
|
||||
(let [b (at (.src c) (.pos c))]
|
||||
(cond
|
||||
(ws? b)
|
||||
(set (.pos c) (+ (.pos c) 1))
|
||||
|
||||
(= b \;)
|
||||
(do
|
||||
(while (and (not (at-end? c)) (!= (at (.src c) (.pos c)) \newline))
|
||||
(set (.pos c) (+ (.pos c) 1)))
|
||||
;; The newline itself, if there is one. If there is not, at-end? is
|
||||
;; already true and the outer loop stops.
|
||||
(when (not (at-end? c))
|
||||
(set (.pos c) (+ (.pos c) 1))))
|
||||
|
||||
:else
|
||||
(return)))))
|
||||
|
||||
;; 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 ─────────────────────────────────────────────────────────
|
||||
|
||||
;; A token starting with a digit, or with a sign or a dot followed by one.
|
||||
;; `-` alone is a symbol in EDN and stays one here.
|
||||
(defn number-start? [c (Ptr Cursor) i i32] bool
|
||||
(let [s (.src c)]
|
||||
(when (>= i (len s))
|
||||
(return false))
|
||||
(when (digit? (at s i))
|
||||
(return true))
|
||||
(and (or (= (at s i) \-) (= (at s i) \+) (= (at s i) \.))
|
||||
(< (+ i 1) (len s))
|
||||
(digit? (at s (+ i 1))))))
|
||||
|
||||
(defn read-number [c (Ptr Cursor) lo i32] Token
|
||||
(let [hi (scan-atom c lo)]
|
||||
(set (.pos c) hi)
|
||||
(let [text (slice (.src c) lo hi)]
|
||||
;; A ratio is caught here and not by a "contains a slash" rule over every
|
||||
;; token, because a slash is perfectly ordinary in a symbol: foo/bar is a
|
||||
;; namespaced name and must stay one.
|
||||
(when (match (index-of-byte text \/) (Some _) true None false)
|
||||
(fail c err-ratio lo)
|
||||
(return (error-token c)))
|
||||
(when (match (parse-i64 text) (Some _) true None false)
|
||||
(return (token c tok-int lo hi lo)))
|
||||
(when (match (parse-f64 text) (Some _) true None false)
|
||||
(return (token c tok-float lo hi lo)))
|
||||
;; "12x", and also EDN's own 1N and 1M, which have no type here.
|
||||
(fail c err-bad-number lo)
|
||||
(error-token c))))
|
||||
|
||||
;; ── Strings ─────────────────────────────────────────────────────────
|
||||
|
||||
;; The whole reason this is not three lines. `text` is the interior, between
|
||||
;; the quotes — so the bytes are usable directly — but `pos` is the opening
|
||||
;; quote, so an editor underlines the literal and not its contents.
|
||||
;;
|
||||
;; A backslash anywhere inside is the refusal, reported at the backslash
|
||||
;; rather than at the start of the string, because the backslash is what has
|
||||
;; to be removed.
|
||||
(defn read-string [c (Ptr Cursor) lo i32] Token
|
||||
(let [i (+ lo 1)
|
||||
s (.src c)]
|
||||
(while (< i (len s))
|
||||
(let [b (at s i)]
|
||||
(when (= b \\)
|
||||
(set (.pos c) i)
|
||||
(fail c err-string-escape i)
|
||||
(return (error-token c)))
|
||||
(when (= b \")
|
||||
(set (.pos c) (+ i 1))
|
||||
(return (token c tok-string (+ lo 1) i lo)))
|
||||
(set i (+ i 1))))
|
||||
;; Ran off the end with the string 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 file 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 file 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-vec-close lo)
|
||||
(token c tok-vec-open lo lo lo)
|
||||
(error-token c)))
|
||||
|
||||
(= b \])
|
||||
(do (set (.pos c) (+ lo 1))
|
||||
(if (pop-close c tok-vec-close lo)
|
||||
(token c tok-vec-close lo lo lo)
|
||||
(error-token c)))
|
||||
|
||||
(= b \{)
|
||||
(do (set (.pos c) (+ lo 1))
|
||||
(if (push-open c tok-map-close lo)
|
||||
(token c tok-map-open lo lo lo)
|
||||
(error-token c)))
|
||||
|
||||
(= b \})
|
||||
(do (set (.pos c) (+ lo 1))
|
||||
(if (pop-close c tok-map-close lo)
|
||||
(token c tok-map-close lo lo lo)
|
||||
(error-token c)))
|
||||
|
||||
(= b \()
|
||||
(do (set (.pos c) (+ lo 1))
|
||||
(if (push-open c tok-list-close lo)
|
||||
(token c tok-list-open lo lo lo)
|
||||
(error-token c)))
|
||||
|
||||
(= b \))
|
||||
(do (set (.pos c) (+ lo 1))
|
||||
(if (pop-close c tok-list-close lo)
|
||||
(token c tok-list-close lo lo lo)
|
||||
(error-token c)))
|
||||
|
||||
(= b \")
|
||||
(read-string c lo)
|
||||
|
||||
;; ── Keywords ───────────────────────────────────────────────────
|
||||
(= b \:)
|
||||
(let [hi (scan-atom c (+ lo 1))]
|
||||
(set (.pos c) hi)
|
||||
(if (= hi (+ lo 1))
|
||||
(do (fail c err-empty-keyword lo) (error-token c))
|
||||
;; text drops the colon: a caller comparing against "name" should not
|
||||
;; have to write ":name", and the compiler-side reader will want the
|
||||
;; bare name to match a field against.
|
||||
(token c tok-keyword (+ lo 1) hi lo)))
|
||||
|
||||
;; ── The refusals that have their own byte ──────────────────────
|
||||
(= b \^)
|
||||
(do (set (.pos c) (+ lo 1))
|
||||
(fail c err-metadata lo)
|
||||
(error-token c))
|
||||
|
||||
(= b \\)
|
||||
(do (set (.pos c) (+ lo 1))
|
||||
(fail c err-char lo)
|
||||
(error-token c))
|
||||
|
||||
(= b \#)
|
||||
(let [hi (scan-atom c (+ lo 1))]
|
||||
(set (.pos c) hi)
|
||||
(cond
|
||||
;; #{ — the brace is a delimiter, so scan-atom stopped before it and
|
||||
;; hi is lo+1. Nothing is pushed on the balance stack: the cursor is
|
||||
;; failing here and will not report a second thing about this file.
|
||||
(and (< (+ lo 1) (len s)) (= (at s (+ lo 1)) \{))
|
||||
(do (fail c err-set lo) (error-token c))
|
||||
|
||||
(bytes=? (slice s (+ lo 1) hi) (bytes "inst"))
|
||||
(do (fail c err-inst lo) (error-token c))
|
||||
|
||||
(bytes=? (slice s (+ lo 1) hi) (bytes "uuid"))
|
||||
(do (fail c err-uuid lo) (error-token c))
|
||||
|
||||
:else
|
||||
(do (fail c err-tagged lo) (error-token c))))
|
||||
|
||||
;; ── Numbers, then everything else as a symbol ──────────────────
|
||||
(number-start? c lo)
|
||||
(read-number c lo)
|
||||
|
||||
:else
|
||||
(let [hi (scan-atom c lo)]
|
||||
;; Two ways to get here without a symbol. `hi = lo` would be a
|
||||
;; zero-length atom and an infinite loop; a byte that is not a symbol
|
||||
;; start is `@` or a backtick, which are Clojure and not EDN. Both
|
||||
;; advance one byte before failing, so the position is the offending
|
||||
;; byte and the loop cannot spin on it.
|
||||
(when (or (= hi lo) (not (sym-start? b)))
|
||||
(set (.pos c) (+ lo 1))
|
||||
(fail c err-unexpected-byte lo)
|
||||
(return (error-token c)))
|
||||
(set (.pos c) hi)
|
||||
(let [text (slice s lo hi)]
|
||||
(cond
|
||||
(bytes=? text (bytes "nil")) (token c tok-nil 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)
|
||||
:else (token c tok-symbol lo hi lo)))))))
|
||||
|
||||
;; ── 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, which is the same reason parse-i64 is
|
||||
;; Flan and not strtoll.
|
||||
|
||||
(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 config
|
||||
;; file that writes `:speed 2` for an f32 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))
|
||||
|
||||
(defn text=? [t Token s string] bool
|
||||
(bytes=? (.text t) (bytes s)))
|
||||
|
||||
;; A keyword whose name is s. The leading colon is not part of `text`, so this
|
||||
;; is written (keyword=? t "hp") and not (keyword=? t ":hp").
|
||||
(defn keyword=? [t Token s string] bool
|
||||
(and (= (.kind t) tok-keyword) (bytes=? (.text t) (bytes s))))
|
||||
|
||||
;; ── Reading past a value ────────────────────────────────────────────
|
||||
|
||||
;; Consumes exactly one value — a scalar, or a whole collection with everything
|
||||
;; nested inside it. This is what a struct reader calls on a map key it does
|
||||
;; not know, so an extra field in a data file 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 file is a crash rather than err-too-deep.
|
||||
(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))
|
||||
;; A scalar is one token and we are done. A closer here is a value ending
|
||||
;; that never began, which pop-close has already reported.
|
||||
(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 hand-written 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 friends 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))
|
||||
Loading…
x
Reference in New Issue
Block a user