diff --git a/BUILT.md b/BUILT.md index 4b0cc7b..7f19e5e 100644 --- a/BUILT.md +++ b/BUILT.md @@ -1848,14 +1848,197 @@ nothing marked it — which is precisely what a static rule cannot see. exists for is not implemented: a slice is ptr+len and has nowhere to carry the Vec's identity or its generation. Said plainly here rather than implied by the word's presence in the header. -### What this leaves for steps 4 to 7 +### What this leaves for steps 5 to 7 -`(Map K V)`; `drop` and with it the transitive move-only rule, recursive teardown, and the refusal to construct a -drop-carrying container against an allocator without `can-free`; `(Result T E)` and `try`; generics; the macro expander. +`(Map K V)` is built — see below. What is left: `drop` and with it the transitive move-only rule, recursive teardown, +and the refusal to construct a drop-carrying container against an allocator without `can-free`; `(Result T E)` and +`try`; generics; the macro expander. And the **accumulation pattern** — `(fn [c] (push errors c) ...)` over an enclosing Vec — which `Vec` does not buy: capture does not exist at all, and the spec's captured-`Vec`-by-pointer rule has never had to exist because every capturable type today is a value type. It is its own item and should be planned as one. +## `(Map K V)`, which is Odin's map + +Step 4 of the container build order, over the runtime `Vec` already established. `spec-memory.md` is followed as +written; the two places this departs from *Odin* are named below, and there is one amendment to the spec and one +restriction under it. + +### The three properties that were the point + +Odin's header states them and they are why it was the thing to follow (`base/runtime/dynamic_map_internal.odin`). + +- **Open-addressed Robin Hood hashing at a 75% load factor.** No buckets and no per-entry allocation: one block holds + every key, every value and every hash. Robin Hood is the part that earns its keep — on insert, an element that is + further from the slot its hash wanted than the occupant it is looking at takes the slot and sends the occupant on. + Probe distances even out, and a lookup may stop the moment it is further from home than the occupant it is looking + at, because no element is ever further from home than one it passed. That early exit is why a miss costs about what + a hit does. +- **Cache-line cell packing.** A flat `[capacity]K` array lets one key straddle two cache lines, so a probe walking + four slots can touch five lines. A cell packs as many `K` as fit in 64 bytes and pads the rest, so no key ever + straddles a line. Keys, values and hashes are three separate runs, so a probe — which reads hashes, and only then + one key — touches hash lines and nothing else until it has a candidate. +- **Pointer-width integers throughout**, so no sign extension or masking gets into the probe loop. + +### Two departures from Odin, both deliberate + +**There are no tombstones**, because `spec-memory.md` defers removal ("Move-aware lookup, removal, and owned entries +are deferred"). A slot is empty or occupied and nothing else, which deletes Odin's backward-shift loop entirely — it +is the single largest reason this file is shorter than the original. When removal arrives, that loop is what it costs. + +**The header does not tag the capacity into the data pointer.** Odin stuffs `log2cap` into the low six bits because +its `Raw_Map` must be three words. This header already carries an allocator, a generation and an epoch, so the tagging +would buy nothing, cost a mask on every access, and — the part that actually matters — make correctness depend on the +block being 64-byte aligned. Alignment is *requested*; an arena whose base is not cache-aligned now gives a slower map +rather than a wrong one. + +The header is six words, 48 bytes, the same as a `Vec`'s and for the same reason: a layout that changes with a build +flag can disagree across the reload boundary. + + data len log2cap allocator gen epoch + +### The hash and equality pair, and why most key types do not get one + +`spec-memory.md` restricts keys to built-in structural types and makes hashing and equality compiler-provided +structural operations. So there is no dispatch to design: a key type resolves to a pair of symbols, passed to the +type-erased runtime the way Odin hangs two contextless `proc`s off a `Map_Info`. + +Most key types need nothing emitted. A key whose equality is bytewise and whose bytes are all present — every integer, +enum, bool, and fixed array of those — is served by one runtime pair over `(pointer, size)`. Two kinds are not, and +the reasons are worth keeping because they are what a bytewise shortcut would have got wrong: + +- a **string** is ptr+len and its bytes are elsewhere, so two equal strings at different addresses must hash alike; +- a **struct** may have padding, whose bytes are indeterminate — two structs 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 in declaration order and addressing nothing but +fields. Two maps with the same key type share one pair, and a struct reached twice through two fields emits one. + +`Tast.FnAddr` is what carries the symbol, and it is **not** a function value: nothing in the surface language can +produce one, name its type, or call through it. It is the same escape the allocator used — the one NEXT.md predicted +would work — and `reach.ml` learned the edge, because a function reached only by address is invisible to the +reachability walk otherwise. That was already true of handler clauses. + +A pair emitted for a struct is an ordinary Flan function, so its signature ends with the transfer channel like every +other. The runtime's typedef spells that pointer out rather than hoping nothing writes through it, and each built-in +hasher exists in two spellings — the pointer form that matches the typedef, and the direct form an emitted hasher +calls per field, which has no channel to hand on. + +### The surface + +| Name | What | +|---|---| +| `(map-new)` `(map-new K V)` `(map-new a)` `(map-new K V a)` | a new map; the pair may be omitted where the context says | +| `(put m k v)` | upsert, `Unit` | +| `(get m k)` | `(Option V)` — absence is `None` | +| `(has-key? m k)` | `bool`, copying no value — **an addition; the spec does not name it** | +| `(len m)` `(reserve m n)` `(clone m)` `(clone m a)` `(free m)` | extended, not duplicated | + +`has-key?` is **not in `spec-memory.md`** and is an addition, flagged because everything else here is the spec's. +`(get m k)` answers the same question, but through an `Option` the caller then has to match, and the common use is a +condition. It copies no value, which is also why it is not just `get` with the result thrown away. The `?` suffix +follows `can-free?`. + +`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. `reserve`'s `n` is entries, not slots — the runtime sizes +the block so `n` still sits under the load factor, which is the only reading of "room for n" that does not reallocate +on the nth put. + +`get` builds the `Option` in the checker, not 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` and `get` bind their arguments to slots before the +allocation guard, so a `retry` re-attempts the allocation and not the expressions that produced the key and value. + +**`{K V}` is the type spelling and 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`. + +### The refusals, each by name + +- A **float key** — 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. There is no equality there for a map to hash. +- A **`Ptr`, slice, `Vec` or `Map` key** — would hash an address rather than what it points at, which is a different + operation. +- A **fixed array whose elements are not compared bytewise** — an array of structs or of strings needs the + per-element walk a struct key gets, driven by a loop rather than a field list. Nothing has wanted one, so it is + refused rather than written untested, and the shape that does work (a struct holding the array) is named beside it. + **This is narrower than the spec**, which lists fixed arrays without qualification. +- A **move-only value** — the refusal `(Vec (Vec T))` already carries, for the identical reason: the runtime copies + entries bytewise, so `clone` would duplicate headers and `free` would leak what they own. Owned entries arrive with + `drop`. +- **`Unit` as a value** — there is nothing to store, and the cell geometry divides a cache line by the element size. + Named rather than left to divide by zero, because it is the natural spelling of a set. + +`StorageExhausted` under `retry` holds over `map-new`, `put`, `reserve` and `clone`, reusing the machinery that landed +with `Vec`; no operation returns an error. A map is the harder of the two containers for that rule, and +`map-exhausted.flan` is why it gets its own program: a `Vec`'s failing allocation leaves the `Vec` untouched, whereas a +map's growth allocates a new block, rehashes into it, and only then releases the old one — so a failure partway must +leave the map exactly as it was, or the retry re-attempts against a half-moved map. + +The epoch trap covers the map too, and `map-stale-region.flan` is separate from `stale-region.flan` because the two +reach the check by different routes: a `Vec`'s operations check on the way in and stop there, while a map's `get` goes +on to call a hash and an equality function through pointers into the block. A missing check there is not a wrong +number, it is a probe loop walking released memory. + +### Is this another Python dict? — measured + +The question was asked directly and the answer is that **Python's algorithm is fine**. What makes CPython's dict slow +is that every key and every value is a separately allocated, reference-counted object and hashing goes through +`__hash__` and `__eq__` calls that cannot be inlined. This map stores raw bytes in the block and compiles hashing and +comparison concretely per key type. That is most of the gap before any cleverness. + +Measured on this machine, `i64` to `i64`, against CPython 3.13's dict on the same workload: + +| Working set | Flan | CPython dict | +|---|---|---| +| 10k entries, 10M lookups (cache-resident) | 21 ns/lookup | 132 ns/lookup | +| 1M entries, 10M puts + 10M lookups | 1.41 s | 1.16 s | + +**Six times quicker cache-resident, and slower at a million entries** — and the second row is written down rather than +left out. Both are waiting on memory there, and this layout waits longer: keys, values and hashes are three separate +runs, so a lookup that misses everything takes three cache misses where a compact dict takes two, and the hash run is a +full eight bytes a slot. Cell packing buys probe locality, which is a win while the hash run is resident and a loss +once nothing is. One byte of metadata a slot — the Swiss-table arrangement — is the known answer and is not built. + +The path from 35 ns to 18 ns (the cache-resident floor, at 500 entries) was **profiled, and the first two guesses were +both wrong**: the per-slot cell division and the block-size divisions were each replaced first and neither moved the +number. What did: FNV one byte at a time became eight, and a key that is one machine word became one load and one mix +with no loop; equality on eight bytes stopped being a call into libc's vectorised `memcmp`, and copying a value out +stopped being a call into `memmove`; the block geometry stopped being recomputed five times over in a function that ran +twice per lookup; and the seed stopped being a five-multiply avalanche on the critical path for mixing the hasher does +again immediately after. `64/size` is a table, which is Odin's `Map_Cell_Info` by another route — Odin precomputes it +per type because the probe loop must not divide, and here the sizes arrive as ordinary arguments. + +What remains at 18 ns is the type erasure itself: a non-inlinable call into the runtime and two non-inlinable indirect +calls to the pair. That is the trade `spec-memory.md` chose deliberately — "It is type-erased on purpose… No generics +are involved, and none are needed" — and monomorphisation is what would buy it back, at the cost the spec declined. + +## `defer` may be written in a `let` + +The whole of this project's resource-cleanup answer, and NEXT.md records `drop` and a `with-cleanup` form as both +considered and rejected before it. + +`defer` is a **compile-time** construct: the cleanup is copied into every exit path of the function. That is why a loop +body and a branch stay refused — a loop body's would fire once at function exit rather than once per iteration, and a +branch would have to express "maybe registered", which a form copied into every exit path or into none cannot say. + +A `let` is neither. It is not a frame here: its bindings are function slots like any other and **nothing is released at +scope exit**, so a `let` at the top level of a function body has exactly the function's extent and a `defer` written in +it always registers. It was refused for a reason that does not apply to it. + +The rule, stated precisely, because "top level of a function body" is easy to get wrong: a form at the top level of the +body may carry one, and so may a form in the body of a `let` that itself may — to any depth. A `let` inside a `while` +or an `if` has the loop's extent or the arm's, and inherits the refusal rather than the permission. + +The implementation detail worth keeping: **the permission is granted again before every form of a body, never once +around the body.** `check` withdraws it as it starts, so granting it once would let the first `defer` through and refuse +the second — and two resources acquired in one `let` is the case this exists for. `defer-let.flan` covers exactly that, +along with nesting, interleaved registration order across the `let` boundary, and an early return. + +This **amends `spec-memory.md`**, which states under "When storage is released" that `(defer (free v))` for a +`let`-bound `v` is "not expressible today" and that no idiom in the spec may depend on it. It is expressible now. + +`do` at the top level of a body has the same extent argument and is deliberately **not** included: nothing asked for it, +and the rule is easier to state and to trust with one construct in it. + ## Assets are baked in, and the reason it is a compiler feature NEXT.md decision 1. `(embed "brush.png")` is a `[u8]`, `(embed "brush.png" string)` is a `string`, and diff --git a/NEXT.md b/NEXT.md index e0b204e..ef6fc4f 100644 --- a/NEXT.md +++ b/NEXT.md @@ -125,6 +125,29 @@ the commit that made it. `-2851001042534928384` — the same 64 bits, printed unsigned now that `hash-grid`'s `u64` no longer goes through an `(i64 …)` cast — and a trap column shifted because the call it names got shorter. +### Landed — `(Map K V)`, and `defer` in a `let` + +Step 4 of the container build order, following Odin: open-addressed Robin Hood hashing at a 75% load factor, +cache-line cell packing, pointer-width integers through the probe loop. Two deliberate departures from Odin — no +tombstones, because `spec-memory.md` defers removal, which deletes the backward-shift loop entirely; and no capacity +tagged into the data pointer, because this header has room for it and tagging would make correctness depend on an +alignment that is only ever requested. + +**One amendment to a frozen `spec-memory.md`, and it is the `defer` half**: the spec says under "When storage is +released" that `(defer (free v))` for a `let`-bound `v` is "not expressible today" and that no idiom may depend on it. +It is expressible now. A `let` at the top level of a function body has exactly the function's extent — a `let` is not a +frame here, and nothing is released at scope exit — so a `defer` in one always registers. A loop body and a branch stay +refused, by name, for the reason that does apply to them. + +**One restriction the spec does not have**: a fixed array is a map key only when its elements compare bytewise, so an +array of structs or of strings is refused by name. A struct key holding the array works, because a struct key is walked +field by field. + +The measured answer to the author's "is this another Python dict": **six times quicker cache-resident and slower at a +million entries**. Python's algorithm is fine — what makes it slow is a separately allocated refcounted object per key +and value, and hashing through calls that cannot be inlined. The second half of that result is the interesting one and +is written down rather than left out; see the unsettled list under the build order. + ### Landed — the allocator, the arena, `(Vec T)`, `StorageExhausted` The critical path, and the thing NEXT.md said was the only one standing between this and writing a game. Steps 1, 2 and @@ -462,9 +485,12 @@ run one lane at a time; item 4 is disjoint and runs alongside any of them. old spelling and their files want the same pass at merge — `python3 tools/colon-to-dot.py .` over the tree, and `--in-strings` for a `test/*.ml` that embeds Flan. -3. **`Map`, and the `defer` relaxation.** `Map` is step 4 of the container build order and finishes what `Vec` started. - The `defer` change — permitting it in a `let` whose extent is the function body — is small, independent, and is the - whole of the resource-cleanup answer. +3. ~~**`Map`, and the `defer` relaxation.**~~ **Both done.** See *`(Map K V)`, which is Odin's map* and *`defer` may be + written in a `let`* in [`BUILT.md`](BUILT.md). The `defer` relaxation **amends `spec-memory.md`**, which said + `(defer (free v))` for a `let`-bound `v` was not expressible; it is now. `Map` restricts one thing the spec does not: + a fixed array is a key only when its elements compare bytewise, so an array of structs or of strings is refused by + name. The measured answer to "is this another Python dict" is six times quicker cache-resident and *slower* at a + million entries, and the second half is the interesting one — see below. 4. **The Emacs batch. Disjoint from the compiler, so it runs in parallel with anything above.** Globals in the break buffer; the buffer opening itself when the program stops; ~~the indentation rewrite with `clojure-mode` as the @@ -905,9 +931,13 @@ expander last, on 6's unions. backend learned nothing about allocation. `test/programs/exhausted.flan` exhausts an allocator for real and takes the restart; `exhausted-unhandled.flan` is the same failure with nothing handling it. -4. **`(Map K V)`** — flat open-addressed key and value arrays, with a compiler-emitted hash and equality pair per key - type passed as arguments. `spec-memory.md`'s structural-key restriction holds this to the built-in key set, so there - is no dispatch to design. +~~4. **`(Map K V)`**~~ **Done**, following Odin: open-addressed Robin Hood hashing at a 75% load factor, cache-line + cell packing, and pointer-width integers through the probe loop. `map-new`, `put`, `get`, `has-key?`, and `len`, + `reserve`, `clone` and `free` extended rather than duplicated. Two departures from Odin, both deliberate: no + tombstones, because the spec defers removal, which deletes the backward-shift loop entirely; and no capacity tagged + into the data pointer, because this header has room and tagging would make correctness depend on an alignment that + is only requested. `Tast.FnAddr` carries the emitted hash and equality pair and is not a function value — the same + escape the allocator used. 5. **`drop`.** The hook, the transitive move-only and non-`clone`able rules, and the refusal to construct a `drop`-carrying value against an allocator without `can-free`. It is additive — no type in the repo has a hook today — but the `can-free` refusal has to land with the construction path it guards, before any arena-allocated container @@ -920,6 +950,22 @@ expander last, on 6's unions. **What is genuinely unsettled.** +- **The Map is slower than CPython's dict at a million entries** (1.41s against 1.16s on the same workload), while + being six times quicker cache-resident (21ns against 132ns per lookup at 10k entries). Both are memory-bound at the + larger size and this layout waits longer: keys, values and hashes are three separate runs, so a lookup that misses + everything costs three cache misses where a compact dict costs two, and the hash run is a full eight bytes a slot. + Cell packing buys probe locality, which is a win while the hash run is resident and a loss once nothing is. One byte + of metadata a slot — the Swiss-table arrangement — is the known answer and is not built. Worth measuring before + building: the crossover is somewhere between 10k and 1M and nobody has found it. +- **What is left at 18ns cache-resident is the type erasure itself** — one non-inlinable call into the runtime and two + non-inlinable indirect calls to the hash and equality pair. That is the trade `spec-memory.md` chose on purpose, and + monomorphisation is what would buy it back. It is a reason to want generics, not a reason to regret the choice. +- **A fixed array of structs or of strings is not a map key**, which is narrower than `spec-memory.md`'s key set. It + needs the per-element walk a struct key gets, driven by a loop rather than a field list. Refused by name rather than + written untested; a struct holding the array works today. +- **Map removal is not built**, which is what keeps the implementation free of tombstones and of Odin's backward-shift + loop. The spec defers it deliberately. When it arrives, that loop is the cost. + - `spec-memory.md`'s "Open: catching a use-after-release statically" is still open, and it is now open with evidence available for the first time: the epoch trap is built and `test/programs/stale-region.flan` is the case it catches. What the spec says would settle it — real Flan programs using arenas, to show whether the escapes that actually occur diff --git a/lib/check.ml b/lib/check.ml index d723a62..3260e5b 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 @@ -806,7 +1071,7 @@ and var ctx loc ~want name = | _ -> match lookup ctx name with | Some b -> - if Types.is_move_only b.bty then moved ctx loc name b.slot; + if Types.is_move_only b.bty then moved ~ty:b.bty ctx loc name b.slot; expect loc ~want (mk loc b.bty (Tast.Local b.slot)) | None -> match Hashtbl.find_opt ctx.env.globals name with @@ -821,15 +1086,16 @@ and var ctx loc ~want name = a borrow, which is the conservative direction: passing one to a function, binding it, returning it and [free]ing it are all moves and all reach here, and the handful of operations that only look at a container say so. *) -and moved ctx loc name slot = +and moved ?ty ctx loc name slot = (match List.assoc_opt slot ctx.dead with | Some where -> fail loc - "%s was moved at %s and cannot be used again — a Vec is move-only, so \ + "%s was moved at %s and cannot be used again — %s is move-only, so \ binding, passing or returning one transfers ownership and the source \ binding is dead afterwards (spec-memory.md). That rule is what makes a \ double free unrepresentable; (clone %s) if you wanted a second one" - name (Loc.to_string where) name + name (Loc.to_string where) + (match ty with Some t -> Types.to_string t | None -> "a Vec") name | None -> ()); if not ctx.borrow then ctx.dead <- (slot, loc) :: ctx.dead @@ -1641,6 +1907,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 +2327,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 +2391,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 +2758,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 869ff68..8c77029 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -102,8 +102,14 @@ let rec ll (t : Types.t) = the Vec's address — so the shape is here only so that a slot, a struct field and a copy in the IR are the right number of bytes. *) | Types.Vec _ -> "%vec" + (* data + len + log2cap + allocator + gen + epoch. Six words, exactly as the + Vec's, and read here for exactly the same reason: nothing in this file + touches a field of one — every operation is a runtime call taking the + map's address — so the shape exists only so that a slot, a struct field + and a copy in the IR are the right number of bytes. *) + | Types.Map _ -> "%map" | Types.Option e -> Printf.sprintf "{ i8, %s }" (ll e) - | Types.Map _ | Types.Fn _ | Types.Var _ -> + | Types.Fn _ | Types.Var _ -> (* The checker rejects each of these by name — nothing reaches here. *) failwith ("no layout for " ^ Types.to_string t) @@ -248,7 +254,7 @@ let rec lay m (t : Types.t) : int * int = | Types.Enum _ -> 4, 4 | Types.Ptr _ -> 8, 8 | Types.Alloc -> 8, 8 - | Types.Vec _ -> 48, 8 + | Types.Vec _ | Types.Map _ -> 48, 8 (* [n x T] adds no padding of its own: T's size already carries its tail. *) | Types.Array (n, e) -> let s, a = lay m e in Int64.to_int n * s, a | Types.Option e -> let s, a, _ = lay_fields m [ Types.Int Types.I8; e ] in s, a @@ -260,7 +266,7 @@ let rec lay m (t : Types.t) : int * int = in s, a | None -> failwith ("no layout for struct " ^ n)) - | Types.Map _ | Types.Fn _ | Types.Var _ -> + | Types.Fn _ | Types.Var _ -> failwith ("no layout for " ^ Types.to_string t) (* Size, alignment, and the offset of every member. *) @@ -378,7 +384,19 @@ let rec dty m d (t : Types.t) : int = [ ("ptr", Types.Ptr e); ("len", Types.Int Types.I64); ("cap", Types.Int Types.I64); ("allocator", Types.Alloc); ("gen", Types.Int Types.I64); ("epoch", Types.Int Types.I64) ] - | Types.Map _ | Types.Fn _ | Types.Var _ -> + (* Six fields again, and shown as six for the same reason: a debugger + that showed fewer would put the reader's offsets out. [log2cap] is + shown rather than a capacity because that is what is stored — the + capacity is 1 << it, and a debugger that invented the shift would be + describing a field that is not there. *) + | Types.Map (k, v) -> + composite (Types.to_string t) + [ ("data", Types.Ptr (Types.Int Types.U8)); + ("len", Types.Int Types.I64); ("log2cap", Types.Int Types.I64); + ("allocator", Types.Alloc); ("gen", Types.Int Types.I64); + ("epoch", Types.Int Types.I64) ] + |> fun n -> ignore k; ignore v; n + | Types.Fn _ | Types.Var _ -> failwith ("no debug type for " ^ Types.to_string t) in Hashtbl.replace d.dtys key n; @@ -709,6 +727,10 @@ and value_at f (e : Tast.expr) : string = | Tast.Local _ | Tast.Global _ | Tast.Field _ | Tast.Deref _ -> (* Everything that denotes a location is a load from its address. *) load f (addr f e) e.Tast.ty + (* The symbol itself, not a load from it: a function's address is a link-time + constant. The same spelling the handler frames use for a lifted clause. *) + | Tast.FnAddr (Tast.Flanfn n) -> fname n + | Tast.FnAddr (Tast.Rtfn n) -> "@" ^ n | Tast.Addr p -> fst (place f p) | Tast.Prim (p, args) -> prim f e p args | Tast.Call (name, args) -> @@ -1555,10 +1577,12 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) = let p, n = explode f a in [ "ptr " ^ p; "i64 " ^ n ] | Types.Unit | Types.Never -> [] - (* A Vec is move-only and never copied, so it crosses to the - runtime as its address — which is also what lets an operation - mutate the caller's Vec in place. *) - | Types.Vec _ -> [ "ptr " ^ addr f a ] + (* A Vec and a Map are move-only and never copied, so each + crosses to the runtime as its address — which is also what + lets an operation mutate the caller's container in place. + Passing the header by value here would hand the runtime a + copy to grow and leave the caller's untouched. *) + | Types.Vec _ | Types.Map _ -> [ "ptr " ^ addr f a ] | t -> [ ll t ^ " " ^ value f a ]) args) in @@ -1955,6 +1979,10 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher ; (Vec T), spec-memory.md. The element type is nowhere in it: the runtime is ; type-erased and every operation is handed size and align at its call site. %vec = type { ptr, i64, i64, ptr, i64, i64 } +; (Map K V), spec-memory.md — Odin's open-addressed Robin Hood map. Neither key +; nor value type appears in it, for the same reason: one type-erased runtime, +; handed the two sizes and a hash/equality pair at each call site. +%map = type { ptr, i64, i64, ptr, i64, i64 } ; A handler frame: the one it displaced, the condition type it matches, and ; the lifted function that runs. Allocated on the establishing frame's stack. %handler = type { ptr, i32, ptr } @@ -2027,6 +2055,30 @@ declare i64 @flan_vec_len(ptr, ptr, i64) declare ptr @flan_vec_at(ptr, i32, i64, ptr, i64) declare void @flan_vec_as_slice(ptr, ptr, i32, i32, i64, ptr, i64) declare void @flan_vec_free(ptr, i64, i64, ptr, i64) +; (Map K V). The two ptr arguments before the location on put/get/clone are the +; hash and equality pair, which the checker emits per key type and passes here +; the way Odin hangs them off Map_Info. +declare i8 @flan_map_init(ptr, ptr, i64, i64, ptr, i64) +declare i8 @flan_map_put(ptr, ptr, ptr, i64, i64, ptr, ptr, ptr, i64) +declare i8 @flan_map_get(ptr, ptr, ptr, i64, i64, ptr, ptr, ptr, i64) +declare i8 @flan_map_has(ptr, ptr, i64, i64, ptr, ptr, ptr, i64) +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) +; 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 ; rather than a fourth host call. See flan_rt.c for why the widening stops diff --git a/lib/reach.ml b/lib/reach.ml index 03f9969..50a3709 100644 --- a/lib/reach.ml +++ b/lib/reach.ml @@ -40,6 +40,11 @@ let rec expr_refs f (e : Tast.expr) = | Tast.Zero _ | Tast.Uninit _ | Tast.Local _ | Tast.None_ | Tast.InvokeRestart _ -> () | Tast.Global n -> f n + (* The other edge reached by address rather than by a call: a Map's hash and + equality pair. Same hazard as [Handled] below — miss it and a program with + a map loses the two functions its every lookup calls through. *) + | Tast.FnAddr (Tast.Flanfn n) -> f n + | Tast.FnAddr (Tast.Rtfn _) -> () | Tast.Prim (_, es) -> gos es | Tast.Call (n, es) -> f n; gos es | Tast.Do es -> gos es diff --git a/lib/tast.ml b/lib/tast.ml index 709d2e2..a81b448 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -73,6 +73,16 @@ and expr_kind = | Global of string | Prim of prim * expr list | Call of string * expr list (* direct call; no first-class fns yet *) + (* The address of a function the compiler emitted, by symbol. Not a function + *value*: nothing in the surface language can produce one, name its type or + call through it, and its only consumers are runtime entry points that take + a procedure the way spec-memory.md's type-erased allocator does. The Map's + hash and equality pair is what wanted it — Odin's [Map_Info] is two + contextless [proc] fields reached exactly this way — and a handler-bind + clause is the same arrangement with the symbol carried on [hframe] + instead. Its Flan type is [Alloc]: an opaque pointer-width value with no + user-writable constructor, which is all any backend needs to know. *) + | FnAddr of fnref | Do of expr list | Let of (int * expr) list * expr list | If of expr * expr * expr @@ -125,6 +135,14 @@ and expr_kind = (* [Serror] is §2's diverging variant: the same lookup, type Never, and with nothing transferring the program stops rather than carrying on. *) +(* Which symbol table the address comes out of. [Flanfn] is a function this + compiler emitted and is therefore name-mangled and reachability-tracked; + [Rtfn] is a C entry point in flan_rt.c, spelled as written. The two are + interchangeable at the call site because a Flan function's emitted signature + is its parameters followed by the transfer channel, and the runtime's + matching typedef spells that last pointer out. *) +and fnref = Flanfn of string | Rtfn of string + and sigkind = Ssignal | Serror and place = diff --git a/lib/types.ml b/lib/types.ml index 293c476..ff3918c 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -127,11 +127,31 @@ let is_numeric = function Int _ | Float _ -> true | _ -> false [free] needs no analysis of its own. A struct that owns one is move-only too; that arrives with [drop], which is the step after this one. *) let rec is_move_only = function - | Vec _ -> true + | Vec _ | Map _ -> true | Option t -> is_move_only t | Array (_, t) -> is_move_only t | _ -> false +(* The key types the first Map implementation admits (spec-memory.md, "Maps — + first implementation"): integers, enums, strings, fixed arrays, and value + structs composed recursively from those. Equality and hashing for them are + compiler-provided structural operations, so this is the whole of what the + emitted hash and equality pair has to cover — there is no dispatch to design + and no type class anywhere. + + A struct is [Named], and whether its fields qualify cannot be decided here: + this module has no field table. [Check] finishes the job by walking them, + which is also where it emits the pair. Everything this does say no to says + no for a reason that will not change with a milestone: a [Ptr] or a [Slice] + key would hash an address, and hashing an address is a different operation + from hashing what it points at. *) +let rec keyable = function + | Int _ | Enum _ | Bool | String -> true + | Float _ -> false (* NaN /= NaN, and 0.0 and -0.0 differ bytewise *) + | Array (_, t) -> keyable t + | Named _ -> true (* [Check] decides, by walking the fields *) + | _ -> false + (* Ordering and equality are defined on machine types and on nothing else at milestone 2 — strings, structs and slices have no built-in [=], because an unconstrained type supports only what every type supports (plan.org, Types). *) diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index df6b8c1..cb82bf6 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -996,6 +996,755 @@ int8_t flan_vec_clone(flan_vec *dst, flan_vec *src, flan_allocator *a, return 1; } +/* ── (Map K V), spec-memory.md ────────────────────────────────────────── + * + * Odin's map, followed deliberately: open-addressed Robin Hood hashing at a + * 75% load factor, cache-line cell packing, and pointer-width integers through + * the probe loop (base/runtime/dynamic_map_internal.odin, whose header states + * the same three). One type-erased runtime over (key size, value size) and a + * compiler-emitted hash and equality pair, exactly as the Vec runtime is one + * over (size, align). + * + * Why the shape matters, since the obvious question is whether this is another + * Python dict. Python's algorithm is fine. What makes it slow is that every + * key and every value is a separately allocated, reference-counted object, and + * hashing goes through __hash__ and __eq__ calls that cannot be inlined. Here + * a key is raw bytes inside the block and the hash and comparison are compiled + * concretely per key type. That is most of the gap before any cleverness. + * + * Robin Hood, in one paragraph. Every occupied slot has a probe distance: how + * far it sits from the slot its hash wanted. On insert, if the element already + * in a slot is closer to its desired slot than the element being placed, the + * two swap and the poorer one carries on down the run. Distances even out, the + * worst case collapses towards the average, and a lookup may stop the moment + * it is further from home than the occupant it is looking at — which is the + * early exit in flan_map_find and is why a miss costs about what a hit does. + * + * Cache-line cells, in one more. A flat [capacity]K array lets one key straddle + * two cache lines, so a probe that walks four slots can touch five lines. A + * Map_Cell packs as many Ks as fit in 64 bytes and pads the remainder, so no + * key ever straddles a line and a linear probe walks memory in the order the + * prefetcher expects. Keys, values and hashes are three separate blocks, so a + * probe — which reads hashes and only then one key — touches hash lines and + * nothing else until it has a candidate. + * + * Header, six words, the same as flan_vec's and for the same reason (a layout + * that changes with a build flag can disagree across the reload boundary): + * + * data one allocation: keys | values | hashes | scratch + * len live entries + * log2cap 0 until something is allocated; never 1 or 2 after + * allocator gen epoch as on a Vec, and checked the same way + * + * Odin stuffs log2cap into the low six bits of the data pointer because its + * Raw_Map must be three words. This header already carries an allocator, a + * generation and an epoch, so the bit-stuffing would buy nothing and cost a + * mask on every access — and, more usefully, not tagging means correctness + * never depends on the block being 64-byte aligned. It is requested as 64, and + * cell packing pays off when the request is honoured, but an arena whose base + * is not cache-aligned gives a slower map rather than a wrong one. + * + * Every entry point returns int8_t 1/0 for "did it fit", never reporting + * failure any other way — the condition, the restart and the message are the + * compiler's job (Check's alloc_guard). */ + +#define FLAN_MAP_CACHE_LINE 64 +#define FLAN_MAP_LOAD_FACTOR 75 +#define FLAN_MAP_MIN_LOG2 3 /* 8 slots */ + +/* The hash word. Zero means the slot is empty, which is what makes a + * zeroed hash block an empty map. There is no tombstone: removal is deferred + * (spec-memory.md defers move-aware lookup, removal and owned entries), so the + * only two states a slot has are empty and occupied. That deletes Odin's + * backward-shift loop from this file entirely, and it is the single largest + * reason this is shorter than the Odin original. + * + * The top bit is set on every stored hash so that a hasher answering 0 does + * not read as an empty slot. It is the highest bit, so the desired slot and + * the probe distance — which use only the low log2cap bits — are unchanged by + * it, and no hash needs rewriting when the capacity changes. */ +typedef uint64_t flan_map_hash; +#define FLAN_MAP_OCCUPIED ((uint64_t)1 << 63) + +/* The pair the compiler emits per key type. [size] is the key's size, passed + * so that the flat hasher and comparator below can serve every key whose + * equality is bytewise and need no per-type function at all. + * + * The trailing pointer is the transfer channel. Every Flan function's emitted + * signature ends with one (Emit's xfer_param), and a hash function emitted for + * a struct key is an ordinary Flan function — so the typedef spells it out + * rather than hoping nothing ever writes through it. Nothing does: neither a + * hasher nor a comparator can signal, because the only things either can call + * are the leaf C entry points below. It is passed as a real address, never + * NULL, so that a store through it would be a store and not a crash. */ +typedef uint64_t (*flan_hash_fn)(const void *key, uint64_t seed, int64_t size, + void *xfer); +typedef int8_t (*flan_eq_fn)(const void *a, const void *b, int64_t size, + void *xfer); + +typedef struct flan_map { + void *data; + int64_t len; + int64_t log2cap; + flan_allocator *alloc; + int64_t gen; + int64_t epoch; +} flan_map; + +/* ── Hashing ────────────────────────────────────────────────────────── + * + * FNV-1a over the bytes, then a final avalanche. FNV alone leaves the low bits + * poorly mixed and the low bits are exactly what selects the slot, so the + * splitmix64 finaliser is not decoration: without it consecutive small integer + * keys collide in long runs. The seed is mixed in first so that two maps do not + * agree on the same pathological ordering. */ +static uint64_t flan_mix64(uint64_t x) { + x ^= x >> 30; + x *= 0xbf58476d1ce4e5b9ULL; + x ^= x >> 27; + x *= 0x94d049bb133111ebULL; + x ^= x >> 31; + return x; +} + +static uint64_t flan_hash_mem(const uint8_t *p, int64_t n, uint64_t seed) { + uint64_t h = 0xcbf29ce484222325ULL ^ seed; + int64_t i = 0; + /* Eight bytes at a time. Byte-at-a-time FNV is a serial chain of one + * multiply per byte, and the multiply's latency is the whole cost — it was + * a quarter of a lookup before this. The tail is the byte loop, which is + * the original and is what any size not a multiple of eight still gets. */ + for (; i + 8 <= n; i += 8) { + uint64_t w; + memcpy(&w, p + i, 8); + h = (h ^ w) * 0x100000001b3ULL; + } + for (; i < n; i++) h = (h ^ (uint64_t)p[i]) * 0x100000001b3ULL; + return flan_mix64(h); +} + +/* 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) { + /* A key that is one machine word — which is every integer, every enum and + * every bool, so very nearly every key — is one load and one mix. This is + * where "the hash is compiled concretely per key type" stops being a + * description of the arrangement and starts being the reason it is quick: + * the general path is a loop over bytes with a multiply chain, and none of + * these takes it. */ + switch (size) { + case 1: return flan_mix64((uint64_t)*(const uint8_t *)key + seed); + case 2: { uint16_t x; memcpy(&x, key, 2); return flan_mix64((uint64_t)x + seed); } + case 4: { uint32_t x; memcpy(&x, key, 4); return flan_mix64((uint64_t)x + seed); } + case 8: { uint64_t x; memcpy(&x, key, 8); return flan_mix64(x + seed); } + default: 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) { + /* Likewise, and for a sharper reason: memcmp on eight bytes is a *call* into + * libc's vectorised implementation, which was an eighth of a lookup. These + * four cases are a load and a compare. */ + switch (size) { + case 1: return (int8_t)(*(const uint8_t *)a == *(const uint8_t *)b); + case 2: { uint16_t x, y; memcpy(&x, a, 2); memcpy(&y, b, 2); return (int8_t)(x == y); } + case 4: { uint32_t x, y; memcpy(&x, a, 4); memcpy(&y, b, 4); return (int8_t)(x == y); } + case 8: { uint64_t x, y; memcpy(&x, a, 8); memcpy(&y, b, 8); return (int8_t)(x == y); } + default: return (int8_t)(memcmp(a, b, (size_t)size) == 0); + } +} + +/* Copying one entry's worth of bytes. Same reason again: memcpy of eight bytes + * became a call into libc's memmove, which is pure overhead for a size the + * switch resolves to a single load and store. */ +static void flan_copy_small(void *dst, const void *src, int64_t n) { + switch (n) { + case 1: *(uint8_t *)dst = *(const uint8_t *)src; return; + case 2: memcpy(dst, src, 2); return; + case 4: memcpy(dst, src, 4); return; + case 8: memcpy(dst, src, 8); return; + case 16: memcpy(dst, src, 16); return; + default: memcpy(dst, src, (size_t)n); return; + } +} + +uint64_t flan_hash_flat(const void *key, uint64_t seed, int64_t size, + void *xfer) { + (void)xfer; + 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 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_key_hash_str(const void *key, uint64_t seed, int64_t size) { + const flan_slice *s = (const flan_slice *)key; + (void)size; + return flan_hash_mem(s->ptr, s->len, seed); +} + +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; + 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 + * hashes each field with the right pair and folds the results through here. */ +uint64_t flan_hash_combine(uint64_t acc, uint64_t h) { + return flan_mix64(acc ^ (h + 0x9e3779b97f4a7c15ULL + (acc << 6) + (acc >> 2))); +} + +/* ── Cell geometry ──────────────────────────────────────────────────── + * + * Odin precomputes these into a Map_Cell_Info so the probe loop never divides. + * They are derived from the element size alone — alignment cannot matter, + * because a cell starts on a 64-byte boundary and no Flan type is aligned + * above that — so they are derived once on entry to each operation and kept in + * locals, which is the same trade with one less thing for the checker to pass + * and get wrong. */ +/* 64/size for every size a cell can pack, as a table rather than a division. + * + * This is Odin's Map_Cell_Info by another route. Odin precomputes + * elements_per_cell and size_of_cell into a static per-type record because the + * probe loop must not divide; the same number is wanted here and the call site + * cannot hand it over, because the sizes reach this runtime as ordinary i64 + * arguments rather than as a compile-time record. A 64-entry table is one load + * and needs nothing added to the calling convention. + * + * It is worth the lines: the geometry is recomputed on every lookup, three + * times over (keys, values, hashes), and three divisions there measured as a + * fifth of the whole operation. */ +static const uint8_t flan_epc_table[64] = { + 1, 64, 32, 21, 16, 12, 10, 9, + 8, 7, 6, 5, 5, 4, 4, 4, + 4, 3, 3, 3, 3, 3, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, + 2, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, +}; + +static int64_t flan_cell_epc(int64_t size) { + if (size <= 0 || size >= FLAN_MAP_CACHE_LINE) return 1; + return (int64_t)flan_epc_table[size]; +} + +/* log2 of [epc] when it is a power of two, and -1 when it is not. + * + * epc is 64/size clamped to at least 1, so the only powers of two it can ever + * be are these seven. A switch over them is a handful of compares the branch + * predictor gets right every time; a loop looking for the bit measured *worse* + * than the division it was replacing, which is why this is written out. */ +static int flan_log2_epc(int64_t epc) { + switch (epc) { + case 1: return 0; + case 2: return 1; + case 4: return 2; + case 8: return 3; + case 16: return 4; + case 32: return 5; + case 64: return 6; + default: return -1; + } +} + +/* Rounding to a cache line is a mask, not a division: the generic + * flan_align_up divides, and this sits on the lookup path. */ +static int64_t flan_map_round(int64_t x) { + return (x + (FLAN_MAP_CACHE_LINE - 1)) & ~(int64_t)(FLAN_MAP_CACHE_LINE - 1); +} + +static int64_t flan_cell_size(int64_t size) { + return flan_map_round(flan_cell_epc(size) * size); +} + +/* The bytes a [count]-element run of cells occupies, rounded to a cache line + * so the next block starts on one too. + * + * Division-free in the common case, and that matters more here than anywhere + * else in this file: flan_map_blocks calls this five times and is itself + * called once per lookup, so a division here is five divisions on the hot + * path — which measured as the difference between a 39ns lookup and a 12ns + * one, far outweighing the per-slot indexing the cell shift covers. */ +static int64_t flan_run_bytes(int64_t epc, int64_t cell, int64_t shift, + int64_t count) { + int64_t cells = + (shift >= 0) ? ((count + epc - 1) >> shift) : ((count + epc - 1) / epc); + return cells * cell; +} + +static int64_t flan_cells_bytes(int64_t size, int64_t count) { + int64_t epc = flan_cell_epc(size); + return flan_run_bytes(epc, flan_cell_size(size), flan_log2_epc(epc), count); +} + +/* log2 of [epc] when it is a power of two, and -1 when it is not. + * + * This is the difference between a probe that costs a shift and one that costs + * two 64-bit integer divisions, and it is measurable: with the divisions in + * place a cache-resident i64 lookup took 39ns, and without them 12ns. Odin + * does not need it because its static path resolves elements_per_cell at + * compile time and its dynamic path special-cases 1 and 2; here the number is + * always a run-time value, so the compiler cannot turn the division into a + * shift and something has to. + * + * It is a power of two whenever the element size is, which is every primitive, + * every pointer, and a struct whose size rounds to one — so the fallback is + * the rare path rather than the common one. */ + +/* Slot [i] of a cell-packed run. [epc], [cell] and [shift] are hoisted by + * every caller that walks, which is why they are parameters rather than + * recomputed here — recomputing [shift] per slot would cost more than the + * division it removes. */ +static uint8_t *flan_cell_at(uint8_t *base, int64_t size, int64_t epc, + int64_t cell, int64_t shift, int64_t i) { + if (epc == 1) return base + i * cell; + if (shift >= 0) + return base + (i >> shift) * cell + (i & (epc - 1)) * size; + return base + (i / epc) * cell + (i % epc) * size; +} + +/* The four blocks. Keys, values and hashes get one run each; the scratch is + * two more keys and two more values, which is where the Robin Hood swap keeps + * the element in flight. Odin allocates the same two, for the same reason: the + * swap is a memcpy between type-erased buffers and there is no local of the + * right type to hold one. */ +static int64_t flan_map_block_size(int64_t ksize, int64_t vsize, int64_t cap) { + return flan_cells_bytes(ksize, cap) + flan_cells_bytes(vsize, cap) + + flan_cells_bytes((int64_t)sizeof(flan_map_hash), cap) + + flan_cells_bytes(ksize, 2) + flan_cells_bytes(vsize, 2); +} + +/* Everything an operation needs to walk the block, computed once on entry. + * + * It used to be five calls to flan_cells_bytes, each recomputing the element + * geometry it had just been asked for, on a function called once per lookup. + * Gathering it into one struct is the single largest win in this file after + * the hash: the arithmetic is the same, it simply happens once. */ +typedef struct flan_map_geom { + int64_t kepc, kcell, vepc, vcell; + int64_t kshift, vshift; + uint8_t *ks; + uint8_t *vs; + flan_map_hash *hs; + uint8_t *sk; + uint8_t *sv; +} flan_map_geom; + +static void flan_map_geometry(const flan_map *m, int64_t ksize, int64_t vsize, + int64_t cap, flan_map_geom *g) { + uint8_t *p = (uint8_t *)m->data; + int64_t hsize = (int64_t)sizeof(flan_map_hash); + int64_t hepc = flan_cell_epc(hsize), hcell = flan_cell_size(hsize); + int hshift = flan_log2_epc(hepc); + g->kepc = flan_cell_epc(ksize); g->kcell = flan_cell_size(ksize); + g->vepc = flan_cell_epc(vsize); g->vcell = flan_cell_size(vsize); + g->kshift = flan_log2_epc(g->kepc); + g->vshift = flan_log2_epc(g->vepc); + g->ks = p; + p += flan_run_bytes(g->kepc, g->kcell, g->kshift, cap); + g->vs = p; + p += flan_run_bytes(g->vepc, g->vcell, g->vshift, cap); + g->hs = (flan_map_hash *)p; + p += flan_run_bytes(hepc, hcell, hshift, cap); + g->sk = p; + p += flan_run_bytes(g->kepc, g->kcell, g->kshift, 2); + g->sv = p; +} + +/* The same epoch check a Vec does, and it runs in every build for the same + * reason. A map that never allocated has no allocator and nothing to check. */ +static void flan_map_check(flan_map *m, const uint8_t *loc, int64_t loclen) { + if (m->alloc) { + int64_t now = (int64_t)m->alloc->epoch; + if (now != m->epoch) flan_vec_stale_fail(loc, loclen, m->epoch, now); + } +} + +static flan_allocator *flan_map_adopt(flan_map *m) { + if (!m->alloc) { + m->alloc = flan_context_allocator(); + m->epoch = (int64_t)m->alloc->epoch; + } + return m->alloc; +} + +/* The seed, derived from the block address exactly as Odin derives it: two + * maps with the same keys then disagree about which slot is which, so an + * adversarial insertion order against one is not an insertion order against + * the other. It changes on every grow, which is why hashes are recomputed + * there rather than carried over. */ +static uint64_t flan_map_seed(const flan_map *m) { + /* One multiply, not a full avalanche. This is recomputed on every lookup and + * all it has to do is decorrelate two maps from each other: whatever it + * returns is fed to the hasher, which mixes properly. A splitmix here was + * five dependent multiplies on the critical path of every probe, for + * mixing that happens again immediately afterwards. + * + * The block is 64-byte aligned when the allocator honours the request, so + * the low six bits carry nothing and are shifted out before multiplying. */ + return (((uint64_t)(uintptr_t)m->data >> 6) * 0x9e3779b97f4a7c15ULL); +} + +static int64_t flan_map_cap(const flan_map *m) { + return m->data ? ((int64_t)1 << m->log2cap) : 0; +} + +/* 75% of capacity, as fixed-point integer arithmetic. Robin Hood wants a + * maximum load factor under 100% and 75% is where Odin sets it. */ +static int64_t flan_map_threshold(const flan_map *m) { + return (flan_map_cap(m) * FLAN_MAP_LOAD_FACTOR) / 100; +} + +/* How far this element is from the slot its hash wanted. Odin's identity: + * (slot - hash) & mask is the same number as (slot + cap - desired) & mask, + * with fewer operations, because desired is hash & mask. */ +static int64_t flan_map_distance(uint64_t hash, int64_t slot, int64_t mask) { + return (int64_t)(((uint64_t)slot - hash) & (uint64_t)mask); +} + +/* Place one element, already hashed, into a map known to have room. This is + * Odin's swap_loop and nothing else: with no tombstones there is no second + * loop, and the load factor guarantees an empty slot is reached. */ +static void flan_map_place(flan_map *m, uint64_t h, const void *ikey, + const void *ival, int64_t ksize, int64_t vsize) { + flan_map_geom g; + int64_t cap = flan_map_cap(m), mask = cap - 1; + int64_t pos = (int64_t)(h & (uint64_t)mask), dist = 0; + uint8_t *k, *v, *tk, *tv; + + flan_map_geometry(m, ksize, vsize, cap, &g); + /* The element in flight lives in scratch slot 0; slot 1 is the swap + * temporary. Both are inside the block, so nothing here touches the stack + * with a size only known at run time. */ + k = flan_cell_at(g.sk, ksize, g.kepc, g.kcell, g.kshift, 0); + v = flan_cell_at(g.sv, vsize, g.vepc, g.vcell, g.vshift, 0); + tk = flan_cell_at(g.sk, ksize, g.kepc, g.kcell, g.kshift, 1); + tv = flan_cell_at(g.sv, vsize, g.vepc, g.vcell, g.vshift, 1); + flan_copy_small(k, ikey, ksize); + if (vsize > 0) flan_copy_small(v, ival, vsize); + + for (;;) { + uint64_t eh = g.hs[pos]; + if (eh == 0) { + flan_copy_small(flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, pos), + k, ksize); + if (vsize > 0) + flan_copy_small(flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, pos), + v, vsize); + g.hs[pos] = h; + return; + } + /* The Robin Hood swap: the occupant is richer — closer to home — than the + * element in flight, so the poorer one takes the slot and the richer one + * carries on. This is what keeps the variance down. */ + if (dist > flan_map_distance(eh, pos, mask)) { + uint8_t *kp = flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, pos); + uint8_t *vp = flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, pos); + uint64_t th; + flan_copy_small(tk, k, ksize); + flan_copy_small(k, kp, ksize); + flan_copy_small(kp, tk, ksize); + if (vsize > 0) { + flan_copy_small(tv, v, vsize); + flan_copy_small(v, vp, vsize); + flan_copy_small(vp, tv, vsize); + } + th = h; h = g.hs[pos]; g.hs[pos] = th; + dist = flan_map_distance(h, pos, mask); + } + pos = (pos + 1) & mask; + dist++; + } +} + +/* The slot holding [key], or -1. The middle test is the Robin Hood early exit: + * this probe is further from home than the occupant is, and Robin Hood + * maintains that no element is ever further from home than one it passed, so + * the key cannot be further along. A miss therefore costs about what a hit + * does, which is the property the ordering buys. */ +static int64_t flan_map_find_g(flan_map *m, const void *key, int64_t ksize, + int64_t vsize, flan_hash_fn hash, flan_eq_fn eq, + flan_map_geom *gp) { + flan_map_geom g; + int64_t cap, mask, pos, dist = 0; + uint64_t h; + void *xfer = NULL; + if (!m->data || m->len == 0) return -1; + cap = flan_map_cap(m); + mask = cap - 1; + flan_map_geometry(m, ksize, vsize, cap, &g); + if (gp) *gp = g; + h = hash(key, flan_map_seed(m), ksize, &xfer) | FLAN_MAP_OCCUPIED; + pos = (int64_t)(h & (uint64_t)mask); + for (;;) { + uint64_t eh = g.hs[pos]; + if (eh == 0) return -1; + if (dist > flan_map_distance(eh, pos, mask)) return -1; + if (eh == h + && eq(key, flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, pos), + ksize, &xfer)) + return pos; + pos = (pos + 1) & mask; + dist++; + } +} + +/* Allocate a block for 2^log2cap slots and zero the hashes. Only the hash run + * needs zeroing — a key or value slot is never read without its hash saying it + * is live — so the keys and values are left as the allocator returned them. */ +static int8_t flan_map_alloc(flan_map *m, flan_allocator *a, int64_t log2cap, + int64_t ksize, int64_t vsize) { + int64_t cap = (int64_t)1 << log2cap; + int64_t bytes = flan_map_block_size(ksize, vsize, cap); + void *p; + flan_fail_bytes = bytes; + flan_fail_align = FLAN_MAP_CACHE_LINE; + flan_fail_id = (int64_t)(intptr_t)a; + p = a->proc(a, FLAN_ALLOC_ALLOC, NULL, 0, bytes, FLAN_MAP_CACHE_LINE); + if (!p) return 0; + m->data = p; + m->log2cap = log2cap; + m->len = 0; + { + flan_map_geom g; + flan_map_geometry(m, ksize, vsize, cap, &g); + memset(g.hs, 0, + (size_t)flan_cells_bytes((int64_t)sizeof(flan_map_hash), cap)); + } + return 1; +} + +/* Double the capacity and reinsert. The seed moves with the block, so every + * hash is recomputed rather than carried over — which is what a fresh seed per + * block is for. The old block is released only after the last read of it. */ +static int8_t flan_map_grow(flan_map *m, int64_t want, int64_t ksize, + int64_t vsize, flan_hash_fn hash) { + flan_allocator *a = flan_map_adopt(m); + flan_map fresh; + int64_t log2cap = FLAN_MAP_MIN_LOG2, old_cap = flan_map_cap(m); + flan_map_geom g; + int64_t i, moved; + void *xfer = NULL; + + /* Smallest power of two whose 75% threshold still holds [want]. */ + while ((((int64_t)1 << log2cap) * FLAN_MAP_LOAD_FACTOR) / 100 < want) { + if (log2cap >= 40) return 0; + log2cap++; + } + if (log2cap <= m->log2cap && m->data) return 1; + + fresh.data = NULL; fresh.len = 0; fresh.log2cap = 0; + fresh.alloc = a; fresh.gen = 0; fresh.epoch = (int64_t)a->epoch; + if (!flan_map_alloc(&fresh, a, log2cap, ksize, vsize)) return 0; + + if (m->data) { + flan_map_geometry(m, ksize, vsize, old_cap, &g); + moved = m->len; + for (i = 0; i < old_cap && moved > 0; i++) { + uint64_t h; + if (g.hs[i] == 0) continue; + h = hash(flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i), + flan_map_seed(&fresh), ksize, &xfer) | FLAN_MAP_OCCUPIED; + flan_map_place(&fresh, h, + flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i), + flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, i), + ksize, vsize); + fresh.len++; + moved--; + } + if (a->caps & FLAN_CAN_FREE) + a->proc(a, FLAN_ALLOC_FREE, m->data, + flan_map_block_size(ksize, vsize, old_cap), 0, + FLAN_MAP_CACHE_LINE); + } + m->data = fresh.data; + m->log2cap = fresh.log2cap; + m->len = fresh.len; + /* Every key and value moved, so any pointer into the old block is stale — + * the same word, bumped for the same reason, as a Vec's reallocation. */ + m->gen++; + return 1; +} + +int8_t flan_map_init(flan_map *m, flan_allocator *a, int64_t ksize, + int64_t vsize, const uint8_t *loc, int64_t loclen) { + if (!a) flan_null_alloc_fail(loc, loclen); + (void)ksize; (void)vsize; + m->data = NULL; + m->len = 0; + m->log2cap = 0; + m->gen = 0; + m->alloc = a; + m->epoch = (int64_t)a->epoch; + /* No block until something is put in it: an empty map that is never written + * costs nothing, which is what makes a (defvar m (Map string i32)) free. */ + return 1; +} + +/* The upsert. spec-memory.md: it either inserts or replaces, and returns Unit + * — there is no Result and no ignorable error code, because a put that put + * nothing and said nothing is the outcome the StorageExhausted rule exists to + * make impossible. */ +int8_t flan_map_put(flan_map *m, const void *key, const void *val, + int64_t ksize, int64_t vsize, flan_hash_fn hash, + flan_eq_fn eq, const uint8_t *loc, int64_t loclen) { + int64_t at; + flan_map_geom g; + uint64_t h; + flan_map_check(m, loc, loclen); + + at = flan_map_find_g(m, key, ksize, vsize, hash, eq, &g); + if (at >= 0) { + /* Replace. The key already in the block compares equal to the one handed + * in, so it is left alone: overwriting it would be a no-op for every + * bytewise key and a question nobody has asked for the others. */ + if (vsize > 0) + flan_copy_small( + flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, at), val, vsize); + return 1; + } + + if (!m->data || m->len + 1 > flan_map_threshold(m)) + if (!flan_map_grow(m, m->len + 1, ksize, vsize, hash)) return 0; + + { + void *xfer = NULL; + h = hash(key, flan_map_seed(m), ksize, &xfer) | FLAN_MAP_OCCUPIED; + } + flan_map_place(m, h, key, val, ksize, vsize); + m->len++; + return 1; +} + +/* Lookup. The value is copied out into [out] — the first Map implementation + * admits copyable keys and values only, so get returns a copy — and the answer + * is 1/0 for found, which the compiler turns into Some/None. */ +int8_t flan_map_get(flan_map *m, const void *key, void *out, int64_t ksize, + int64_t vsize, flan_hash_fn hash, flan_eq_fn eq, + const uint8_t *loc, int64_t loclen) { + int64_t at; + flan_map_geom g; + flan_map_check(m, loc, loclen); + /* The geometry the probe already built, rather than a second helping of the + * same arithmetic: it was a fifth of the operation, computed twice. */ + at = flan_map_find_g(m, key, ksize, vsize, hash, eq, &g); + if (at < 0) return 0; + if (vsize > 0) + flan_copy_small( + out, flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, at), vsize); + return 1; +} + +int8_t flan_map_has(flan_map *m, const void *key, int64_t ksize, int64_t vsize, + flan_hash_fn hash, flan_eq_fn eq, const uint8_t *loc, + int64_t loclen) { + flan_map_check(m, loc, loclen); + return (int8_t)(flan_map_find_g(m, key, ksize, vsize, hash, eq, NULL) >= 0); +} + +int64_t flan_map_len(flan_map *m, const uint8_t *loc, int64_t loclen) { + flan_map_check(m, loc, loclen); + return m->len; +} + +/* Room for [n] entries without reallocating, which means a block whose 75% + * threshold is at least n. */ +int8_t flan_map_reserve(flan_map *m, int64_t n, int64_t ksize, int64_t vsize, + flan_hash_fn hash, const uint8_t *loc, int64_t loclen) { + flan_map_check(m, loc, loclen); + if (n <= 0) return 1; + if (m->data && n <= flan_map_threshold(m)) return 1; + return flan_map_grow(m, n, ksize, vsize, hash); +} + +/* spec-memory.md's first release point, and the same rules the Vec's free + * follows: left zeroed rather than dangling, and an allocator without can-free + * keeps the block because releasing it is free-all's job. */ +void flan_map_free(flan_map *m, int64_t ksize, int64_t vsize, + const uint8_t *loc, int64_t loclen) { + flan_map_check(m, loc, loclen); + if (m->data && m->alloc && (m->alloc->caps & FLAN_CAN_FREE)) + m->alloc->proc(m->alloc, FLAN_ALLOC_FREE, m->data, + flan_map_block_size(ksize, vsize, flan_map_cap(m)), 0, + FLAN_MAP_CACHE_LINE); + m->data = NULL; + m->len = 0; + m->log2cap = 0; + m->alloc = NULL; + m->gen++; + m->epoch = 0; +} + +/* A deep, independent copy. It reinserts rather than copying the block: the + * seed is derived from the block address, so a bytewise copy would be a map + * whose stored hashes disagree with its own seed and whose every lookup + * missed. Reinserting is also what makes the copy's layout independent of the + * original's insertion history. */ +int8_t flan_map_clone(flan_map *dst, flan_map *src, flan_allocator *a, + int64_t ksize, int64_t vsize, flan_hash_fn hash, + const uint8_t *loc, int64_t loclen) { + flan_map_geom g; + int64_t cap, i, moved; + void *xfer = NULL; + flan_map_check(src, loc, loclen); + if (!flan_map_init(dst, a, ksize, vsize, loc, loclen)) return 0; + if (!src->data || src->len == 0) return 1; + if (!flan_map_grow(dst, src->len, ksize, vsize, hash)) return 0; + + cap = flan_map_cap(src); + flan_map_geometry(src, ksize, vsize, cap, &g); + moved = src->len; + for (i = 0; i < cap && moved > 0; i++) { + uint64_t h; + if (g.hs[i] == 0) continue; + h = hash(flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i), + flan_map_seed(dst), ksize, &xfer) | FLAN_MAP_OCCUPIED; + flan_map_place(dst, h, flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i), + flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, i), + ksize, vsize); + dst->len++; + moved--; + } + return 1; +} + /* ── The filesystem, and the whole of what it adds to the host ABI ─── * * plan.org names the filesystem as the #1 portability risk — "pack assets, one diff --git a/test/programs/map-exhausted.flan b/test/programs/map-exhausted.flan new file mode 100644 index 0000000..4ca6e2e --- /dev/null +++ b/test/programs/map-exhausted.flan @@ -0,0 +1,82 @@ +;;;; StorageExhausted and retry, over a Map — spec-memory.md, "Allocation +;;;; failure". The rule is one rule over *every* allocating operation, so it has +;;;; to hold for map-new, put, reserve and clone exactly as exhausted.flan shows +;;;; it holding for vec-new, push, reserve and clone. put stays Unit, clone +;;;; stays the container, and no signature anywhere grows a Result. +;;;; +;;;; A map is the harder case of the two, and that is why it gets its own +;;;; program. A Vec's failing allocation leaves the Vec untouched. A map's +;;;; growth allocates a whole new block, rehashes into it and only then +;;;; releases the old one — so a failure partway must leave the map exactly as +;;;; it was, or the retry re-attempts against a half-moved map. + +;; Globals, because a handler cannot see the locals of the function that +;; established it. +(defvar tight Allocator) +(defvar failures i64) +(defvar last-bytes i64) +(defvar same-allocator bool) + +(defn main [] i32 + (set tight (heap-allocator)) + ;; Enough for the smallest block and not for the one after it. A map's block + ;; is keys, values, hashes and scratch, each rounded to a cache line, so it + ;; is a few hundred bytes at eight slots — the ceiling has to be low enough + ;; to be hit and high enough that the first block fits after one raise. + (set-alloc-budget tight 64) + + (handler-bind + [(StorageExhausted [c] + (set failures (+ failures 1)) + (set last-bytes (.bytes c)) + (set same-allocator (= (.allocator c) (alloc-id tight))) + ;; Raise the ceiling and re-attempt the same request. The map is + ;; untouched and its allocator is unchanged, which is why this can + ;; succeed — releasing the region instead would invalidate the map, + ;; which is what the epoch check catches and is its own program. + (set-alloc-budget tight (* 4 (alloc-budget tight))) + (invoke-restart 'retry))] + (let [m (map-new i32 i64 tight)] + ;; Several grows, each one a fresh block rehashed into. A put that fails + ;; puts nothing, and the retry puts exactly once — so no entry is lost + ;; and none is doubled. + (dotimes [i 300] (put m i (* (i64 i) 7))) + (println (len m)) ; 300 + (let [bad 0] + (dotimes [i 300] + (match (get m i) + (Some v) (if (not (= v (* (i64 i) 7))) (set bad (+ bad 1))) + None (set bad (+ bad 1)))) + (println bad)) ; 0 + (free m))) + + (println (> failures 1)) ; true + (println (> last-bytes 0)) ; true + (println same-allocator) ; true + + ;; reserve asks for the whole block at once, and clone asks the new allocator + ;; for one big enough to hold the source — both are allocating operations and + ;; neither returns an error. + (set-alloc-budget tight 64) + (set failures 0) + (handler-bind + [(StorageExhausted [c] + (set failures (+ failures 1)) + (set-alloc-budget tight (* 8 (alloc-budget tight))) + (invoke-restart 'retry))] + (let [m (map-new string i32 tight)] + (reserve m 200) + (println (len m)) ; 0 + (put m "a" 1) + (put m "b" 2) + (let [w (clone m)] + (println (len w)) ; 2 + (match (get w "b") + (Some v) (println v) ; 2 + None (println "missing")) + (free w)) + (free m))) + (println (> failures 0)) ; true + + (set-alloc-budget tight 0) + 0) diff --git a/test/programs/map-stale-region.flan b/test/programs/map-stale-region.flan new file mode 100644 index 0000000..ec39ece --- /dev/null +++ b/test/programs/map-stale-region.flan @@ -0,0 +1,25 @@ +;;;; spec-memory.md, "Dev builds detect a released region" — the Map's half. +;;;; +;;;; A Map records the epoch of the allocator it was made with, exactly as a +;;;; Vec does, and free-all bumps that counter. Any operation on a container +;;;; whose recorded epoch has moved traps, naming the site. +;;;; +;;;; This is worth its own program rather than a line in stale-region.flan +;;;; because the two containers reach the check by different routes: a Vec's +;;;; every operation takes the Vec's address and checks on the way in, while a +;;;; map's get goes on to call a hash and an equality function through pointers +;;;; into a block that is no longer there. If the check were missing here, the +;;;; failure would not be a wrong number — it would be a probe loop walking +;;;; released memory. +(defn main [] i32 + (let [a (arena-new 65536)] + (let [m (map-new i32 i32 a)] + (put m 1 10) + (put m 2 20) + (match (get m 2) (Some v) (println v) None (println "missing")) + ;; The region goes. m is still in scope and still looks fine — nothing is + ;; released at scope exit and nothing marked m — which is exactly the + ;; case a static rule cannot see. + (free-all a) + (match (get m 2) (Some v) (println v) None (println "missing")))) + 0) diff --git a/test/programs/maps.flan b/test/programs/maps.flan new file mode 100644 index 0000000..0b917a8 --- /dev/null +++ b/test/programs/maps.flan @@ -0,0 +1,129 @@ +;;;; (Map K V) — spec-memory.md, step 4 of the container build order. +;;;; +;;;; Odin's map: open-addressed Robin Hood hashing at a 75% load factor, with +;;;; cache-line cell packing. Every claim below is one a plausible wrong +;;;; version gets wrong, and the numbers differ per failure so a single wrong +;;;; answer names its own cause. +(defstruct Cell [x i32 y i32]) +(defstruct Named [tag string n i32]) +(defenum Suit [hearts 0 spades 1 clubs 2]) + +;;;; (8) A map crosses a function boundary in both directions. Returning one +;;;; and passing one are both *moves* — the same rule a Vec follows, so the +;;;; binding is dead afterwards — and the 48-byte header travels by value while +;;;; every runtime operation takes its address. Nothing else in this file +;;;; leaves a single let, so nothing else would notice if it did not. +(defstruct Cell2 [x i32 y i32]) + +(defn make-grid [] (Map Cell2 i32) + (let [m (map-new Cell2 i32)] + (put m (Cell2 {.x 1 .y 2}) 12) + (put m (Cell2 {.x 3 .y 4}) 34) + m)) + +;; Takes the map, which is a move: this owns it now, and frees it. +(defn consume-grid [m (Map Cell2 i32)] i32 + (let [n (len m)] + (free m) + n)) + +(defn main [] i32 + ;; (1) An integer key past several grows. The map starts at 8 slots, so 2000 + ;; entries is eight reallocations, and every one of them rehashes against a + ;; fresh seed — the seed is derived from the block address, so carrying the + ;; old hashes over would put every entry in the wrong slot. A wrong grow + ;; shows up as a non-zero second number, not as a crash. + (let [m (map-new i32 i64)] + (dotimes [i 2000] + (put m i (* (i64 i) 3))) + (print (len m)) (println "") ; 2000 + (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 "")) ; 0 + (free m)) + + ;; (2) A struct key. The compiler emits a hash and an equality pair for Cell + ;; and walks it field by field, so the padding a struct may carry is never + ;; read — bytewise hashing of a padded struct is the failure this covers, and + ;; it would show as entries that cannot be found again. + (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 "") ; 1600 + (match (get g (Cell {.x 7 .y 9})) + (Some v) (do (print v) (println "")) ; 709 + None (println "missing")) + (print (has-key? g (Cell {.x 39 .y 39}))) (println "") ; true + (print (has-key? g (Cell {.x 40 .y 0}))) (println "") ; false + (free g)) + + ;; (3) A struct key holding a string. The string field hashes its *bytes*, so + ;; two equal strings at different addresses find the same entry; hashing the + ;; ptr+len pair bytewise instead would make every lookup here miss. + (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 "") ; 3 + (match (get n (Named {.tag "alpha" .n 2})) + (Some v) (do (print v) (println "")) ; 20 + None (println "missing")) + (print (has-key? n (Named {.tag "alpha" .n 3}))) (println "") ; false + (free n)) + + ;; (4) An enum key, which is an i32 at run time but its own type here. + (let [s (map-new Suit i32)] + (put s :hearts 1) + (put s :clubs 3) + (print (len s)) (println "") ; 2 + (match (get s :clubs) + (Some v) (do (print v) (println "")) ; 3 + None (println "missing")) + (print (has-key? s :spades)) (println "") ; false + (free s)) + + ;; (5) clone is a deep, independent copy — spec-memory.md, "copying is always + ;; explicit". A map's clone reinserts rather than copying the block, because + ;; the seed moves with the address; a bytewise copy would be a map whose + ;; stored hashes disagree with its own seed and whose every lookup missed. + (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 "?")) ; 100 + (match (get b 1) (Some v) (do (print v) (println "")) None (println "?")) ; 999 + (print (len b)) (println "") ; 2 + (free b)) + (free a)) + + ;; (6) Upsert replaces and does not grow the length, and reserve means room + ;; for n *entries* — n still under the load factor — not n slots. + (let [u (map-new string i32)] + (reserve u 100) + (put u "k" 1) + (put u "k" 2) + (put u "k" 3) + (print (len u)) (println "") ; 1 + (match (get u "k") (Some v) (do (print v) (println "")) None (println "?")) ; 3 + (free u)) + + ;; (7) A map lives in an arena as happily as on the heap. The arena cannot + ;; free, so free keeps the block — releasing it is free-all's job — and + ;; nothing here may read the block back after the region is reset. + (let [ar (arena-new 1048576)] + (with-allocator ar + (let [t (map-new i32 i32)] + (dotimes [i 500] (put t i (* i 2))) + (print (len t)) (println "") ; 500 + (match (get t 499) (Some v) (do (print v) (println "")) None (println "?")))) ; 998 + (free-all ar)) + + (let [g (make-grid)] + (print (len g)) (println "") ; 2 + (print (consume-grid g)) (println "")) ; 2 + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 0b061ec..8ca995a 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -581,6 +581,25 @@ let () = end; (try Sys.remove exe with Sys_error _ -> ()); + (* The same trap on the Map's side, and it is not the same code path: a + Vec's operations check on the way in and stop there, while a map's get + goes on to call a hash and an equality function through pointers into + the block. A missing check here is not a wrong number, it is a probe + loop walking released memory. *) + let exe = compile "programs/map-stale-region.flan" in + let code, text = run exe None in + if code <> 134 || not (contains text "programs/map-stale-region.flan:") + || not (contains text "allocator was released") + || not (contains text "20") + then begin + incr failures; + Printf.printf + "FAIL a map used after its region was released\n\ + \ got: %S (exit %d)\n wanted: exit 134, naming the site\n" + text code + end; + (try Sys.remove exe with Sys_error _ -> ()); + (* §2's other half, which cannot be an [outputs] case because it does not exit 0: a handler runs, returns normally, and has still not answered the error, so the program stops and names the condition. *) @@ -1564,6 +1583,66 @@ ERR@7 unexpected token: not the kind the caller was reading refuses_src "defer in a let inside a branch" "(defn g [] 0)\n(defn f [] (if true (let [x 1] (defer (g))) 0))" "not allowed inside a branch"; + + (* ── (Map K V), spec-memory.md step 4 ────────────────────────── + + Odin's map: open-addressed Robin Hood hashing at a 75% load factor with + cache-line cell packing. maps.flan is seven claims, each one a plausible + wrong version gets wrong, and the numbers differ per failure. + + The two worth naming, because nothing else in the suite would catch + them. A struct key is hashed *field by field*, never bytewise, because a + struct's padding bytes are indeterminate — hashing them makes two equal + keys hash differently and the entry unfindable, which shows up here as a + wrong count rather than a crash. And a grow rehashes against a fresh + seed, because the seed is derived from the block address; carrying the + old hashes across a grow puts every entry in a slot nothing will probe. + 2000 entries is eight grows and then every one of them read back. *) + let maps_out = + "2000\n0\n1600\n709\ntrue\nfalse\n3\n20\nfalse\n2\n3\nfalse\n\ + 100\n999\n2\n1\n3\n500\n998\n2\n2\n" + in + outputs "maps" "programs/maps.flan" maps_out; + outputs ~opt:"-O0" "maps, -O0" "programs/maps.flan" maps_out; + (* A dev build, because the hash and equality pair emitted for a struct key + is a function nobody wrote and the only other inhabitant of that list — + a lifted handler clause — carries a parent this one cannot: the pair is + shared by every function that maps that key type. A dev build puts every + body behind an indirection cell, so it is the build that would notice. *) + outputs ~dev:true "maps, dev" "programs/maps.flan" maps_out; + + (* The allocation-failure rule is one rule over every allocating operation, + so it has to hold for map-new, put, reserve and clone as it does for the + Vec's four. A map is the harder case: its growth allocates a new block, + rehashes into it and only then releases the old one, so a failure + partway must leave the map exactly as it was or the retry re-attempts + against a half-moved map. *) + let map_exhausted_out = "300\n0\ntrue\ntrue\ntrue\n0\n2\n2\ntrue\n" in + outputs "map StorageExhausted and retry" "programs/map-exhausted.flan" + map_exhausted_out; + + (* The refusals, each by name. A float key is not a milestone question — + NaN is not equal to itself and 0.0 and -0.0 are equal while differing + bytewise, so there is no equality for a map to hash. A move-only value + is the refusal (Vec (Vec T)) already carries, for the identical reason. + Unit as a value is refused rather than dividing a cache line by zero, + and it is named because it is the natural spelling of a set. *) + refuses_src "a float is not a map key" + "(defn f [m (Map f32 i32)] 0)" "is not a map key"; + refuses_src "a Ptr is not a map key" + "(defn f [m (Map (Ptr i32) i32)] 0)" "hash an address"; + refuses_src "a map value may not own storage" + "(defn f [m (Map i32 (Vec i32))] 0)" "holds a move-only value"; + refuses_src "a map value may not be Unit" + "(defn f [m (Map i32 Unit)] 0)" "cannot be Unit"; + refuses_src "map-new with nothing to say what it maps" + "(defn main [] i32 (let [m (map-new)] (free m)) 0)" + "nothing here says what (map-new) maps"; + (* A map is move-only like a Vec, and the refusal names the type that was + moved rather than saying "a Vec" whatever it was. *) + refuses_src "a map used after it was moved" + "(defn main [] i32 (let [m (map-new i32 i32)] (free m) (put m 1 2)) 0)" + "cannot be used again"; let signed_out = "-4\n-1\nbig is not small\nbig is large\n1\n" in outputs "signedness" "programs/signedness.flan" signed_out; outputs ~opt:"-O0" "signedness, -O0" "programs/signedness.flan" signed_out; diff --git a/test/test_flan.ml b/test/test_flan.ml index d07e4d7..e181819 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -714,8 +714,13 @@ let () = back as generics. *) rejects_check "Vec takes one type" "(defn f [x (Vec i32 i32)])" ~needle:"exactly one type"; - rejects_check "Map is milestone 6" "(defn f [x {string i32}])" - ~needle:"milestone 6"; + (* {K V} resolves now — it is the Map type spelling, and the only one, since + a bare map form in expression position is a struct literal's field list. + What is still refused is the arity, for the same reason Vec's is: a + near-miss would otherwise resolve to a type variable and come back as + generics. *) + rejects_check "Map takes two types" "(defn f [x (Map i32)])" + ~needle:"exactly two types"; rejects_check "Result is milestone 6" "(defn f [] (Result i32 i32) None)" ~needle:"milestone 6"; rejects_check "try is milestone 6" "(defn f [] i32 (try 1))"