The collector walks a Map's full slots, so a Map may hold closures and dyn values and keeps them alive

docs/BUILT.md

@@ -4575,8 +4575,13 @@ read of a local. So the prelude's `map`, `filter` and `reduce` are as cheap in a
 closure as in one that makes none: a map, filter and reduce loop measured 1.77G instructions at LLVM `-O2` with
 and without one unrelated escaping closure.
 
-**What is refused.** A `Map` whose values hold a function value (`fn-in-map.flan`): a `Map`'s storage is not walked.
+**A `Map`'s values are walked the same way** (`fn-in-map.flan`). A descriptor's `maps` table names each `Map` header
-A bare `Fn` field, global or array element is still refused for its zero; `(Option (Fn ...))` holds one.
+and the value type's descriptor; `flan_rt.c` reports each `Map` block through the same hook, and the marker walks the
+full slots of a live block, reading the slot count from the header and the stride and value offset from the block's
+own head. It covers a dyn value as well as a closure, so `(Map K dyn)` holds dyn values the collector keeps. The hook
+is installed by any program holding a dyn, not only one making heap closures.
+
+**What is refused.** A bare `Fn` field, global or array element, for its zero; `(Option (Fn ...))` holds one.
 
 **A module that makes a heap closure is never unloaded**: the environment points at the module's descriptor and
 code, so making one counts toward the same gate a string literal does. A capturing `fn` typed at the dev prompt takes

lib/check.ml

@@ -13639,8 +13639,11 @@ let rec hidden_dyn p seen (t : Types.t) : Types.t option =
   | Types.Dyn -> None
   | Types.Array (_, e) -> hidden_dyn p seen e
   | Types.Vec e | Types.Option e -> under e
+  (* A Map's values are walked through the value type's own descriptor, so a
+     dyn there is found wherever that descriptor finds one. A key never holds
+     one: dyn is not a key type. *)
   | Types.Map (k, v) ->
-    if dyn_anywhere p seen k || dyn_anywhere p seen v then Some t else None
+    if dyn_anywhere p seen k then Some t else hidden_dyn p seen v
   (* A pointer and a slice are views of storage something else roots; see the
      note above. What they point at is checked where it is declared. *)
   | Types.Ptr (_, e) | Types.Slice (_, e) -> hidden_dyn p seen e
@@ -13760,53 +13763,8 @@ let rec holds_fn p seen (t : Types.t) =
          | None -> false)
   | _ -> false
 
-(* The first Map under this type whose values hold a function value. A
-   closure's environment is found by walking the storage a function value
-   sits in, and a Map's storage is not walked — so an (Fn ...) there would be
-   one the collector frees under it. A Vec's is, which is the container to
-   use; and a (CFn ...) carries no environment and may go in a Map freely. *)
-let rec map_of_fn p seen (t : Types.t) : Types.t option =
-  match t with
-  | Types.Map (k, v) when holds_fn p [] k || holds_fn p [] v -> Some t
-  | Types.Array (_, e) | Types.Vec e | Types.Option e
-  | Types.Ptr (_, e) | Types.Slice (_, e) -> map_of_fn p seen e
-  | Types.Map (_, v) -> map_of_fn p seen v
-  | Types.Named n when not (List.mem n seen) ->
-    let seen = n :: seen in
-    let fields =
-      match List.find_opt (fun (s : Tast.structure) -> s.Tast.sname = n)
-              p.Tast.structs with
-      | Some s -> s.Tast.fields
-      | None ->
-        match List.find_opt (fun (u : Tast.data) -> u.Tast.dname = n)
-                p.Tast.datas with
-        | Some u -> List.concat_map (fun (c : Tast.variant) -> c.Tast.vfields) u.Tast.cases
-        | None ->
-          match List.find_opt (fun (u : Tast.structure) -> u.Tast.sname = n)
-                  p.Tast.unions with
-          | Some u -> u.Tast.fields
-          | None -> []
-    in
-    List.fold_left
-      (fun acc (fl : Tast.field) ->
-         match acc with Some _ -> acc | None -> map_of_fn p seen fl.Tast.fty)
-      None fields
-  | _ -> None
-
 let dyn_descriptors (p : Tast.program) =
   let check loc what (t : Types.t) =
