A fixed array of strings or of structs is a map key, hashed and compared element by element
This commit is contained in:
parent
a41e43cbba
commit
580d377847
5
TODO.org
5
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
|
||||
|
||||
129
lib/check.ml
129
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 =
|
||||
|
||||
30
test/programs/map-array-key.flan
Normal file
30
test/programs/map-array-key.flan
Normal file
@ -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)
|
||||
@ -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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user