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

lib/ast.ml

@@ -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
+     None of these four reaches [Check]'s signature pass. [Classes.expand]
-     into ordinary [Defn]s before pass one collects anything, the way [Shim]
+     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 point [x y]) or (defclass state [pause bool step bool]) — the
-  | Defclass of string * (string * Loc.t) list
+     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

lib/check.ml

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

lib/classes.ml

@@ -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
+    one. What it writes is [defn]s, and they are checked, emitted, rooted,
-    writes is [defn]s, and they are checked, emitted, rooted, redefined and
+    redefined and inspected as any other function is. The one exception is
-    inspected as any other function 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) ->
+       | Ast.Defclass (n, _) -> Hashtbl.replace classes n d.Ast.dloc
-         (* 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.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. *)

lib/dev.ml

@@ -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
+  (* The classes: where each was written, off the session's declarations,
-     [defclass] into its constructor [defn] before the checker runs, so the
+     and its slots as the checker paired them, off its environment — the
-     class is not in [Tast.program] or the checker's environment, and the
+     slot vector is unreadable before pairing. The constructor the checker
-     declarations are the one place that still has it. Its constructor is
+     wrote is dropped from the [fn] rows for the macro rows' reason: one name,
-     dropped from the [fn] rows for the macro rows' reason: one name, one row,
+     one row, and [class] is what was written. *)
-     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

lib/emit.ml

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

lib/load.ml

@@ -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
+       [MapLit] arm above takes about a map literal's keys. A slot's *type* is
-       is qualified, so [pkg/point] is what an instance's shape tag reads and
+       a type like any other, and the vector is unpaired, so it goes through
-       two packages' [point] classes are two classes. *)
+       [rename_pitem] as a [defn]'s does: a bare symbol the package owns is a
-    | Ast.Defclass (n, slots) -> Ast.Defclass (qualify alias n, slots)
+       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
+  (* A class's slot names are keywords and name nothing; its slot types are
-     written by [Classes.expand], long after this, out of the slots alone. *)
+     uses, recorded the way an unpaired [defn] vector's are. *)
-  | Ast.Defclass _ -> ()
+  | 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

lib/parse.ml