-    (match map_of_fn p [] t with
-     | Some at ->
-       Loc.failk "check/fn-in-map" loc
-         "%s is %s%s, a Map whose values are function values. A function \
-          value's environment is found by walking the storage it sits in, \
-          and a Map's storage is not walked, so the collector would free an \
-          environment still in use. Keep the function values in a Vec, or \
-          make them (CFn ...) if they capture nothing"
-         what (Types.to_string t)
-         (if Types.equal t at then ""
-          else Printf.sprintf ", and holds %s" (Types.to_string at))
-     | None -> ());
     (match hidden_dyn p [] t with
      | Some at ->
        Loc.failk "check/dyn-descriptor" loc

lib/emit.ml

@@ -459,23 +459,26 @@ let align_up x a = if a <= 1 then x else ((x + a - 1) / a) * a
    pointer is four bytes and [goff] would name the wrong word. *)
 type gcword = { goff : int; gpath : (string * string list) list }
 
-(* Every word of an instance the collector follows, by kind — the three
+(* Every word of an instance the collector follows, by kind — the four
    tables of runtime/flan_dyn.h's [flan_desc]. [gvec] carries each Vec's
-   element type, whose own descriptor the entry points at. *)
+   element type and [gmap] each Map's value type, whose own descriptor the
+   entry points at. *)
 type gclayout = {
   gdyn : gcword list;
   genv : gcword list;
   gvec : (gcword * Types.t) list;
+  gmap : (gcword * Types.t) list;
 }
 
 (* A descriptor this module has to write out: its symbol, the words, the
    instance size, and the symbol of each Vec entry's element descriptor in
-   [gvec]'s order. *)
+   [gvec]'s order and of each Map entry's value descriptor in [gmap]'s. *)
 type desc = {
   dsym  : string;
   dlay  : gclayout;
   dsize : int;
   dvecs : string list;
+  dmaps : string list;
 }
 
 (* ── Module-level state ────────────────────────────────────────────── *)
@@ -741,16 +744,12 @@ and dyn_offsets m (t : Types.t) : int list =
           — which is a run-time question a static descriptor cannot answer.
           Refused in [Check] rather than described wrongly here. *)
        | None -> acc)
-    (* [Types.Option], [Types.Vec] and [Types.Map] fall through here with no
+    (* [Types.Option] and [Types.Vec] fall through here with no arm of their
-       arm of their own and answer no offsets, which is correct only because
+       own and answer no offsets, which is correct only because nothing
-       nothing reaches this function holding one with a dyn inside it:
+       reaches this function holding one with a dyn inside it:
        [Check.hidden_dyn] refuses that at every global, parameter, return and
-       frame slot first. If that gate is ever relaxed — the typed-container
+       frame slot first. A [Types.Map]'s dyn values are not words of the
-       view the M2 queue's item 3 is building is exactly the kind of change
+       instance at all; [gc_layout] names the header in its [gmap] table. *)
-       that would relax it for [Vec]/[Map] — this arm has to grow alongside
-       it, the way the array and struct arms above already walk their own
-       storage; until then a silent [] here would be an unrooted dyn, not a
-       refusal. *)
     | _ -> acc
   in
   List.sort_uniq compare (go [] 0 t [])
@@ -794,7 +793,7 @@ let desc_mangle (t : Types.t) =
    symbol. *)
 let rec desc_of m (t : Types.t) : string option =
   let l = gc_layout m t in
-  if l.gdyn = [] && l.genv = [] && l.gvec = [] then None
+  if l.gdyn = [] && l.genv = [] && l.gvec = [] && l.gmap = [] then None
   else
     let key = Types.to_string t in
     match Hashtbl.find_opt m.descs key with
@@ -806,17 +805,19 @@ let rec desc_of m (t : Types.t) : string option =
       (* Claimed before the elements are asked for, so the counter a nested
          element's symbol takes cannot be this one's. *)
       Hashtbl.replace m.descs key
-        { dsym = sym; dlay = l; dsize = fst (lay m t); dvecs = [] };
+        { dsym = sym; dlay = l; dsize = fst (lay m t); dvecs = []; dmaps = [] };
-      let dvecs =
+      let elems what l =
         List.map
           (fun (_, e) ->
              match desc_of m e with
              | Some s -> s
-             | None -> internal "a Vec entry whose element has no words")
+             | None -> internal "a %s entry whose element has no words" what)
-          l.gvec
+          l
       in
+      let dvecs = elems "Vec" l.gvec in
+      let dmaps = elems "Map" l.gmap in
       Hashtbl.replace m.descs key
-        { dsym = sym; dlay = l; dsize = fst (lay m t); dvecs };
+        { dsym = sym; dlay = l; dsize = fst (lay m t); dvecs; dmaps };
       Some sym
 
 (* ── The words the collector follows ─────────────────────────────────
@@ -845,7 +846,7 @@ let rec desc_of m (t : Types.t) : string option =
    at the same x86-64 offset and at different wasm32 ones, and marking a word
    twice costs nothing. *)
 and gc_layout m (t : Types.t) : gclayout =
