map-keys and map-values walk a Map of closures, since (map-next m cur k) walks keys alone and neither needs a zeroed value, and nothing names spike/ any more

emacs/MANUAL.md

@@ -1052,7 +1052,7 @@ it is written in the compiler, so there is no file to open.
 `C-c C-l` on a name opens `*flan-lowering*`: the LLVM IR the frontend emits for
 that function, what `llc` makes of it at `-O0` and at `-O2`, and what the
 hand-written x86 backend emits, all narrowed to the one function. It is
-`spike/x86/dump.sh` with a buffer around it. Reading one against another is the
+`tools/dump.sh` with a buffer around it. Reading one against another is the
 only way to check a lowering by eye, and the reason the second backend is
 trustworthy is that the two agree.
 

emacs/flan-lower.el

@@ -19,7 +19,7 @@
 ;; to is not an Emacs package and cannot be listed here either -- emacs/MANUAL.md
 ;; says what has to be on PATH.
 
-;; `spike/x86/dump.sh' prints four lowerings of one function side by side --
+;; `tools/dump.sh' prints four lowerings of one function side by side --
 ;; the LLVM IR the frontend emits, what `llc' makes of it at -O0 and at -O2,
 ;; and what the hand-written x86 backend emits.  Reading one against another is
 ;; the only way to check a lowering by eye, and the whole reason the second

lib/check.ml

@@ -9583,15 +9583,28 @@ and named_call ?(qualified = false) ctx ~want loc name args =
      No hash and no equality pair go with it — walking asks nothing about a
      key — so this is the one map entry point whose signature carries neither,
      and the sizes are still needed because the runtime is type-erased. *)
+  (* (map-next m cur k) walks the keys alone. It is what lets a walk need no
+     place for a value, which matters when the value is a function value: one
+     cannot be zeroed to make the place, and a key never is one. *)
   | "map-next" ->
-    arity ctx loc name 4 args;
     (match args with
-     | [ target; cur; k; v ] ->
+     | [ _; _; _ ] | [ _; _; _; _ ] -> ()
+     | _ ->
+       fail loc
+         "map-next is (map-next m (addr cursor) (addr k) (addr v)) or, for \
+          the keys alone, (map-next m (addr cursor) (addr k)) — given %d \
+          arguments" (List.length args));
+    (match args with
+     | target :: cur :: k :: rest ->
        let target = check_target ctx target in
        let kt, vt = map_kv loc "map-next" target.Tast.ty in
        let cur = check ctx ~want:(Types.Ptr (Types.Mut, (Types.Int Types.I64))) cur in
        let k = check ctx ~want:(Types.Ptr (Types.Mut, kt)) k in
-       let v = check ctx ~want:(Types.Ptr (Types.Mut, vt)) v in
+       let vp = Types.Ptr (Types.Mut, vt) in
+       let v = match rest with
+         | [ v ] -> check ctx ~want:vp v
+         | _ -> mk loc vp (Tast.Zero vp)
+       in
        let found =
          rt loc (Types.Int Types.I8) "flan_map_next"
            [ target; cur; k; v; size_of loc kt; size_of loc vt; here loc ]

lib/prelude.ml

@@ -572,20 +572,22 @@ let source = {flan|
   {:where (hashable? $k)}
   (let [out (vec-new $k)
         cur (i64 0)
-        key (the $k (zeroed))
+        key (the $k (zeroed))]
-        val (the $v (zeroed))]
+    (while (map-next m (addr cur) (addr key))
-    (while (map-next m (addr cur) (addr key) (addr val))
       (push out key))
     out))
 
 (defn map-values [m (Map $k $v)] (Vec $v)
   {:where (hashable? $k)}
+  ;; Walked by key and read back with get, because a place to copy a value
+  ;; into would have to be zeroed first, and a function value cannot be.
   (let [out (vec-new $v)
         cur (i64 0)
-        key (the $k (zeroed))
+        key (the $k (zeroed))]
-        val (the $v (zeroed))]
+    (while (map-next m (addr cur) (addr key))
-    (while (map-next m (addr cur) (addr key) (addr val))
+      (match (get m key)
-      (push out val))
+        (Some val) (push out val)
+        None (do)))
     out))
 
 ;; ── The sign questions, over every numeric type at once ───────────────

runtime/flan_rt.c

@@ -3567,7 +3567,8 @@ int8_t flan_map_next(flan_map *m, int64_t *cursor, void *kout, void *vout,
   for (; i < cap; i++) {
     if (!(g.ctrl[i] & FLAN_CTRL_FULL)) continue;
     memcpy(kout, flan_map_k(&g, i), (size_t)ksize);
-    memcpy(vout, flan_map_v(&g, i), (size_t)vsize);
+    /* NULL from (map-next m cur k), the keys-only walk. */
+    if (vout) memcpy(vout, flan_map_v(&g, i), (size_t)vsize);
     *cursor = i + 1;
     return 1;
   }

test/dune

@@ -112,11 +112,6 @@
   (alias corpus)
   (source_tree syntax)
   (file %{workspace_root}/conditions-play.flan)
-  (glob_files %{workspace_root}/spike/backend/*.flan)
-  (glob_files %{workspace_root}/spike/generics/*.flan)
-  (glob_files %{workspace_root}/spike/js/*.flan)
-  (glob_files %{workspace_root}/spike/x86/*.flan)
-  (glob_files %{workspace_root}/spike/x86/bench/*.flan)
   (glob_files %{workspace_root}/web/examples/*.flan)
   (glob_files %{workspace_root}/web/examples/geom/*.flan)))
 

test/programs/map-keys.flan

@@ -8,6 +8,9 @@
 (defonce k i32 0)
 (defonce v i32 0)
 
+(defn adder [n i32] (Fn [i32] i32)
+  (fn [x] (+ x n)))
+
 (defn main [] i32
   (let [m (map-new i32 i64)]
     (put m 30 (i64 300))
@@ -39,4 +42,18 @@
       (free nk))
     (free names)
     (free none))
+  ;; Closures as the values: a function value cannot be zeroed, so the walk
+  ;; must not need a place for one.
+  (let [fs (map-new i32 (Fn [i32] i32))]
+    (put fs 1 (adder 1))
+    (put fs 2 (adder 2))
+    (let [ks (map-keys fs)
+          vs (map-values fs)
+          total 0]
+      (dotimes [i (length vs)] (set total (+ total ((at vs i) 10))))
+      (println (length ks))
+      (println total)
+      (free ks)
+      (free vs))
+    (free fs))
   0)

test/test_acceptance.ml

@@ -4422,8 +4422,10 @@ level "1"
     in
     outputs "map iteration" "programs/map-iter.flan" map_iter_out;
     outputs ~opt:"-O0" "map iteration, -O0" "programs/map-iter.flan" map_iter_out;
-    outputs "map-keys and map-values" "programs/map-keys.flan"
+    let map_keys_out = "10 20 30 \n100 200 300 \n3\n0\n2\n23\n" in
-      "10 20 30 \n100 200 300 \n3\n0\n";
+    outputs "map-keys and map-values" "programs/map-keys.flan" map_keys_out;
+    outputs ~x86:true "map-keys and map-values, --x86" "programs/map-keys.flan"
+      map_keys_out;
     (* A fixed array of strings, and of structs, as a key: an emitted pair
        with a loop in it, the one hashing and equality function the checker
        builds around a [While]. *)