diff --git a/TODO.org b/TODO.org index eae50d2f..08a02ae2 100644 --- a/TODO.org +++ b/TODO.org @@ -590,10 +590,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] @@ -717,10 +718,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~: 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] @@ -1387,9 +1388,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/check.ml b/lib/check.ml index 08dba0f0..0de974a6 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -5978,12 +5978,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 -> @@ -9521,6 +9545,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. \ @@ -9600,9 +9633,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 @@ -9737,15 +9770,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 @@ -9775,6 +9812,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 — @@ -11890,8 +11942,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/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/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/lib/emit.ml b/lib/emit.ml index ef173b09..3bef9108 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -5010,6 +5010,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 8ef51d16..9208a601 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -1642,15 +1642,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 @@ -1995,6 +1990,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. @@ -3552,8 +3551,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) { @@ -3600,8 +3603,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) { @@ -3712,6 +3721,24 @@ 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, 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); +} + flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) { flan_obj *o = want_map("has-key?", m, k); if (o->kind == OBJ_VIEW) { @@ -3798,6 +3825,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. */ @@ -3812,8 +3862,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; @@ -3839,33 +3888,17 @@ 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(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); if (o->kind == OBJ_VIEW) { const uint8_t *fty; @@ -3874,14 +3907,24 @@ void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc, return; } 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 fb40211f..5e6a118b 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 @@ -244,6 +242,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 b63d9b39..bda24f0a 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 @@ -474,9 +478,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/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 new file mode 100644 index 00000000..9ae1150e --- /dev/null +++ b/test/programs/dyn-field-trap.flan @@ -0,0 +1,20 @@ +;;;; 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 [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)] + (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) + (= 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 new file mode 100644 index 00000000..bed59b9f --- /dev/null +++ b/test/programs/dyn-field-trap.fln @@ -0,0 +1,27 @@ +;;;; 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: [str]) -> 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 + 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 new file mode 100644 index 00000000..8f48a9b0 --- /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 {:a 1}) (= (.missing {:a 1}) (get {:a 1} :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..e36d11b8 --- /dev/null +++ b/test/syntax/handwritten/dynfields.fln @@ -0,0 +1,34 @@ +;; 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]) + let plain = {:a 1} + println(plain.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 25aaefb5..ea8e0e58 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 \ @@ -5701,6 +5699,73 @@ 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 + (* 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, \ + 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)"); + ("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: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" 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 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 a2287ce7..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, @@ -7418,6 +7490,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 @@ -9330,13 +9418,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" @@ -9366,34 +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 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)"; - 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)" + 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 _ -> ()); @@ -9625,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_dyn.ml b/test/test_dyn.ml index a7d4f7ac..263bdc94 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/test/test_flan.ml b/test/test_flan.ml index ffcb80dc..6b853e5f 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -2863,6 +2863,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. *) diff --git a/web/index.html b/web/index.html index e5395bb2..8fa15b52 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,11 @@ 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. 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