-  let dyn = ref [] and env = ref [] and vec = ref [] in
+  let dyn = ref [] and env = ref [] and vec = ref [] and map = ref [] in
   let step ty idx path = path @ [ (ty, idx) ] in
   let rec go ~full seen off path (t : Types.t) =
     match t with
@@ -858,6 +859,13 @@ and gc_layout m (t : Types.t) : gclayout =
        [desc_of] claims before it recurses, is what closes that loop. *)
     | Types.Vec e when m.gcfn ->
       if reaches_fn m [] e then vec := ({ goff = off; gpath = path }, e) :: !vec
+    (* A Map's values, when they hold a function value's environment or a
+       dyn. The key never does: neither is a key type. The value type's own
+       descriptor is what the entry points at, so a Map of Maps is walked
+       through the inner one's. *)
+    | Types.Map (_, v) ->
+      if (m.gcfn && reaches_fn m [] v) || reaches_dyn m [] v then
+        map := ({ goff = off; gpath = path }, v) :: !map
     | Types.Array (n, e) ->
       let s, _ = lay m e in
       for i = 0 to Int64.to_int n - 1 do
@@ -924,7 +932,8 @@ and gc_layout m (t : Types.t) : gclayout =
   in
   let uniq l = List.sort_uniq order l in
   { gdyn = uniq !dyn; genv = uniq !env;
-    gvec = List.sort_uniq (fun (a, _) (b, _) -> order a b) !vec }
+    gvec = List.sort_uniq (fun (a, _) (b, _) -> order a b) !vec;
+    gmap = List.sort_uniq (fun (a, _) (b, _) -> order a b) !map }
 
 (* Whether an [(Fn ...)] is anywhere in a value's storage, a Vec's elements
    included. A type met again on the way contributes nothing more, which
@@ -933,7 +942,8 @@ and gc_layout m (t : Types.t) : gclayout =
 and reaches_fn m seen (t : Types.t) =
   match t with
   | Types.Fn _ -> true
-  | Types.Array (_, e) | Types.Vec e | Types.Option e -> reaches_fn m seen e
+  | Types.Array (_, e) | Types.Vec e | Types.Option e | Types.Map (_, e) ->
+    reaches_fn m seen e
   | Types.Named nm when not (List.mem nm seen) ->
     let seen = nm :: seen in
     let fields =
@@ -950,17 +960,35 @@ and reaches_fn m seen (t : Types.t) =
     List.exists (fun (fl : Tast.field) -> reaches_fn m seen fl.Tast.fty) fields
   | _ -> false
 
+(* Whether a dyn word is anywhere [gc_layout] records one: directly, in a
+   fixed array, in a struct field, or in a Map's values. The other places a
+   dyn could sit are refused by [Check.hidden_dyn]. *)
+and reaches_dyn m seen (t : Types.t) =
+  match t with
+  | Types.Dyn -> true
+  | Types.Array (_, e) | Types.Map (_, e) -> reaches_dyn m seen e
+  | Types.Named nm when not (List.mem nm seen) ->
+    (match Hashtbl.find_opt m.structs nm with
+     | Some st ->
+       List.exists
+         (fun (fl : Tast.field) -> reaches_dyn m (nm :: seen) fl.Tast.fty)
+         st.Tast.fields
+     | None -> false)
+  | _ -> false
+
 (* Whether the collector has anything to follow in a value of this type —
    the question every rooting decision asks. [dyn_offsets <> []] was that
    question until an [Fn] could hold an environment. *)
 let traced m (t : Types.t) =
   t = Types.Dyn
-  || (let l = gc_layout m t in l.gdyn <> [] || l.genv <> [] || l.gvec <> [])
+  || (let l = gc_layout m t in
+      l.gdyn <> [] || l.genv <> [] || l.gvec <> [] || l.gmap <> [])
 
 (* The words to clear before an instance at a pushed root can be marked, as
    x86-64 byte offsets of eight-byte words: each dyn word, each environment
-   word, and each Vec header's pointer and length. The LLVM backend walks
+   word, each Vec header's pointer and length, and each Map header's block
-   [gpath] instead; see [zero_words]. *)
+   pointer and capacity. The LLVM backend walks [gpath] instead; see
+   [zero_words]. *)
 let gc_zero_offsets m (t : Types.t) : int list =
   if t = Types.Dyn then [ 0 ]
   else
