From 605eb97e757291c11b29ce67712e5546963988d0 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 05:52:56 +0700 Subject: [PATCH 1/3] A dyn value's .field and [:key] read as get and assign as put. --- TODO.org | 8 +-- lib/check.ml | 73 +++++++++++++++++++++------ lib/emit.ml | 1 + runtime/flan_dyn.c | 28 ++++++++-- runtime/flan_dyn.h | 3 ++ spec-syntax.md | 4 ++ test/programs/dyn-field-trap.flan | 18 +++++++ test/programs/dyn-field-trap.fln | 23 +++++++++ test/programs/dyn-fields.flan | 36 +++++++++++++ test/syntax/handwritten/dynfields.fln | 33 ++++++++++++ test/syntax/handwritten/dynfields.out | 5 ++ test/test_acceptance.ml | 57 +++++++++++++++++++++ test/test_dev.ml | 16 ++++++ test/test_dyn.ml | 2 +- web/index.html | 12 +++-- 15 files changed, 291 insertions(+), 28 deletions(-) create mode 100644 test/programs/dyn-field-trap.flan create mode 100644 test/programs/dyn-field-trap.fln create mode 100644 test/programs/dyn-fields.flan create mode 100644 test/syntax/handwritten/dynfields.fln create mode 100644 test/syntax/handwritten/dynfields.out diff --git a/TODO.org b/TODO.org index cc934a8c..3552de2f 100644 --- a/TODO.org +++ b/TODO.org @@ -726,10 +726,10 @@ of !=. * Checker -** NEXT A dyn value takes .field and [:key] -Decided 2026-09-26: on a dyn value, ~x.name~ / ~(.name x)~ reads ~(get x :name)~ and -assigning it is ~(put x :name v)~ — a class slot or a map key; ~m[:k]~ indexes a dyn -map as ~(get m :k)~, and assigning it puts. +** DONE A dyn value takes .field and [:key] +CLOSED: [2026-09-26] +Assigning ~x.name~ or ~m[:k]~ is ~put~, not the stricter ~(set (get x :k) v)~: it adds +a key a plain map or a class lacks. ~m[k]~ on a dyn map takes any key, as ~get~ does. ** DONE A slice from a C pointer, and a pointer cast CLOSED: [2026-09-25] diff --git a/lib/check.ml b/lib/check.ml index a23f2e83..9508adf3 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -5945,12 +5945,36 @@ and check_value ctx ?want (e : Ast.expr) : Tast.expr = let v = check ctx ~want:Types.Dyn v in expect ctx loc ~want (rt loc Types.Unit "flan_dyn_slot_set" [ target; k; v; here loc ]) + (* (set (.name x) v) on a dyn is (put x :name v): a class slot's declared + type is checked by put, and a map takes a key it did not hold. Not + [flan_dyn_slot_set], which refuses a plain map — .name reads either, so + assigning it writes either. The target is checked once, here. *) + | Ast.Set (Ast.Pfield (target, name), v) -> + let t = check_target ctx target in + if t.Tast.ty = Types.Dyn then begin + refuse_const_change ctx loc t; + let k = dyn_kw ctx loc name in + let v = check ctx ~want:Types.Dyn v in + expect ctx loc ~want + (rt loc Types.Unit "flan_dyn_map_put" [ t; k; v; here loc ]) + end else begin + let p, pty = field_place ~store:true ctx loc target t name in + let v = check ctx ~want:pty v in + expect ctx loc ~want (mk loc Types.Unit (Tast.Set (p, v))) + end | Ast.Set (p, v) -> let p, pty = check_place ctx loc p in let v = check ctx ~want:pty v in expect ctx loc ~want (mk loc Types.Unit (Tast.Set (p, v))) + (* On a dyn, (.name x) is (get x :name) — the same call, so a missing key is + nil and a value that is not a map traps with get's own sentence. *) | Ast.Field (target, name) -> - let target, sname = struct_target ctx target in + let t = check_target ctx target in + if t.Tast.ty = Types.Dyn then + expect ctx loc ~want + (rt loc Types.Dyn "flan_dyn_get" [ t; dyn_kw ctx loc name; here loc ]) + else + let target, sname = struct_of ctx target t in let s = Option.get (fields_named ctx.env sname) in (match Tast.field_index s name with | None -> @@ -9567,9 +9591,9 @@ and fields_named env n : Tast.structure option = (* The target of [.field] is a struct or an untagged union, or one level of pointer to one. The auto-deref is inserted here as a real node, so no - backend re-derives it. *) -and struct_target ctx (target : Ast.expr) : Tast.expr * string = - let t = check_target ctx target in + backend re-derives it. The target comes checked, because every caller + looks first for a dyn, whose [.name] is a map entry and not a field. *) +and struct_of ctx (target : Ast.expr) (t : Tast.expr) : Tast.expr * string = let has n = fields_named ctx.env n <> None in match t.Tast.ty with | Types.Named n when has n -> t, n @@ -9704,15 +9728,19 @@ and check_place ?(store = true) ctx loc (p : Ast.place) : Tast.place * Types.t = | Some (ty, false) -> Tast.Pglobal name, ty | None -> unknown_name ~setting:true ctx loc name) | Ast.Pfield (target, name) -> - let target, sname = struct_target ctx target in - let s = Option.get (fields_named ctx.env sname) in - (match Tast.field_index s name with - | None -> - Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname) - "%s has no field %s" (tyname loc (Types.Named sname)) name - | Some i -> - if store then Option.iter (refuse_const_place ctx.env loc) (const_reached target); - Tast.Pfield (target, i), (List.nth s.Tast.fields i).Tast.fty) + let t = check_target ctx target in + if t.Tast.ty = Types.Dyn then begin + let x = match target.Ast.e with Ast.Var x -> x | _ -> "x" in + if Source.indented_at loc then + fail loc + "%s.%s is an entry of a dyn map, and has no address. Read it into \ + a local: let v = %s.%s" x name x name + else + fail loc + "(.%s %s) is an entry of a dyn map, and has no address. Read it \ + into a local: (let [v (.%s %s)] ...)" name x name x + end; + field_place ~store ctx loc target t name | Ast.Pindex (target, idx) -> let target = check_target ctx target in (match target.Tast.ty with @@ -9742,6 +9770,21 @@ and check_place ?(store = true) ctx loc (p : Ast.place) : Tast.place * Types.t = "a class slot (get inst :slot) is written with set and has no address. \ Read it into a local with let" +(* The dyn keyword [:name], for a dyn's [.name]. *) +and dyn_kw ctx loc name = check ctx ~want:Types.Dyn { Ast.e = Ast.Kw name; loc } + +(* A struct field as a place, over a target already checked. *) +and field_place ~store ctx loc target t name = + let target, sname = struct_of ctx target t in + let s = Option.get (fields_named ctx.env sname) in + match Tast.field_index s name with + | None -> + Loc.failk "check/unknown-field" loc ~notes:(declared_note ctx.env sname) + "%s has no field %s" (tyname loc (Types.Named sname)) name + | Some i -> + if store then Option.iter (refuse_const_place ctx.env loc) (const_reached target); + Tast.Pfield (target, i), (List.nth s.Tast.fields i).Tast.fty + (* An index or a slice bound that is a literal is known now, so it is an error now rather than a trap later. Only literals: a [defconst] is a global in the typed IR, not a folded constant, so [(at arr size)] still traps at runtime — @@ -11840,8 +11883,8 @@ and named_call ?(qualified = false) ctx ~want loc name args = stored under the key. *) if target.Tast.ty = Types.Dyn then expect ctx loc ~want - (rt loc Types.Dyn "flan_dyn_map_get" - [ target; check ctx ~want:Types.Dyn k ]) + (rt loc Types.Dyn "flan_dyn_get" + [ target; check ctx ~want:Types.Dyn k; here loc ]) else begin let kt, vt = map_kv loc "get" target.Tast.ty in let k = check ctx ~want:kt k in diff --git a/lib/emit.ml b/lib/emit.ml index ed5eb35c..2df56188 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5007,6 +5007,7 @@ declare void @flan_dyn_class_def(i64, ptr, i64) declare void @flan_dyn_class_hook(ptr) declare i64 @flan_dyn_kw(ptr, i64) declare i64 @flan_dyn_map_get(i64, i64) +declare i64 @flan_dyn_get(i64, i64, ptr, i64) declare void @flan_dyn_map_set(i64, i64, i64) declare i64 @flan_dyn_map_contains(i64, i64) ; The ones that trap carry the site as ptr+len, the way the bounds and diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 2c9e048f..75cba6d5 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -1963,6 +1963,10 @@ flan_dyn flan_dyn_vec_new(void); flan_dyn flan_dyn_map_new(void); void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen); void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v); +flan_dyn flan_dyn_get(flan_dyn m, flan_dyn k, const uint8_t *loc, + int64_t loclen); +void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, + int64_t loclen); /* The user hook, run on an instance the name-matching has just brought up to * date. [inst], [added] and [gone] are rooted by the caller. @@ -3037,8 +3041,12 @@ flan_dyn flan_dyn_at(flan_dyn v, flan_dyn i, const uint8_t *loc, int64_t loclen) { int64_t k; flan_obj *o; + /* m[:k] on a map is (get m :k), whatever the key: get's rule, nil when + * absent. */ + if (is_map(v)) return flan_dyn_get(v, i, loc, loclen); if (!is_text(v) && !is_vec(v)) - trap2(loc, loclen, TYPE_TRAP, "at", "only a text or a vec is indexed", v, i); + trap2(loc, loclen, TYPE_TRAP, "at", "only a text, a vec or a map is indexed", + v, i); k = need_index(loc, loclen, "at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { @@ -3086,8 +3094,14 @@ void flan_dyn_set_at(flan_dyn v, flan_dyn i, flan_dyn x, const uint8_t *loc, if (is_text(v)) trap2(loc, loclen, TYPE_TRAP, "set-at", "a text is immutable — build another one", v, i); + /* Assigning m[:k] is (put m :k x), a class slot's type check with it. */ + if (is_map(v)) { + flan_dyn_map_put(v, i, x, loc, loclen); + return; + } if (!is_vec(v)) - trap2(loc, loclen, TYPE_TRAP, "set-at", "only a vec is assigned into", v, i); + trap2(loc, loclen, TYPE_TRAP, "set-at", + "only a vec or a map is assigned into", v, i); k = need_index(loc, loclen, "set-at", v, i); o = dyn_obj(v); if (o->kind == OBJ_VIEW) { @@ -3191,6 +3205,14 @@ flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k) { return i < 0 ? flan_dyn_nil() : o->u.v.items[i * 2 + 1]; } +/* A program's (get m k) and (.k m): the same, with the site a value that is + * not a map is refused at. */ +flan_dyn flan_dyn_get(flan_dyn m, flan_dyn k, const uint8_t *loc, + int64_t loclen) { + if (!is_map(m)) trap2(loc, loclen, TYPE_TRAP, "get", "only a map answers it", m, k); + return flan_dyn_map_get(m, k); +} + flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) { flan_obj *o = want_map("has-key?", m, k); return flan_dyn_from_bool(map_find(o, k) >= 0); @@ -3333,7 +3355,7 @@ void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, int64_t loclen) { flan_obj *o; class_entry *e; - if (!is_map(m)) trap2(NULL, 0, TYPE_TRAP, "put", "only a map answers it", m, k); + if (!is_map(m)) trap2(loc, loclen, TYPE_TRAP, "put", "only a map answers it", m, k); o = dyn_obj(m); e = class_sync(o); /* A map with no class, and a class with no typed slot, stop at the test. */ diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 39d6173e..7e8538a6 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -244,6 +244,9 @@ void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen); * to ask when nil might also be stored. [set] replaces the value of an equal * key in place, so a key occurs once and insertion order is print order. */ flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k); +/* [get]'s, and a dyn's [.field]: [flan_dyn_map_get] with a site. */ +flan_dyn flan_dyn_get(flan_dyn m, flan_dyn k, const uint8_t *loc, + int64_t loclen); void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v); /* [put]'s: [flan_dyn_map_set], with the site a typed class slot's refusal * prints. */ diff --git a/spec-syntax.md b/spec-syntax.md index 0416c89a..ca66d31e 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -172,6 +172,10 @@ Each item: the proposal, then the reason in one line. one symbol. `test/programs/dev-rerun.flan:65` names a global `.init-once.counter`; rename it. **Built**, without the rename: it prints and reads back through the fallback, `defonce(.init-once.counter, i64, 7)`. +- **On a dyn value, `x.name` is `(get x :name)` and `x.name = v` is + `(put x :name v)`**, for a class slot and a plain map's key alike; `m[:k]` + is `(get m :k)` and `m[:k] = v` puts. The paren spellings `(.name x)` and + `(at m :k)` mean the same. **Built.** - **`and`, `or`, `not` are words**, since they are Flan's own names. **Built.** - **Casts and type-taking builtins are calls:** `i32(x)`, `vec-new(u8)`, `max-value(u8)`, `the([3 f32], [1 2 3.5])`. A pointer cast is the type diff --git a/test/programs/dyn-field-trap.flan b/test/programs/dyn-field-trap.flan new file mode 100644 index 00000000..499f3bf3 --- /dev/null +++ b/test/programs/dyn-field-trap.flan @@ -0,0 +1,18 @@ +;;;; A dyn's .field and [:key] trap with get's and put's own sentences, one +;;;; per run. The argument chooses which; the test asserts the line numbers. +(defclass State [paused bool step bool]) + +(defn as-dyn [d dyn] dyn d) + +(defn main [args [string]] i32 + (let [which (if (> (length args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0) + s (State false false) + n (as-dyn 3)] + (println "before") + (cond + (= which 0) (println (.paused n)) + (= which 1) (set (.paused s) 1) + (= which 2) (set (.paused n) true) + (= which 3) (set (at s :step) 2) + :else (println (at n :paused)))) + 0) diff --git a/test/programs/dyn-field-trap.fln b/test/programs/dyn-field-trap.fln new file mode 100644 index 00000000..dd9c64ea --- /dev/null +++ b/test/programs/dyn-field-trap.fln @@ -0,0 +1,23 @@ +;;;; A dyn's .field and [:key] trap with get's and put's own sentences, one +;;;; per run. The argument chooses which; the test asserts the line numbers. +defclass(State, [paused bool step bool]) + +fn as-dyn(d) -> dyn = d + +fn main(args: [string]) -> i32 + let which = + if length(args) > 1 then i32(bytes->i64(bytes-view(args[1]))) else 0 + let s = State(false, false) + let n = as-dyn(3) + println("before") + if which == 0 + println(n.paused) + elif which == 1 + s.paused = 1 + elif which == 2 + n.paused = true + elif which == 3 + s[:step] = 2 + else + println(n[:paused]) + 0 diff --git a/test/programs/dyn-fields.flan b/test/programs/dyn-fields.flan new file mode 100644 index 00000000..e1c83ad5 --- /dev/null +++ b/test/programs/dyn-fields.flan @@ -0,0 +1,36 @@ +;;;; A dyn value's (.field x) and (at m :key): a read is get, a set is put. +(defclass State [paused bool step bool]) +(defclass Pos [x y]) +(defclass Body [pos count items]) + +(defonce state (State false false)) + +(defn game-input [] () + (when true + (set (.paused state) (not (.paused state))))) + +(defn pick [b dyn] dyn b) + +(defn main [] i32 + (game-input) + (println (.paused state)) + (game-input) + (println (.paused state)) + (let [b (Body (Pos 1 2) 0 [10 20 30])] + (set (.count b) (+ (.count b) 1)) + (++ (.count b)) + (update (.count (pick b)) + 10) + (set (.x (.pos b)) 7) + (update (.y (.pos b)) * 10) + (set (at (.items b) 0) 11) + (update (at (.items b) 1) + 5) + (println (.count b) (.x (.pos b)) (.y (.pos b)) (at (.items b) 0) (at (.items b) 1)) + (println (.missing b) (= (.missing b) (get b :missing)))) + (let [m {:hp 3}] + (set (.hp m) (- (.hp m) 1)) + (set (at m :mp) 9) + (update (at m :mp) + 1) + (set (.name m) "slime") + (set (at m 1) :one) + (println (at m :hp) (.mp m) (at m :gone) (at m 1) m)) + 0) diff --git a/test/syntax/handwritten/dynfields.fln b/test/syntax/handwritten/dynfields.fln new file mode 100644 index 00000000..49d2956d --- /dev/null +++ b/test/syntax/handwritten/dynfields.fln @@ -0,0 +1,33 @@ +;; A dyn value's .field and [:key]: a read is get, an assignment is put. + +defclass(State, [paused bool step bool]) +defclass(Pos, [x y]) +defclass(Body, [pos count items]) + +once state = State(false, false) + +fn game-input() -> () + if true + state.paused = not(state.paused) + +fn main() -> i32 + game-input() + println(state.paused) + game-input() + println(state.paused) + let b = Body(Pos(1, 2), 0, [10 20 30]) + b.count += 1 + b.count += 1 + b.pos.x = 7 + b.pos.y *= 10 + b.items[0] = 11 + b.items[1] += 5 + println(b.count, b.pos.x, b.pos.y, b.items[0], b.items[1]) + println(b.missing) + let m = {:hp 3} + m.hp -= 1 + m[:mp] = 9 + m[:mp] += 1 + m.name = "slime" + println(m[:hp], m.mp, m[:gone], m) + 0 diff --git a/test/syntax/handwritten/dynfields.out b/test/syntax/handwritten/dynfields.out new file mode 100644 index 00000000..780925d7 --- /dev/null +++ b/test/syntax/handwritten/dynfields.out @@ -0,0 +1,5 @@ +true +false +2 7 20 11 25 +nil +2 10 nil {:hp 2 :mp 10 :name "slime"} diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index f12aca6d..eec23df7 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5701,6 +5701,63 @@ level "1" slot_trap (); slot_trap ~x86:true (); + (* A dyn's (.field x) and (at m :key) are get and put: a class slot, a + plain map's key, nil for one it lacks, and chained and compound forms + over both. The .fln spelling is test/syntax/handwritten/dynfields.fln. *) + let fields_out = + "true\nfalse\n12 7 20 11 25\nnil true\n\ + 2 10 nil :one {:hp 2 :mp 10 :name \"slime\" 1 :one}\n" + in + outputs "dyn: .field and [:key]" "programs/dyn-fields.flan" fields_out; + outputs ~opt:"-O0" "dyn: .field and [:key], -O0" "programs/dyn-fields.flan" + fields_out; + outputs ~x86:true "dyn: .field and [:key], --x86" "programs/dyn-fields.flan" + fields_out; + outputs ~dev:true "dyn: .field and [:key], --dev" "programs/dyn-fields.flan" + fields_out; + (* Their refusals are get's, put's and at's own sentences, placed at the + access, in both syntaxes. *) + let field_trap ?x86 path rows = + let exe = compile ?x86 path in + List.iter + (fun (arg, want) -> + let code, text = run exe (Some arg) in + if code <> 134 || not (contains text want) then begin + incr failures; + Printf.printf + "FAIL dyn: a .field's refusal%s\n got: %S (exit %d)\n \ + wanted: %S (exit 134)\n" + (match x86 with Some true -> ", --x86" | _ -> "") + text code want + end) + rows; + (try Sys.remove exe with Sys_error _ -> ()) + in + let field_rows (l0, l1, l2, l3, l4) = + [ ("0", l0 ^ ": dyn get: int and keyword, and only a map answers it — \ + (get 3 :paused)"); + ("1", l1 ^ ": dyn put: the slot :paused of State is declared bool, \ + and this is int — (put #State{:paused false :step false} \ + :paused 1)"); + ("2", l2 ^ ": dyn put: int and keyword, and only a map answers it — \ + (put 3 :paused)"); + ("3", l3 ^ ": dyn put: the slot :step of State is declared bool, and \ + this is int"); + ("4", l4 ^ ": dyn at: int and keyword, and only a text, a vec or a \ + map is indexed — (at 3 :paused)") ] + in + let flan_rows = + field_rows ("dyn-field-trap.flan:13:28", "dyn-field-trap.flan:14:19", + "dyn-field-trap.flan:15:19", "dyn-field-trap.flan:16:19", + "dyn-field-trap.flan:17:22") + in + field_trap "programs/dyn-field-trap.flan" flan_rows; + field_trap ~x86:true "programs/dyn-field-trap.flan" flan_rows; + field_trap "programs/dyn-field-trap.fln" + (field_rows ("dyn-field-trap.fln:14:13", "dyn-field-trap.fln:16:5", + "dyn-field-trap.fln:18:5", "dyn-field-trap.fln:20:5", + "dyn-field-trap.fln:22:13")); + (* A numeric cast opening a dyn box — TODO.org, "A numeric cast opens a dyn box". programs/dyn-cast.flan is one program because the three behaviours are one story told in order: the same-kind casts print, the diff --git a/test/test_dev.ml b/test/test_dev.ml index e7dd4f1b..8ad6cb22 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -7418,6 +7418,22 @@ let () = if read () <> "\"kept\"" then fail "--%s: the global was not readable before any thunk ran: %S" backend (read ()); + (* A dyn's .field and [:key] are get and put in a thunk too. *) + List.iter + (fun (code, want) -> + let r = + request c + (Printf.sprintf + "(:op \"eval-expr\" :code %s \ + :file \"programs/dev-dyn-global.flan\")" + (Wire.quote code)) + in + if answer r <> want then + fail "--%s: %s answered %S (%s: %s), not %S" backend code + (answer r) (status r) (said r) want) + [ ("(.s config)", "\"kept\""); + ("(do (set (.n config) 5) (++ (.n config)) (.n config))", "6"); + ("(do (set (at config :n) 1) (at config :n))", "1") ]; for cycle = 1 to 3 do let r = churn () in if status r <> "ok" then diff --git a/test/test_dyn.ml b/test/test_dyn.ml index 96875fce..7ab4675d 100644 --- a/test/test_dyn.ml +++ b/test/test_dyn.ml @@ -230,7 +230,7 @@ let () = ("atrange", "index 9 is out of bounds for text of length 2"); ("atnegative", "index -1 is out of bounds"); ("setattext", "a text is immutable"); - ("setatnotvec", "only a vec is assigned into"); + ("setatnotvec", "only a vec or a map is assigned into"); ("setatrange", "index 0 is out of bounds for vec of length 0"); ("push", "only a vec is pushed to"); ("needi64", "dyn i64: text"); diff --git a/web/index.html b/web/index.html index 817f687b..4314a6c0 100644 --- a/web/index.html +++ b/web/index.html @@ -700,7 +700,9 @@ program was edited elsewhere would not be worth having.

{:a 1 :b "two"} is a dyn map and [1 2 3] is a dyn vector. get, put, has-key?, at and length read and write them, the same names the typed -Map and Vec answer to. A keyword is a value here rather +Map and Vec answer to. (.hp m) is +(get m :hp) and (at m :hp) is too; set on +either is put. A keyword is a value here rather than only a way to name an enum member: keywords are interned, so comparing two is comparing two pointers.

@@ -724,10 +726,10 @@ for anything that is not an instance. type-of answers any value's kind as a keyword — :nil, :bool, :int, :float, :text, :vec, :map or :keyword — and an instance's class name, so a class cannot be named -after one of those kinds. The slots are map keys: get -reads one, and set writes one, as in -(set (get s :pause) true). put writes one too, and is -also how a key the class does not declare is added.

+after one of those kinds. The slots are map keys: (.pause s) +reads one, and (set (.pause s) true) writes one, checking its +type. get and put do the same, and put +is also how a key the class does not declare is added.

Dispatch comes in the two styles and they are one mechanism. defgeneric dispatches on the class of the first argument, which is From 4eefd25df9e8d184af3e89d89c069feeffd2f0b8 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 06:02:51 +0700 Subject: [PATCH 2/3] A class instance refuses a key its class does not declare, read or written, through get, put, .field and [:key]. --- TODO.org | 18 +++--- docs/SBCL-REDEFINITION-NOTES.md | 7 +-- lib/classes.ml | 6 +- runtime/flan_dyn.c | 87 +++++++++++++++++---------- runtime/flan_dyn.h | 6 +- test/programs/dyn-class-slots.flan | 5 +- test/programs/dyn-class.flan | 4 +- test/programs/dyn-field-trap.flan | 4 +- test/programs/dyn-field-trap.fln | 6 +- test/programs/dyn-fields.flan | 2 +- test/syntax/handwritten/dynfields.fln | 3 +- test/test_acceptance.ml | 34 +++++++---- test/test_dev.ml | 32 +++------- web/index.html | 5 +- 14 files changed, 117 insertions(+), 102 deletions(-) diff --git a/TODO.org b/TODO.org index 06379f38..9a98629b 100644 --- a/TODO.org +++ b/TODO.org @@ -587,10 +587,11 @@ method to a running program is an ordinary redefinition. ** CANCELLED Class features deferred, each with its reason CLOSED: [2026-09-20] Inheritance, multi-argument dispatch, =:before=/=:after=/=:around= and -=call-next-method=, named-slot construction, unknown-slot checking, computed -dispatch values. With single dispatch on literal values there is no specificity -question, and inheritance or multiple dispatch would create one. Unknown-slot -checking needs class-typed tracking the dyn side deliberately does not have. +=call-next-method=, named-slot construction, compile-time unknown-slot checking, +computed dispatch values. With single dispatch on literal values there is no +specificity question, and inheritance or multiple dispatch would create one. +Compile-time unknown-slot checking needs class-typed tracking the dyn side +deliberately does not have; the runtime refuses an unknown slot instead. ** DONE update-instance-for-redefined-class, the user hook CLOSED: [2026-09-25] @@ -732,8 +733,8 @@ of !=. ** DONE A dyn value takes .field and [:key] CLOSED: [2026-09-26] -Assigning ~x.name~ or ~m[:k]~ is ~put~, not the stricter ~(set (get x :k) v)~: it adds -a key a plain map or a class lacks. ~m[k]~ on a dyn map takes any key, as ~get~ does. +Assigning ~x.name~ or ~m[:k]~ is ~put~: a plain map gains the key, and a class +instance refuses one its class does not declare, on read too, as ~get~ and ~put~ now do. ** DONE A slice from a C pointer, and a pointer cast CLOSED: [2026-09-25] @@ -1402,9 +1403,8 @@ CLOSED: [2026-09-20] CLHS 4.3.6. Nothing is enumerated and no heap is walked — the redefinition is constant time and each instance pays once, at its next touch. Neither printer migrates, so a stale instance shows its old slots to the editor -until something touches it. The registry is advisory: a key the class never -declared is dropped by the next migration, which is data loss with no enforcement -behind it. +until something touches it. An instance holds only declared slots — get, put and +set refuse any other key — so the migration's drop loses nothing a program wrote. ** WAIT A class registry keeps one slot list per class, not one per layout version Decided 2026-09-25: waits for a case name-matching migration to the current list gets wrong. diff --git a/docs/SBCL-REDEFINITION-NOTES.md b/docs/SBCL-REDEFINITION-NOTES.md index d54b7533..7fb2acec 100644 --- a/docs/SBCL-REDEFINITION-NOTES.md +++ b/docs/SBCL-REDEFINITION-NOTES.md @@ -326,10 +326,9 @@ The CLOS answer would need, concretely: Flan spelling of that hook is a generic function, e.g. `(defmethod update-for-redefined point [p added discarded] ...)`, which fits the dispatch mechanism that already exists. -- A decision on whether `put` of an unknown slot stays legal. Today it is — a - class instance is an open map, and TODO.org, "Class features deferred, each with - its reason", already defers refusing an unknown slot at `(get p :z)`. If unknown slots stay legal, the registry's slot list is - advisory and the whole update protocol is advisory with it. +- A decision on whether `put` of an unknown slot stays legal. Decided + 2026-09-26: it does not; `get`, `put` and `set` refuse an unknown slot on an + instance at run time, so the registry's slot list is enforced. This is a real, SBCL/CLOS-precedented design that Flan's runtime can actually support. It is also a feature with no user yet, since redefinition on the dyn diff --git a/lib/classes.ml b/lib/classes.ml index cc006999..f6ed51a8 100644 --- a/lib/classes.ml +++ b/lib/classes.ml @@ -185,9 +185,9 @@ let collect (decls : Ast.decl list) = is what [class-of] answers and what a generic dispatches on. Named-slot construction — the dyn twin of [(Cursor {.src s})], with an - omitted slot meaning nil — is deferred, and so is refusing an unknown slot - at [(get p :z)]. Both are recorded in TODO.org, "Class features deferred, - each with its reason". *) + omitted slot meaning nil — is deferred (TODO.org, "Class features deferred, + each with its reason"). An unknown slot, [(get p :z)], is refused at run + time by the runtime's [trap_no_slot]. *) let constructor n (slots : Ast.field list) loc : Ast.decl = (* Two slots of one name would write one entry and read one value, and the constructor would take two arguments for it. The duplicate parameter diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index ffad7f19..250f8f37 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -1610,15 +1610,10 @@ flan_dyn flan_dyn_map_new(void) { * * **What the registry constrains.** A store into a slot the class declares * — the constructor's, [put]'s, [set]'s — is checked against the slot's - * type. A key the class does not declare is not refused by [put]: a class - * instance is an open map — TODO.org, "Class features deferred, each with its - * reason", defers unknown-slot checking — so a key nobody declared can be - * written to one, and the migration below will *drop* it at the next - * redefinition, because its rule is that an instance's keys are the class's - * slots. That is real data loss and it is written down as such in TODO.org, - * "A redefined defclass migrates its instances lazily", rather than dressed - * up as enforcement. [set] does refuse an undeclared key, because a slot it - * writes has to exist. + * type. A key the class does not declare is refused by [get], [put] and + * [set] alike ([trap_no_slot]), so an instance's keys are its class's slots + * and the migration below, which keeps only those, drops nothing a program + * wrote. * * **Where a migration happens.** [want_map], so every [get], [put] and * [has-key?]; [flan_dyn_len]'s map arm; and [dyn_equal]'s, so two instances @@ -3206,10 +3201,20 @@ flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k) { } /* A program's (get m k) and (.k m): the same, with the site a value that is - * not a map is refused at. */ + * not a map is refused at, and a key an instance's class does not declare + * refused rather than answered nil — [trap_no_slot]. */ +static class_entry *class_sync(flan_obj *o); +static int64_t class_slot(class_entry *e, flan_dyn k); +static _Noreturn void trap_no_slot(const uint8_t *loc, int64_t loclen, + const char *op, flan_obj *o, + class_entry *e, flan_dyn k); flan_dyn flan_dyn_get(flan_dyn m, flan_dyn k, const uint8_t *loc, int64_t loclen) { + class_entry *e; if (!is_map(m)) trap2(loc, loclen, TYPE_TRAP, "get", "only a map answers it", m, k); + e = class_sync(dyn_obj(m)); + if (e != NULL && class_slot(e, k) < 0) + trap_no_slot(loc, loclen, "get", dyn_obj(m), e, k); return flan_dyn_map_get(m, k); } @@ -3294,6 +3299,29 @@ static flan_dyn check_slot(const uint8_t *loc, int64_t loclen, int by, static inline void map_store(flan_obj *o, flan_dyn k, flan_dyn v); +/* A key an instance's class does not declare, read or written. An instance + * has exactly its class's slots — a typo in a slot name is an error at the + * access and not a new key — so get, put and set all refuse one; a plain map + * takes any key. */ +static _Noreturn void trap_no_slot(const uint8_t *loc, int64_t loclen, + const char *op, flan_obj *o, + class_entry *e, flan_dyn k) { + char sk[SAY_MAX]; + kw_entry *c = o->u.v.klass; + int64_t i; + say(sk, SAY_MAX, k); + said_len = 0; + said_add("dyn %s: %.*s has no slot %s. Its slots are", op, (int)c->len, + (const char *)(c + 1), sk); + if (e == NULL || e->nslots == 0) said_add(" none"); + else + for (i = 0; i < e->nslots; i++) + said_add(" :%.*s", (int)e->slots[i]->len, + (const char *)(e->slots[i] + 1)); + flan_say(loc, loclen, "%s", said_buf); + flan_trap((const uint8_t *)"DynType", 7); +} + /* A constructor's stores: [flan_dyn_map_set]'s, with the refusal worded for * the constructor call it happened inside rather than for a [put] nobody * wrote, and placed at the slot's declaration. */ @@ -3308,8 +3336,7 @@ void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v, * they are three different mistakes: the value is not a class instance at * all (a map's entries are written with [put], which is where inserting a * key is real); the key is not a slot the class declares; the value does not - * fit the slot's type. The first two are why this is not [put]: a declared - * slot always exists, so writing one is a store and never an insertion. */ + * fit the slot's type. The first is why this is not [put]. */ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, int64_t loclen) { flan_obj *o; @@ -3329,43 +3356,37 @@ void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v, o = dyn_obj(m); e = class_sync(o); j = class_slot(e, k); - if (j < 0) { - char sk[SAY_MAX]; - kw_entry *c = o->u.v.klass; - int64_t i; - say(sk, SAY_MAX, k); - said_len = 0; - said_add("dyn set: %.*s has no slot %s. Its slots are", - (int)c->len, (const char *)(c + 1), sk); - if (e == NULL || e->nslots == 0) said_add(" none"); - else - for (i = 0; i < e->nslots; i++) - said_add(" :%.*s", (int)e->slots[i]->len, - (const char *)(e->slots[i] + 1)); - said_add("; a key the class does not declare is added with put, not set"); - flan_say(loc, loclen, "%s", said_buf); - flan_trap((const uint8_t *)"DynType", 7); - } + if (j < 0) trap_no_slot(loc, loclen, "set", o, e, k); if (!slot_admit(&e->types[j], v, &out)) trap_slot_type(loc, loclen, BY_SET, o, e, j, m, v); map_store(o, k, out); } -void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, - int64_t loclen) { +static void map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, + int64_t loclen, int any_key) { flan_obj *o; class_entry *e; if (!is_map(m)) trap2(loc, loclen, TYPE_TRAP, "put", "only a map answers it", m, k); o = dyn_obj(m); e = class_sync(o); + if (!any_key && e != NULL && class_slot(e, k) < 0) + trap_no_slot(loc, loclen, "put", o, e, k); /* A map with no class, and a class with no typed slot, stop at the test. */ if (e != NULL && e->typed) v = check_slot(loc, loclen, BY_PUT, o, e, m, k, v); map_store(o, k, v); } -/* The same with no site: a map literal's stores, and test/dyn_ops.c. */ +/* A program's put, and the store under a dyn's [.k] and [:k]. */ +void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, + int64_t loclen) { + map_put(m, k, v, loc, loclen, 0); +} + +/* With no site and any key: an untagged map literal's stores, and + * test/dyn_ops.c, which builds instances' odd states by hand. No program + * reaches an instance through it. */ void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) { - flan_dyn_map_put(m, k, v, NULL, 0); + map_put(m, k, v, NULL, 0, 1); } /* The store under all three, with the instance already brought up to date. */ diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 7e8538a6..2a5b1bd5 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -156,10 +156,8 @@ flan_dyn flan_dyn_type_of(flan_dyn v); * declares are dropped. The instance's identity is preserved throughout; * this is CLHS 4.3.6, and [flan_dyn_class_hook] is its user hook. * - * The drop is unconditional, which is the honest cost of a class instance - * being an open map: a key written by a raw [put] that the class never - * declared is dropped by the next migration too. The registry describes the - * class's intention and does not enforce it. */ + * No key the class never declared can be there to drop: [get], [put] and + * [set] refuse one on an instance. */ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n); /* The body update-instance-for-redefined-class dispatches through, as a diff --git a/test/programs/dyn-class-slots.flan b/test/programs/dyn-class-slots.flan index 662d1ade..d5bb62d3 100644 --- a/test/programs/dyn-class-slots.flan +++ b/test/programs/dyn-class-slots.flan @@ -28,12 +28,9 @@ (println (get s :step)) (set (get s :tag) [1 2]) (println (get s :tag)) - ;; put reaches the same check for a declared slot, and still inserts a - ;; key the class does not declare -- an instance is an open map to put. + ;; put reaches the same check for a declared slot. (put s :speed 2.5) - (put s :scratch 9) (println (get s :speed)) - (println (get s :scratch)) (println (length s)) ;; A typed caller boxes into the dyn parameter as any call does. (set (get s :step) (twelve)) diff --git a/test/programs/dyn-class.flan b/test/programs/dyn-class.flan index 87f9eeb4..9a5991d1 100644 --- a/test/programs/dyn-class.flan +++ b/test/programs/dyn-class.flan @@ -64,7 +64,9 @@ (println (get p :x)) (println (has-key? p :x)) (println (has-key? p :nothing)) - (println (get p :nothing)) + ;; A key its class does not declare is refused on an instance; a plain + ;; map answers nil for one it lacks. + (println (get {:x 1} :nothing)) ;; The shape tag, as a value. Every value can be asked; only an instance ;; answers with a name. diff --git a/test/programs/dyn-field-trap.flan b/test/programs/dyn-field-trap.flan index 499f3bf3..9ae1150e 100644 --- a/test/programs/dyn-field-trap.flan +++ b/test/programs/dyn-field-trap.flan @@ -4,7 +4,7 @@ (defn as-dyn [d dyn] dyn d) -(defn main [args [string]] i32 +(defn main [args [str]] i32 (let [which (if (> (length args) 1) (i32 (bytes->i64 (bytes-view (at args 1)))) 0) s (State false false) n (as-dyn 3)] @@ -14,5 +14,7 @@ (= which 1) (set (.paused s) 1) (= which 2) (set (.paused n) true) (= which 3) (set (at s :step) 2) + (= which 5) (set (.pasued s) true) + (= which 6) (println (.pasued s)) :else (println (at n :paused)))) 0) diff --git a/test/programs/dyn-field-trap.fln b/test/programs/dyn-field-trap.fln index dd9c64ea..bed59b9f 100644 --- a/test/programs/dyn-field-trap.fln +++ b/test/programs/dyn-field-trap.fln @@ -4,7 +4,7 @@ defclass(State, [paused bool step bool]) fn as-dyn(d) -> dyn = d -fn main(args: [string]) -> i32 +fn main(args: [str]) -> i32 let which = if length(args) > 1 then i32(bytes->i64(bytes-view(args[1]))) else 0 let s = State(false, false) @@ -18,6 +18,10 @@ fn main(args: [string]) -> i32 n.paused = true elif which == 3 s[:step] = 2 + elif which == 5 + s.pasued = true + elif which == 6 + println(s.pasued) else println(n[:paused]) 0 diff --git a/test/programs/dyn-fields.flan b/test/programs/dyn-fields.flan index e1c83ad5..8f48a9b0 100644 --- a/test/programs/dyn-fields.flan +++ b/test/programs/dyn-fields.flan @@ -25,7 +25,7 @@ (set (at (.items b) 0) 11) (update (at (.items b) 1) + 5) (println (.count b) (.x (.pos b)) (.y (.pos b)) (at (.items b) 0) (at (.items b) 1)) - (println (.missing b) (= (.missing b) (get b :missing)))) + (println (.missing {:a 1}) (= (.missing {:a 1}) (get {:a 1} :missing)))) (let [m {:hp 3}] (set (.hp m) (- (.hp m) 1)) (set (at m :mp) 9) diff --git a/test/syntax/handwritten/dynfields.fln b/test/syntax/handwritten/dynfields.fln index 49d2956d..e36d11b8 100644 --- a/test/syntax/handwritten/dynfields.fln +++ b/test/syntax/handwritten/dynfields.fln @@ -23,7 +23,8 @@ fn main() -> i32 b.items[0] = 11 b.items[1] += 5 println(b.count, b.pos.x, b.pos.y, b.items[0], b.items[1]) - println(b.missing) + let plain = {:a 1} + println(plain.missing) let m = {:hp 3} m.hp -= 1 m[:mp] = 9 diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index cc897c87..ab9f246b 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -5652,13 +5652,12 @@ level "1" (* Typed class slots and set on a slot: the stores that fit, then one run per refusal. The constructor, put and set each check a declared - slot's type, set refuses a slot the class does not declare and a - value that is not an instance, and put still inserts an undeclared - key. On both backends, because every one of these is a runtime call + slot's type, and set refuses a slot the class does not declare and a + value that is not an instance. On both backends, because every one of these is a runtime call whose arguments the two emit separately. *) let slots_out = "#state{:pause false :step 3 :speed 1.5 :name \"sand\" :tag :x}\n\ - true\n-7\n[1 2]\n2.5\n9\n6\n12\n3.5\ntrue\n2\n:state\n" + true\n-7\n[1 2]\n2.5\n5\n12\n3.5\ntrue\n2\n:state\n" in outputs "dyn: typed class slots" "programs/dyn-class-slots.flan" slots_out; outputs ~x86:true "dyn: typed class slots, --x86" @@ -5688,8 +5687,7 @@ level "1" is declared i32, and 5000000000 is not a value it holds \ exactly"); ("3", "dyn-slot-trap.flan:17:19: dyn set: state has no slot :paws. \ - Its slots are :pause :step :tag; a key the class does not \ - declare is added with put, not set"); + Its slots are :pause :step :tag"); ("4", "dyn-slot-trap.flan:18:19: dyn set: (get m k) is a place only \ on a class instance, and this is a map with no class"); ("5", "dyn-slot-trap.flan:19:28: dyn construct: the slot :owner of \ @@ -5733,7 +5731,9 @@ level "1" rows; (try Sys.remove exe with Sys_error _ -> ()) in - let field_rows (l0, l1, l2, l3, l4) = + (* 5 and 6 are a misspelt slot on a class instance, written and read: + refused naming the class and its slots, never a new key or a nil. *) + let field_rows (l0, l1, l2, l3, l4, l5, l6) = [ ("0", l0 ^ ": dyn get: int and keyword, and only a map answers it — \ (get 3 :paused)"); ("1", l1 ^ ": dyn put: the slot :paused of State is declared bool, \ @@ -5744,19 +5744,27 @@ level "1" ("3", l3 ^ ": dyn put: the slot :step of State is declared bool, and \ this is int"); ("4", l4 ^ ": dyn at: int and keyword, and only a text, a vec or a \ - map is indexed — (at 3 :paused)") ] + map is indexed — (at 3 :paused)"); + ("5", l5 ^ ": dyn put: State has no slot :pasued. Its slots are \ + :paused :step"); + ("6", l6 ^ ": dyn get: State has no slot :pasued. Its slots are \ + :paused :step") ] in let flan_rows = field_rows ("dyn-field-trap.flan:13:28", "dyn-field-trap.flan:14:19", "dyn-field-trap.flan:15:19", "dyn-field-trap.flan:16:19", - "dyn-field-trap.flan:17:22") + "dyn-field-trap.flan:19:22", "dyn-field-trap.flan:17:19", + "dyn-field-trap.flan:18:28") + and fln_rows = + field_rows ("dyn-field-trap.fln:14:13", "dyn-field-trap.fln:16:5", + "dyn-field-trap.fln:18:5", "dyn-field-trap.fln:20:5", + "dyn-field-trap.fln:26:13", "dyn-field-trap.fln:22:5", + "dyn-field-trap.fln:24:13") in field_trap "programs/dyn-field-trap.flan" flan_rows; field_trap ~x86:true "programs/dyn-field-trap.flan" flan_rows; - field_trap "programs/dyn-field-trap.fln" - (field_rows ("dyn-field-trap.fln:14:13", "dyn-field-trap.fln:16:5", - "dyn-field-trap.fln:18:5", "dyn-field-trap.fln:20:5", - "dyn-field-trap.fln:22:13")); + field_trap "programs/dyn-field-trap.fln" fln_rows; + field_trap ~x86:true "programs/dyn-field-trap.fln" fln_rows; (* A numeric cast opening a dyn box — TODO.org, "A numeric cast opens a dyn box". programs/dyn-cast.flan is one program because the three diff --git a/test/test_dev.ml b/test/test_dev.ml index 02b4c0ff..c97466da 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -9346,13 +9346,13 @@ let () = (* ── A slot lost, and a second generation ── [:y] goes. Nothing calls [area] after this: its method reads :y, - which is now nil, and a generic that traps on a slot its class no + which is now refused, and a generic that traps on a slot its class no longer has is the program being wrong rather than the migration. *) let r = redefine "(defclass point [x z])" in if status r <> "ok" then fail "removing a slot from a class: %s" (said r) else begin - holds "a lost slot reads as absent" - "(if (= (get (at instances 0) :y) nil) 1 0)"; + holds "a lost slot is absent" + "(if (has-key? (at instances 0) :y) 0 1)"; holds "a lost slot is gone from the count" "(if (= (length (at instances 0)) 2) 1 0)"; holds "the slots either side of it are untouched" @@ -9385,31 +9385,13 @@ let () = end; (* ── A definition that did not change ── - Every C-c C-k re-runs a file's class definitions, and a generation - bumped per registration rather than per *change* would migrate - every instance in the program on every save. Here that would be - visible: the value written below is put into a slot the class - declares, and a spurious migration would keep it — so the - discriminating half is the raw key on the line after, which a real - migration drops and an ignored re-registration leaves alone. *) - holds "a key written straight into an instance" - "(do (put (at instances 0) :scratch 7) 1)"; + Every C-c C-k re-runs a file's class definitions, and re-running + an unchanged one has to leave its instances' values alone. *) let r = redefine "(defclass point [x z w])" in if status r <> "ok" then fail "re-evaluating an unchanged class: %s" (said r) else - holds "an unchanged definition migrates nothing" - "(if (= (get (at instances 0) :scratch) 7) 1 0)"; - (* And the same key after a definition that *did* change, which is - the advisory registry stated as a test rather than as a hope: a - class instance is an open map, [put] accepts any key, and the next - migration drops the ones the class does not declare. TODO.org, "A - redefined defclass migrates its instances lazily", says so in as - many words. *) - let r = redefine "(defclass point [x z w q])" in - if status r <> "ok" then fail "a fourth redefinition: %s" (said r) - else - holds "a migration drops a key the class never declared" - "(if (= (get (at instances 0) :scratch) nil) 1 0)" + holds "an unchanged definition keeps the values" + "(if (= (get (at instances 1) :x) 5) 1 0)" end; (try Unix.close c with Unix.Unix_error _ -> ()); (try Unix.kill mpid Sys.sigkill with Unix.Unix_error _ -> ()); diff --git a/web/index.html b/web/index.html index b506108b..8fa15b52 100644 --- a/web/index.html +++ b/web/index.html @@ -728,8 +728,9 @@ kind as a keyword — :nil, :bool, :int, :keyword — and an instance's class name, so a class cannot be named after one of those kinds. The slots are map keys: (.pause s) reads one, and (set (.pause s) true) writes one, checking its -type. get and put do the same, and put -is also how a key the class does not declare is added.

+type. get and put do the same. A key the class does +not declare is refused, so a misspelled slot stops the program at the line that +misspelled it.

Dispatch comes in the two styles and they are one mechanism. defgeneric dispatches on the class of the first argument, which is From f39612bc7c0709d789c0f4ed1338bf65ed7dae2d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 26 Sep 2026 06:21:07 +0700 Subject: [PATCH 3/3] Code a request sends without :syntax is read in its file's syntax, or the program's when it names none, and a dotted dyn name points to its accessor. --- lib/check.ml | 9 +++ lib/dev.ml | 17 ++++-- spec-syntax.md | 8 ++- test/programs/dev-fln-dyn.fln | 26 +++++++++ test/test_dev.ml | 105 ++++++++++++++++++++++++++++++---- test/test_flan.ml | 6 ++ 6 files changed, 154 insertions(+), 17 deletions(-) create mode 100644 test/programs/dev-fln-dyn.fln diff --git a/lib/check.ml b/lib/check.ml index 73ebfae8..8edfa59f 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -9529,6 +9529,15 @@ and unknown_name : 'a. ?setting:bool -> ctx -> Loc.t -> string -> 'a = else Loc.failk "check/dot-access" loc ~notes "unknown name %s — %s, and %s has no field %s" name how sn field + | None, Some Types.Dyn -> + let how = + if setting then Printf.sprintf "(set (.%s %s) ...)" field head + else Printf.sprintf "(.%s %s)" field head + in + Loc.failk "check/dot-access" loc + "unknown name %s — a dot is part of the name here, not field access. \ + %s is dyn, and its :%s is reached with %s" + name head field how | None, Some t -> Loc.failk "check/dot-access" loc "unknown name %s — a dot is part of the name here, not field access. \ diff --git a/lib/dev.ml b/lib/dev.ml index 7bf0d8d6..4f078e5f 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -4590,10 +4590,19 @@ let rec handle t req = match Wire.string_field req "syntax", Wire.string_field req "op", Wire.string_field req "file" with | (Some _ as s), _, _ -> Source.syntax_of_field s - (* A whole file named with no [:syntax] is in the syntax its name says: - that is not a guess, it is what [Source.read_file] would do. *) - | None, Some "load-file", Some f when Source.is_indented f -> Source.Indented - | None, _, _ -> Source.Paren + (* With no [:syntax], a file named is in the syntax its name says — what + [Source.read_file] would do — for every op, so code sent from a .fln + buffer by a client that left the field out is not read as parens. A + paren expansion sent back under a .fln name says [:syntax "paren"]. *) + | None, _, Some f when Source.is_source f -> + if Source.is_indented f then Source.Indented else Source.Paren + (* A pseudo-name — "", "", whose text is built in parens — + is paren. No file at all is the program's own syntax: evaluating in a + stopped frame names none, and its code is written as the program is. *) + | None, _, Some _ -> Source.Paren + | None, _, None -> + if Source.is_indented t.session.Session.file then Source.Indented + else Source.Paren in let at = match Wire.int_field req "line", Wire.int_field req "col" with diff --git a/spec-syntax.md b/spec-syntax.md index 0f1f0381..887b4fe6 100644 --- a/spec-syntax.md +++ b/spec-syntax.md @@ -462,9 +462,11 @@ Each step lands on its own, with `dune test --root .` green. space-padding in `flan--text-at` (`emacs/flan.el:2602-2622`), which breaks significant indentation, with `:line`/`:col` fields; the reader seeds its indent stack with that column. **Built** (also `load-file` and restart - arguments; no `:syntax` means paren, except a `load-file` of a `.fln` - file; several indented statements sent as one expression read as - `(do …)`). + arguments; with no `:syntax` a request is read in the syntax of the + source `:file` it names, as paren under a pseudo-name such as ``, + and with no `:file` at all in the program's — so + evaluating in a stopped frame of a `.fln` program reads indented; + several indented statements sent as one expression read as `(do …)`). 5. **Emacs mode** for `.fln`: - A top-level form runs from a column-0 line that isn't `else`, `elif`, `on` or `restart` to just before the next one, minus trailing blank and diff --git a/test/programs/dev-fln-dyn.fln b/test/programs/dev-fln-dyn.fln new file mode 100644 index 00000000..aa66939b --- /dev/null +++ b/test/programs/dev-fln-dyn.fln @@ -0,0 +1,26 @@ +;; A dyn class instance in a .fln program, for code evaluated from its buffer: +;; eval-expr reads the request's syntax, at a stop as well as at a park. +import agent "vendor:agent" + +defclass(State, [paused bool step bool]) + +once state = State(false, false) +once go = false + +struct Missing(id: i32) + +fn boom() -> i64 + restart-case + error(Missing{.id 1}) + 0 + restart carry-on() + -1 + +fn main() -> i32 + agent/start("/tmp/flan-dev-fln-dyn-fallback.sock") + for i in range(4000) + agent/wait(5) + if go + go = false + boom() + 0 diff --git a/test/test_dev.ml b/test/test_dev.ml index c97466da..be21fb4e 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -7283,6 +7283,78 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ xsock2; xout2; msock; mout ]; + (* ── Code from a .fln program, with no :syntax ────────────────────── + A request that leaves :syntax out is read in the syntax of the file it + names, and with no file — evaluating in a stopped frame names none — + in the program's. So a dyn instance's dot assignment evaluates from a + .fln buffer at a park and in the program's own stopped frame. *) + List.iter + (fun backend -> + let fsock = tmp ("flndyn" ^ backend ^ ".sock") + and fout = tmp ("flndyn" ^ backend ^ ".out") in + (try Sys.remove fsock with Sys_error _ -> ()); + let ffd = + Unix.openfile fout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let fpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-fln-dyn.fln"; "-s"; fsock; + "--" ^ backend |] + Unix.stdin ffd Unix.stderr + in + Unix.close ffd; + if not (listening ~pid:fpid fsock) then begin + fail "the .fln dyn daemon (--%s) %s" backend !listen_why; + (try Unix.kill fpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect fsock in + let ask ?frame code = + request c + (match frame with + | Some n -> + Printf.sprintf "(:op \"eval-expr\" :frame %d :code %s)" n + (Wire.quote code) + | None -> + Printf.sprintf + "(:op \"eval-expr\" :code %s :file \"programs/dev-fln-dyn.fln\")" + (Wire.quote code)) + in + let answer r = + match Wire.string_field r "value" with + | Some v -> v + | None -> Option.value ~default:(status r) (Wire.string_field r "message") + in + let is ?frame what code want = + let a = answer (ask ?frame code) in + if a <> want then fail "--%s: %s answered %S, not %S" backend what a want + in + if not (await ~ms:20000 (fun () -> status (ask "1") = "ok")) then + fail "--%s: the .fln dyn program never took an expression" backend + else begin + is "a dot assignment from a .fln file" "state.paused = not(state.paused)" "()"; + is "and a dot read" "state.paused" "true"; + ignore (ask "go = true"); + let stopped () = + match Wire.field (request c "(:op \"describe\")") "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + if not (await ~ms:20000 stopped) then + fail "--%s: the .fln dyn program did not stop in boom" backend + else begin + is ~frame:0 "a dot assignment in a stopped frame" + "state.paused = not(state.paused)" "()"; + is ~frame:0 "and a dot read there" "state.paused" "false" + end + end; + (try Unix.close c with Unix.Unix_error _ -> ()); + (try Unix.kill fpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] fpid) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ fsock; fout ]) + [ "x86"; "llvm" ]; + (* ── The dyn globals a park holds ─────────────────────────────────── *) (* The banner a finished run prints says the globals are as it left them, @@ -9382,16 +9454,9 @@ let () = "(if (= (type-of (at instances 1)) :point) 1 0)"; holds "and a kind for anything that is not an instance" "(if (= (type-of (get (at instances 1) :w)) :nil) 1 0)" - end; - - (* ── A definition that did not change ── - Every C-c C-k re-runs a file's class definitions, and re-running - an unchanged one has to leave its instances' values alone. *) - let r = redefine "(defclass point [x z w])" in - if status r <> "ok" then fail "re-evaluating an unchanged class: %s" (said r) - else - holds "an unchanged definition keeps the values" - "(if (= (get (at instances 1) :x) 5) 1 0)" + end + (* A definition that did not change migrates nothing: the hook block + below asks that with a method that would mark the instance. *) end; (try Unix.close c with Unix.Unix_error _ -> ()); (try Unix.kill mpid Sys.sigkill with Unix.Unix_error _ -> ()); @@ -9623,6 +9688,26 @@ let () = if not (await warned) then fail "%sno warning for a kept value that does not fit: %S" what (output ()) + end; + (* ── A definition that did not change ── + Every C-c C-k re-runs a file's class definitions, and one that + bumped the generation per registration rather than per change + would migrate every instance on every save. A method that marks + the instance says whether a migration ran: not for the same + definition again, and once for a changed one. *) + if defined "a method that marks the instance" + "(defmethod update-instance-for-redefined-class point \ + [p added discarded] (set (get p :radius) 777) nil)" + && defined "the same definition again" + "(defclass point [x str radius z n i32 note str])" + then begin + holds "an unchanged definition migrates nothing" + "(if (= (get (at instances 0) :radius) 4) 1 0)"; + if defined "a changed definition after it" + "(defclass point [x str radius z n i32 note str w])" + then + holds "a changed one runs the method" + "(if (= (get (at instances 0) :radius) 777) 1 0)" end end; (try Unix.close c with Unix.Unix_error _ -> ()); diff --git a/test/test_flan.ml b/test/test_flan.ml index 1f3d72cb..7bd14bb5 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2888,6 +2888,12 @@ let () = "(defstruct P [x i32]) (defn f [] i32 (let [p (P {.x 1})] (set (.x p) 2) (.x p)))"; rejects_check "a dotted head that is not a struct says what it is" "(defn f [] i32 (let [n 1] n.x))" ~needle:"n is i32, which has no fields"; + rejects_check "a dotted dyn head points to the accessor" + "(defn f [] i32 (let [s {:p 1}] (println s.p) 0))" + ~needle:"s is dyn, and its :p is reached with (.p s)"; + rejects_check "and to the place in a set" + "(defn f [] i32 (let [s {:p 1}] (set s.p 2) 0))" + ~needle:"s is dyn, and its :p is reached with (set (.p s) ...)"; (* The fourth shape: nothing is bound under the head either, so the message claims nothing about what q is — only that the dot is not the operator the writer took it for. *)