From cc2cfa175b2c1e6eb8fb952d44dfdd6b59f248f7 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 22:50:54 +0700 Subject: [PATCH] Sets are read, and the reader that answers a Value is the package's MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The tokenizer refused #{} because "it needs a hash set to even represent" — which is a claim about a reader, and a tokenizer represents nothing. #{ now pushes } on the same balance stack { does, there is one new token kind and no new closer, and err-set is gone rather than kept with a message it no longer earns. skip-value needed nothing: it is written against the depth and not against the kinds. The dynamic reader moves out of test/programs/arena-edn.flan and into vendor/edn/read.flan as (edn/read bytes), answering an (Option Value) against whichever allocator the caller bound. Two decisions are written down where they are made: * a set is a Value.Set holding a deduplicated (Vec Value), because (Map Value bool) does not typecheck — keyable refuses a key holding a Vec or a Map — and restricting elements to keyable Values would refuse #{[0 0] [1 0]}, which is the file this was built for. Insert is O(n) against a structural value=?, so building the tileset's 54 pairs is 1458 comparisons, once. * a Value copies every string into the allocator where a Token stays a view. A view handed back out of the function that owns the buffer is a dangling pointer, and free-all would not even take it. Odin's json parser clones for the same reason. An imported defdata was a refusal in load.ml — "not implemented yet (milestone 4)" — and it had to go first. It is the type's name plus the Type. half of a constructor symbol, which arrives as a Var node when the case has no fields and a Struct node when it has; a match pattern needed nothing, because a case resolves against the scrutinee's type and was never a top-level name. programs/pkg-data.flan is that on its own. programs/edn-read.flan reads assets/edn/tileset.edn, which is the editor's real output: :texture-path and a :selected-cells of 54 integer pairs, with no type declared for any of it. It also overwrites the source buffer in place after reading and prints the document back, which is the copy contract asserted rather than described. --- FIX.org | 28 ++++ NEXT.md | 4 +- docs/PORTING.md | 18 ++- lib/load.ml | 53 ++++++- test/dune | 20 ++- test/programs/arena-edn.flan | 120 +++++--------- test/programs/assets/edn/tileset.edn | 2 + test/programs/edn-read.flan | 125 +++++++++++++++ test/programs/edn.flan | 23 ++- test/programs/pkg-data.flan | 41 +++++ test/programs/pkgs/tree/tree.flan | 32 ++++ test/test_acceptance.ml | 78 ++++++++- test/test_sanitize.ml | 4 + vendor/edn/edn.flan | 82 +++++++--- vendor/edn/read.flan | 229 +++++++++++++++++++++++++++ 15 files changed, 731 insertions(+), 128 deletions(-) create mode 100644 test/programs/assets/edn/tileset.edn create mode 100644 test/programs/edn-read.flan create mode 100644 test/programs/pkg-data.flan create mode 100644 test/programs/pkgs/tree/tree.flan create mode 100644 vendor/edn/read.flan 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)))