@@ -968,6 +996,7 @@ let gc_zero_offsets m (t : Types.t) : int list =
     List.map (fun w -> w.goff) l.gdyn
     @ List.map (fun w -> w.goff) l.genv
     @ List.concat_map (fun (w, _) -> [ w.goff; w.goff + 8 ]) l.gvec
+    @ List.concat_map (fun (w, _) -> [ w.goff; w.goff + 16 ]) l.gmap
 
 (* A [gpath] as an LLVM constant expression over [base]: nested constant
    [getelementptr]s, one per step. Over [ptr null] and through [ptrtoint] it
@@ -4273,7 +4302,12 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
           (fun ((w : gcword), _) ->
              store "ptr null" (w.gpath @ [ ("%vec", [ "i32 0"; "i32 0" ]) ]);
              store "i64 0" (w.gpath @ [ ("%vec", [ "i32 0"; "i32 1" ]) ]))
-          l.gvec
+          l.gvec;
+        List.iter
+          (fun ((w : gcword), _) ->
+             store "ptr null" (w.gpath @ [ ("%map", [ "i32 0"; "i32 0" ]) ]);
+             store "i64 0" (w.gpath @ [ ("%map", [ "i32 0"; "i32 2" ]) ]))
+          l.gmap
       end
     in
     let push base (ty : Types.t) =
@@ -5130,12 +5164,13 @@ let emit_main m ?(startup = false) ?(gc = false) ?(dyn_globals = []) (fn : Tast.
      dyn global's initialiser runs in the startup function below, and the very
      first thing it does is allocate. *)
   if gc then Buffer.add_string b "  call void @flan_gc_init()\n";
-  (* Before anything can allocate a Vec block: a program that can make a
+  (* Before anything can allocate a Vec or Map block: a program that can make
-     collector-owned closure environment has flan_rt.c report every Vec block
+     a collector-owned closure environment, or that holds a dyn, has
-     to the collector, which reads a Vec's elements only through a block it
+     flan_rt.c report every such block to the collector, which reads a
-     knows to be live (runtime/flan_dyn.c, "The Vec blocks a marker may
+     container's elements only through a block it knows to be live
-     read"). *)
+     (runtime/flan_dyn.c, "The Vec blocks a marker may read"). *)
-  if m.gcfn then Buffer.add_string b "  call void @flan_dyn_track_vecs()\n";
+  if m.gcfn || gc then
+    Buffer.add_string b "  call void @flan_dyn_track_vecs()\n";
   (* The dyn globals, rooted here and never popped, which is the whole of what
      a global's extent means. They go on the stack *before* the startup
      function runs, because that function is what fills them and its first
@@ -5409,21 +5444,24 @@ let descriptors m =
           let l = d.dlay in
           let offs = table d.dsym "offs" "i64" (List.map word l.gdyn) in
           let envs = table d.dsym "envs" "i64" (List.map word l.genv) in
-          let vecs =
+          let pairs suffix words syms =
-            table d.dsym "vecs" "{ i64, ptr }"
+            table d.dsym suffix "{ i64, ptr }"
               (List.map2
                  (fun ((w : gcword), _) e ->
                     Printf.sprintf "{ i64, ptr } { i64 %s, ptr @\"%s\" }"
                       (offset_const w) e)
-                 l.gvec d.dvecs)
+                 words syms)
           in
+          let vecs = pairs "vecs" l.gvec d.dvecs in
+          let maps = pairs "maps" l.gmap d.dmaps in
           Buffer.add_string b
             (Printf.sprintf
                "@\"%s\" = private unnamed_addr constant \
-                { i64, i64, ptr, i64, ptr, i64, ptr } \
+                { i64, i64, ptr, i64, ptr, i64, ptr, i64, ptr } \
-                { i64 %d, i64 %d, ptr %s, i64 %d, ptr %s, i64 %d, ptr %s }\n"
+                { i64 %d, i64 %d, ptr %s, i64 %d, ptr %s, i64 %d, ptr %s, \
+                i64 %d, ptr %s }\n"
                d.dsym d.dsize (List.length l.gdyn) offs (List.length l.genv)
-               envs (List.length l.gvec) vecs));
+               envs (List.length l.gvec) vecs (List.length l.gmap) maps));
   Buffer.contents b
 
 (* The same table in the other backend's syntax. It lives here rather than in
@@ -5467,19 +5505,22 @@ let descriptors_asm m =
        in
        let offs = table "offs" (List.map (fun w -> string_of_int w.goff) l.gdyn) in
        let envs = table "envs" (List.map (fun w -> string_of_int w.goff) l.genv) in
-       let vecs =
+       let pairs suffix words syms =
-         table "vecs"
+         table suffix
            (List.concat
               (List.map2
                  (fun ((w : gcword), _) e -> [ string_of_int w.goff; ".L" ^ e ])
-                 l.gvec d.dvecs))
+                 words syms))
        in
