From 580d37784789fa28f511c941aac8df8eed403e85 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 15:21:30 +0700 Subject: [PATCH] A fixed array of strings or of structs is a map key, hashed and compared element by element --- TODO.org | 5 -- lib/check.ml | 129 +++++++++++++++++++++++++++++-- test/programs/map-array-key.flan | 30 +++++++ test/test_acceptance.ml | 10 +++ 4 files changed, 161 insertions(+), 13 deletions(-) create mode 100644 test/programs/map-array-key.flan diff --git a/TODO.org b/TODO.org index 3614651e..e096ce4a 100644 --- a/TODO.org +++ b/TODO.org @@ -911,11 +911,6 @@ there is a =Vec= to write real arena programs with, so whether the escapes that actually occur are lexical can now be answered. The next thing to look at, not the next thing to build. -** TODO A fixed array of structs or of strings is not a map key -Refused by name, narrower than the spec's key set; a struct holding the array -works. It needs the per-element walk a struct key gets, driven by a loop rather -than a field list. - ** DONE (vec-new [u8]) is refused CLOSED: [2026-09-25] The type positions of =vec-new= and =map-new= take a type expression: brackets, or diff --git a/lib/check.ml b/lib/check.ml index e916db18..2a8ded87 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -3662,14 +3662,9 @@ let rec key_pair env loc (k : Types.t) : Tast.fnref * Tast.fnref = fail loc "%s is a union, and a union is not a map key — key on the member you \ meant" n - | Types.Array (_, e) -> - (* A fixed array of a struct or of strings would need the same per-element - walk a struct key gets, driven by a loop rather than by a field list. - Nothing has wanted one, so it is refused by name rather than written - untested — and refused with the shape that does work named beside it. *) - fail loc - "a fixed array of %s is not a map key — a struct holding the array is" - (Types.to_string e) + (* A bytewise array took the arm above; this is one whose elements need + their own pair, a string's or a struct's. *) + | Types.Array (n, e) -> array_key_pair env loc n e | Types.Float _ -> (* Not a milestone question, which is why it is said separately: NaN is not equal to itself, and 0.0 and -0.0 are equal while differing bytewise. A @@ -3801,6 +3796,124 @@ and struct_key_pair env loc n = Tast.Flanfn hname, Tast.Flanfn ename end +(* The pair for a fixed array whose elements are not bytewise: the struct + pair's shape, with the field list replaced by a loop over the elements, so + [[64 string]] is one call site in a loop and not sixty-four. Each element is + hashed and compared by its own pair, so an array of structs holding strings + is served by the same recursion. *) +and array_key_pair env loc n e = + if Int64.compare n 0L <= 0 then + fail loc + "%s has no elements, so it is not a map key — every value of it would be \ + the same key" (Types.to_string (Types.Array (n, e))); + let aty = Types.Array (n, e) in + (* The type's printed form, with what a symbol cannot hold replaced. *) + let tag = + String.map + (fun c -> match c with + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-' -> c + | _ -> '_') + (Types.to_string aty) + in + let hname = "map/hash/array/" ^ tag and ename = "map/eq/array/" ^ tag in + let known name = + List.exists (fun (f : Tast.fn) -> f.Tast.name = name) env.lifted + in + if known hname then Tast.Flanfn hname, Tast.Flanfn ename + else begin + let pty = Types.Ptr (Types.Mut, aty) in + let hparams = [ pty; hash_ty; Types.Int Types.I64 ] in + let eparams = [ pty; pty; Types.Int Types.I64 ] in + let placeholder name ret params = + { Tast.name; params; slots = Array.of_list params; + snames = Array.make (List.length params) None; + ret; body = []; fdefers = []; fenv = None; fparent = None; floc = loc } + in + env.lifted <- + placeholder hname hash_ty hparams + :: placeholder ename (Types.Int Types.I8) eparams + :: env.lifted; + let h, eq = key_pair env loc e in + let call ret f args = + match f with + | Tast.Rtfn s -> rt loc ret (direct s) args + | Tast.Flanfn s | Tast.Fnval s -> mk loc ret (Tast.Call (s, args)) + in + let elem_addr p i = + let target = mk loc aty (Tast.Deref (mk loc pty (Tast.Local p))) in + mk loc (Types.Ptr (Types.Mut, e)) + (Tast.Addr (Tast.Pindex (target, [ mk loc index_ty (Tast.Local i) ]))) + in + (* The counter and its loop, which carries no break and no continue — the + condition tast.ml puts on a [While] the checker invents. *) + let loop ctx body = + let i = fresh_slot ~name:"i" ctx index_ty in + let iv = mk loc index_ty (Tast.Local i) in + let limit = mk loc index_ty (Tast.Int (n, Types.I32)) in + let one = mk loc index_ty (Tast.Int (1L, Types.I32)) in + let cond = mk loc Types.Bool (Tast.Prim (Tast.Lt, [ iv; limit ])) in + let step = + mk loc Types.Unit + (Tast.Set (Tast.Plocal i, + mk loc index_ty (Tast.Prim (Tast.Add, [ iv; one ])))) + in + mk loc Types.Unit + (Tast.Let ([ (i, mk loc index_ty (Tast.Int (0L, Types.I32))) ], + [ mk loc Types.Unit (Tast.While (cond, [ body i ], [ step ])) ])) + in + let hctx = invented_ctx env hash_ty in + let kp = fresh_slot ~name:"key" hctx pty in + let seed = fresh_slot ~name:"seed" hctx hash_ty in + ignore (fresh_slot ~name:"size" hctx (Types.Int Types.I64)); + let acc = fresh_slot ~name:"h" hctx hash_ty in + let hbody = + [ mk loc Types.Unit + (Tast.Set (Tast.Plocal acc, mk loc hash_ty (Tast.Local seed))); + loop hctx (fun i -> + let one = + call hash_ty h + [ elem_addr kp i; mk loc hash_ty (Tast.Local seed); + size_of loc e ] + in + mk loc Types.Unit + (Tast.Set (Tast.Plocal acc, + rt loc hash_ty "flan_hash_combine" + [ mk loc hash_ty (Tast.Local acc); one ]))); + mk loc hash_ty (Tast.Local acc) ] + in + let ectx = invented_ctx env (Types.Int Types.I8) in + let ap = fresh_slot ~name:"a" ectx pty in + let bp = fresh_slot ~name:"b" ectx pty in + ignore (fresh_slot ~name:"size" ectx (Types.Int Types.I64)); + let i8 v = mk loc (Types.Int Types.I8) (Tast.Int (v, Types.I8)) in + let ebody = + [ loop ectx (fun i -> + let same = + call (Types.Int Types.I8) eq + [ elem_addr ap i; elem_addr bp i; size_of loc e ] + in + mk loc Types.Unit + (Tast.If (mk loc Types.Bool (Tast.Prim (Tast.Eq, [ same; i8 0L ])), + mk loc Types.Never (Tast.Return (Some (i8 0L))), + unit_at loc))); + i8 1L ] + in + let finish name ret params ctx body = + { Tast.name; params; + slots = Array.of_list (List.rev ctx.slot_tys); + snames = Array.of_list (List.rev ctx.slot_names); + ret; body; fdefers = []; fenv = None; fparent = None; floc = loc } + in + env.lifted <- + finish hname hash_ty hparams hctx hbody + :: finish ename (Types.Int Types.I8) eparams ectx ebody + :: List.filter + (fun (f : Tast.fn) -> + f.Tast.name <> hname && f.Tast.name <> ename) + env.lifted; + Tast.Flanfn hname, Tast.Flanfn ename + end + (* The pair as two expressions, ready to be passed. Their Flan type is [(Ptr ())]: one opaque word, which is all the backend needs. *) let key_fns env loc k = diff --git a/test/programs/map-array-key.flan b/test/programs/map-array-key.flan new file mode 100644 index 00000000..a06d2e67 --- /dev/null +++ b/test/programs/map-array-key.flan @@ -0,0 +1,30 @@ +;; A fixed array of strings, and of structs holding a string, as a map key. +;; Each element is hashed and compared by its own pair, so two keys built from +;; different storage with the same bytes are the same key. + +(defstruct Tag [name string n i32]) + +(defn main [] i32 + (let [m (map-new [2 string] i32) + a (the [2 string] ["ab" "cd"]) + b (the [2 string] [(slice "xab" 1) (slice "cdx" 0 2)]) + c (the [2 string] ["ab" "ce"])] + (put m a 1) + (put m c 3) + (println (or-else (get m b) -1)) + (println (or-else (get m c) -1)) + (println (length m)) + (put m b 2) + (println (length m)) + (println (or-else (get m a) -1)) + (free m)) + (let [t (map-new [3 Tag] i32) + x (the [3 Tag] [(Tag "a" 1) (Tag "b" 2) (Tag "c" 3)]) + y (the [3 Tag] [(Tag "a" 1) (Tag "b" 2) (Tag "c" 4)])] + (put t x 10) + (put t y 20) + (println (or-else (get t (the [3 Tag] [(Tag "a" 1) (Tag "b" 2) (Tag "c" 3)])) -1)) + (println (or-else (get t y) -1)) + (println (length t)) + (free t)) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index c960773a..2cdd798d 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -4424,6 +4424,16 @@ level "1" 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"; + (* 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]. *) + let map_array_key_out = "1\n3\n2\n2\n2\n10\n20\n2\n" in + outputs "an array of strings or structs as a map key" + "programs/map-array-key.flan" map_array_key_out; + outputs ~opt:"-O0" "an array of strings or structs as a map key, -O0" + "programs/map-array-key.flan" map_array_key_out; + outputs ~x86:true "an array of strings or structs as a map key, --x86" + "programs/map-array-key.flan" map_array_key_out; (* Removal, which is the operation that can break the others. A probe stops at the first group holding an empty slot, so a slot emptied in