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

A dyn value takes .field and [:key] as get and put, and a class instance refuses a slot it does not have

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-26 09:28:25 +07:00
commit 36156c9de9
22 changed files with 542 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
TODO.org
View File

@ -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]
@ -714,10 +715,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]
@ -1386,9 +1387,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.

7
docs/SBCL-REDEFINITION-NOTES.md
View File

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

82
lib/check.ml
View File

@ -5962,12 +5962,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 ->
@ -9505,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. \
@ -9584,9 +9617,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
@ -9721,15 +9754,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
@ -9759,6 +9796,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 —
@ -11874,8 +11926,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

6
lib/classes.ml
View File

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

17
lib/dev.ml
View File

@ -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 — "<repl>", "<inspect>", 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

1
lib/emit.ml
View File

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

113
runtime/flan_dyn.c
View File

@ -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
@ -1963,6 +1958,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 +3036,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 +3089,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 +3200,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);
return flan_dyn_from_bool(map_find(o, k) >= 0);
@ -3272,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. */
@ -3286,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;
@ -3307,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(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);
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. */

9
runtime/flan_dyn.h
View File

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

12
spec-syntax.md
View File

@ -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 `<repl>`,
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

26
test/programs/dev-fln-dyn.fln Normal file
View File

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

5
test/programs/dyn-class-slots.flan
View File

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

4
test/programs/dyn-class.flan
View File

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

20
test/programs/dyn-field-trap.flan Normal file
View File

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

27
test/programs/dyn-field-trap.fln Normal file
View File

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

36
test/programs/dyn-fields.flan Normal file
View File

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

34
test/syntax/handwritten/dynfields.fln Normal file
View File

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

5
test/syntax/handwritten/dynfields.out Normal file
View File

@ -0,0 +1,5 @@
true
false
2 7 20 11 25
nil
2 10 nil {:hp 2 :mp 10 :name "slime"}

77
test/test_acceptance.ml
View File

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

145
test/test_dev.ml
View File

@ -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 _ -> ());

2
test/test_dyn.ml
View File

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

6
test/test_flan.ml
View File

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

13
web/index.html
View File

@ -700,7 +700,9 @@ program was edited elsewhere would not be worth having.</p>
<code>{:a 1 :b "two"}</code> is a dyn map and <code>[1 2 3]</code> is a dyn vector.
<code>get</code>, <code>put</code>, <code>has-key?</code>, <code>at</code> and
<code>length</code> read and write them, the same names the typed
<code>Map</code> and <code>Vec</code> answer to. A keyword is a value here rather
<code>Map</code> and <code>Vec</code> answer to. <code>(.hp m)</code> is
<code>(get m :hp)</code> and <code>(at m :hp)</code> is too; <code>set</code> on
either is <code>put</code>. 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.</p>
@ -724,10 +726,11 @@ for anything that is not an instance. <code>type-of</code> answers any value's
kind as a keyword — <code>:nil</code>, <code>:bool</code>, <code>:int</code>,
<code>:float</code>, <code>:text</code>, <code>:vec</code>, <code>:map</code> or
<code>:keyword</code> — and an instance's class name, so a class cannot be named
after one of those kinds. The slots are map keys: <code>get</code>
reads one, and <code>set</code> writes one, as in
<code>(set (get s :pause) true)</code>. <code>put</code> writes one too, and is
also how a key the class does not declare is added.</p>
after one of those kinds. The slots are map keys: <code>(.pause s)</code>
reads one, and <code>(set (.pause s) true)</code> writes one, checking its
type. <code>get</code> and <code>put</code> 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.</p>
<p>Dispatch comes in the two styles and they are one mechanism.
<code>defgeneric</code> dispatches on the class of the first argument, which is