+       let vecs = pairs "vecs" l.gvec d.dvecs in
+       let maps = pairs "maps" l.gmap d.dmaps in
        Buffer.add_string b
          (Printf.sprintf
             "\t.align\t8\n.L%s:\n\t.quad\t%d\n\t.quad\t%d\n\t.quad\t%s\n\
-             \t.quad\t%d\n\t.quad\t%s\n\t.quad\t%d\n\t.quad\t%s\n"
+             \t.quad\t%d\n\t.quad\t%s\n\t.quad\t%d\n\t.quad\t%s\n\
+             \t.quad\t%d\n\t.quad\t%s\n"
             d.dsym d.dsize (List.length l.gdyn) offs (List.length l.genv) envs
-            (List.length l.gvec) vecs))
+            (List.length l.gvec) vecs (List.length l.gmap) maps))
     rows;
   Buffer.contents b
 

lib/x86.ml

@@ -4512,9 +4512,10 @@ let emit_main ?(ann = false) ?(startup = false) ?(gc = false)
     xor_rr b ~dst:rax ~src:rax;
     call_sym b "flan_gc_init"
   end;
-  (* A program that can make a collector-owned closure environment has the
+  (* A program that can make a collector-owned closure environment, or holds
-     collector told of every Vec block from here on; see [Emit.emit_main]. *)
+     a dyn, has the collector told of every Vec and Map block from here on;
-  if md.Emit.gcfn then begin
+     see [Emit.emit_main]. *)
+  if md.Emit.gcfn || gc then begin
     xor_rr b ~dst:rax ~src:rax;
     call_sym b "flan_dyn_track_vecs"
   end;

runtime/flan_dyn.c

@@ -131,6 +131,8 @@ typedef uint64_t flan_dyn;
  * - [vecs]: a (Vec T) header whose elements hold words of their own, with the
  *   element's descriptor. The marker reads the header's pointer and length
  *   where they are, so a push that reallocated is seen.
+ * - [maps]: a (Map K V) header whose values hold words of their own, with the
+ *   value's descriptor. Read the same way, and walked over the full slots.
  *
  * [size] is the stride of one instance as the compiler's element-size
  * arithmetic counts it, which is what a Vec's elements are laid out at. The
@@ -149,6 +151,8 @@ typedef struct flan_desc {
   const int64_t       *envs;
   int64_t              nvec;
   const flan_desc_vec *vecs;
+  int64_t              nmap;
+  const flan_desc_vec *maps;
 } flan_desc;
 
 #define DYN_QNAN    0xFFF8000000000000ULL
@@ -248,6 +252,23 @@ void flan_dyn_vec_hdr_layout(int64_t out[6]) {
   out[5] = (int64_t)offsetof(flan_dyn_vec_hdr, epoch);
 }
 