@@ -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
+       List.iter
-             (dname n,
+         (fun (s : Form.t) -> match s.v with Sym _ -> no_sigil s | _ -> ())
-              List.map
+         slots;
-                (fun (s : Form.t) ->
+       mk (Ast.Defclass (dname n, pitems slots))
-                   match s.v with
+     | _ -> fail f "defclass is (defclass Name [slot Type ...])")
-                   | 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 ({ v = Sym ("defgeneric" | "defmulti" as which); _ } :: args) ->
     let generic = String.equal which "defgeneric" in

lib/session.ml

@@ -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 =
+  (* The slots as the checker paired them, off each side's environment: the
-    List.fold_left
+     vector is not readable before pairing, and [t.env] is the one the
-      (fun acc (d : Ast.decl) ->
+     running program was checked against. Only the names decide the
-         match d.Ast.d with
+     constructor's arity; the types are the registration's business below. *)
-         | Ast.Defclass (m, slots) when String.equal m n ->
+  let slot_names env n =
-           Some (List.map fst slots)
+    Option.map (List.map fst) (Check.class_slots env n)
-         | _ -> acc)
-      None ds
   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
+         (* The slots in one string, a line each with the slot's type
-            splits them. A dyn vector would have been the obvious shape
+            after its name: the runtime splits them. A dyn vector would
-            and is the wrong one — it is a collector object, so the
+            have been the obvious shape and is the wrong one — it is a
-            registry would hold something the marker has to reach, where
+            collector object, so the registry would hold something the
-            a packed string reaches interned keywords that are immortal
+            marker has to reach, where a packed string reaches interned
-            already. *)
+            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

runtime/flan_dyn.c

@@ -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
+ * reason", defers unknown-slot checking — so a key nobody declared can be
- * can be written to one, and the migration below will *drop* it at the next
+ * 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
+ * no definition has been registered for — which, now that the constructor
- * that was built and never reloaded: nothing has changed shape, so nothing
+ * registers its class, is only an instance built by something other than a
- * needs to migrate, and the registry earns its keep only once an editor has
+ * constructor: test/dyn_ops.c, calling the runtime directly. */
- * sent a new definition. */
 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
+static slot_type slot_type_of(const uint8_t *w, int64_t n) {
- * over: the class's name as a keyword, and the slot names packed into one
+  static const struct { const char *w; uint8_t kind; int64_t lo, hi; } known[] = {
- * string, newline between and no leading colons — the shape a string literal
+    { "bool", ST_BOOL, 0, 0 },
- * already crosses in, rather than a dyn vector this would have to root.
+    { "string", ST_TEXT, 0, 0 },
- *
+    { "f32", ST_FLOAT, 0, 0 },
- * The generation is bumped only when the list actually differs. That is what
+    { "f64", ST_FLOAT, 0, 0 },
- * makes C-c C-k idempotent: reloading a file re-runs every one of its class
+    { "i8", ST_INT, INT8_MIN, INT8_MAX },
- * definitions, and a bump per reload would migrate every instance in the
+    { "i16", ST_INT, INT16_MIN, INT16_MAX },
- * program every time anybody saved, for no change. */
+    { "i32", ST_INT, INT32_MIN, INT32_MAX },
-void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) {
+    { "i64", ST_INT, INT64_MIN, INT64_MAX },
-  kw_entry  *k;
+    { "u8", ST_INT, 0, UINT8_MAX },
-  kw_entry **list = NULL;
+    { "u16", ST_INT, 0, UINT16_MAX },
-  int64_t    count = 0, i, start;
+    { "u32", ST_INT, 0, UINT32_MAX },
-  class_entry *e;
+    { "u64", ST_INT, 0, INT64_MAX },
-  if (flan_dyn_tag(name) != FLAN_DYN_TAG_KEYWORD)
+  };
-    /* No location: the caller is the thunk a reload runs, which has no
+  slot_type t = { ST_ANY, 0, 0, NULL };
-       source position of its own — the class's own [defclass] is where a
+  size_t i;
-       reader would look, and it is not on any stack by the time this runs.
+  for (i = 0; i < sizeof known / sizeof known[0]; i++)
-       Unreachable from written Flan in any case; only the compiler emits
+    if ((int64_t)strlen(known[i].w) == n && memcmp(known[i].w, w, (size_t)n) == 0) {
-       this call, and it emits a keyword. */
+      t.kind = known[i].kind;
-    trap1(NULL, 0, TYPE_TRAP, "class definition",
+      t.lo = known[i].lo;
-          "a class name is a keyword", name);
+      t.hi = known[i].hi;
-  k = dyn_kw(name);
+      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
+  *names = NULL;
-   * class — (defclass marker []) is in the corpus — allocates nothing. */
+  *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) {
+  if (count == 0) return 0;
-    list = (kw_entry **)malloc((size_t)count * sizeof *list);
+  *names = (kw_entry **)malloc((size_t)count * sizeof **names);
-    if (list == NULL) trap_oom(NULL, 0, count * (int64_t)sizeof *list);
+  *types = (slot_type *)malloc((size_t)count * sizeof **types);
-    count = 0;
+  if (*names == NULL || *types == NULL)
-    for (i = 0, start = 0; i <= n; i++)
+    trap_oom(NULL, 0, count * (int64_t)(sizeof **names + sizeof **types));
-      if (i == n ? i > start : slots[i] == '\n') {
+  count = 0;
-        if (i > start)
+  for (i = 0, start = 0; i <= n; i++)
-          list[count++] = dyn_kw(flan_dyn_kw(slots + start, i - start));
+    if (i == n ? i > start : spec[i] == '\n') {
-        start = i + 1;
+      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++;
       }
-  }
+      start = i + 1;
-  e = class_find(k);
+    }
-  if (e != NULL) {
+  return count;
-    int same = e->nslots == count;
+}
-    if (same)
+
-      for (i = 0; i < count; i++)
+static void class_add(kw_entry *k, kw_entry **list, slot_type *types,
-        if (e->slots[i] != list[i]) { same = 0; break; }
+                      int64_t count) {
-    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;
-  }
   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. */
+ * hands it the class's own name and nothing else can reach this.
-flan_dyn flan_dyn_map_new_class(flan_dyn k) {
+ *
+ * [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;

runtime/flan_dyn.h

@@ -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,
+ * as a keyword and [slots]/[n] is its slots packed into one string, a line
- * newline between and no leading colons. The compiler emits one call per
+ * 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

test/dyn_ops.c

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

test/programs/dyn-class-slots.flan

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

test/programs/dyn-slot-trap.flan

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

test/test_acceptance.ml

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

test/test_flan.ml

@@ -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])]
+  (* A slot vector is a defn's parameter vector: a name followed by a type
-     is therefore two slots, one of them unfortunately named — the parser
+     is a typed slot, a name followed by another name is an untyped one. The
-     cannot tell a type's name from a slot's and does not have to, since a
+     type is what a stored dyn value is checked against, so it is one a dyn
-     slot has no type to write. What it can tell is a form that is not a name
+     value can be checked as, and nothing else. *)
-     at all. *)
+  accepts "typed slots, and untyped ones beside them"
-  rejects_check "a slot is a name, not a type expression"
+    "(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 ─────────────────── *)

test/test_session.ml

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

web/examples/classes.flan

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

web/index.html

@@ -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
+slots, and a slot may be followed by a type, the way a parameter is:
-positional; and <code>class-of</code> answers the tag, or <code>nil</code> for
+<code>[x y]</code> is two slots that hold any value, and <code>[pause bool]</code>
-anything that is not an instance. The slots are map keys, so nothing was added to
+is one that holds only a bool. The type is checked whenever a value is stored,
-read or write one.</p>
+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
+<pre><code>;; A class is a named dyn map with a shape tag. A slot with no type holds
-;; carry no types, and its constructor is the class's own name, positional.
+;; any value, and its constructor is the class's own name, positional.
 (defclass point [x y])
 (defclass circle [r])