JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge: sets tokenize, and the reader belongs to the package

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-19 02:19:39 +07:00
commit 6960a7e929
17 changed files with 762 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
FIX.org
View File

@ -340,8 +340,7 @@ Ten bug lanes and three demolitions, all on dev-loop and verified together:
two-process child, armed in the agent, with a spawn-SIGKILL-reap test.
Found in passing: the eight orphans split 4/4 — four are MERGED daemons
whose editor vanished, a separate defect (accept_loop has no client
liveness), recorded here. The eight are still alive and the author decides
their fate.
liveness), recorded here. The eight were killed by hand on 2026-09-18.
- That second defect is now fixed too. accept_loop keeps a grace since the
last client let go of the socket, and ends the session when it runs out.
The connection is per session and not per request — Emacs holds one
@ -354,3 +353,31 @@ Ten bug lanes and three demolitions, all on dev-loop and verified together:
may be watching. FLAN_DEV_CLIENT_GRACE overrides in seconds; non-positive
turns it off. Six unit rows on the decision and one end-to-end daemon whose
client drops without a [close].
* 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.

4
NEXT.md
View File

@ -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

18
docs/PORTING.md
View File

@ -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.
---

2
game-data.edn Normal file
View File

@ -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]}}

53
lib/load.ml
View File

@ -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

4
sand.flan
View File

@ -29,6 +29,7 @@
(import rl "vendor:raylib") ; directory = package; declaration optional
(import agent "vendor:agent") ; the dev agent: redefinitions, installed below
(import edn "vendor:edn")
;;;; ── The simulation ───────────────────────────────────────────
;;;;
@ -83,6 +84,7 @@
;; Move the grain at [row col] as far down as it can, sliding to a free
;; diagonal neighbour when the cell below is taken.
;;
;; Imperative `while` with early `return`, not loop/recur — see plan.org
;; "Loop story". The recur version read as a tail call but was a countdown
@ -164,6 +166,8 @@
(when (rl/mouse-button-released? :left) (next-color))
(step))
;; (defconst the-data (Vec u8) (slurp "game-data.edn"))
(defn game-draw [] ()
(rl/clear-background rl/black)
(dotimes [row rows]

22
test/dune
View File

@ -24,8 +24,9 @@
(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, and the JSON one,
; which programs/json.flan does.
; The EDN package — the tokenizer and the dynamic reader over it — which
; programs/edn.flan, arena-edn.flan and edn-read.flan import; and the JSON
; tokenizer, which programs/json.flan does.
(glob_files %{workspace_root}/vendor/edn/*)
(glob_files %{workspace_root}/vendor/json/*)
; The ported raylib examples. Only one of them has a headless acceptance
@ -43,6 +44,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.
@ -57,6 +60,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
@ -84,6 +92,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/*)
@ -124,7 +133,8 @@
(glob_files %{workspace_root}/vendor/json/*)
(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
@ -160,6 +170,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/*)
@ -168,6 +179,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/*)
@ -216,6 +228,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/*)
@ -223,6 +236,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/*))
@ -377,12 +391,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/*))

120
test/programs/arena-edn.flan
View File

@ -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)

2
test/programs/assets/edn/tileset.edn Normal file
View File

@ -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]}}

132
test/programs/edn-read.flan Normal file
View File

@ -0,0 +1,132 @@
;;;; (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}}")
;; Three map cases and not one, because #{{:a 1} {:a 1} {:a 2}} answers 2
;; whether tables=? works or does nothing at all — two merge and one does
;; not, or none merge and there were only ever three. The pair below
;; isolates it: the first must be 1, and the second must be 2 on the
;; *keys*, which a size compare alone would get wrong.
(set-size "#{{:a 1} {:a 1}}")
(set-size "#{{:a 1} {:b 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)

23
test/programs/edn.flan
View File

@ -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 "{}")

41
test/programs/pkg-data.flan Normal file
View File

@ -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)

32
test/programs/pkgs/tree/tree.flan Normal file
View File

@ -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)))

82
test/test_acceptance.ml
View File

@ -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,45 @@ 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. The three map sizes are three
and not one because #{{:a 1} {:a 1} {:a 2}} answers 2 whether the map
compare works or does nothing: 1 for #{{:a 1} {:a 1}} is the one that
says it works, and 2 for #{{:a 1} {:b 1}} is the one that says a size
compare alone is not it.
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\n1\n2\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 +1855,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 +2203,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 +2236,11 @@ k<a>
[<>[<>i<1>]<>[<>i<2>[<>i<3>]<>]<>]<>
{<>k<a>{<>k<b>[<>]<>}<>}<>
#<>i<1>i<2>}<>
#<>}<>
{<>k<a>#<>i<1>i<2>}<>k<b>i<3>}<>
#<>[<>i<4>i<3>]<>[<>i<2>i<2>]<>}<>
k<a>
i<1>
s<x>
@ -2184,7 +2260,8 @@ s<a b>
2 escaped strings are refused: unescaping needs a copy of the bytes, and there is no allocator to put one in
2 escaped strings are refused: unescaping needs a copy of the bytes, and there is no allocator to put one in
0 unterminated string: end of input before the closing quote
0 sets #{} are refused: there is no hash set, and no allocator to build one in
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 +2279,7 @@ s<a b>
[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

16
test/test_sanitize.ml
View File

@ -132,18 +132,22 @@ let corpus =
"programs/debug-permuted.flan", [];
"programs/destructure.flan", [];
"programs/edn.flan", [];
(* The JSON reader, which is the corpus's densest allocator: every string
in the document is a (Vec u8) grown a byte at a time and then handed
out as a view of its own block, and the block is never freed because
the view IS the answer. ASan is what says the view still points at the
block after the growth that moved it. *)
"programs/json.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
same directory; the new C here is three more path buffers, which is
exactly what this tool is for. *)
"programs/files.flan", [];
(* The JSON reader, which is the corpus's densest allocator: every string
in the document is a (Vec u8) grown a byte at a time and then handed
out as a view of its own block, and the block is never freed because
the view IS the answer. ASan is what says the view still points at the
block after the growth that moved it. *)
"programs/json.flan", [];
"programs/machine.flan", [];
"programs/math.flan", [];
"programs/math3.flan", [];

82
vendor/edn/edn.flan vendored
View File

@ -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)]

235
vendor/edn/read.flan vendored Normal file
View File

@ -0,0 +1,235 @@
;;;; 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.
;;
;; One collision the Option does NOT resolve, said here rather than discovered:
;; empty input answers (Some Value.Nil), the same as the document `nil`. Empty
;; is not malformed — a tokenizer over no bytes reports no error, correctly —
;; and the alternative is this function deciding that an empty file is a
;; failure, which is the caller's question and not the reader's.
(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)))