+/* flan_map, restated for the same reason and read the same way: only
+ * [data], [log2cap], [alloc] and [epoch]. With it, the three numbers of the
+ * block's geometry the marker needs — flan_rt.c's FLAN_MAP_HEAD, _GROUP and
+ * _ALIGN. If either file's table changes, change both. */
+typedef struct flan_dyn_map_hdr {
+  void    *data;
+  int64_t  len;
+  int64_t  log2cap;
+  void    *alloc;
+  int64_t  epoch;
+} flan_dyn_map_hdr;
+
+#define DYN_MAP_HEAD  24
+#define DYN_MAP_GROUP 8
+#define DYN_MAP_ALIGN 64
+#define DYN_MAP_FULL  0x80
+
 /* flan_allocator's prefix, far enough to read the one word a stale-container
  * check needs. The struct has more fields after [epoch]; this file never
  * touches them; and the alignment of a leading same-typed prefix is the same
@@ -1259,6 +1280,64 @@ typedef struct { char *p; int64_t n; const flan_desc *e; } vec_work;
 static vec_work *vstack;
 static int64_t   vstack_n, vstack_cap;
 
+/* Maps still to walk: a live block's control run, its slots, the slot count,
+ * the stride and value offset the block's own head records, and the value's
+ * descriptor. Queued for the Vec queue's reason. */
+typedef struct {
+  const uint8_t *ctrl; char *slots; int64_t cap, stride, voff;
+  const flan_desc *e;
+} map_work;
+static map_work *mapstack;
+static int64_t   mapstack_n, mapstack_cap;
+
+/* A live block, not reset since it was made: the checks a Vec's block and a
+ * Map's share. The allocator header is never freed, so its epoch is always
+ * readable. */
+static vblock *live_block(void *p) {
+  vblock *b = vblock_find((uintptr_t)p);
+  if (b == NULL) return NULL;
+  if (b->alloc != NULL
+      && (int64_t)((flan_dyn_alloc_hdr *)b->alloc)->epoch != b->epoch)
+    return NULL;
+  return b;
+}
+
+/* Queue the map whose header is at [h]. The slot count comes from the
+ * header and everything else from the block, and the walk is bounded by the
+ * block's recorded size, so a stale header copy naming a block another map
+ * now owns reads nothing outside that block. */
+static void queue_map(const flan_dyn_map_hdr *h, const flan_desc *e) {
+  vblock *b;
+  const int64_t *head;
+  int64_t cap, ctrl, stride, voff;
+  if (e == NULL || h->data == NULL || h->log2cap <= 0 || h->log2cap > 40)
+    return;
+  b = live_block(h->data);
+  if (b == NULL || b->bytes < DYN_MAP_HEAD) return;
+  cap = (int64_t)1 << h->log2cap;
+  ctrl = (DYN_MAP_HEAD + cap + (DYN_MAP_GROUP - 1) + (DYN_MAP_ALIGN - 1))
+         & ~(int64_t)(DYN_MAP_ALIGN - 1);
+  head = (const int64_t *)h->data;
+  stride = head[1];
+  voff = head[2];
+  if (stride <= 0 || voff < 0 || voff + e->size > stride) return;
+  if (ctrl > b->bytes || (b->bytes - ctrl) / stride < cap) return;
+  if (mapstack_n == mapstack_cap) {
+    int64_t c = mapstack_cap ? mapstack_cap * 2 : 16;
+    map_work *m = (map_work *)realloc(mapstack, (size_t)c * sizeof *m);
+    if (m == NULL) trap_oom(NULL, 0, c * (int64_t)sizeof *m);
+    mapstack = m;
+    mapstack_cap = c;
+  }
+  mapstack[mapstack_n].ctrl = (const uint8_t *)h->data + DYN_MAP_HEAD;
+  mapstack[mapstack_n].slots = (char *)h->data + ctrl;
+  mapstack[mapstack_n].cap = cap;
+  mapstack[mapstack_n].stride = stride;
+  mapstack[mapstack_n].voff = voff;
+  mapstack[mapstack_n].e = e;
+  mapstack_n++;
+}
+
 /* The words [d] names inside the instance at [base]. A Vec entry is checked
  * against the live blocks above and queued; [mark_desc] drains the queue
  * before it returns. */
