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

A defclass slot may declare a type that every store into it checks, and set writes a declared slot

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 11:40:08 +07:00
parent 8b4c6f81df
commit 2682214499
18 changed files with 744 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lib/ast.ml
View File

@ -199,6 +199,11 @@ and place =
| Pfield of expr * string (* (set (.hp e) v) *)
| Pindex of expr * expr list (* (set (at grid r c) v) *)
| Pderef of expr (* (set (deref p) v) *)
(* (set (get inst :slot) v) — a class instance's declared slot. A map has
no such place: an absent key has no location, and [put] is how one is
written. Which of the two a value is, is known only at run time, so
this is a runtime store that refuses a plain map. *)
| Pslot of expr * expr
and arm = { pat : pattern; body : expr list; aloc : Loc.t }
@ -282,8 +287,10 @@ and decl_kind =
| Defvar of string * texpr option * init * reinit
| Defconst of string * texpr option * expr
(* ── The dyn side's classes and generic functions ──────────────────
None of these four reaches [Check]. [Classes.expand] turns the whole set
into ordinary [Defn]s before pass one collects anything, the way [Shim]
None of these four reaches [Check]'s signature pass. [Classes.expand]
turns the generic forms into ordinary [Defn]s before pass one collects
anything, and [Check.pair_decls] turns a [Defclass] into its constructor
once its slot vector can be paired, the way [Shim]
already turns a [DeclareC] into a [Declare] plus a [Defn]: a class is a
constructor, and a generic function is one function whose body is a
dispatch over the methods written for it.
@ -293,8 +300,11 @@ and decl_kind =
anywhere in the file, or arrive at a reload long after the generic did,
and a macro sees one form. *)
(* (defclass point [x y]) — the slot names, in constructor order. *)
| Defclass of string * (string * Loc.t) list
(* (defclass point [x y]) or (defclass state [pause bool step bool]) — the
slot vector, in constructor order, left unpaired for the reason a
[defn]'s is: [[x y]] is two slots or one slot [x] of type [y] depending
on whether [y] names a type. [Check.pair_decls] pairs it. *)
| Defclass of string * pitem list
(* (defgeneric area [self] dyn) — CLOS's class dispatch: the dispatch value
is the shape tag of the first argument. The parameter vector and the
return slot are a [defn]'s, and there is no body. *)
@ -413,6 +423,7 @@ let map_children f (e : expr) : expr =
| Pfield (x, n) -> Pfield (ex x, n)
| Pindex (x, is) -> Pindex (ex x, List.map ex is)
| Pderef x -> Pderef (ex x)
| Pslot (x, k) -> Pslot (ex x, ex k)
in
let kind =
match e.e with

111
lib/check.ml
View File

@ -181,6 +181,13 @@ type env = {
flag is what lets [resolve_name] say the honest thing in each place
instead of a suggestion that cannot be followed. *)
mutable in_field : bool;
(* Every [defclass], by name: its slots in constructor order, each with the
type a value stored in it must have — [Types.Dyn] for a slot written
with no type. Filled by [pair_decls], which is where a slot vector is
first readable. The type is a declaration about the values and not a
layout: an instance is a dyn map whatever this says, and what reads it
is [class_spec], which is what the runtime checks a store against. *)
classes : (string, (string * Types.t) list) Hashtbl.t;
}
let new_env () = {
@ -210,6 +217,7 @@ let new_env () = {
tvpreds = [];
chain = [];
in_field = false;
classes = Hashtbl.create 8;
}
(* Where a named type was declared, and what it has, as a note.
@ -1491,6 +1499,40 @@ let pair_params env (items : Ast.pitem list) : Ast.field list =
in
go items
(* A class slot's type, resolved and held to the set a stored dyn value can
be checked against: its tag says bool, int, float or text and nothing
finer, so those are the types there are. A narrower integer is a range on
top of the int tag. Everything else a type can be — a struct, a Vec, a
pointer — does not cross into dyn at all, so a slot of one could never be
written. *)
let slot_type env cls (f : Ast.field) : Types.t =
let t = resolve env f.Ast.fty in
match t with
| Types.Dyn | Types.Bool | Types.Int _ | Types.Float _ | Types.String -> t
| other ->
Loc.failk "check/slot-type" f.Ast.fty.Ast.tloc
"the slot %s of %s is declared %s, and a class slot holds a dyn value, \
which can be checked as bool, an integer type, f32, f64 or string. \
Write one of those, or leave the type out and the slot holds any dyn \
value: [%s]"
f.Ast.fname cls (Types.to_string other) f.Ast.fname
(* What the runtime is told a class is: one line per slot, in constructor
order, the slot's name and then its type's name after a space — no type
for a dyn slot. The same string goes to [flan_dyn_map_new_class] from the
constructor and to [flan_dyn_class_def] from a reload, so the two cannot
describe one class differently. *)
let class_spec_of (slots : (string * Types.t) list) =
String.concat "\n"
(List.map
(fun (n, t) ->
match t with
| Types.Dyn -> n
| t -> n ^ " " ^ Types.to_string t)
slots)
let class_slots env n = Hashtbl.find_opt env.classes n
(* Every [defn] in the program, with its parameter vector paired. Run as a pass
of its own, after the type names are registered and before any signature is
resolved, so that nothing downstream ever sees an unpaired one. *)
@ -1503,6 +1545,18 @@ let pair_decls env (decls : Ast.decl list) : Ast.decl list =
List.map
(fun (d : Ast.decl) ->
match d.Ast.d with
(* A class's slot vector is paired here and nowhere earlier, for the
reason a [defn]'s is, and its constructor is written from the
pairs — [Classes.expand] left the declaration as it was for exactly
this. *)
| Ast.Defclass (n, items) ->
let slots = pair_params env items in
Hashtbl.replace env.classes n
(List.map
(fun (f : Ast.field) ->
(f.Ast.fname, slot_type env n f))
slots);
Classes.constructor n slots d.Ast.dloc
| Ast.Defn f -> { d with Ast.d = Ast.Defn (fn f) }
| Ast.Declare (f, c) -> { d with Ast.d = Ast.Declare (fn f, c) }
| Ast.DeclareC (f, c) -> { d with Ast.d = Ast.DeclareC (fn f, c) }
@ -3450,10 +3504,14 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
| Ast.MapLit (tag, kvs) ->
let m = fresh_slot ctx Types.Dyn in
let mval = mk loc Types.Dyn (Tast.Local m) in
(* A class's constructor stores through [flan_dyn_slot_init], which is
the plain store plus the slot's type check, worded for the
constructor rather than for a [put] nobody wrote. *)
let store = if tag = None then "flan_dyn_map_set" else "flan_dyn_slot_init" in
let sets =
List.map
(fun (k, v) ->
rt loc Types.Unit "flan_dyn_map_set"
rt loc Types.Unit store
[ mval; check ctx ~want:Types.Dyn k;
check ctx ~want:Types.Dyn v ])
kvs
@ -3466,8 +3524,19 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
match tag with
| None -> rt loc Types.Dyn "flan_dyn_map_new" []
| Some cls ->
(* The class's slots and their types ride along, so the first
instance built registers the class with the runtime and every
store after it — this literal's own included — is checked. A
class registered already, by an earlier instance or by a reload,
keeps what it has: redefining one is a reload's business. *)
let spec =
match Hashtbl.find_opt ctx.env.classes cls with
| Some slots -> class_spec_of slots
| None -> ""
in
rt loc Types.Dyn "flan_dyn_map_new_class"
[ rt loc Types.Dyn "flan_dyn_kw" [ mk loc Types.String (Tast.Str cls) ] ]
[ rt loc Types.Dyn "flan_dyn_kw" [ mk loc Types.String (Tast.Str cls) ];
mk loc Types.String (Tast.Str spec) ]
in
expect ctx loc ~want
(mk loc Types.Dyn (Tast.Let ([ (m, empty) ], sets @ [ mval ])))
@ -3586,6 +3655,23 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
let v = check ctx ~want:pty v in
expect ctx loc ~want (mk loc Types.Unit (Tast.Set (p, v)))
end
(* (set (get inst :slot) x) — a class instance's declared slot. A call and
not a place for [flan_dyn_set_at]'s reason: the runtime has to look at
the value to know it is an instance, which of its slots the key names,
and whether [x] fits the type that slot was declared with, and it traps
on each with a sentence of its own. A typed map has no such place; its
entries are written with [put]. *)
| Ast.Set (Ast.Pslot (target, k), v) ->
let target = check ctx target in
if target.Tast.ty <> Types.Dyn then
fail loc
"(get m k) is a place only on a class instance, and this is %s. A \
map's entries are written with (put m k v)"
(Types.to_string target.Tast.ty);
let k = check ctx ~want:Types.Dyn k in
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 ])
| Ast.Set (p, v) ->
let p, pty = check_place ctx loc p in
let v = check ctx ~want:pty v in
@ -6187,6 +6273,13 @@ and check_place ctx loc (p : Ast.place) : Tast.place * Types.t =
| Types.Ptr t -> Tast.Pderef target, t
| other ->
fail loc "deref takes a (Ptr T), found %s" (Types.to_string other))
(* Only [set] writes a class slot, and it has its own arm above. A slot
lives in a map the collector may move entries of, so it has no address
to hand out. *)
| Ast.Pslot _ ->
fail loc
"a class slot (get inst :slot) is written with set and has no address. \
Read it into a local with let"
(* 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
@ -7829,12 +7922,14 @@ and named_call ?(qualified = false) ctx ~want loc name args =
let target = check ctx target in
(* A put into a dyn map is a call and nothing else, the way a push into
a dyn vec is: the runtime owns the storage, so there is no guard, no
restart and no region check. An equal key's value is replaced. *)
restart and no region check. An equal key's value is replaced. The
site rides along for the one refusal a put can meet, a class
instance's typed slot. *)
if target.Tast.ty = Types.Dyn then
expect ctx loc ~want
(rt loc Types.Unit "flan_dyn_map_set"
(rt loc Types.Unit "flan_dyn_map_put"
[ target; check ctx ~want:Types.Dyn k;
check ctx ~want:Types.Dyn v ])
check ctx ~want:Types.Dyn v; here loc ])
else begin
let kt, vt = map_kv loc "put" target.Tast.ty in
let k = check ctx ~want:kt k in
@ -10845,7 +10940,11 @@ let collect env (decls : Ast.decl list) =
driver that assembled a declaration list and skipped that pass would
otherwise get a missing name from wherever the constructor was
called, with nothing pointing here. *)
| Ast.Defclass (n, _) | Ast.Defgeneric { Ast.name = n; _ }
| Ast.Defclass (n, _) ->
fail loc
"internal: the class %s reached the checker unpaired — \
pair_decls writes its constructor, and did not run" n
| Ast.Defgeneric { Ast.name = n; _ }
| Ast.Defmulti { Ast.name = n; _ } ->
fail loc
"internal: %s reached the checker unexpanded — Classes.expand did \

59
lib/classes.ml
View File

@ -4,9 +4,11 @@
[(defclass point [x y])] is a constructor. [(defgeneric area [self] dyn)]
and [(defmulti describe [x] dyn (get x :kind))] are each one function whose
body is a dispatch, and [(defmethod area point [p] ...)] is a branch of
one. Nothing below this pass knows any of the four forms exists: what it
writes is [defn]s, and they are checked, emitted, rooted, redefined and
inspected as any other function is.
one. What it writes is [defn]s, and they are checked, emitted, rooted,
redefined and inspected as any other function is. The one exception is
[defclass], which passes through untouched: its slot vector reads like a
[defn]'s and cannot be paired until every type name is known, so
[Check.pair_decls] pairs it and calls [constructor] below.
**Why a pass and not a macro.** A macro sees one form. This needs the
whole declaration list, because a method may be written anywhere — above
@ -65,23 +67,7 @@ let collect (decls : Ast.decl list) =
List.iter
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defclass (n, slots) ->
(* 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 that falls out of it is refused by the checker anyway;
this says which declaration it came from. *)
let seen = Hashtbl.create 8 in
List.iter
(fun (s, sloc) ->
if Hashtbl.mem seen s then
Loc.failk "check/duplicate-slot" sloc
"%s names the slot %s twice. A slot is a key in the \
instance's map, so the second would replace the first and \
the constructor would take an argument that goes nowhere"
n s;
Hashtbl.replace seen s ())
slots;
Hashtbl.replace classes n d.Ast.dloc
| Ast.Defclass (n, _) -> Hashtbl.replace classes n d.Ast.dloc
| Ast.Defgeneric fn ->
Hashtbl.replace generics fn.Ast.name
{ gkind = `Class; gfn = fn; gloc = d.Ast.dloc; gms = [] }
@ -162,14 +148,37 @@ let collect (decls : Ast.decl list) =
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". *)
let constructor n slots loc : Ast.decl =
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
that falls out of it is refused by the checker anyway; this says which
declaration it came from. *)
let seen = Hashtbl.create 8 in
List.iter
(fun (f : Ast.field) ->
if Hashtbl.mem seen f.Ast.fname then
Loc.failk "check/duplicate-slot" f.Ast.floc
"%s names the slot %s twice. A slot is a key in the instance's \
map, so the second would replace the first and the constructor \
would take an argument that goes nowhere"
n f.Ast.fname;
Hashtbl.replace seen f.Ast.fname ())
slots;
(* Every parameter is dyn whatever its slot's type. The type is checked
where the value is stored — the constructor's own stores included — so
a caller holding a dyn passes it as it is, and a caller holding an i32
boxes it; neither has to convert to the slot's type first. *)
let params =
List.map
(fun (s, sloc) -> { Ast.fname = s; fty = dyn_at sloc; floc = sloc })
(fun (f : Ast.field) ->
{ Ast.fname = f.Ast.fname; fty = dyn_at f.Ast.floc; floc = f.Ast.floc })
slots
in
let pairs =
List.map (fun (s, sloc) -> (ex sloc (Ast.Kw s), ex sloc (Ast.Var s))) slots
List.map
(fun (f : Ast.field) ->
(ex f.Ast.floc (Ast.Kw f.Ast.fname), ex f.Ast.floc (Ast.Var f.Ast.fname)))
slots
in
{ Ast.d =
Ast.Defn
@ -343,7 +352,9 @@ let expand (decls : Ast.decl list) : Ast.decl list =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defclass (n, slots) -> Some (constructor n slots d.Ast.dloc)
(* Kept: its slot vector cannot be paired until every type name is
known, so [Check.pair_decls] writes the constructor. *)
| Ast.Defclass _ -> Some d
| Ast.Defgeneric fn | Ast.Defmulti fn ->
Some (dispatcher (Hashtbl.find generics fn.Ast.name))
(* Gone: its body is inside its generic's dispatch. *)

26
lib/dev.ml
View File

@ -1422,17 +1422,29 @@ let defs t =
[M-.] on a prelude macro from "the prelude is not a file on disk" into a
shrug about the daemon having no location. *)
let macro_locs = Hashtbl.create 16 in
(* The classes, off the session's declarations: [Classes.expand] turns a
[defclass] into its constructor [defn] before the checker runs, so the
class is not in [Tast.program] or the checker's environment, and the
declarations are the one place that still has it. Its constructor is
dropped from the [fn] rows for the macro rows' reason: one name, one row,
and [class] is what was written. *)
(* The classes: where each was written, off the session's declarations,
and its slots as the checker paired them, off its environment — the
slot vector is unreadable before pairing. The constructor the checker
wrote is dropped from the [fn] rows for the macro rows' reason: one name,
one row, and [class] is what was written. *)
let classes =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defclass (n, slots) -> Some (n, List.map fst slots, d.Ast.dloc)
| Ast.Defclass (n, _) ->
let slots =
Option.value ~default:[]
(Check.class_slots t.session.Session.env n)
in
Some
(n,
List.map
(fun (s, ty) ->
match ty with
| Types.Dyn -> s
| ty -> s ^ " " ^ Types.to_string ty)
slots,
d.Ast.dloc)
| _ -> None)
t.session.Session.decls
in

5
lib/emit.ml
View File

@ -4370,7 +4370,10 @@ declare i64 @flan_dyn_from_bool(i32)
declare i64 @flan_dyn_from_bytes(ptr, i64)
declare i64 @flan_dyn_vec_new()
declare i64 @flan_dyn_map_new()
declare i64 @flan_dyn_map_new_class(i64)
declare i64 @flan_dyn_map_new_class(i64, ptr, i64)
declare void @flan_dyn_slot_set(i64, i64, i64, ptr, i64)
declare void @flan_dyn_slot_init(i64, i64, i64)
declare void @flan_dyn_map_put(i64, i64, i64, ptr, i64)
declare i64 @flan_dyn_class_of(i64)
declare void @flan_dyn_class_def(i64, ptr, i64)
declare i64 @flan_dyn_kw(ptr, i64)

28
lib/load.ml
View File

@ -390,6 +390,7 @@ and rename_place owned alias bound (p : Ast.place) : Ast.place =
| Ast.Pfield (t, f) -> Ast.Pfield (go t, f)
| Ast.Pindex (t, idx) -> Ast.Pindex (go t, List.map go idx)
| Ast.Pderef t -> Ast.Pderef (go t)
| Ast.Pslot (t, k) -> Ast.Pslot (go t, go k)
let rename_field owned alias (f : Ast.field) : Ast.field =
{ f with Ast.fty = rename_texpr owned alias f.Ast.fty }
@ -501,12 +502,17 @@ let qualify_decl owned alias (d : Ast.decl) : Ast.decl =
and the rename is the ordinary one: the declared name, plus whatever
inside them is a name of this package.
A class's slots are not renamed. They are keywords in the map the
A class's slot names are not renamed. They are keywords in the map the
constructor builds, and a keyword belongs to nobody — the same line the
[MapLit] arm above takes about a map literal's keys. The *class's* name
is qualified, so [pkg/point] is what an instance's shape tag reads and
two packages' [point] classes are two classes. *)
| Ast.Defclass (n, slots) -> Ast.Defclass (qualify alias n, slots)
[MapLit] arm above takes about a map literal's keys. A slot's *type* is
a type like any other, and the vector is unpaired, so it goes through
[rename_pitem] as a [defn]'s does: a bare symbol the package owns is a
type of this package, since no slot name is ever an owned name that
matters. The *class's* name is qualified, so [pkg/point] is what an
instance's shape tag reads and two packages' [point] classes are two
classes. *)
| Ast.Defclass (n, slots) ->
Ast.Defclass (qualify alias n, List.map (rename_pitem owned alias) slots)
(* A generic's parameters are dyn and were written out by the parser, so
there is no unpaired vector here and [bound] is exactly the parameter
names. *)
@ -832,6 +838,7 @@ and place_uses acc loc (p : Ast.place) =
| Ast.Pfield (t, _) -> expr_uses acc t
| Ast.Pindex (t, idx) -> expr_uses acc t; List.iter (expr_uses acc) idx
| Ast.Pderef t -> expr_uses acc t
| Ast.Pslot (t, k) -> expr_uses acc t; expr_uses acc k
let decl_uses acc (d : Ast.decl) =
let field (f : Ast.field) = texpr_uses acc f.Ast.fty in
@ -873,9 +880,14 @@ let decl_uses acc (d : Ast.decl) =
| Ast.Zeroed | Ast.Uninit -> ())
| Ast.Defconst (_, t, v) ->
Option.iter (texpr_uses acc) t; expr_uses acc v
(* A class's slots are keywords and name nothing. Its constructor's body is
written by [Classes.expand], long after this, out of the slots alone. *)
| Ast.Defclass _ -> ()
(* A class's slot names are keywords and name nothing; its slot types are
uses, recorded the way an unpaired [defn] vector's are. *)
| Ast.Defclass (_, slots) ->
List.iter
(function
| Ast.Pname (n, loc) -> acc := (n, loc) :: !acc
| Ast.Ptype t -> texpr_uses acc t)
slots
| Ast.Defgeneric f | Ast.Defmulti f -> fn f
(* The generic is a use — a method in one package extending another's has to
pull that package in — and so is the class in the dispatch slot, for the

29
lib/parse.ml
View File

@ -1205,13 +1205,19 @@ and place (f : Form.t) : Ast.place =
either inserts or replaces — so there is no store into a lookup, and an
entry that is absent has no location to store into. Refused here rather
than parsed into a place form the language does not have. *)
(* A class instance's slot: declared by its defclass, so it always exists
and is a place, where a map's absent key is not. Whether the value is an
instance or a map is a run-time fact, so the store is a run-time call
and a map there is refused by it. *)
| List [ { v = Sym "get"; _ }; target; key ] ->
Ast.Pslot (expr target, expr key)
| List ({ v = Sym "get"; _ } :: _) ->
fail f "(get m k) is not a place — a map is written with (put m k v)"
| List [ { v = Sym "deref"; _ }; p ] -> Ast.Pderef (expr p)
| _ ->
fail f
"%s is not assignable. set takes a name, (.field x), (at a i ...), \
or (deref p)"
(deref p), or a class slot (get inst :slot)"
(Form.to_string f)
and arms f (items : Form.t list) : Ast.arm list =
@ -1484,20 +1490,15 @@ let rec decl (f : Form.t) : Ast.decl =
only names can be read here. *)
| List ({ v = Sym "defclass"; _ } :: args) ->
(match args with
(* The slot vector is a [defn]'s parameter vector in every respect —
[[x y]] two dyn slots, [[pause bool step bool]] two typed ones — and
is carried undecided for the same reason. *)
| [ n; { v = Vec slots; _ } ] ->
mk (Ast.Defclass
(dname n,
List.map
(fun (s : Form.t) ->
match s.v with
| Sym name -> no_sigil s; (name, s.loc)
| _ ->
fail s
"a class slot is a name — its value is dyn, so there \
is no type to write. Read one with (get p :%s)"
(Form.to_string s))
slots))
| _ -> fail f "defclass is (defclass Name [slot ...])")
List.iter
(fun (s : Form.t) -> match s.v with Sym _ -> no_sigil s | _ -> ())
slots;
mk (Ast.Defclass (dname n, pitems slots))
| _ -> fail f "defclass is (defclass Name [slot Type ...])")
| List ({ v = Sym ("defgeneric" | "defmulti" as which); _ } :: args) ->
let generic = String.equal which "defgeneric" in

35
lib/session.ml
View File

@ -747,27 +747,27 @@ let eval ?(origin = "<eval>") ?pause t src : change =
A class whose slot list did not change is not in here at all: its
constructor has the same signature and goes through [compatible]
untouched. *)
let class_slots (ds : Ast.decl list) n =
List.fold_left
(fun acc (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defclass (m, slots) when String.equal m n ->
Some (List.map fst slots)
| _ -> acc)
None ds
(* The slots as the checker paired them, off each side's environment: the
vector is not readable before pairing, and [t.env] is the one the
running program was checked against. Only the names decide the
constructor's arity; the types are the registration's business below. *)
let slot_names env n =
Option.map (List.map fst) (Check.class_slots env n)
in
let incoming_classes =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defclass (n, slots) -> Some (n, List.map fst slots)
| Ast.Defclass (n, _) ->
Some (n, Option.value ~default:[] (Check.class_slots env n))
| _ -> None)
incoming
in
let relaxed =
List.filter_map
(fun (n, slots) ->
match class_slots t.decls n with
let slots = List.map fst slots in
match slot_names t.env n with
| Some old when old <> slots ->
(* Every function of the running program that calls the
constructor or takes its address, minus the ones this
@ -971,15 +971,16 @@ let eval ?(origin = "<eval>") ?pause t src : change =
{ Tast.e = Tast.Prim (Tast.Rt "flan_dyn_kw", [ str n ]);
ty = Types.Dyn; loc }
in
(* The slot names in one string, newline between: the runtime
splits them. A dyn vector would have been the obvious shape
and is the wrong one — it is a collector object, so the
registry would hold something the marker has to reach, where
a packed string reaches interned keywords that are immortal
already. *)
(* The slots in one string, a line each with the slot's type
after its name: the runtime splits them. A dyn vector would
have been the obvious shape and is the wrong one — it is a
collector object, so the registry would hold something the
marker has to reach, where a packed string reaches interned
keywords that are immortal already. The constructor carries
the same string, from the same function. *)
{ Tast.e =
Tast.Prim (Tast.Rt "flan_dyn_class_def",
[ kw; str (String.concat "\n" slots) ]);
[ kw; str (Check.class_spec_of slots) ]);
ty = Types.Unit; loc })
incoming_classes
in

400
runtime/flan_dyn.c
View File

@ -1172,12 +1172,14 @@ flan_dyn flan_dyn_map_new(void) {
* of dyn vectors would have needed both, and would have needed them to
* survive a collection triggered from inside a migration.
*
* **What the registry does not do.** It does not constrain [put]. A class
* **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", already defers unknown-slot checking — so a key nobody declared
* can be written to one, and the migration below will *drop* it at the next
* 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,
* slots. [set] does refuse one, because a slot it writes has to exist. 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.
*
@ -1219,9 +1221,26 @@ flan_dyn flan_dyn_map_new(void) {
* runs ahead of its definition declares itself. */
flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n);
/* What a slot may hold. A dyn value's tag is the whole of what can be asked
* of it, so these are the tags, plus a range on top of the int tag for a
* slot declared with a narrower integer type. [word] is the type as the
* defclass wrote it, for the sentence a refusal prints. */
enum { ST_ANY, ST_BOOL, ST_INT, ST_FLOAT, ST_TEXT };
typedef struct slot_type {
uint8_t kind;
int64_t lo, hi; /* ST_INT only */
const char *word; /* static; NULL for ST_ANY */
} slot_type;
typedef struct class_entry {
kw_entry *name;
kw_entry **slots; /* interned, immortal, in declaration order */
slot_type *types; /* one per slot, same order */
/* Per slot, the generation a migration last warned about a value that no
* longer fits the slot's type. One warning per slot per redefinition,
* however many instances carry such a value. */
uint32_t *warned;
int64_t nslots;
uint32_t gen;
} class_entry;
@ -1237,74 +1256,99 @@ static class_entry *class_find(kw_entry *name) {
}
/* The generation a new instance of [name] is stamped with. Zero for a class
* no definition has been registered for, which is every class in a program
* that was built and never reloaded: nothing has changed shape, so nothing
* needs to migrate, and the registry earns its keep only once an editor has
* sent a new definition. */
* no definition has been registered for — which, now that the constructor
* registers its class, is only an instance built by something other than a
* constructor: test/dyn_ops.c, calling the runtime directly. */
static uint32_t class_gen(kw_entry *name) {
class_entry *e = class_find(name);
return e == NULL ? 0u : e->gen;
}
/* One class's current slot list, as the compiler's per-reload thunk hands it
* over: the class's name as a keyword, and the slot names packed into one
* string, newline between and no leading colons — the shape a string literal
* already crosses in, rather than a dyn vector this would have to root.
*
* The generation is bumped only when the list actually differs. That is what
* makes C-c C-k idempotent: reloading a file re-runs every one of its class
* definitions, and a bump per reload would migrate every instance in the
* program every time anybody saved, for no change. */
void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
kw_entry *k;
kw_entry **list = NULL;
int64_t count = 0, i, start;
class_entry *e;
if (flan_dyn_tag(name) != FLAN_DYN_TAG_KEYWORD)
/* No location: the caller is the thunk a reload runs, which has no
source position of its own — the class's own [defclass] is where a
reader would look, and it is not on any stack by the time this runs.
Unreachable from written Flan in any case; only the compiler emits
this call, and it emits a keyword. */
trap1(NULL, 0, TYPE_TRAP, "class definition",
"a class name is a keyword", name);
k = dyn_kw(name);
static slot_type slot_type_of(const uint8_t *w, int64_t n) {
static const struct { const char *w; uint8_t kind; int64_t lo, hi; } known[] = {
{ "bool", ST_BOOL, 0, 0 },
{ "string", ST_TEXT, 0, 0 },
{ "f32", ST_FLOAT, 0, 0 },
{ "f64", ST_FLOAT, 0, 0 },
{ "i8", ST_INT, INT8_MIN, INT8_MAX },
{ "i16", ST_INT, INT16_MIN, INT16_MAX },
{ "i32", ST_INT, INT32_MIN, INT32_MAX },
{ "i64", ST_INT, INT64_MIN, INT64_MAX },
{ "u8", ST_INT, 0, UINT8_MAX },
{ "u16", ST_INT, 0, UINT16_MAX },
{ "u32", ST_INT, 0, UINT32_MAX },
{ "u64", ST_INT, 0, INT64_MAX },
};
slot_type t = { ST_ANY, 0, 0, NULL };
size_t i;
for (i = 0; i < sizeof known / sizeof known[0]; i++)
if ((int64_t)strlen(known[i].w) == n && memcmp(known[i].w, w, (size_t)n) == 0) {
t.kind = known[i].kind;
t.lo = known[i].lo;
t.hi = known[i].hi;
t.word = known[i].w;
return t;
}
/* A word this table does not know is a compiler newer than this runtime.
Holding anything is the answer that loses no data. */
return t;
}
static int slot_fits(const slot_type *t, flan_dyn v) {
int tag = flan_dyn_tag(v);
switch (t->kind) {
case ST_BOOL: return tag == FLAN_DYN_TAG_BOOL;
case ST_TEXT: return tag == FLAN_DYN_TAG_TEXT;
case ST_FLOAT: return tag == FLAN_DYN_TAG_FLOAT;
case ST_INT: {
int64_t x;
if (tag != FLAN_DYN_TAG_INT) return 0;
x = dyn_int_value(v);
return x >= t->lo && x <= t->hi;
}
default: return 1;
}
}
/* A class's slots as the compiler hands them over: one line per slot, the
* slot's name and then, after a space, its type's name — nothing for a slot
* written with no type. The same string comes from a constructor and from a
* reload, so it is read in one place. The count is returned; both arrays are
* NULL for a class with no slots, which allocates nothing. */
static int64_t class_spec(const uint8_t *spec, int64_t n, kw_entry ***names,
slot_type **types) {
int64_t count = 0, i, start;
if (n < 0) n = 0;
/* Count first, then fill: one allocation of the right size, and an empty
* class — (defclass marker []) is in the corpus — allocates nothing. */
*names = NULL;
*types = NULL;
for (i = 0, start = 0; i <= n; i++)
if (i == n ? i > start : slots[i] == '\n') {
if (i == n ? i > start : spec[i] == '\n') {
if (i > start) count++;
start = i + 1;
}
if (count > 0) {
list = (kw_entry **)malloc((size_t)count * sizeof *list);
if (list == NULL) trap_oom(NULL, 0, count * (int64_t)sizeof *list);
count = 0;
for (i = 0, start = 0; i <= n; i++)
if (i == n ? i > start : slots[i] == '\n') {
if (i > start)
list[count++] = dyn_kw(flan_dyn_kw(slots + start, i - start));
start = i + 1;
if (count == 0) return 0;
*names = (kw_entry **)malloc((size_t)count * sizeof **names);
*types = (slot_type *)malloc((size_t)count * sizeof **types);
if (*names == NULL || *types == NULL)
trap_oom(NULL, 0, count * (int64_t)(sizeof **names + sizeof **types));
count = 0;
for (i = 0, start = 0; i <= n; i++)
if (i == n ? i > start : spec[i] == '\n') {
if (i > start) {
int64_t sp = start;
while (sp < i && spec[sp] != ' ') sp++;
(*names)[count] = dyn_kw(flan_dyn_kw(spec + start, sp - start));
(*types)[count] = sp < i ? slot_type_of(spec + sp + 1, i - sp - 1)
: slot_type_of(NULL, 0);
count++;
}
}
e = class_find(k);
if (e != NULL) {
int same = e->nslots == count;
if (same)
for (i = 0; i < count; i++)
if (e->slots[i] != list[i]) { same = 0; break; }
if (same) { free(list); return; }
free(e->slots);
e->slots = list;
e->nslots = count;
/* Wrapping is not a correctness question — what matters is that the new
* generation differs from the one the live instances carry — but zero is
* reserved for "no definition registered", so it is stepped over. */
e->gen = e->gen + 1u;
if (e->gen == 0u) e->gen = 1u;
return;
}
start = i + 1;
}
return count;
}
static void class_add(kw_entry *k, kw_entry **list, slot_type *types,
int64_t count) {
if (classes_n == classes_cap) {
int64_t cap = classes_cap ? classes_cap * 2 : 8;
class_entry *t =
@ -1315,6 +1359,11 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
}
classes[classes_n].name = k;
classes[classes_n].slots = list;
classes[classes_n].types = types;
classes[classes_n].warned =
count > 0 ? (uint32_t *)calloc((size_t)count, sizeof(uint32_t)) : NULL;
if (count > 0 && classes[classes_n].warned == NULL)
trap_oom(NULL, 0, count * (int64_t)sizeof(uint32_t));
classes[classes_n].nslots = count;
/* One, never zero: an instance built before this registration carries zero
* and has to be seen as stale, because the definition it was built from is
@ -1323,6 +1372,61 @@ void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
classes_n++;
}
/* One class's current definition, as the compiler's per-reload thunk hands
* it over: the class's name as a keyword, and [class_spec]'s string.
*
* The generation is bumped only when the definition actually differs — a
* slot's name or its type. That is what makes C-c C-k idempotent: reloading
* a file re-runs every one of its class definitions, and a bump per reload
* would migrate every instance in the program every time anybody saved, for
* no change. */
void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
kw_entry *k;
kw_entry **list;
slot_type *types;
int64_t count, i;
class_entry *e;
if (flan_dyn_tag(name) != FLAN_DYN_TAG_KEYWORD)
/* No location: the caller is the thunk a reload runs, which has no
source position of its own — the class's own [defclass] is where a
reader would look, and it is not on any stack by the time this runs.
Unreachable from written Flan in any case; only the compiler emits
this call, and it emits a keyword. */
trap1(NULL, 0, TYPE_TRAP, "class definition",
"a class name is a keyword", name);
k = dyn_kw(name);
count = class_spec(slots, n, &list, &types);
e = class_find(k);
if (e != NULL) {
int same = e->nslots == count;
if (same)
for (i = 0; i < count; i++)
if (e->slots[i] != list[i] || e->types[i].kind != types[i].kind
|| e->types[i].lo != types[i].lo || e->types[i].hi != types[i].hi) {
same = 0;
break;
}
if (same) { free(list); free(types); return; }
free(e->slots);
free(e->types);
free(e->warned);
e->slots = list;
e->types = types;
e->warned =
count > 0 ? (uint32_t *)calloc((size_t)count, sizeof(uint32_t)) : NULL;
if (count > 0 && e->warned == NULL)
trap_oom(NULL, 0, count * (int64_t)sizeof(uint32_t));
e->nslots = count;
/* Wrapping is not a correctness question — what matters is that the new
* generation differs from the one the live instances carry — but zero is
* reserved for "no definition registered", so it is stepped over. */
e->gen = e->gen + 1u;
if (e->gen == 0u) e->gen = 1u;
return;
}
class_add(k, list, types, count);
}
/* The migration. [o] is left holding exactly the class's current slots, in
* the class's order, with the values it already had for the ones it still
* has and nil for the ones it has just gained — which is precisely the
@ -1367,6 +1471,27 @@ static void class_sync(flan_obj *o) {
if (flan_dyn_tag(key) == FLAN_DYN_TAG_KEYWORD
&& dyn_kw(key) == e->slots[j]) {
v = o->u.v.items[i * 2 + 1];
/* A kept value that the slot's new type does not admit is kept
anyway: throwing it away would be the data loss a redefinition
exists to avoid, and there is nothing to convert it to. What it
gets is a warning, once per slot per redefinition, and the next
write to the slot is checked like any other. A slot the class
has only just gained holds nil without a word: it holds nothing,
rather than something of the wrong type. */
if (!slot_fits(&e->types[j], v) && e->warned[j] != e->gen) {
char sv[SAY_MAX];
kw_entry *c = o->u.v.klass, *sl = e->slots[j];
e->warned[j] = e->gen;
say(sv, SAY_MAX, v);
fflush(stdout);
fprintf(stderr,
"warning: %.*s was redefined, and its slot :%.*s is now "
"declared %s. An instance holds %s there, which is %s; it "
"keeps that value, and the next write to :%.*s is checked\n",
(int)c->len, (const char *)(c + 1),
(int)sl->len, (const char *)(sl + 1), e->types[j].word, sv,
tag_of(v), (int)sl->len, (const char *)(sl + 1));
}
break;
}
}
@ -1386,11 +1511,25 @@ static void class_sync(flan_obj *o) {
/* The same map with a shape tag on it: what a (defclass ...) constructor
* calls. [k] is a keyword and anything else traps by name — the compiler
* hands it the class's own name and nothing else can reach this. */
flan_dyn flan_dyn_map_new_class(flan_dyn k) {
* hands it the class's own name and nothing else can reach this.
*
* [spec] is the class's definition, [class_spec]'s string, and it registers
* the class the first time any instance of it is built. That is what makes
* a slot's type checked in a program that is never reloaded — the registry
* used to be filled only by a reload. A class already registered keeps
* what it has, and has to: a constructor compiled before a redefinition may
* still be on some stack, and letting its definition win would put the
* class back the way it was. Redefining is [flan_dyn_class_def]'s alone. */
flan_dyn flan_dyn_map_new_class(flan_dyn k, const uint8_t *spec, int64_t n) {
flan_obj *o;
if (flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD)
trap1(NULL, 0, TYPE_TRAP, "class instance", "a class tag is a keyword", k);
if (class_find(dyn_kw(k)) == NULL) {
kw_entry **list;
slot_type *types;
int64_t count = class_spec(spec, n, &list, &types);
class_add(dyn_kw(k), list, types, count);
}
o = gc_alloc(OBJ_MAP, 0);
o->len = 0;
o->u.v.items = NULL;
@ -2265,8 +2404,141 @@ flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k) {
return flan_dyn_from_bool(map_find(o, k) >= 0);
}
void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) {
/* A class slot's type, checked at the store — SBCL's place for it
* (src/pcl/slots.lisp, [set-slot-value]'s typecheck before the write),
* because the store is where the wrong value is. -1 when [k] is not a slot
* the class declares. */
static int64_t class_slot(class_entry *e, flan_dyn k) {
int64_t j;
if (e == NULL || flan_dyn_tag(k) != FLAN_DYN_TAG_KEYWORD) return -1;
for (j = 0; j < e->nslots; j++)
if (e->slots[j] == dyn_kw(k)) return j;
return -1;
}
/* The three stores that reach a declared slot, for the sentence a refusal
* prints: the call as it would have been written. */
enum { BY_PUT, BY_SET, BY_NEW };
static _Noreturn void trap_slot_type(const uint8_t *loc, int64_t loclen,
int by, flan_obj *o, class_entry *e,
int64_t j, flan_dyn m, flan_dyn v) {
char sm[SAY_MAX], sv[SAY_MAX];
kw_entry *sl = e->slots[j], *c = o->u.v.klass;
int sn = (int)sl->len, cn = (int)c->len;
const char *ss = (const char *)(sl + 1), *cs = (const char *)(c + 1);
say(sm, SAY_MAX, m);
say(sv, SAY_MAX, v);
fflush(stdout);
trap_where(loc, loclen);
fprintf(stderr, "dyn %s: the slot :%.*s of %.*s is declared %s, and ",
by == BY_PUT ? "put" : by == BY_SET ? "set" : "construct", sn, ss,
cn, cs, e->types[j].word);
/* An int of the wrong size is the right tag, so the tag is not the news. */
if (e->types[j].kind == ST_INT && flan_dyn_tag(v) == FLAN_DYN_TAG_INT)
fprintf(stderr, "%s is outside its range — ", sv);
else
fprintf(stderr, "this is %s — ", tag_of(v));
if (by == BY_PUT)
fprintf(stderr, "(put %s :%.*s %s)\n", sm, sn, ss, sv);
else if (by == BY_SET)
fprintf(stderr, "(set (get %s :%.*s) %s)\n", sm, sn, ss, sv);
else
fprintf(stderr, "(%.*s ...) with :%.*s %s\n", cn, cs, sn, ss, sv);
flan_trap((const uint8_t *)"DynType", 7);
}
static void check_slot(const uint8_t *loc, int64_t loclen, int by,
flan_obj *o, flan_dyn m, flan_dyn k, flan_dyn v) {
class_entry *e;
int64_t j;
if (o->u.v.klass == NULL) return;
e = class_find(o->u.v.klass);
j = class_slot(e, k);
if (j >= 0 && !slot_fits(&e->types[j], v))
trap_slot_type(loc, loclen, by, o, e, j, m, v);
}
static void map_store(flan_obj *o, flan_dyn k, flan_dyn v);
/* 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. */
void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v) {
flan_obj *o = want_map("construct", m, k);
check_slot(NULL, 0, BY_NEW, o, m, k, v);
map_store(o, k, v);
}
/* (set (get inst :slot) v). Three refusals, each its own sentence, because
* 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. */
void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
const uint8_t *loc, int64_t loclen) {
flan_obj *o;
class_entry *e;
int64_t j;
if (!is_map(m) || dyn_obj(m)->u.v.klass == NULL) {
char sm[SAY_MAX];
say(sm, SAY_MAX, m);
fflush(stdout);
trap_where(loc, loclen);
fprintf(stderr,
"dyn set: (get m k) is a place only on a class instance, and "
"this is %s%s — %s. A map's entries are written with "
"(put m k v)\n",
is_map(m) ? "a map with no class" : "a ",
is_map(m) ? "" : tag_of(m), sm);
flan_trap((const uint8_t *)"DynType", 7);
}
o = dyn_obj(m);
class_sync(o);
e = class_find(o->u.v.klass);
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);
fflush(stdout);
trap_where(loc, loclen);
fprintf(stderr, "dyn set: %.*s has no slot %s. Its slots are",
(int)c->len, (const char *)(c + 1), sk);
if (e == NULL || e->nslots == 0) fprintf(stderr, " none");
else
for (i = 0; i < e->nslots; i++)
fprintf(stderr, " :%.*s", (int)e->slots[i]->len,
(const char *)(e->slots[i] + 1));
fprintf(stderr, "; a key the class does not declare is written with "
"(put inst k v)\n");
flan_trap((const uint8_t *)"DynType", 7);
}
if (!slot_fits(&e->types[j], v))
trap_slot_type(loc, loclen, BY_SET, o, e, j, m, v);
map_store(o, k, v);
}
/* [put]: a key the class declares is checked against its type, and the
* refusal names [loc]. A key it does not declare is let through: an
* instance is an open map to [put], and the next redefinition drops such a
* key — see "Classes" above. */
void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v, const uint8_t *loc,
int64_t loclen) {
flan_obj *o = want_map("put", m, k);
check_slot(loc, loclen, BY_PUT, o, m, k, v);
map_store(o, k, v);
}
/* The same with no site: a map literal's stores, and test/dyn_ops.c. */
void flan_dyn_map_set(flan_dyn m, flan_dyn k, flan_dyn v) {
flan_dyn_map_put(m, k, v, NULL, 0);
}
/* The store under all three, with the instance already brought up to date. */
static void map_store(flan_obj *o, flan_dyn k, flan_dyn v) {
int64_t i = map_find(o, k);
if (i >= 0) {
o->u.v.items[i * 2 + 1] = v;

23
runtime/flan_dyn.h
View File

@ -88,15 +88,28 @@ flan_dyn flan_dyn_map_new(void);
*
* The tag is not traced and does not have to be: an interned keyword entry is
* immortal and is not a collector object. */
flan_dyn flan_dyn_map_new_class(flan_dyn k);
flan_dyn flan_dyn_map_new_class(flan_dyn k, const uint8_t *spec, int64_t n);
/* A constructor's store into a slot, checked against the slot's declared
* type — [flan_dyn_map_set] with a refusal worded for the constructor. */
void flan_dyn_slot_init(flan_dyn m, flan_dyn k, flan_dyn v);
/* (set (get inst :slot) v): [m] must be a class instance and [k] a slot its
* class declares, and [v] must fit the slot's type; each is a trap with its
* own sentence, at [loc]. A declared slot always exists, so this stores and
* never inserts. */
void flan_dyn_slot_set(flan_dyn m, flan_dyn k, flan_dyn v,
const uint8_t *loc, int64_t loclen);
/* The class's name as a keyword, or nil for anything that is not an instance
* — an ordinary map included. Never traps. */
flan_dyn flan_dyn_class_of(flan_dyn v);
/* A class definition, registered or re-registered: [name] is the class's name
* as a keyword and [slots]/[n] is its slot names packed into one string,
* newline between and no leading colons. The compiler emits one call per
* as a keyword and [slots]/[n] is its slots packed into one string, a line
* each, the slot's name and then — after a space, for a typed slot — its
* type's name: "x i64\ny" is an i64 slot :x and a slot :y of any value.
* [flan_dyn_map_new_class] takes the same string. The compiler emits one call per
* (defclass ...) into the thunk a reload runs, so a definition that changed
* lands here before anything touches an instance.
*
@ -185,6 +198,10 @@ void flan_dyn_push(flan_dyn v, flan_dyn x, const uint8_t *loc, int64_t loclen);
* 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);
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. */
void flan_dyn_map_put(flan_dyn m, flan_dyn k, flan_dyn v,
const uint8_t *loc, int64_t loclen);
flan_dyn flan_dyn_map_contains(flan_dyn m, flan_dyn k);
/* Structural, and per type it renders what typed [print] renders. Never

6
test/dyn_ops.c
View File

@ -1061,7 +1061,8 @@ static void define(const char *name, const char *slots) {
* Built through the same entry point a constructor uses, so it is stamped
* exactly as compiled code would stamp it. */
static flan_dyn a_point(int64_t x, int64_t y) {
flan_dyn p = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5));
flan_dyn p = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5),
(const uint8_t *)"x\ny", 3);
flan_dyn_map_set(p, flan_dyn_kw((const uint8_t *)"x", 1),
flan_dyn_from_i64(x));
flan_dyn_map_set(p, flan_dyn_kw((const uint8_t *)"y", 1),
@ -1176,7 +1177,8 @@ static void classes(void) {
define("point", "x\ny\nn");
/* Built by hand rather than through [a_point], because it is the instance
the *new* constructor would build: three slots, stamped current. */
q = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5));
q = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5),
(const uint8_t *)"x\ny\nn", 5);
flan_dyn_map_set(q, flan_dyn_kw((const uint8_t *)"x", 1),
flan_dyn_from_i64(1));
flan_dyn_map_set(q, flan_dyn_kw((const uint8_t *)"y", 1),

38
test/programs/dyn-class-slots.flan Normal file
View File

@ -0,0 +1,38 @@
;;;; Typed class slots, and set on a slot.
;;;;
;;;; A slot vector reads as a defn's parameter vector: [pause bool] is a slot
;;;; of type bool, and a name followed by another name is a slot with no type,
;;;; which holds any dyn value. The type is checked when a value is stored --
;;;; by the constructor, by put and by set -- and not when one is read: an
;;;; instance is a dyn map whatever its slots say.
;;;;
;;;; set writes a declared slot. A class declares its slots, so one always
;;;; exists and (get s :pause) is a place, where a plain map's absent key is
;;;; not. dyn-slot-trap.flan has the refusals.
(defclass state [pause bool step i32 speed f64 name string tag])
(defn twelve [] i64 12)
(defn main [] i32
(let [s (state false 3 1.5 "sand" :x)]
(println s)
(set (get s :pause) true)
(println (get s :pause))
;; An i32 slot takes any int in i32's range; a dyn caller passes the
;; value as it is, with nothing converted first.
(set (get s :step) -7)
(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 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))
(println (get s :step)))
0)

18
test/programs/dyn-slot-trap.flan Normal file
View File

@ -0,0 +1,18 @@
;;;; The refusals of a typed class slot, one per run because each ends the
;;;; process. The argument chooses which. The line numbers are asserted by
;;;; the test, so an edit above them moves them.
(defclass state [pause bool step i32 tag])
(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 3 nil)]
(println "before")
(cond
(= which 0) (println (state 1 2 3))
(= which 1) (put s :pause 1)
(= which 2) (set (get s :step) 5000000000)
(= which 3) (set (get s :paws) true)
:else (set (get (as-dyn {:pause 1}) :pause) true)))
0)

41
test/test_acceptance.ml
View File

@ -4935,6 +4935,47 @@ level "1"
index_site ();
index_site ~x86:true ();
(* 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
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\n"
in
outputs "dyn: typed class slots" "programs/dyn-class-slots.flan" slots_out;
outputs ~x86:true "dyn: typed class slots, --x86"
"programs/dyn-class-slots.flan" slots_out;
let slot_trap ?x86 () =
let exe = compile ?x86 "programs/dyn-slot-trap.flan" 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 class slot's refusal%s\n got: %S \
(exit %d)\n wanted: %S (exit 134)\n"
(match x86 with Some true -> ", --x86" | _ -> "")
text code want
end)
[ ("0", "dyn construct: the slot :pause of state is declared bool, \
and this is int — (state ...) with :pause 1");
("1", "dyn-slot-trap.flan:14:19: dyn put: the slot :pause of state \
is declared bool, and this is int");
("2", "dyn-slot-trap.flan:15:19: dyn set: the slot :step of state \
is declared i32, and 5000000000 is outside its range");
("3", "dyn-slot-trap.flan:16:19: dyn set: state has no slot :paws. \
Its slots are :pause :step :tag");
("4", "dyn-slot-trap.flan:17:13: dyn set: (get m k) is a place only \
on a class instance, and this is a map with no class") ];
(try Sys.remove exe with Sys_error _ -> ())
in
slot_trap ();
slot_trap ~x86:true ();
(* 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

36
test/test_flan.ml
View File

@ -2611,14 +2611,31 @@ let () =
rejects_check "a constructor takes one argument per slot"
"(defclass point [x y])\n(defn main [] i32 (let [p (point 1)] 0))"
~needle:"point";
(* A slot vector holds names and nothing else. [(defclass point [x i64])]
is therefore two slots, one of them unfortunately named — the parser
cannot tell a type's name from a slot's and does not have to, since a
slot has no type to write. What it can tell is a form that is not a name
at all. *)
rejects_check "a slot is a name, not a type expression"
(* A slot vector is a defn's parameter vector: a name followed by a type
is a typed slot, a name followed by another name is an untyped one. The
type is what a stored dyn value is checked against, so it is one a dyn
value can be checked as, and nothing else. *)
accepts "typed slots, and untyped ones beside them"
"(defclass state [pause bool step bool n i32 tag])\n\
(defn main [] i32 (let [s (state false true 3 :x)] (if (= (get s :n) 3) 0 1)))";
rejects_check "a slot's type is one a dyn value can be checked as"
"(defclass point [x (Ptr i64)])\n(defn main [] i32 0)"
~needle:"a class slot is a name";
~needle:"the slot x of point is declared (Ptr i64)";
rejects_check "a capitalised name in a slot vector is an unknown type"
"(defclass point [x Widget])\n(defn main [] i32 0)"
~needle:"unknown type Widget";
rejects_check "a slot's type is resolved like any other"
"(defclass point [x f65])\n(defn main [] i32 0)"
~needle:"did you mean f64";
(* The slot is a place: its class declares it, so it always exists. *)
accepts "set writes a class slot"
"(defclass state [pause bool])\n\
(defn main [] i32 (let [s (state false)] (set (get s :pause) true) \
(if (get s :pause) 0 1)))";
rejects_check "a class slot has no address"
"(defclass state [pause bool])\n\
(defn main [] i32 (let [s (state false)] (addr (get s :pause)) 0))"
~needle:"addr takes the address of a place";
rejects_check "a class does not name a slot twice"
"(defclass point [x x])\n(defn main [] i32 0)"
~needle:"names the slot x twice";
@ -3710,7 +3727,10 @@ let () =
into a lookup and no place form for one. Refused with that reason rather
than as a milestone that will never arrive. *)
rejects_check "a map entry as a place"
"(defn f [] () (set (get m 1) 2))"
"(defn f [m (Map i64 i64)] () (set (get m 1) 2))"
~needle:"entries are written with (put m k v)";
rejects_check "get with three arguments is not a place"
"(defn f [m dyn] () (set (get m 1 2) 2))"
~needle:"a map is written with (put m k v)";
(* ── restart-case and invoke-restart, §3 to §6 ─────────────────── *)

14
test/test_session.ml
View File

@ -1384,6 +1384,20 @@ let () =
(String.concat " " c.Session.fns)
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a class and its caller evaluated together: %s" m);
(* A slot's type changed and nothing else. Every constructor parameter is
dyn whatever the slot says, so the signature is the one it was and a
compiled caller is no reason to refuse — the type is checked where a
value is stored, at run time. What has to reach the program is the new
definition, and the registration carries it with the type after the
name, which is what makes the runtime see a change and migrate. *)
(let t, _ = Session.create ~file:"programs/dev-class.flan" () in
ignore (Session.eval t "(defn origin [] dyn (point 0 0))");
match Session.eval t "(defclass point [x i64 y])" with
| c ->
if not (has c.Session.ir "c\"x i64\\0Ay\"") then
fail "a slot's new type did not reach the registration"
| exception Loc.Error { Loc.dmsg = m; _ } ->
fail "a slot's type changed under a compiled caller was refused: %s" m);
(* ── What a slot is shown as ──────────────────────────────────────────
[strip_rebind] takes only a trailing ~N — [~] is the reader's delimiter

4
web/examples/classes.flan
View File

@ -1,5 +1,5 @@
;; A class is a named dyn map with a shape tag. Its slots are names and
;; carry no types, and its constructor is the class's own name, positional.
;; A class is a named dyn map with a shape tag. A slot with no type holds
;; any value, and its constructor is the class's own name, positional.
(defclass point [x y])
(defclass circle [r])

18
web/index.html
View File

@ -710,10 +710,16 @@ unit carries nothing for a dyn word to hold, and boxing it is refused — and
<h3>Classes and generic functions</h3>
<p>A class is a named dyn map with a shape tag. <code>defclass</code> names its
slots, which carry no types; the constructor is the class's own name and is
positional; and <code>class-of</code> answers the tag, or <code>nil</code> for
anything that is not an instance. The slots are map keys, so nothing was added to
read or write one.</p>
slots, and a slot may be followed by a type, the way a parameter is:
<code>[x y]</code> is two slots that hold any value, and <code>[pause bool]</code>
is one that holds only a bool. The type is checked whenever a value is stored,
and a slot may be <code>bool</code>, an integer type, <code>f32</code>,
<code>f64</code> or <code>string</code>. The constructor is the class's own name
and is positional, and <code>class-of</code> answers the tag, or <code>nil</code>
for anything that is not an instance. 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>
<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
@ -725,8 +731,8 @@ which is last whatever order it was written in. The generic states the return ty
once, for every method; a method has no return slot; and every parameter of both is
<code>dyn</code>, written or not.</p>
<pre><code>;; A class is a named dyn map with a shape tag. Its slots are names and
;; carry no types, and its constructor is the class's own name, positional.
<pre><code>;; A class is a named dyn map with a shape tag. A slot with no type holds
;; any value, and its constructor is the class's own name, positional.
(defclass point [x y])
(defclass circle [r])