diff --git a/FIX.org b/FIX.org index bdee8b5..144b3ad 100644 --- a/FIX.org +++ b/FIX.org @@ -311,3 +311,31 @@ Ten bug lanes and three demolitions, all on dev-loop and verified together: whose editor vanished, a separate defect (accept_loop has no client liveness), recorded here, not fixed. The eight are still alive and the author decides their fate. + +* The dynamic half of item 4, finished +Item 4 above is the complaint at line 23: the edn module should read into a +struct *and* answer a dynamic value when no type is given. The dynamic half is +now the package's rather than a test program's. + +- [#{}] is read, not refused. The tokenizer's stated reason ("needs a hash set + to even represent") was a claim about a reader, and a tokenizer represents + nothing; [#{] pushes [}] on the same balance stack [{] does, one new token + kind, and [err-set] is gone rather than kept with a new message. +- [vendor/edn/read.flan] holds the [Value] data type and [(edn/read bytes)], + which answers an [(Option Value)] against the calling convention's + allocator. A set is [Value.Set] holding a deduplicated [(Vec Value)] — + [(Map Value bool)] does not typecheck, because [keyable] refuses a key + holding a Vec or a Map, and restricting set elements to keyable Values would + refuse [#{[0 0] [1 0]}], which is the file this was built for. +- A Value COPIES every string into the allocator; a Token stays a view. The + two layers diverge deliberately and both headers say so. A view handed out + of the function that owns the buffer is a dangling pointer no free-all would + even take back. +- Needed one compiler change to be possible at all: an imported [defdata] was + a refusal in load.ml ("not implemented yet, milestone 4"). It is a rename of + the type's name plus the [Type.Case] half of a constructor symbol; a match + pattern resolves its case against the scrutinee's type and never needed one. + +Still not built, still item 9 on docs/PORTING.md's list: [(read-edn T bytes)], +the typed half. It wants a compile-time walk over a struct's fields and there +is no run-time type information to do it with at run time. diff --git a/NEXT.md b/NEXT.md index b032bcd..76682ed 100644 --- a/NEXT.md +++ b/NEXT.md @@ -1732,7 +1732,9 @@ Two smaller findings, both written down beside the code that ran into them: the flow analysis (spec-memory.md, "The repeal"): the early-`return` shape compiles now, and `replace-bytes` no longer needs its `if` workaround, though it keeps it harmlessly. -Already present and easy to miss: an **EDN parser**, at `vendor/edn/edn.flan`. +Already present and easy to miss: an **EDN reader**, at `vendor/edn/` — `edn.flan` is the non-allocating +tokenizer, `read.flan` is `(edn/read bytes)` answering a dynamic `Value` against the calling convention's +allocator. Sets are read, as a `Value.Set` holding a deduplicated `(Vec Value)`. ## Decided: the Clojure patterns we are deliberately not copying diff --git a/docs/PORTING.md b/docs/PORTING.md index b49d23d..4349110 100644 --- a/docs/PORTING.md +++ b/docs/PORTING.md @@ -206,14 +206,18 @@ type's shape rather than its name. `engine.lisp` `read-data`, `game.lisp` `load-tileset` and `read-bitmask` read plists out of `assets/*.data` at startup, and `reload-config!` re-reads the config while the game -runs. `vendor/edn/edn.flan` is a 561-line tokenizer with `int-of` / `text=?` / -`keyword=?` / `expect`, and `test/programs/edn.flan` includes a hand-written struct -reader as the worked example. +runs. `vendor/edn/edn.flan` is the tokenizer — `int-of` / `text=?` / `keyword=?` / +`expect` — and `vendor/edn/read.flan` is `(edn/read bytes)`, which answers a dynamic +`Value` for a document nobody declared a type for. `test/programs/edn.flan` is the +hand-written struct reader as the worked example; `test/programs/edn-read.flan` reads the +tileset file itself. -So this is writable today. It costs a hand-written reader per schema — two here, the -tileset (`:texture-path`, `:selected-cells`) and the bitmask table — because `(read-edn T -bytes)` is not built. Call it ~80 lines, once, at load time. See §3 for whether it should -be written at all. +So this is writable today, and the tileset needs no hand-written reader at all: it reads +as a `Value.Table` whose `:selected-cells` is a `Value.Set` of pairs, against an arena, +released by one `free-all`. A hand-written reader is still what a *struct* costs, because +`(read-edn T bytes)` is not built — call it ~80 lines for the bitmask table if it wants +to land in a struct rather than a `Value`. See §3 for whether it should be written at +all. --- diff --git a/lib/load.ml b/lib/load.ml index b2d01df..e95b073 100644 --- a/lib/load.ml +++ b/lib/load.ml @@ -135,6 +135,29 @@ let entries dir suffix = let qualify alias n = alias ^ "/" ^ n +(* A data type's value is written [Value.Int], which the reader hands over as + one symbol with a dot in the middle of it. The half before the dot is a + top-level name the package declares; the half after it is a case, and a + case is not a declaration and has no existence apart from its type. So a + rename splits the symbol and qualifies the half that is a name — without + this, the package's own [(Value.Int {.n 1})] would survive the import + naming a type the importer has never heard of. + + Written as a rule about the symbol rather than as a [Defdata] case in + [rename_expr] because the constructor arrives in three different Ast nodes + — [Var] for a case with no fields, [Struct] for one with them, [Call] for + the mistake of writing [(Value.Int)] — and one of them checking for cases + while the others did not is precisely the kind of gap that shows up as a + package whose nullary cases import and whose others do not. *) +let qualify_name owned alias bound n = + let declared n = List.mem n owned && not (List.mem n bound) in + if declared n then qualify alias n + else + match String.index_opt n '.' with + | Some i when declared (String.sub n 0 i) -> + qualify alias (String.sub n 0 i) ^ String.sub n i (String.length n - i) + | _ -> n + (* The type names the package itself declares. Only these are rewritten: a reference to [i32] or to [Ptr] must survive untouched. *) let rec rename_texpr owned alias (t : Ast.texpr) : Ast.texpr = @@ -169,7 +192,7 @@ let rec rename_texpr owned alias (t : Ast.texpr) : Ast.texpr = let rec rename_expr owned alias bound (e : Ast.expr) : Ast.expr = let go = rename_expr owned alias bound in let gos = List.map go in - let name n = if List.mem n owned && not (List.mem n bound) then qualify alias n else n in + let name n = qualify_name owned alias bound n in let k = match e.Ast.e with | Ast.Int _ | Ast.Float _ | Ast.Byte _ | Ast.Str _ | Ast.Kw _ @@ -336,10 +359,21 @@ let qualify_decl owned alias (d : Ast.decl) : Ast.decl = than anything a user wrote. *) | Ast.Import (a, _) -> fail loc "internal: the import of %s was not resolved before qualifying" a - | Ast.Defdata (n, _) -> - fail loc "%s is a data type, and an imported data type is not \ - implemented yet \ - (milestone 4)" n + (* A data type imports as the struct above it does, plus one thing the + struct has no equivalent of: the case table. That table is the checker's + and it is built from this declaration, so qualifying the type's name + here is all it takes — [env.cases] keys itself on [type ^ "." ^ case] + and a pattern resolves its case against the *scrutinee's* type, never + against a name. Which is why an importer still writes [(Int n)] bare in + a match: the case name was never a top-level name to qualify. *) + | Ast.Defdata (n, vs) -> + Ast.Defdata + (qualify alias n, + List.map + (fun (v : Ast.variant) -> + { v with + Ast.vfields = List.map (rename_field owned alias) v.Ast.vfields }) + vs) in { d with Ast.d = k } @@ -387,8 +421,13 @@ let rec rename_form owned alias bound (f : Form.t) : Form.t = let keep v = { f with Form.v = v } in let go b x = rename_form owned alias b x in match f.Form.v with - | Form.Sym n when List.mem n owned && not (List.mem n bound) -> - keep (Form.Sym (qualify alias n)) + (* [qualify_name] and not the plain membership test, so that a macro + quasiquoting [Value.Int] emits the importer's spelling of it. A macro is + renamed over the text its author wrote and nothing downstream gets a + second chance at it, so a case name missed here is wrong code rather than + a refusal. *) + | Form.Sym n when qualify_name owned alias bound n <> n -> + keep (Form.Sym (qualify_name owned alias bound n)) | Form.List (({ Form.v = Form.Sym ("let" | "loop"); _ } as hd) :: { Form.v = Form.Vec bs; loc = bloc } :: body) -> (* Sequential, as [let] itself is: an initialiser sees the bindings before diff --git a/test/dune b/test/dune index 1f2004e..0905e49 100644 --- a/test/dune +++ b/test/dune @@ -24,7 +24,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. + ; The EDN package — the tokenizer and the dynamic reader over it — which + ; programs/edn.flan, arena-edn.flan and edn-read.flan import. (glob_files %{workspace_root}/vendor/edn/*) ; The ported raylib examples. Only one of them has a headless acceptance ; case, but it imports its example as a package and that example imports @@ -41,6 +42,8 @@ (glob_files programs/pkgs/ring-a/*) (glob_files programs/pkgs/ring-b/*) (glob_files programs/pkgs/ring-c/*) + ; The package that exports a data type, which pkg-data.flan imports. + (glob_files programs/pkgs/tree/*) ; The packages that declare macros: one whose macros a program calls ; qualified, and the two whose macros do not terminate — a ring, and one ; that never settles. Each is its own directory, so each needs its own glob. @@ -55,6 +58,11 @@ ; The files programs/embed.flan bakes in. An embed reads them at *compile* ; time, so they are a dependency of the checker run and not of the program. (glob_files programs/assets/*) + ; And the tileset programs/edn-read.flan bakes in, which is under assets/ and + ; not in it: embed.flan holds (embed-dir "assets") in a [3 EmbedFile], so a + ; fourth file beside those three is a type error in an unrelated program. + ; embed-dir does not descend and neither does a glob, so this is its own line. + (glob_files programs/assets/edn/*) ; The reload primitive's host: a C main that dlopens what Build.shared made. (file reload_host.c) ; A shared object that is not a redefinition module, for the agent's refusal @@ -82,6 +90,7 @@ (deps (glob_files programs/*.flan) (glob_files programs/assets/*) + (glob_files programs/assets/edn/*) ; The raylib bindings and the ported example the raylib case builds. The ; example imports examples/digits.flan, so the directory comes whole. (glob_files %{workspace_root}/vendor/raylib/*) @@ -121,7 +130,8 @@ (glob_files %{workspace_root}/vendor/edn/*) (glob_files %{workspace_root}/examples/*) (glob_files programs/*.flan) - (glob_files programs/assets/*)) + (glob_files programs/assets/*) + (glob_files programs/assets/edn/*)) (action (run ./test_sanitize.exe))) ; The corpus a third time, under Valgrind's memcheck. Its own alias for the @@ -156,6 +166,7 @@ (glob_files %{workspace_root}/examples/*) (glob_files programs/*.flan) (glob_files programs/assets/*) + (glob_files programs/assets/edn/*) ; The package tree the multi-level cases import, as in the test stanza ; above: a glob per directory, because dune's glob does not descend. (glob_files programs/pkgs/shape/*) @@ -164,6 +175,7 @@ (glob_files programs/pkgs/ring-a/*) (glob_files programs/pkgs/ring-b/*) (glob_files programs/pkgs/ring-c/*) + (glob_files programs/pkgs/tree/*) ; And the macro-declaring packages, for the same reason. (glob_files programs/pkgs/mac/*) (glob_files programs/pkgs/macring/*) @@ -211,6 +223,7 @@ (glob_files %{workspace_root}/examples/*) (glob_files programs/*.flan) (glob_files programs/assets/*) + (glob_files programs/assets/edn/*) ; A glob per package directory, because dune's glob does not descend. (glob_files programs/pkgs/shape/*) (glob_files programs/pkgs/area/*) @@ -218,6 +231,7 @@ (glob_files programs/pkgs/ring-a/*) (glob_files programs/pkgs/ring-b/*) (glob_files programs/pkgs/ring-c/*) + (glob_files programs/pkgs/tree/*) (glob_files programs/pkgs/mac/*) (glob_files programs/pkgs/macring/*) (glob_files programs/pkgs/macspin/*)) @@ -371,12 +385,14 @@ (glob_files %{workspace_root}/examples/*) (glob_files programs/*.flan) (glob_files programs/assets/*) + (glob_files programs/assets/edn/*) (glob_files programs/pkgs/shape/*) (glob_files programs/pkgs/area/*) (glob_files programs/pkgs/draw/*) (glob_files programs/pkgs/ring-a/*) (glob_files programs/pkgs/ring-b/*) (glob_files programs/pkgs/ring-c/*) + (glob_files programs/pkgs/tree/*) (glob_files programs/pkgs/mac/*) (glob_files programs/pkgs/macring/*) (glob_files programs/pkgs/macspin/*)) diff --git a/test/programs/arena-edn.flan b/test/programs/arena-edn.flan index 70c8cb2..556ffd7 100644 --- a/test/programs/arena-edn.flan +++ b/test/programs/arena-edn.flan @@ -8,7 +8,7 @@ ;;;; ;;;; ── The allocator story, which is the point of the program ─────────── ;;;; -;;;; read-value below takes no allocator and names none. It does not need to: +;;;; edn/read takes no allocator and names none. It does not need to: ;;;; spec-memory.md puts the allocator in the calling convention, so every ;;;; (vec-new) and (map-new) inside it takes the *context*, and the caller ;;;; chooses the tier with (with-allocator ...) around the call. An explicit @@ -35,81 +35,31 @@ ;;;; alternative, and it needs nothing from the language that was not already ;;;; there. ;;;; -;;;; ── One lifetime that is not the region's ──────────────────────────── +;;;; ── The reader moved, and what is left here ────────────────────────── ;;;; -;;;; A Token's text is a slice INTO the source buffer, and (string ...) over it -;;;; is a view and not a copy — so every Text, every Key and every map key here -;;;; points at `src`, not at the arena. The document outlives free-all in that -;;;; one respect and dies with the buffer instead. That is edn.flan's stated -;;;; contract and not a new one; it is repeated because a reader looking at a -;;;; value that survived a free-all would otherwise think the region had -;;;; leaked. +;;;; read-value used to be written out in this file. It is vendor/edn's now, as +;;;; (edn/read bytes), and what this program keeps is the half that was always +;;;; the demonstration: the walk back over a document nobody declared a type +;;;; for, and the one free-all that ends it. The strings are the package's own +;;;; copies in the region now rather than views into `doc`, which is why there +;;;; is nothing left here saying which parts of the value outlive the release. (import edn "vendor:edn") (defvar frame Allocator) -(defdata Value - [(Nil []) - (Bool [b bool]) - (Int [n i64]) - (Float [x f64]) - (Text [s string]) - (Key [s string]) - (List [items (Vec Value)]) - (Table [entries (Map string Value)])]) - -;; One token in hand, and the cursor for whatever the token opens. A vector and -;; a map recurse; everything else is a leaf. -(defn read-value [c (Ptr edn/Cursor) t edn/Token] Value - (cond - (= (.kind t) edn/tok-bool) - (Value.Bool {.b (match (edn/bool-of t) (Some v) v None false)}) - (= (.kind t) edn/tok-int) - (Value.Int {.n (match (edn/int-of t) (Some v) v None (i64 0))}) - (= (.kind t) edn/tok-float) - (Value.Float {.x (match (edn/float-of t) (Some v) v None 0.0)}) - (= (.kind t) edn/tok-string) (Value.Text {.s (string (.text t))}) - (= (.kind t) edn/tok-keyword) (Value.Key {.s (string (.text t))}) - (= (.kind t) edn/tok-symbol) (Value.Key {.s (string (.text t))}) - - (= (.kind t) edn/tok-vec-open) - (let [items (vec-new Value) - u (edn/next c)] - (while (and (edn/ok? c) - (!= (.kind u) edn/tok-vec-close) - (!= (.kind u) edn/tok-eof)) - (push items (read-value c u)) - (set u (edn/next c))) - (Value.List {.items items})) - - ;; A map's key is whatever token is there — a keyword here, and its text - ;; slice is the key. The value is read by the same recursion, so a map of - ;; vectors of maps is one call per level and no special case. - (= (.kind t) edn/tok-map-open) - (let [entries (map-new string Value) - k (edn/next c)] - (while (and (edn/ok? c) - (!= (.kind k) edn/tok-map-close) - (!= (.kind k) edn/tok-eof)) - (let [v (edn/next c)] - (put entries (string (.text k)) (read-value c v))) - (set k (edn/next c))) - (Value.Table {.entries entries})) - - :else Value.Nil)) - -;; 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, so a document is read back -;; with the operations that were already there. -(defn count-leaves [v Value] i32 +(defn count-leaves [v edn/Value] i32 (match v (List items) (let [n 0] (dotimes [i (len items)] (set n (+ n (count-leaves (at items i))))) n) + (Set 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 — nothing @@ -119,13 +69,13 @@ (let [n 0 cur (i64 0) k "" - v Value.Nil] + v edn/Value.Nil] (while (map-next! entries (addr cur) (addr k) (addr v)) (set n (+ n (count-leaves v)))) n) _ 1)) -(defn sum-ints [v Value] i64 +(defn sum-ints [v edn/Value] i64 (match v (Int n) n (List items) @@ -137,16 +87,11 @@ (match (get entries "xs") (Some x) (sum-ints x) None (i64 0)) _ (i64 0))) -(defn describe [v Value] string +(defn describe [v edn/Value] string (match v Nil "nil" (Bool _b) "bool" (Int _n) "int" (Float _x) "float" - (Text _s) "string" (Key _s) "keyword" (List _i) "vector" (Table _e) "map")) - -(defn read-doc [src string] Value - (let [b (bytes src) - c (edn/cursor b) - t (edn/next (addr c))] - (read-value (addr c) t))) + (Text _s) "string" (Key _s) "keyword" (List _i) "vector" + (Set _i) "set" (Table _e) "map")) (defconst doc "{:name \"level-1\" @@ -159,16 +104,23 @@ (defn main [] i32 (set frame (arena-new 65536)) (with-allocator frame - (let [v (read-doc doc)] - (println (describe v)) - (println (count-leaves v)) - (println (sum-ints v)) - (match v - (Table entries) - (match (get entries "name") - (Some n) (println (describe n)) - None (println "missing")) - _ (println "not a map")))) + ;; None is the malformed document, and it cannot happen for a literal that + ;; is right here — but reading it back out of the Option is what makes the + ;; refusal visible at the call site instead of arriving as a Nil that looks + ;; like data. + (match (edn/read (bytes doc)) + (Some v) + (do + (println (describe v)) + (println (count-leaves v)) + (println (sum-ints v)) + (match v + (Table entries) + (match (get entries "name") + (Some n) (println (describe n)) + None (println "missing")) + _ (println "not a map"))) + None (println "malformed"))) ;; The whole document, in one operation and with no per-element teardown. (free-all frame) (arena-destroy frame) diff --git a/test/programs/assets/edn/tileset.edn b/test/programs/assets/edn/tileset.edn new file mode 100644 index 0000000..d4b5566 --- /dev/null +++ b/test/programs/assets/edn/tileset.edn @@ -0,0 +1,2 @@ +{:texture-path "./source-assets/Sprout Lands Premium/Objects/Mushrooms, Flowers, Stones.png", + :selected-cells #{[4 3] [2 2] [0 0] [3 9] [2 8] [1 0] [2 3] [0 6] [3 3] [1 1] [0 5] [3 4] [4 2] [3 0] [1 9] [4 7] [4 10] [4 9] [1 10] [2 9] [4 11] [4 1] [4 6] [1 4] [1 11] [1 3] [4 8] [1 5] [1 8] [1 7] [0 3] [2 11] [2 7] [3 6] [4 5] [0 2] [2 0] [0 4] [3 11] [0 10] [3 1] [3 10] [2 1] [3 8] [1 6] [4 4] [3 7] [2 10] [2 6] [1 2] [3 5] [3 2] [0 1] [4 0]}} diff --git a/test/programs/edn-read.flan b/test/programs/edn-read.flan new file mode 100644 index 0000000..2e1d295 --- /dev/null +++ b/test/programs/edn-read.flan @@ -0,0 +1,125 @@ +;;;; (edn/read bytes) over the file it was built for, plus the two properties +;;;; that are only claims until something runs them. +;;;; +;;;; assets/edn/tileset.edn is the real thing, copied out of the editor that +;;;; writes it: a map of :texture-path to a string and :selected-cells to a set +;;;; of 54 integer pairs. Nothing here declares a type for it — the point. +;;;; +;;;; It is in a subdirectory of assets/ rather than in it, because programs/ +;;;; embed.flan holds (embed-dir "assets") in a [3 EmbedFile] and a fourth file +;;;; beside the other three is a type error in a program that has nothing to do +;;;; with this one. embed-dir does not descend, which is what makes a +;;;; subdirectory the answer rather than a second assets directory. +;;;; The hand-written struct reader in programs/edn.flan is the other route and +;;;; needs a defstruct per file; this one needs nothing and reads a file whose +;;;; keys it has never heard of. +;;;; +;;;; The two properties: +;;;; +;;;; * a set holds each value once, by *structure*. #{[0 0] [0 0]} is one +;;;; element, and a dedup written with `=` would make it two — two Vec +;;;; headers over two blocks are never the same header. +;;;; +;;;; * a Value owns its strings. The last case reads a document out of a +;;;; buffer and then overwrites every byte of that buffer in place. A +;;;; reader holding views prints the overwriting bytes; one holding copies +;;;; prints what was in the file. The buffer is written rather than freed +;;;; because a freed buffer is a read of released memory, which can pass by +;;;; luck; overwriting it cannot. + +(import edn "vendor:edn") + +(defvar frame Allocator) + +;; The document, read at compile time. An embed is bytes in the binary, so +;; there is no file open here and no path to get wrong at run time. +(defconst tileset (embed "assets/edn/tileset.edn")) + +;; [a b] as a Value, so a membership test can be written against a pair this +;; program made rather than one it found. Building a Value from outside the +;; package is the same two forms as building one inside it. +(defn pair [a i64 b i64] edn/Value + (let [items (vec-new edn/Value)] + (push items (edn/Value.Int {.n a})) + (push items (edn/Value.Int {.n b})) + (edn/Value.List {.items items}))) + +(defn field [v edn/Value k string] edn/Value + (match v + (Table entries) (match (get entries k) (Some x) x None edn/Value.Nil) + _ edn/Value.Nil)) + +(defn show-tileset [] () + (match (edn/read tileset) + (Some doc) + (do + (match (field doc "texture-path") + (Text s) (println s) + _ (println "no texture path")) + (match (field doc "selected-cells") + (Set cells) + (do + (println (len cells)) + ;; Two cells that are in the file and one that is not. A reader + ;; that flattened the pairs into 108 integers would still have + ;; the right count of *something*, and would miss both of these. + (println (edn/member? cells (pair (i64 4) (i64 3)))) + (println (edn/member? cells (pair (i64 0) (i64 0)))) + (println (edn/member? cells (pair (i64 3) (i64 4)))) + (println (edn/member? cells (pair (i64 9) (i64 9))))) + _ (println "no cells"))) + None (println "malformed"))) + +;; The size of a set after the dedup, which is the whole of what the dedup can +;; be asked for. +(defn set-size [src string] () + (match (edn/read (bytes src)) + (Some v) (match v (Set items) (println (len items)) _ (println "not a set")) + None (println "malformed"))) + +;; A document in a buffer this program owns and can write to. (bytes "literal") +;; is not that — a literal is constant data behind a writable-looking slice — +;; so the source is built with append! and the write goes through as-slice. +(defn survives-its-buffer [] () + (let [buf (vec-new u8)] + (append! (addr buf) (bytes "{:name \"level-1\" :xs [1 2]}")) + (let [src (as-slice buf) + v (edn/read src)] + (dotimes [i (len src)] + (set (at src i) \x)) + (match v + (Some doc) + (match (field doc "name") + (Text s) (println s) + _ (println "no name")) + None (println "malformed"))))) + +(defn main [] i32 + (set frame (arena-new 262144)) + (with-allocator frame + (do + (show-tileset) + (println "") + + ;; Dedup, on each kind of element a set can hold. The nested pair is the + ;; one a structural compare is needed for; the nested *set* is the one + ;; that also needs the compare to ignore order, or #{1 2} and #{2 1} + ;; would be two elements. + (set-size "#{}") + (set-size "#{1 1 2}") + (set-size "#{[0 0] [0 0] [0 1]}") + (set-size "#{\"a\" \"a\" :a :a}") + (set-size "#{#{1 2} #{2 1}}") + (set-size "#{{:a 1} {:a 1} {:a 2}}") + (set-size "#{1 1.0}") ; an int and a float are two values + (set-size "#{true false true}") + (println "") + + (survives-its-buffer) + ;; And the refusal, which has to be distinguishable from the document + ;; that is literally nil. + (match (edn/read (bytes "#{1 2")) (Some _v) (println "read") None (println "malformed")) + (match (edn/read (bytes "nil")) (Some _v) (println "read") None (println "malformed")))) + (free-all frame) + (arena-destroy frame) + 0) diff --git a/test/programs/edn.flan b/test/programs/edn.flan index b27b24f..d9c845a 100644 --- a/test/programs/edn.flan +++ b/test/programs/edn.flan @@ -35,6 +35,9 @@ (= k edn/tok-map-close) "}" (= k edn/tok-list-open) "(" (= k edn/tok-list-close) ")" + ;; A set closes on `}`, so the dump shows `#` … `}` and there is no letter + ;; for a set's closer to have. + (= k edn/tok-set-open) "#" :else "?")) (defn dump [src string] () @@ -170,6 +173,17 @@ (dump "{:a {:b []}}") (println "") + ;; Sets. `#{` is one token and two bytes, and the `}` that ends it is the + ;; same token a map's is — which is the whole of what the balance stack was + ;; told. The last two are the cases a `#` arm that forgot to push get wrong: + ;; a set inside a map has to close the set before the map, and an empty set + ;; is the one where the opener and the closer are adjacent. + (dump "#{1 2}") + (dump "#{}") + (dump "{:a #{1 2} :b 3}") + (dump "#{[4 3] [2 2]}") + (println "") + ;; 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") @@ -202,7 +216,10 @@ (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 + ;; A set is read now, so what is left to refuse about one is its balance. A + ;; `#{` that pushed nothing would answer "no error" for both of these. + (refusal "#{1 2)") ; the wrong closer for a set + (refusal "#{1 2") ; end of input with the set still open (refusal "#foo {}") ; a tagged literal (refusal "#inst \"2024\"") ; named separately (refusal "#uuid \"x\"") @@ -229,6 +246,10 @@ ;; 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\"}") + ;; An unknown key whose value is a set, which skip-value has to walk past on + ;; the balance stack like any other collection — and a set nested in it, so + ;; that a `#{` pushing nothing would leave the map open and swallow :hp. + (show-enemy "{:name \"wisp\" :tags #{:a #{:b} [1]} :hp 5}") ;; :speed given as an integer — 2 and 2.0 are the same number. (show-enemy "{:name \"imp\" :hp 1 :speed 2}") (show-enemy "{}") diff --git a/test/programs/pkg-data.flan b/test/programs/pkg-data.flan new file mode 100644 index 0000000..4bc0bce --- /dev/null +++ b/test/programs/pkg-data.flan @@ -0,0 +1,41 @@ +;;;; A data type imported from a package, which was a refusal until vendor/edn +;;;; needed one — "an imported data type is not implemented yet (milestone 4)". +;;;; +;;;; Four things, and each is a different way the rename could be half done: +;;;; the type named in a signature, a constructor written on this side of the +;;;; import, a constructor the *package* wrote and the import had to rewrite, +;;;; and a match whose patterns name the cases bare. The last is the one that +;;;; needs no rename at all — a pattern resolves against the scrutinee's type — +;;;; and it is here so that the day someone qualifies case names too, this says +;;;; what broke. + +(import tree "pkgs/tree") + +(defvar frame Allocator) + +;; The type in a signature, and a bare pattern over a value the package made. +(defn describe [t tree/Node] string + (match t + (Leaf _n) "leaf" + (Branch _k) "branch" + Empty "empty")) + +(defn main [] i32 + (set frame (arena-new 4096)) + (with-allocator frame + (let [kids (vec-new tree/Node)] + ;; Written here, qualified, which is how the importer spells it. + (push kids (tree/Node.Leaf {.n (i64 1)})) + ;; Written inside the package, unqualified, and rewritten by the import. + (push kids (tree/leaf (i64 2))) + (push kids (tree/nothing)) + (let [t (tree/Node.Branch {.kids kids})] + (println (describe t)) + (println (describe (tree/leaf (i64 9)))) + (println (describe (tree/nothing))) + ;; Summed by the package's own match, over a value this file built, so + ;; the two sides agree about the layout and not only about the names. + (println (tree/total t))))) + (free-all frame) + (arena-destroy frame) + 0) diff --git a/test/programs/pkgs/tree/tree.flan b/test/programs/pkgs/tree/tree.flan new file mode 100644 index 0000000..6261e6d --- /dev/null +++ b/test/programs/pkgs/tree/tree.flan @@ -0,0 +1,32 @@ +;;;; A data type a package exports, which is what vendor/edn's Value needed. +;;;; +;;;; A struct imports by renaming one name. A data type has a second half — the +;;;; case table — and the question this package exists to answer is where each +;;;; half ends up. The answer is that a case is not a top-level name: it has no +;;;; existence apart from its type, so the only thing to qualify is the [Node.] +;;;; in front of it, and an importer's [(Leaf n)] pattern stays bare because it +;;;; resolves against the scrutinee's type and never against a name. + +(defdata Node + [(Leaf [n i64]) + (Branch [kids (Vec Node)]) + (Empty [])]) + +;; Built inside the package, where the constructor is written unqualified and +;; the import has to rewrite it. +(defn leaf [n i64] Node (Node.Leaf {.n n})) + +;; A case with no fields is a value and not a call, so this is the [Var] node +;; where the others are [Struct] nodes — the second shape the rename has to +;; catch, and the one it is easy to catch only half of. +(defn nothing [] Node Node.Empty) + +(defn total [t Node] i64 + (match t + (Leaf n) n + (Branch kids) + (let [s (i64 0)] + (dotimes [i (len kids)] + (set s (+ s (total (at kids i))))) + s) + Empty (i64 0))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 46baa50..e7de03e 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -559,10 +559,16 @@ let () = [u8], and the reader above it builds a (Vec Value) and a (Map string Value) against whichever allocator the *caller* bound. It takes no allocator parameter and names none — spec-memory.md puts the - allocator in the calling convention, so (with-allocator a (read-doc s)) + allocator in the calling convention, so (with-allocator a (edn/read s)) is the whole of "read-edn taking an allocator", and there is no new machinery to add for it. + The reader is the package's now rather than the program's, and the + expected output did not move when it went there, which is the useful + thing about running this unchanged: the promotion was a move and not a + rewrite. What the program keeps is the walk back over a document nobody + declared a type for. + The numbers are structural: "map" is the document's shape, 12 is every leaf in it, 6 is [1 2 3] summed, and "string" is :name's value read back through the map. A reader that flattened a level or dropped a nested @@ -573,6 +579,41 @@ let () = outputs ~opt:"-O0" "an EDN document in an arena, -O0" "programs/arena-edn.flan" arena_edn_out; + (* The package's entry point over the file it exists for. assets/tileset.edn + is the editor's real output: a map of :texture-path to a string and + :selected-cells to a set of 54 integer pairs, and nothing in the program + declares a type for any of it. + + Three claims, and each line is one a plausible wrong version misses. + 54 with three memberships and a miss: a reader that flattened the pairs + into 108 integers would have a count of something and would answer no to + every pair, and [3 4] answering yes where [9 9] answers no is what says + the pair compare is positional. The dedup sizes are next: 1 for + #{#{1 2} #{2 1}} needs set equality to ignore order, 2 for #{1 1.0} + needs an int and a float to stay two values, and 2 for #{[0 0] [0 0] + [0 1]} is the one a dedup written with `=` gets wrong, because two Vec + headers over two blocks are never equal. + + Then "level-1", which is the whole of the copy contract: the document is + read out of a (Vec u8) and every byte of that buffer is then overwritten + in place. A reader holding views into the source prints x's. The buffer + is written and not freed on purpose — a read of released memory can pass + by luck, and this cannot. + + Last, that a malformed document is distinguishable from the document + that is literally nil, which is why the entry point answers an Option + and not a Value. *) + let edn_read_out = + "./source-assets/Sprout Lands Premium/Objects/Mushrooms, Flowers, \ + Stones.png\n\ + 54\ntrue\ntrue\ntrue\nfalse\n\n\ + 0\n2\n2\n2\n1\n2\n2\n2\n\n\ + level-1\nmalformed\nread\n" + in + outputs "edn/read over the tileset" "programs/edn-read.flan" edn_read_out; + outputs ~opt:"-O0" "edn/read over the tileset, -O0" + "programs/edn-read.flan" edn_read_out; + (* And the branch that makes it safe, which needs a program that dies to say anything — the shape bounds.flan uses, and for the same reason. Run 0 is the control and must not trap: a (Vec (Vec i32)) in the region @@ -1810,6 +1851,23 @@ let () = shape/Box and not area/shape/Box. *) outputs "a diamond, with a type crossing it" "programs/pkg-diamond.flan" "3\n6\n20\n"; + (* A data type crossing the same boundary, which was a refusal by name + until vendor/edn needed one. The rename has two halves and the second + is the one that is easy to do by accident only: the type's name is a + declaration, and [Node.Leaf] is a *symbol* carrying that name in front + of a dot, arriving as a Struct node when the case has fields and as a + Var node when it does not. A match's patterns need no rename at all — + a case resolves against the scrutinee's type — and pkg-data.flan writes + them bare on both sides of the import to say so. + + The numbers and words are the test: "branch"/"leaf"/"empty" are this + program's match over values the package built, and 3 is the package's + match over a value this program built, so the two sides agree about the + layout and not only about the spelling. *) + outputs "a data type imported from a package" "programs/pkg-data.flan" + "branch\nleaf\nempty\n3\n"; + outputs ~opt:"-O0" "a data type imported from a package, -O0" + "programs/pkg-data.flan" "branch\nleaf\nempty\n3\n"; (* A local shadows an imported name. Qualification rewrites a package's own names wherever they are used, and a binding is where it has to stop — in an expression and in a place, which are two separate lines of the @@ -2141,6 +2199,15 @@ let () = 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. + Sets are read rather than refused, so what used to be one refusal line + is now four dump lines and two *balance* refusals. The dump lines are + what a "#{" arm that forgot to push on the balance stack gets wrong: + the set inside a map still prints, but the map's own closer arrives + with nothing open. The two refusals are the wrong closer and the end of + input, which are the only things left to be wrong about a set once it + is a delimiter like the others. The set of pairs is the shape the + motivating file has, here at the token level. + 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 @@ -2165,6 +2232,11 @@ k [<>[<>i<1>]<>[<>i<2>[<>i<3>]<>]<>]<> {<>k{<>k[<>]<>}<>}<> +#<>i<1>i<2>}<> +#<>}<> +{<>k#<>i<1>i<2>}<>ki<3>}<> +#<>[<>i<4>i<3>]<>[<>i<2>i<2>]<>}<> + k i<1> s @@ -2184,7 +2256,8 @@ s 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 +5 unbalanced: this closing delimiter does not match the one that is open +5 unbalanced: this closing delimiter does not match the one that is open 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 @@ -2202,6 +2275,7 @@ s [goblin] hp=12 speed=1.5 boss=no [dragon] hp=40 speed=0 boss=yes +[wisp] hp=5 speed=0 boss=no [imp] hp=1 speed=2 boss=no [] hp=0 speed=0 boss=no ERR@7 unexpected token: not the kind the caller was reading diff --git a/test/test_sanitize.ml b/test/test_sanitize.ml index 90e630d..566be8e 100644 --- a/test/test_sanitize.ml +++ b/test/test_sanitize.ml @@ -132,6 +132,10 @@ let corpus = "programs/debug-permuted.flan", []; "programs/destructure.flan", []; "programs/edn.flan", []; + (* The copy edn/read makes of every string: the document is read out of a + (Vec u8) that is then overwritten in place, so a reader still holding + views is reading a buffer it does not own and ASan is what says so. *) + "programs/edn-read.flan", []; "programs/enum-compare.flan", []; "programs/error.flan", []; (* Makes and removes its own tree, so the two runs of the sweep see the diff --git a/vendor/edn/edn.flan b/vendor/edn/edn.flan index e1efbf4..a0eec3b 100644 --- a/vendor/edn/edn.flan +++ b/vendor/edn/edn.flan @@ -1,12 +1,17 @@ ;;;; 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. +;;;; This is the bottom layer 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. +;;;; +;;;; Two layers sit above it. `read.flan`, in this package, is the one that +;;;; exists: `(edn/read bytes)` walks this cursor and answers a dynamic +;;;; `Value`. The other, `(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, and test/programs/edn.flan is a worked example of +;;;; doing exactly that. ;;;; ;;;; ── The lifetime contract, which the type system does not state ───── ;;;; @@ -24,6 +29,15 @@ ;;;; the kind of contract that otherwise gets discovered from a corrupted ;;;; string three frames later. ;;;; +;;;; **`read.flan` does not follow this rule, deliberately.** The two layers of +;;;; this package diverge on exactly this point: a Token is a view, and a Value +;;;; owns copies of every string in it. The reason is that a view is a fine +;;;; thing for a cursor a caller is driving inside the function that holds the +;;;; buffer, and a trap for a document handed back out of one. Said the other +;;;; way: the contract above is a property of the *layer*, not of the package, +;;;; and a caller who mixes them — holding a Token out of an `(edn/read ...)` +;;;; that has returned — is on the tokenizer's terms and not the reader's. +;;;; ;;;; ── What is refused, and why ──────────────────────────────────────── ;;;; ;;;; Every refusal below is a *named* one with a reason attached, reachable as @@ -38,7 +52,6 @@ ;;;; 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. @@ -102,6 +115,12 @@ (defconst tok-map-close 12) ; } (defconst tok-list-open 13) ; ( (defconst tok-list-close 14) ; ) +;; #{ — and there is deliberately no tok-set-close. A set closes on `}`, the +;; same byte a map closes on, and a closer that answered a different kind +;; depending on what was open would be asking the caller to track a thing the +;; opener already told it. Appended rather than slotted in beside the other +;; openers because these are the numbers a caller branches on. +(defconst tok-set-open 15) ; #{ ;; ── Error codes ───────────────────────────────────────────────────── @@ -109,18 +128,22 @@ (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 +(defconst err-tagged 4) ; refusal +(defconst err-inst 5) ; refusal +(defconst err-uuid 6) ; refusal +(defconst err-metadata 7) ; refusal +(defconst err-ratio 8) ; refusal +(defconst err-char 9) ; refusal +(defconst err-bad-number 10) +(defconst err-empty-keyword 11) +(defconst err-unbalanced 12) ; a closer that does not match what is open +(defconst err-too-deep 13) +(defconst err-unexpected-token 14) ; raised by a caller, not by the tokenizer + +;; err-set was 4 and is gone rather than kept with a new message. A code that +;; nothing raises is a code a caller can still test for and never see, and +;; renumbering the rest is free: these are named constants, and the only place +;; a number appears is in this list. ;; 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 @@ -177,7 +200,6 @@ (= 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" @@ -449,10 +471,17 @@ (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. + ;; hi is lo+1; the brace itself is consumed here, which is why the + ;; position moves to lo+2 and not to hi. + ;; + ;; The closer pushed is tok-map-close, because the byte that closes a + ;; set is `}`. That is not a compromise: the balance stack holds the + ;; *closing kind still owed*, and a set and a map owe the same one. (and (< (+ lo 1) (len s)) (= (at s (+ lo 1)) \{)) - (do (fail c err-set lo) (error-token c)) + (do (set (.pos c) (+ lo 2)) + (if (push-open c tok-map-close lo) + (token c tok-set-open lo lo lo) + (error-token c))) (bytes=? (slice s (+ lo 1) hi) (bytes "inst")) (do (fail c err-inst lo) (error-token c)) @@ -524,6 +553,11 @@ ;; 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. +;; +;; Being written against the depth and not against the kinds is also why sets +;; cost this function nothing: `#{` pushes in `next` like every other opener, +;; so a set was already a collection here before it was one anywhere else. An +;; arm per collection kind would have been a second list to forget to add to. (defn skip-value [c (Ptr Cursor)] bool (let [start (.depth c) t (next c)] diff --git a/vendor/edn/read.flan b/vendor/edn/read.flan new file mode 100644 index 0000000..03fbc0d --- /dev/null +++ b/vendor/edn/read.flan @@ -0,0 +1,229 @@ +;;;; The dynamic reader: an EDN document, and no type to read it into. +;;;; +;;;; `edn.flan` answers "what is the next token". This answers "what is in the +;;;; file", for a caller that has no struct to hand — a config file whose keys +;;;; are not known until it is read, a tileset, a save. `(read-edn Enemy bytes)` +;;;; is the other direction and is not here: it wants a compile-time walk over +;;;; a struct's fields, there is no run-time type information in this language, +;;;; and it is its own project (NEXT.md item 9). +;;;; +;;;; ── Where the storage comes from ───────────────────────────────────── +;;;; +;;;; `read` takes no allocator and names none. It does not need to: +;;;; spec-memory.md puts the allocator in the calling convention, so every +;;;; (vec-new) and (map-new) below takes the *context*, and the caller chooses +;;;; the tier by writing (with-allocator frame (edn/read bytes)). An explicit +;;;; allocator at a construction site overrides that, which is how this would +;;;; take one as a parameter if the idiom could not say it — and the idiom +;;;; says it, so there is no allocator parameter here and nothing lost. +;;;; +;;;; The tier has to be a region, and that is enforced rather than documented: +;;;; a (Vec Value) whose elements own storage traps at its construction against +;;;; any allocator that can free one block. Calling `read` with the heap in the +;;;; context dies at the first collection in the document, naming the line. +;;;; See test/programs/arena-region.flan. +;;;; +;;;; There is no teardown in this file — no drop, no destructor, no recursive +;;;; free. One (free-all frame) releases the whole document, because every part +;;;; of it came out of the one region. +;;;; +;;;; ── A Value owns its strings, and a Token does not ─────────────────── +;;;; +;;;; This is the one place the two layers of this package disagree, and it is +;;;; deliberate. A Token's text is a slice INTO the source buffer; a Value's +;;;; strings are copies, in the allocator, and the document does not point at +;;;; the source at all once `read` has returned. +;;;; +;;;; A view would be cheaper and would be a trap. `read` hands its answer back +;;;; out of the function that owns the buffer, which is exactly the case +;;;; edn.flan's lifetime contract says a view cannot survive: the caller frees +;;;; the bytes it slurped, or reads the next file into them, and every string +;;;; in the document is garbage with nothing to say so. A free-all on the arena +;;;; would not even take them, because they were never in it. +;;;; +;;;; Odin settles the same question the same way: core/encoding/json's parser +;;;; clones a string even when it holds no escapes (parser.odin:388), clones +;;;; keys (:254), and its destroy_value frees them (types.odin:96). A reader +;;;; whose result is self-contained is the only kind that can be a library. +;;;; +;;;; ── Sets are a Vec, and why they are not a Map ─────────────────────── +;;;; +;;;; `Value.Set` holds a (Vec Value), deduplicated on insert by a structural +;;;; `value=?`. The obvious shape — a (Map Value bool) — does not typecheck and +;;;; cannot be made to: lib/types.ml `keyable` refuses a key type holding a Vec +;;;; or a Map, and Value holds both. Restricting set elements to the Values +;;;; that *are* keyable was the other way out and is worse: `#{[0 0] [1 0]}` is +;;;; legal EDN and is the exact shape this was built for, so the restriction +;;;; would refuse the motivating file to buy a faster insert. +;;;; +;;;; The cost is stated rather than hidden: insert is O(n) and building a set +;;;; of n elements is O(n²). For the file this was written for — 54 integer +;;;; pairs — that is 1458 comparisons, once, at load. A set large enough for +;;;; the quadratic to matter is one this shape is wrong for, and the reader +;;;; will know before this comment does. + +(defdata Value + [(Nil []) + (Bool [b bool]) + (Int [n i64]) + (Float [x f64]) + (Text [s string]) + (Key [s string]) + (List [items (Vec Value)]) + (Set [items (Vec Value)]) + (Table [entries (Map string Value)])]) + +;; ── Copying a token's text ────────────────────────────────────────── + +;; The (Vec u8) is the copy; the string is a view of it, and the Vec header is +;; dropped here on purpose. Nothing individually owns a block in a region — +;; free-all owns all of them — so keeping the header around to free through +;; would be keeping a handle for an operation that never happens. +(defn copy-text [s [u8]] string + (let [b (vec-new u8)] + (append! (addr b) s) + (string (as-slice b)))) + +;; ── Structural equality ───────────────────────────────────────────── + +;; What the set's dedup is written against. Recursive, because a set element +;; may be a vector or a map or another set, and `=` on a Value would compare a +;; Vec header against a Vec header — two copies of one document would never be +;; equal and two aliases of one block always would. +(defn value=? [a Value b Value] bool + (match a + Nil (match b Nil true _ false) + ;; `=` on two bools is refused by the language (plan.org, Types), so the + ;; comparison is written as the thing it means. + (Bool x) (match b (Bool y) (if x y (not y)) _ false) + (Int x) (match b (Int y) (= x y) _ false) + (Float x) (match b (Float y) (= x y) _ false) + ;; Text and Key are compared by their bytes and never to each other: + ;; "a" and :a are two values in EDN and stay two here. + (Text x) (match b (Text y) (bytes=? (bytes x) (bytes y)) _ false) + (Key x) (match b (Key y) (bytes=? (bytes x) (bytes y)) _ false) + (List xs) (match b (List ys) (items=? xs ys) _ false) + (Set xs) (match b (Set ys) (sets=? xs ys) _ false) + (Table e) (match b (Table f) (tables=? e f) _ false))) + +;; A vector is equal element by element, in order. +(defn items=? [xs (Vec Value) ys (Vec Value)] bool + (when (!= (len xs) (len ys)) + (return false)) + (dotimes [i (len xs)] + (when (not (value=? (at xs i) (at ys i))) + (return false))) + true) + +;; A set is not. #{1 2} and #{2 1} are one value written two ways, and a +;; positional compare would make `#{#{1 2} #{2 1}}` a two-element set — which +;; is the case that decides whether this function is worth having separately +;; from items=?. +(defn sets=? [xs (Vec Value) ys (Vec Value)] bool + (when (!= (len xs) (len ys)) + (return false)) + (dotimes [i (len xs)] + (when (not (member? ys (at xs i))) + (return false))) + true) + +(defn member? [xs (Vec Value) v Value] bool + (dotimes [i (len xs)] + (when (value=? (at xs i) v) + (return true))) + false) + +;; Maps compare by size and then by lookup, which is what makes the walk +;; order-independent — two maps built by inserting the same pairs in different +;; orders iterate differently and are the same map. +(defn tables=? [a (Map string Value) b (Map string Value)] bool + (when (!= (len a) (len b)) + (return false)) + (let [cur (i64 0) + k "" + v Value.Nil] + (while (map-next! a (addr cur) (addr k) (addr v)) + (match (get b k) + (Some w) (when (not (value=? v w)) (return false)) + None (return false)))) + true) + +;; ── Reading ───────────────────────────────────────────────────────── + +;; One token in hand, and the cursor for whatever that token opens. Public +;; because it is the entry point for a caller who wants the error *position*: +;; a caller driving its own Cursor can ask (edn/error-pos c) afterwards, and +;; `read` below cannot, because the cursor it made is gone. +(defn read-value [c (Ptr Cursor) t Token] Value + (cond + (= (.kind t) tok-bool) + (Value.Bool {.b (match (bool-of t) (Some v) v None false)}) + (= (.kind t) tok-int) + (Value.Int {.n (match (int-of t) (Some v) v None (i64 0))}) + (= (.kind t) tok-float) + (Value.Float {.x (match (float-of t) (Some v) v None 0.0)}) + (= (.kind t) tok-string) (Value.Text {.s (copy-text (.text t))}) + (= (.kind t) tok-keyword) (Value.Key {.s (copy-text (.text t))}) + ;; A symbol becomes a Key. There is no Symbol case, because nothing that + ;; reads a document this way tells the two apart — and a case nobody can + ;; act on differently is a case that only makes matches longer. + (= (.kind t) tok-symbol) (Value.Key {.s (copy-text (.text t))}) + + (= (.kind t) tok-vec-open) + (let [items (vec-new Value) + u (next c)] + (while (and (ok? c) + (!= (.kind u) tok-vec-close) + (!= (.kind u) tok-eof)) + (push items (read-value c u)) + (set u (next c))) + (Value.List {.items items})) + + ;; A set ends on tok-map-close, because `}` is the byte that ends it. The + ;; dedup is here and not at the end: a set with a duplicate in it never + ;; exists, so nothing downstream has to know that one might. + (= (.kind t) tok-set-open) + (let [items (vec-new Value) + u (next c)] + (while (and (ok? c) + (!= (.kind u) tok-map-close) + (!= (.kind u) tok-eof)) + (let [v (read-value c u)] + (when (not (member? items v)) + (push items v))) + (set u (next c))) + (Value.Set {.items items})) + + ;; A map's key is whatever token is there, and its text is the key — + ;; copied, so :a and "a" collide as keys here where EDN keeps them apart. + ;; That is a real narrowing and it is the price of a (Map string Value): + ;; the alternative is a (Map Value Value), which `keyable` refuses for the + ;; reason the set's comment above gives. + (= (.kind t) tok-map-open) + (let [entries (map-new string Value) + k (next c)] + (while (and (ok? c) + (!= (.kind k) tok-map-close) + (!= (.kind k) tok-eof)) + (let [v (next c)] + (put entries (copy-text (.text k)) (read-value c v))) + (set k (next c))) + (Value.Table {.entries entries})) + + :else Value.Nil)) + +;; The whole document, from a byte slice, in the calling convention's +;; allocator. +;; +;; (Option Value) and not Value, which is the one place this departs from +;; edn.flan's "errors live on the cursor, not in the return type". The cursor +;; is made inside this function and dies with it, so there is nothing left for +;; a caller to ask — and a Value.Nil answer would be indistinguishable from the +;; document that is literally `nil`, which is the class of quiet wrongness the +;; package's refusals exist to avoid. A caller who needs the byte offset builds +;; the Cursor itself and calls read-value; that is the three lines below. +(defn read [src [u8]] (Option Value) + (let [c (cursor src) + t (next (addr c)) + v (read-value (addr c) t)] + (if (ok? (addr c)) (Some v) None)))