@@ -1266,17 +1345,17 @@ static void mark_words(char *base, const flan_desc *d) {
   int64_t j;
   for (j = 0; j < d->n; j++) mark_value(*(flan_dyn *)(base + d->offs[j]));
   for (j = 0; j < d->nenv; j++) mark_env(*(uintptr_t *)(base + d->envs[j]));
+  for (j = 0; j < d->nmap; j++)
+    queue_map((const flan_dyn_map_hdr *)(base + d->maps[j].off),
+              d->maps[j].elem);
   for (j = 0; j < d->nvec; j++) {
     flan_dyn_vec_hdr *h = (flan_dyn_vec_hdr *)(base + d->vecs[j].off);
     const flan_desc *e = d->vecs[j].elem;
     vblock *b;
     int64_t n;
     if (e == NULL || e->size <= 0 || h->len <= 0) continue;
-    b = vblock_find((uintptr_t)h->ptr);
+    b = live_block(h->ptr);
     if (b == NULL) continue;
-    if (b->alloc != NULL
-        && (int64_t)((flan_dyn_alloc_hdr *)b->alloc)->epoch != b->epoch)
-      continue;
     n = b->bytes / e->size;
     if (h->len < n) n = h->len;
     if (vstack_n == vstack_cap) {
@@ -1295,10 +1374,17 @@ static void mark_words(char *base, const flan_desc *d) {
 
 static void mark_desc(char *base, const flan_desc *d) {
   mark_words(base, d);
-  while (vstack_n > 0) {
+  while (vstack_n > 0 || mapstack_n > 0) {
-    vec_work w = vstack[--vstack_n];
     int64_t i;
-    for (i = 0; i < w.n; i++) mark_words(w.p + i * w.e->size, w.e);
+    if (vstack_n > 0) {
+      vec_work w = vstack[--vstack_n];
+      for (i = 0; i < w.n; i++) mark_words(w.p + i * w.e->size, w.e);
+    } else {
+      map_work w = mapstack[--mapstack_n];
+      for (i = 0; i < w.cap; i++)
+        if (w.ctrl[i] & DYN_MAP_FULL)
+          mark_words(w.slots + i * w.stride + w.voff, w.e);
+    }
   }
 }
 
@@ -1355,7 +1441,8 @@ static void gc_sweep(void) {
 void *flan_dyn_env_new(int64_t size, const flan_desc *d) {
   flan_obj *o = gc_alloc(OBJ_ENV, size);
   o->len = size;
-  o->u.env.desc = (d != NULL && (d->n > 0 || d->nenv > 0 || d->nvec > 0))
+  o->u.env.desc = (d != NULL && (d->n > 0 || d->nenv > 0 || d->nvec > 0
+                                || d->nmap > 0))
                       ? d : NULL;
   memset(o + 1, 0, (size_t)size);
   envset_put((uintptr_t)(o + 1));
@@ -1384,7 +1471,7 @@ void flan_dyn_root_push(flan_dyn *slot) { root_add(slot, NULL); }
  * compiler found no dyn in — but it still occupies an entry, because the count
  * is what the epilogue knows, and it is turned into an empty descriptor rather
  * than stored as NULL, which on this stack means something else. */
-static const flan_desc desc_empty = { 0, 0, NULL, 0, NULL, 0, NULL };
+static const flan_desc desc_empty = { 0, 0, NULL, 0, NULL, 0, NULL, 0, NULL };
 
 void flan_dyn_root_push_desc(void *base, const flan_desc *d) {
   root_add(base, d == NULL ? &desc_empty : d);

runtime/flan_dyn.h

@@ -56,8 +56,11 @@ typedef uint64_t flan_dyn;
  * pointer-sized, holding a collector-allocated environment, null, or a
  * widened function's code address, told apart by the collector's own set of
  * environments and never by dereferencing — and [vecs], each a (Vec T)
- * header at [off] whose live elements are marked through [elem]. A descriptor
+ * header at [off] whose live elements are marked through [elem] — and
- * with only dyn words leaves the last four fields zero.
+ * [maps], each a (Map K V) header at [off] whose full slots' values are marked
+ * through [elem]; a key never holds a word the collector follows, because no
+ * such type is a key. A descriptor with only dyn words leaves the last six
+ * fields zero.
  *
  * Nothing in this ABI ever writes a descriptor. See [flan_dyn_root_push_desc]
  * and [flan_dyn_env_new]. */
@@ -75,6 +78,8 @@ typedef struct flan_desc {
   const int64_t       *envs;
   int64_t              nvec;
   const flan_desc_vec *vecs;
+  int64_t              nmap;
+  const flan_desc_vec *maps;
 } flan_desc;
 
 /* ── Constructors ──────────────────────────────────────────────────── */

runtime/flan_rt.c

@@ -2561,13 +2561,14 @@ void flan_vec_region_only(flan_vec *v, const uint8_t *loc, int64_t loclen) {
                          loc, loclen);
 }
 
-/* Told of every Vec block this file allocates, moves or frees: the old block
+/* Told of every Vec block and every Map block this file allocates, moves or
- * (or NULL), the new one (or NULL), its size in bytes, and the allocator and
+ * frees: the old block (or NULL), the new one (or NULL), its size in bytes,
- * epoch it was made under. NULL unless flan_dyn.c's [flan_dyn_track_vecs] has
+ * and the allocator and epoch it was made under. NULL unless flan_dyn.c's
- * installed its own — a program that can make a collector-owned closure
+ * [flan_dyn_track_vecs] has installed its own — a program that can make a
- * environment, which may sit in a Vec, installs it so the collector never
+ * collector-owned closure environment or holds a dyn, either of which may sit
- * reads a block a stale header copy still names. A pointer rather than a
+ * in a Vec or a Map, installs it so the collector never reads a block a stale
- * call so this file names nothing in flan_dyn.c. */
+ * header copy still names. A pointer rather than a call so this file names
+ * nothing in flan_dyn.c. */
 void (*flan_vec_block_hook)(void *old, void *fresh, int64_t bytes, void *alloc,
                             int64_t epoch) = NULL;
 
@@ -3339,6 +3340,10 @@ static int8_t flan_map_rebuild(flan_map *m, int64_t log2cap, int64_t ksize,
       a->proc(a, FLAN_ALLOC_FREE, m->data,
               flan_map_block_size(ksize, vsize, old_cap), 0, FLAN_MAP_ALIGN);
   }
+  if (flan_vec_block_hook)
+    flan_vec_block_hook(m->data, fresh.data,
+                        flan_map_block_size(ksize, vsize, flan_map_cap(&fresh)),
+                        m->alloc, m->epoch);
   m->data = fresh.data;
   m->log2cap = fresh.log2cap;
   return 1;
@@ -3586,6 +3591,8 @@ void flan_map_free(flan_map *m, int64_t ksize, int64_t vsize,
     m->alloc->proc(m->alloc, FLAN_ALLOC_FREE, m->data,
                    flan_map_block_size(ksize, vsize, flan_map_cap(m)), 0,
                    FLAN_MAP_ALIGN);
+  if (m->data && flan_vec_block_hook)
+    flan_vec_block_hook(m->data, NULL, 0, NULL, 0);
   m->data = NULL;
   m->len = 0;
   m->log2cap = 0;

test/programs/fn-in-map.flan

@@ -1,9 +1,58 @@
-;; A closure's environment is found by walking the storage its function value
+;; A Map holding closures and a Map holding dyn values, both kept alive by the
-;; sits in — a frame slot, a global, a struct, an Option, a Vec's elements —
+;; collector across enough allocation that it runs many times. A Map's block is
-;; and a Map's storage is not walked. An (Fn ...) as a Map's value would hold
+;; walked like a Vec's: the full slots' values are marked through the value
-;; an environment the collector cannot see and would free. A Vec holds them,
+;; type's descriptor. A lost value is a use of freed memory here, not a wrong
-;; and a (CFn ...) carries no environment and may go in a Map.
+;; number.
+
+(defn adder [n i32] (Fn [i32] i32)
+  (fn [x] (+ x n)))
+
+;; Garbage, and plenty of it: every pass boxes and drops a vector of four.
+(defn churn [n i32] ()
+  (dotimes [i n]
+    (let [junk (vec-new dyn)]
+      (push junk i)
+      (push junk "row")
+      (push junk 2.5)
+      (push junk true))))
+
 (defn main [] i32
-  (let [ops (map-new string (Fn [i32] i32))]
+  (let [ops (map-new string (Fn [i32] i32))
-    (put ops "id" (fn [x] x))
+        many (map-new i32 (Fn [i32] i32))
-    0))
+        rows (map-new i32 dyn)]
+    (put ops "one" (adder 1))
+    (put ops "ten" (adder 10))
+    (put ops "hundred" (adder 100))
+    ;; Each value a dyn vector the collector allocated, reachable from
+    ;; nothing but the map.
+    (dotimes [i 64]
+      (let [row (vec-new dyn)]
+        (push row i)
+        (push row "row")
+        (put rows i row)))
+    (churn 40000)
+    ;; Grown after the churn, so a rebuilt block is walked too.
+    (dotimes [i 64]
+      (put many i (adder i)))
+    (churn 40000)
+    (let [total 0]
+      (dotimes [i 64]
+        (set total (+ total (match (get many i) (Some f) (f 0) None 0))))
+      (println total))
+    (dotimes [i 3]
+      (let [name (at ["one" "ten" "hundred"] i)]
+        (println (match (get ops name) (Some f) (f 1) None -1))))
+    (let [cur (i64 0)
+          k 0
+          v (the dyn nil)
+          sum 0
+          n 0]
+      (while (map-next rows (addr cur) (addr k) (addr v))
+        (set sum (+ sum (i32 (at v 0))))
+        (set n (+ n 1)))
+      (println n)
+      (println sum))
+    (free ops)
+    (free many)
+    (free rows))
+  0)

test/test_acceptance.ml

@@ -4732,8 +4732,15 @@ level "1"
       "programs/fn-vec-stale.flan" fn_vec_stale_out;
     outputs ~x86:true "a stale Vec header is not marked through, --x86"
       "programs/fn-vec-stale.flan" fn_vec_stale_out;
-    refuses "a Map cannot hold function values" "programs/fn-in-map.flan"
+    (* A Map's block is walked: closures and dyn values held only by a Map
-      "a Map's storage is not walked";
+       survive enough allocation to collect many times. *)
+    let fn_in_map_out = "2016\n2\n11\n101\n64\n2016\n" in
+    outputs "a Map keeps its closures and dyn values alive"
+      "programs/fn-in-map.flan" fn_in_map_out;
+    outputs ~opt:"-O0" "a Map keeps its closures and dyn values alive, -O0"
+      "programs/fn-in-map.flan" fn_in_map_out;
+    outputs ~x86:true "a Map keeps its closures and dyn values alive, --x86"
+      "programs/fn-in-map.flan" fn_in_map_out;
     (* Capture is by value, and a store into a copy is refused rather than
        left to change the copy and not the local. *)
     refuses "a captured local is a copy and cannot be assigned"