diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 34130ffa..7c4a4b01 100644 --- a/emacs/MANUAL.md +++ b/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. diff --git a/emacs/flan-lower.el b/emacs/flan-lower.el index 4fdd3268..87197096 100644 --- a/emacs/flan-lower.el +++ b/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 diff --git a/lib/check.ml b/lib/check.ml index a61a85fe..9ca97cf7 100644 --- a/lib/check.ml +++ b/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 ] diff --git a/lib/prelude.ml b/lib/prelude.ml index 52db7810..92110375 100644 --- a/lib/prelude.ml +++ b/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)) - val (the $v (zeroed))] - (while (map-next m (addr cur) (addr key) (addr val)) + key (the $k (zeroed))] + (while (map-next m (addr cur) (addr key)) (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)) - val (the $v (zeroed))] - (while (map-next m (addr cur) (addr key) (addr val)) - (push out val)) + key (the $k (zeroed))] + (while (map-next m (addr cur) (addr key)) + (match (get m key) + (Some val) (push out val) + None (do))) out)) ;; ── The sign questions, over every numeric type at once ─────────────── diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 2b52b9be..a02103e8 100644 --- a/runtime/flan_rt.c +++ b/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; } diff --git a/test/dune b/test/dune index ed527938..81b2a2a0 100644 --- a/test/dune +++ b/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))) diff --git a/test/programs/map-keys.flan b/test/programs/map-keys.flan index c204325f..b6ff9362 100644 --- a/test/programs/map-keys.flan +++ b/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) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 34242856..19a2ae4a 100644 --- a/test/test_acceptance.ml +++ b/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" - "10 20 30 \n100 200 300 \n3\n0\n"; + let map_keys_out = "10 20 30 \n100 200 300 \n3\n0\n2\n23\n" in + 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]. *)