From 008eec0ad506b9587f4da2bf614696fd6461a978 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 15:33:06 +0700 Subject: [PATCH] A Flan program can reach the Map now MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The checker half. {K V} and (Map K V) resolve, and map-new, put, get, has-key?, len, reserve, clone and free are named calls over the type-erased runtime, with the two sizes and the key's hash and equality pair produced at the site because the site is where the concrete types are known. len, reserve, clone and free were extended rather than given map-shaped names of their own, which is what at and len already did for Vec: one question, one word. The key's pair is resolved per key type and mostly is not emitted at all. Every integer, enum, bool and fixed array of those is compared bytewise and served by one runtime pair over (pointer, size). A string is not, because its bytes are elsewhere and two equal strings at different addresses must hash alike. A struct is not, because its padding bytes are indeterminate — two structs equal field by field can differ bytewise — and because it may hold a string. So a struct gets a pair emitted for it, walking its fields in declaration order and addressing nothing but fields, and that is the only case that does. Two maps with the same key type share one pair, and a struct reached twice through two fields emits one. get returns (Option V) and builds it here rather than in the runtime, which has no idea what an Option's layout is — keeping it that way is what lets one entry point serve every value type. put is upsert returning Unit. Both bind their arguments to slots before the guard, so a retry re-attempts the allocation and not the expressions that produced the key and the value. Refusals, each by name: a float key has no usable equality at all, which is not a milestone question; a Ptr, slice, Vec or Map key would hash an address rather than what it points at; a move-only value would have its header duplicated by clone, which is the refusal (Vec (Vec T)) already carries; Unit as a value has no bytes to store, and it is the natural spelling of a set, so it is refused by name rather than by dividing a cache line by zero. --- lib/check.ml | 506 ++++++++++++++++++++++++++++++++++++++++++++-- lib/emit.ml | 16 +- runtime/flan_rt.c | 45 ++++- tmpchk/m2.flan | 52 +++++ 4 files changed, 589 insertions(+), 30 deletions(-) create mode 100644 tmpchk/m2.flan diff --git a/lib/check.ml b/lib/check.ml index d723a62..a4c4327 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -245,13 +245,63 @@ let unimplemented loc what milestone = fail loc "%s is not implemented yet — milestone %d (see plan.org)" what milestone +(* ── (Map K V), spec-memory.md ────────────────────────────────────────── + Both halves are checked where the type is written, not where an operation + is, so that a map nothing ever uses is still refused if it cannot work. + [Check.key_pair] emits the hash and equality pair later, at the operation, + and repeats these refusals rather than assuming: the two are reached by + different paths and a silent disagreement between them would be worse than + saying the same thing twice. *) +let map_type loc (k : Types.t) (v : Types.t) = + (* The value. The restriction is the one [(Vec (Vec T))] already carries, + for the identical reason: the runtime copies and releases entries + bytewise, so an owning value would have its header duplicated by clone + and its buffer dropped on the floor by free. *) + if Types.is_move_only v then + fail loc + "(Map %s %s) holds a move-only value, and the type-erased runtime \ + copies entries bytewise — so clone would duplicate headers instead of \ + copying, and free would leak what they own. Owned entries arrive with \ + drop (step 5 in NEXT.md)" + (Types.to_string k) (Types.to_string v); + (* Unit has no bytes, so a slot for one is a slot of nothing: the cell + geometry divides the cache line by the element size and there is nothing + to divide by. It is also the natural spelling of a *set*, which is why + someone will write it, so it is refused by name rather than by a crash. *) + if Types.equal v Types.Unit then + fail loc + "a map value cannot be Unit — there is nothing to store. A set of keys \ + is not built yet; use (Map %s bool) and ignore the value" + (Types.to_string k); + if Types.equal k Types.Unit then + fail loc "a map key cannot be Unit — every key would be the same key"; + (* The key, as far as the type alone can say. A struct passes here and is + decided at the operation, by [key_pair], which walks its fields — the + struct table is not necessarily complete while a type is being resolved, + and every map that exists reaches an operation anyway, because a global of + move-only type is refused and a local needs (map-new). *) + if not (Types.keyable k) then + fail loc + "%s is not a map key. The first implementation takes integers, enums, \ + bools, strings, fixed arrays of those, and value structs composed of \ + those (spec-memory.md, \"Maps — first implementation\"). A float has \ + no usable equality — NaN is not equal to itself — and a Ptr, a slice, \ + a Vec or a Map would hash an address rather than what it points at" + (Types.to_string k); + Types.Map (k, v) + let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t = let loc = t.Ast.tloc in match t.Ast.t with | Ast.Tname n -> resolve_name env ~seen loc n | Ast.Tslice e -> Types.Slice (resolve env ~seen e) | Ast.Tarray (l, e) -> Types.Array (array_len env loc l, resolve env ~seen e) - | Ast.Tmap _ -> unimplemented loc "the Map type" 6 + (* {K V} is the type spelling. There is no map *literal*: a bare map form in + expression position is a struct literal's field list, and giving the same + braces two meanings is what the colon-to-dot change was for. A map is + built with (map-new) and filled with (put). *) + | Ast.Tmap (k, v) -> + map_type loc (resolve env ~seen k) (resolve env ~seen v) (* The function *value* is refused where it is written; the annotation was not refused anywhere, so [(defn f [g (Fn [] i32)])] type checked and then died in emit with "no layout for". Refused here, beside the Map line @@ -280,7 +330,9 @@ let rec resolve env ?(seen = []) (t : Ast.texpr) : Types.t = (Types.to_string e); Types.Vec e | "Vec", _ -> fail loc "(Vec T) takes exactly one type" - | "Map", _ -> unimplemented loc "(Map K V)" 6 + | "Map", [ k; v ] -> + map_type loc (resolve env ~seen k) (resolve env ~seen v) + | "Map", _ -> fail loc "(Map K V) takes exactly two types" | "Result", _ -> unimplemented loc "(Result T E)" 6 | "Handle", _ -> unimplemented loc "(Handle T)" 6 | _ -> @@ -530,6 +582,219 @@ let expect loc ~want (got : Tast.expr) = (* ── Expressions ───────────────────────────────────────────────────── *) +(* ── (Map K V): the key's hash and equality pair ──────────────────────── + spec-memory.md restricts the first implementation to built-in structural + key types — integers, enums, strings, fixed arrays, and value structs + composed recursively from those — and makes equality and hashing for them + compiler-provided structural operations rather than type classes. So there + is no dispatch to design: every key type resolves, here, to a pair of + symbols, and the pair is passed to the type-erased runtime the way Odin + hangs its two contextless procs off a Map_Info. + + Most key types need no emitted function at all. A key whose equality is + bytewise and whose bytes are all present is served by one runtime pair over + (pointer, size), which is what [bytewise_key] identifies. Two kinds are not: + + - a [string] is ptr+len and its bytes are elsewhere, so two equal strings at + different addresses must still hash the same; + - a struct may have padding, whose bytes are indeterminate, so two structs + that are equal field by field can differ bytewise — and it may hold a + string, which brings the first problem inside it. + + A struct therefore gets a pair emitted for it, walking its fields, and that + is the only case that does. *) + +let rec bytewise_key = function + | Types.Int _ | Types.Enum _ | Types.Bool -> true + | Types.Array (_, t) -> bytewise_key t + | _ -> false + +let hash_ty = Types.Int Types.U64 + +(* A context for a function the checker is about to invent. Nothing is + reachable from it: no outer scope, no defers, and [defer_ok] false, because + none of these is a body anyone wrote. *) +let invented_ctx env ret = + { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; + defers = []; outer = []; in_handler = false; in_frames = None; + in_defer = false; defer_ok = false; defer_block = "a nested form"; + dead = []; borrow = false; owner = "" } + +(* The address of field [i] of the struct the pointer in slot [p] points at. *) +let field_addr_of loc sty fty p i = + let target = mk loc sty (Tast.Deref (mk loc (Types.Ptr sty) (Tast.Local p))) in + mk loc (Types.Ptr fty) (Tast.Addr (Tast.Pfield (target, i))) + +(* The pointer form is what a Map_Info holds; the direct form is what an + emitted hasher calls. See flan_rt.c on why they are two symbols. *) +let direct = function + | "flan_hash_flat" -> "flan_key_hash_flat" + | "flan_eq_flat" -> "flan_key_eq_flat" + | "flan_hash_str" -> "flan_key_hash_str" + | "flan_eq_str" -> "flan_key_eq_str" + | s -> s + +(* The pair for [k]: (hash, equality), each a symbol to be taken the address + of. Emits a function for a struct key the first time it sees one, and finds + it in [env.lifted] every time after — the name is derived from the type, so + two maps with the same key type share one pair. *) +let rec key_pair env loc (k : Types.t) : Tast.fnref * Tast.fnref = + match k with + | Types.String -> Tast.Rtfn "flan_hash_str", Tast.Rtfn "flan_eq_str" + | t when bytewise_key t -> + Tast.Rtfn "flan_hash_flat", Tast.Rtfn "flan_eq_flat" + | Types.Named n when Hashtbl.mem env.structs n -> struct_key_pair env loc 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 is a map key only when its elements are compared \ + bytewise, and %s is not — a struct or a string element needs a \ + per-element walk that is not written. A struct key holding the array \ + works, because a struct key is walked field by field" + (Types.to_string 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 + float key therefore has no equality for a hash map to use, whatever the + implementation does. *) + fail loc + "a float is not a map key: NaN is not equal to itself, and 0.0 and -0.0 \ + are equal but differ bytewise, so there is no equality here for a map \ + to hash. Key on an integer, or on a quantised integer of your choosing" + | other -> + fail loc + "%s is not a map key. The first implementation takes integers, enums, \ + bools, strings, fixed arrays of those, and value structs composed of \ + those (spec-memory.md, \"Maps — first implementation\"). A Ptr, a \ + slice, a Vec or a Map would hash an address rather than what it points \ + at, which is a different operation" + (Types.to_string other) + +and struct_key_pair env loc n = + let hname = "map/hash/" ^ n and ename = "map/eq/" ^ n 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 sty = Types.Named n in + let fields = (Hashtbl.find env.structs n).Tast.fields in + if fields = [] then + fail loc + "%s has no fields, so every value of it is equal to every other — a \ + map keyed on it holds at most one entry, which is not a map" n; + let hparams = [ Types.Ptr sty; hash_ty; Types.Int Types.I64 ] in + let eparams = [ Types.Ptr sty; Types.Ptr sty; Types.Int Types.I64 ] in + (* Registered before the fields are walked, so a struct reached twice + through two different fields emits one pair and not two. A struct cannot + contain itself by value, so there is no cycle to break — only sharing. + The body is filled in below; nothing can call these in between. *) + let placeholder name ret params = + { Tast.name; params; slots = Array.of_list params; + snames = Array.make (List.length params) None; + ret; body = []; fdefers = []; fparent = None; floc = loc } + in + env.lifted <- + placeholder hname hash_ty hparams + :: placeholder ename (Types.Int Types.I8) eparams + :: env.lifted; + + (* The hash: seed, then one combine per field, in declaration order. Each + field is hashed by its own pair — the same recursion, so a string field + hashes its bytes and a nested struct hashes field by field. Padding is + never reached, because nothing here addresses anything but a field. *) + let hctx = invented_ctx env hash_ty in + let kp = fresh_slot ~name:"key" hctx (Types.Ptr sty) 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 steps = + List.mapi + (fun i (fl : Tast.field) -> + let fty = fl.Tast.fty in + let h, _ = key_pair env loc fty in + let args = + [ field_addr_of loc sty fty kp i; + mk loc hash_ty (Tast.Local seed); size_of loc fty ] + in + let one = + match h with + | Tast.Rtfn s -> rt loc hash_ty (direct s) args + | Tast.Flanfn s -> mk loc hash_ty (Tast.Call (s, args)) + 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 ]))) + fields + in + let hbody = + (mk loc Types.Unit + (Tast.Set (Tast.Plocal acc, mk loc hash_ty (Tast.Local seed)))) + :: steps + @ [ mk loc hash_ty (Tast.Local acc) ] + in + + (* The equality: one early return per field, then true. Written as returns + rather than as a conjunction so that the comparison stops at the first + field that differs, which for a struct with a string field is the + difference between one memcmp and two. *) + let ectx = invented_ctx env (Types.Int Types.I8) in + let ap = fresh_slot ~name:"a" ectx (Types.Ptr sty) in + let bp = fresh_slot ~name:"b" ectx (Types.Ptr sty) 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 checks = + List.mapi + (fun i (fl : Tast.field) -> + let fty = fl.Tast.fty in + let _, eq = key_pair env loc fty in + let args = + [ field_addr_of loc sty fty ap i; + field_addr_of loc sty fty bp i; size_of loc fty ] + in + let call = + match eq with + | Tast.Rtfn s -> rt loc (Types.Int Types.I8) (direct s) args + | Tast.Flanfn s -> mk loc (Types.Int Types.I8) (Tast.Call (s, args)) + in + let differs = + mk loc Types.Bool (Tast.Prim (Tast.Eq, [ call; i8 0L ])) + in + mk loc Types.Unit + (Tast.If (differs, + mk loc Types.Never (Tast.Return (Some (i8 0L))), + unit_at loc))) + fields + in + let ebody = checks @ [ 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 = []; 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 + [Alloc]: an opaque pointer-width value with no user-writable constructor, + which is all the backend needs and all any Flan type ever says about it. *) +let key_fns env loc k = + let h, e = key_pair env loc k in + mk loc Types.Alloc (Tast.FnAddr h), mk loc Types.Alloc (Tast.FnAddr e) + let rec check ctx ?want (e : Ast.expr) : Tast.expr = let loc = e.Ast.loc in (* Read the permission this form was given and withdraw it in the same @@ -1641,6 +1906,42 @@ and vec_new_elem ctx ~want loc args = "nothing here says what (vec-new) is a Vec of — write the element \ type, as (vec-new i32), or give the binding a type") +(* The key and value types, or the reason this is not a Map. *) +and map_kv loc what (t : Types.t) = + match t with + | Types.Map (k, v) -> k, v + | other -> fail loc "%s takes a (Map K V), found %s" what (Types.to_string other) + +(* The key and value for [map-new]: two leading bare symbols naming types, or + the expectation at the site. The same rule [vec-new] uses, with the same + escape for a symbol that is really a binding — an allocator, in practice — + and the pair is written together or not at all, because (map-new string) + says half of a type and half is not a type. *) +and map_new_types ctx ~want loc args = + let is_type n = + lookup ctx n = None + && (not (Hashtbl.mem ctx.env.globals n)) + && (List.mem n Types.primitive_names + || Hashtbl.mem ctx.env.structs n + || Hashtbl.mem ctx.env.enums n + || Hashtbl.mem ctx.env.aliases n) + in + match args with + | { Ast.e = Ast.Var k; _ } :: { Ast.e = Ast.Var v; _ } :: rest + when is_type k && is_type v -> + resolve_name ctx.env ~seen:[] loc k, resolve_name ctx.env ~seen:[] loc v, rest + | { Ast.e = Ast.Var k; _ } :: rest when is_type k && rest = [] -> + fail loc + "(map-new %s) names a key and no value — write both, as (map-new %s \ + i32), or give the binding a type" k k + | _ -> + (match want with + | Some (Types.Map (k, v)) -> k, v, args + | _ -> + fail loc + "nothing here says what (map-new) maps — write the key and value \ + types, as (map-new string i32), or give the binding a type") + (* The element type, or the reason this is not a Vec. *) and vec_elem loc what (t : Types.t) = match t with @@ -2025,14 +2326,24 @@ and named_call ctx ~want loc name args = (match args with | [ target; n ] -> let target = borrowed ctx target (fun () -> check ctx target) in - let elem = vec_elem loc "reserve" target.Tast.ty in let n = check ctx ~want:index_ty n in let n64 = mk loc (Types.Int Types.I64) (Tast.Prim (Tast.Cast (Types.Int Types.I64), [ n ])) in let attempt = - rt loc (Types.Int Types.I8) "flan_vec_reserve" - [ target; n64; size_of loc elem; align_of loc elem; here loc ] + match target.Tast.ty with + (* For a map the number is entries, not slots: the runtime sizes the + block so that [n] still sits under the 75% load factor, which is + the only reading of "room for n" that does not reallocate on the + nth put. *) + | Types.Map (k, v) -> + let hash, _ = key_fns ctx.env loc k in + rt loc (Types.Int Types.I8) "flan_map_reserve" + [ target; n64; size_of loc k; size_of loc v; hash; here loc ] + | _ -> + let elem = vec_elem loc "reserve" target.Tast.ty in + rt loc (Types.Int Types.I8) "flan_vec_reserve" + [ target; n64; size_of loc elem; align_of loc elem; here loc ] in expect loc ~want (alloc_guard ctx loc attempt) | _ -> assert false) @@ -2079,34 +2390,185 @@ and named_call ctx ~want loc name args = expect loc ~want (rt loc Types.Unit "flan_vec_free" [ target; size_of loc elem; align_of loc elem; here loc ]) + | Types.Map (k, v) -> + expect loc ~want + (rt loc Types.Unit "flan_map_free" + [ target; size_of loc k; size_of loc v; here loc ]) | other -> (* A field is never freed on its own: it would leave its owner partly dead with no way to say so. *) fail loc - "free takes a move-only value — a Vec, or a struct that owns one — \ - found %s. A resource type with a drop hook is step 5 and does not \ - exist yet" + "free takes a move-only value — a Vec, a Map, or a struct that owns \ + one — found %s. A resource type with a drop hook is step 5 and does \ + not exist yet" (Types.to_string other)) (* (clone v) uses the current allocator, (clone v a) names one. A deep, independent copy: spec-memory.md's "copying is always explicit". *) | "clone" -> (match args with | target :: rest when List.length rest <= 1 -> + (* Checked once, then dispatched on what it turned out to be: checking + it inside a guard as well would allocate the target's slots twice and + evaluate whatever it was written as twice. *) let target = borrowed ctx target (fun () -> check ctx target) in - let elem = vec_elem loc "clone" target.Tast.ty in let a = allocator_arg ctx loc rest in - let d = fresh_slot ctx (Types.Vec elem) in + (match target.Tast.ty with + (* A map's clone reinserts rather than copying the block, because the + seed is derived from the block's address — see flan_rt.c. That is + the runtime's business; from here it is one more allocating call + under the same guard. *) + | Types.Map (k, v) -> + let mty = Types.Map (k, v) in + let hash, _ = key_fns ctx.env loc k in + let d = fresh_slot ctx mty in + let attempt = + rt loc (Types.Int Types.I8) "flan_map_clone" + [ mk loc mty (Tast.Local d); target; a; + size_of loc k; size_of loc v; hash; here loc ] + in + expect loc ~want + (mk loc mty + (Tast.Let ([ (d, mk loc mty (Tast.Zero mty)) ], + [ alloc_guard ctx loc attempt; + mk loc mty (Tast.Local d) ]))) + | _ -> + let elem = vec_elem loc "clone" target.Tast.ty in + let d = fresh_slot ctx (Types.Vec elem) in + let attempt = + rt loc (Types.Int Types.I8) "flan_vec_clone" + [ mk loc (Types.Vec elem) (Tast.Local d); target; a; + size_of loc elem; align_of loc elem; here loc ] + in + expect loc ~want + (mk loc (Types.Vec elem) + (Tast.Let ([ (d, mk loc (Types.Vec elem) + (Tast.Zero (Types.Vec elem))) ], + [ alloc_guard ctx loc attempt; + mk loc (Types.Vec elem) (Tast.Local d) ])))) + | _ -> fail loc "clone is (clone v) or (clone v allocator)") + + (* ── (Map K V), spec-memory.md ─────────────────────────────────── *) + (* Every one of these is a named call over the same type-erased runtime the + Vec uses, with the two sizes and the key's hash and equality pair produced + here because here is where the concrete types are known. No generics are + involved and none are needed — which is exactly what Odin's Map_Info says + too, being two sizes and two contextless procs. *) + + (* (map-new), (map-new K V), (map-new a), (map-new K V a). The same shape + [vec-new] has and for the same reason: a [let] has no type annotation, so + a local map has nowhere else to say what it holds. Where the context does + say — a defvar's type, a parameter, a return type — the pair may be left + out. *) + | "map-new" -> + let k, v, args = map_new_types ctx ~want loc args in + let a = allocator_arg ctx loc args in + let mty = map_type loc k v in + let m = fresh_slot ctx mty in + let attempt = + rt loc (Types.Int Types.I8) "flan_map_init" + [ mk loc mty (Tast.Local m); a; size_of loc k; size_of loc v; + here loc ] + in + expect loc ~want + (mk loc mty + (Tast.Let ([ (m, mk loc mty (Tast.Zero mty)) ], + [ alloc_guard ctx loc attempt; + mk loc mty (Tast.Local m) ]))) + + (* (put m k v) — the upsert. Unit, not a Result and not an ignorable error + code: see [alloc_guard]. spec-memory.md is explicit that it either + inserts or replaces, and that (set (get m k) v) is not map syntax. *) + | "put" -> + arity loc name 3 args; + (match args with + | [ target; k; v ] -> + let target = borrowed ctx target (fun () -> check ctx target) in + let kt, vt = map_kv loc "put" target.Tast.ty in + let k = check ctx ~want:kt k in + let v = check ctx ~want:vt v in + (* Both are bound before the loop, so that a [retry] re-attempts the + allocation and not the expressions that produced the key and the + value. The same rule [push] follows for its element. *) + let ks = fresh_slot ctx kt and vs = fresh_slot ctx vt in + let hash, eq = key_fns ctx.env loc kt in let attempt = - rt loc (Types.Int Types.I8) "flan_vec_clone" - [ mk loc (Types.Vec elem) (Tast.Local d); target; a; - size_of loc elem; align_of loc elem; here loc ] + rt loc (Types.Int Types.I8) "flan_map_put" + [ target; addr_of loc (mk loc kt (Tast.Local ks)); + addr_of loc (mk loc vt (Tast.Local vs)); + size_of loc kt; size_of loc vt; hash; eq; here loc ] in expect loc ~want - (mk loc (Types.Vec elem) - (Tast.Let ([ (d, mk loc (Types.Vec elem) (Tast.Zero (Types.Vec elem))) ], - [ alloc_guard ctx loc attempt; - mk loc (Types.Vec elem) (Tast.Local d) ]))) - | _ -> fail loc "clone is (clone v) or (clone v allocator)") + (mk loc Types.Unit + (Tast.Let ([ (ks, k); (vs, v) ], [ alloc_guard ctx loc attempt ]))) + | _ -> assert false) + + (* (get m k) -> (Option V). Absence is None, not an untyped nil, and the + first implementation admits copyable values only, so this is a copy. + There is no allocation here and therefore no guard: a lookup that finds + nothing is an answer, not a failure. *) + | "get" -> + arity loc name 2 args; + (match args with + | [ target; k ] -> + let target = borrowed ctx target (fun () -> check ctx target) in + let kt, vt = map_kv loc "get" target.Tast.ty in + let k = check ctx ~want:kt k in + let hash, eq = key_fns ctx.env loc kt in + let ks = fresh_slot ctx kt in + let out = fresh_slot ctx vt in + let found = + rt loc (Types.Int Types.I8) "flan_map_get" + [ target; addr_of loc (mk loc kt (Tast.Local ks)); + addr_of loc (mk loc vt (Tast.Local out)); + size_of loc kt; size_of loc vt; hash; eq; here loc ] + in + let oty = Types.Option vt in + (* The runtime answers 1/0 and fills [out] only when it answers 1, so + the Option is built here rather than there: the runtime has no idea + what an Option's layout is, and keeping it that way is what lets one + entry point serve every value type. *) + let some = mk loc oty (Tast.Some_ (mk loc vt (Tast.Local out))) in + let none = mk loc oty Tast.None_ in + let cond = + mk loc Types.Bool + (Tast.Prim (Tast.Ne, + [ found; + mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ])) + in + expect loc ~want + (mk loc oty + (Tast.Let ([ (ks, k); + (out, mk loc vt (Tast.Zero vt)) ], + [ mk loc oty (Tast.If (cond, some, none)) ]))) + | _ -> assert false) + + (* (has-key? m k). (get m k) answers the same question, but through an + Option the caller then has to match; this is the form a condition wants, + and it copies no value. *) + | "has-key?" -> + arity loc name 2 args; + (match args with + | [ target; k ] -> + let target = borrowed ctx target (fun () -> check ctx target) in + let kt, vt = map_kv loc "has-key?" target.Tast.ty in + let k = check ctx ~want:kt k in + let hash, eq = key_fns ctx.env loc kt in + let ks = fresh_slot ctx kt in + let found = + rt loc (Types.Int Types.I8) "flan_map_has" + [ target; addr_of loc (mk loc kt (Tast.Local ks)); + size_of loc kt; size_of loc vt; hash; eq; here loc ] + in + expect loc ~want + (mk loc Types.Bool + (Tast.Let ([ (ks, k) ], + [ mk loc Types.Bool + (Tast.Prim + (Tast.Ne, + [ found; + mk loc (Types.Int Types.I8) + (Tast.Int (0L, Types.I8)) ])) ]))) + | _ -> assert false) (* ── Assets, decision 1: embedded at compile time ────────────── Odin's #load and #load_directory are the model (src/parser.cpp, @@ -2295,8 +2757,14 @@ and named_call ctx ~want loc name args = | Types.Vec _ -> let n = rt loc (Types.Int Types.I64) "flan_vec_len" [ a; here loc ] in expect loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ]))) + (* Extended rather than given a name of its own, for the reason [at] and + [len] were extended over Vec: one question, one word. *) + | Types.Map _ -> + let n = rt loc (Types.Int Types.I64) "flan_map_len" [ a; here loc ] in + expect loc ~want (mk loc index_ty (Tast.Prim (Tast.Cast index_ty, [ n ]))) | other -> - fail loc "len takes an array, a slice, a string or a Vec, found %s" + fail loc + "len takes an array, a slice, a string, a Vec or a Map, found %s" (Types.to_string other)) | "at" -> (match args with diff --git a/lib/emit.ml b/lib/emit.ml index e6a0206..8c77029 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -2066,10 +2066,18 @@ declare i8 @flan_map_reserve(ptr, i64, i64, i64, ptr, ptr, i64) declare i8 @flan_map_clone(ptr, ptr, ptr, i64, i64, ptr, ptr, i64) declare i64 @flan_map_len(ptr, ptr, i64) declare void @flan_map_free(ptr, i64, i64, ptr, i64) -declare i64 @flan_hash_flat(ptr, i64, i64) -declare i8 @flan_eq_flat(ptr, ptr, i64) -declare i64 @flan_hash_str(ptr, i64, i64) -declare i8 @flan_eq_str(ptr, ptr, i64) +; The pointer forms, whose signatures end with the transfer channel because a +; hash emitted for a struct key is an ordinary Flan function. Only ever taken +; as an address, never called directly from here. +declare i64 @flan_hash_flat(ptr, i64, i64, ptr) +declare i8 @flan_eq_flat(ptr, ptr, i64, ptr) +declare i64 @flan_hash_str(ptr, i64, i64, ptr) +declare i8 @flan_eq_str(ptr, ptr, i64, ptr) +; The direct forms, which an emitted struct hasher calls per field. +declare i64 @flan_key_hash_flat(ptr, i64, i64) +declare i8 @flan_key_eq_flat(ptr, ptr, i64) +declare i64 @flan_key_hash_str(ptr, i64, i64) +declare i8 @flan_key_eq_str(ptr, ptr, i64) declare i64 @flan_hash_combine(i64, i64) ; The filesystem. flan_file_read is not here: nothing Flan emits calls it — ; only flan_slurp_into does, from C — and flan_slurp_into is runtime glue diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 957b3e4..cadf150 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1120,35 +1120,66 @@ static uint64_t flan_hash_mem(const uint8_t *p, int64_t n, uint64_t seed) { /* The key is [size] bytes and its equality is bytewise. Every integer, enum, * bool, float and fixed array of those is served by this one pair, so the * compiler emits a function only for a key type that needs one. */ +/* Each of the four comes in two spellings, and the split is not decoration. + * + * flan_key_hash_flat(k, seed, size) called directly + * flan_hash_flat(k, seed, size, xfer) taken as a function pointer + * + * The pointer form has to match flan_hash_fn, whose last parameter exists + * because a hash function emitted for a struct key is an ordinary Flan + * function and every Flan function's signature ends with the transfer channel. + * The direct form has to match what such an emitted function *calls*, and an + * emitted function has no channel to hand on — it would be passing its own, + * which is not the same thing and not something a leaf hasher should see. So + * one is the implementation and the other is a thin wrapper, rather than one + * function called two ways with an argument that is a lie in one of them. */ +uint64_t flan_key_hash_flat(const void *key, uint64_t seed, int64_t size) { + return flan_hash_mem((const uint8_t *)key, size, seed); +} + +int8_t flan_key_eq_flat(const void *a, const void *b, int64_t size) { + return (int8_t)(memcmp(a, b, (size_t)size) == 0); +} + uint64_t flan_hash_flat(const void *key, uint64_t seed, int64_t size, void *xfer) { (void)xfer; - return flan_hash_mem((const uint8_t *)key, size, seed); + return flan_key_hash_flat(key, seed, size); } int8_t flan_eq_flat(const void *a, const void *b, int64_t size, void *xfer) { (void)xfer; - return (int8_t)(memcmp(a, b, (size_t)size) == 0); + return flan_key_eq_flat(a, b, size); } /* A string is ptr+len and its bytes are elsewhere, so neither the flat hasher * nor memcmp is correct for it: two equal strings at different addresses must * hash the same. [size] is ignored; the shape is fixed. */ -uint64_t flan_hash_str(const void *key, uint64_t seed, int64_t size, - void *xfer) { +uint64_t flan_key_hash_str(const void *key, uint64_t seed, int64_t size) { const flan_slice *s = (const flan_slice *)key; - (void)size; (void)xfer; + (void)size; return flan_hash_mem(s->ptr, s->len, seed); } -int8_t flan_eq_str(const void *a, const void *b, int64_t size, void *xfer) { +int8_t flan_key_eq_str(const void *a, const void *b, int64_t size) { const flan_slice *x = (const flan_slice *)a, *y = (const flan_slice *)b; - (void)size; (void)xfer; + (void)size; if (x->len != y->len) return 0; if (x->len == 0) return 1; return (int8_t)(memcmp(x->ptr, y->ptr, (size_t)x->len) == 0); } +uint64_t flan_hash_str(const void *key, uint64_t seed, int64_t size, + void *xfer) { + (void)xfer; + return flan_key_hash_str(key, seed, size); +} + +int8_t flan_eq_str(const void *a, const void *b, int64_t size, void *xfer) { + (void)xfer; + return flan_key_eq_str(a, b, size); +} + /* Combining, for a key type the compiler does emit a function for: a struct * with padding (whose padding bytes are indeterminate and must not be hashed) * or one with a string field (whose bytes are elsewhere). The emitted function diff --git a/tmpchk/m2.flan b/tmpchk/m2.flan new file mode 100644 index 0000000..7493741 --- /dev/null +++ b/tmpchk/m2.flan @@ -0,0 +1,52 @@ +(defstruct Cell [x i32 y i32]) +(defstruct Named [tag string n i32]) + +(defn main [] i32 + ;; An integer key, past several grows: 2000 entries in a map that starts at 8. + (let [m (map-new i32 i64)] + (dotimes [i 2000] + (put m i (* (i64 i) 3))) + (print (len m)) (println "") + (let [bad 0] + (dotimes [i 2000] + (match (get m i) + (Some v) (if (not (= v (* (i64 i) 3))) (set bad (+ bad 1))) + None (set bad (+ bad 1)))) + (print bad) (println "")) + (free m)) + + ;; A struct key: the compiler emits a hash and an equality pair for Cell and + ;; walks it field by field, so padding is never read. + (let [g (map-new Cell i32)] + (dotimes [i 40] + (dotimes [j 40] + (put g (Cell {.x i .y j}) (+ (* i 100) j)))) + (print (len g)) (println "") + (match (get g (Cell {.x 7 .y 9})) (Some v) (do (print v) (println "")) None (println "missing")) + (print (has-key? g (Cell {.x 39 .y 39}))) (println "") + (print (has-key? g (Cell {.x 40 .y 0}))) (println "") + (free g)) + + ;; A struct key holding a string: the string field hashes its bytes, so two + ;; equal strings at different addresses find the same entry. + (let [n (map-new Named i32)] + (put n (Named {.tag "alpha" .n 1}) 10) + (put n (Named {.tag "alpha" .n 2}) 20) + (put n (Named {.tag "beta" .n 1}) 30) + (print (len n)) (println "") + (match (get n (Named {.tag "alpha" .n 2})) (Some v) (do (print v) (println "")) None (println "missing")) + (print (has-key? n (Named {.tag "alpha" .n 3}))) (println "") + (free n)) + + ;; clone is a deep, independent copy. + (let [a (map-new i32 i32)] + (put a 1 100) + (put a 2 200) + (let [b (clone a)] + (put b 1 999) + (match (get a 1) (Some v) (do (print v) (println "")) None (println "missing")) + (match (get b 1) (Some v) (do (print v) (println "")) None (println "missing")) + (print (len b)) (println "") + (free b)) + (free a)) + 0)