JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'worktree-agent-afcd2406f3660629b' into worktree-agent-ab63ab2e0656f837e

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 14:22:33 +07:00
commit 70e19753dd
11 changed files with 1056 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

334
SPIKE-GENERICS.md Normal file
View File

@ -0,0 +1,334 @@
# The generics spike, answered: it runs, and the bill lands on the dev loop rather than on the checker
Milestone 5's parametric polymorphism, run early and deliberately out of order, as a spike rather than as a
decision. **Feasible, and smaller than expected.** A generic function written in Flan goes through the ordinary
frontend, is instantiated at each concrete type its call sites ask for, is emitted as real functions and runs,
answering correctly at every one of them. The whole of it is `lib/check.ml`; `lib/types.ml`, `lib/tast.ml`,
`lib/emit.ml` and every backend are untouched, and `dune test --root .` is green (203 checks, 0 failures) either
side of it.
The demonstrations are `spike/generics/*.flan` and are run with the ordinary driver —
`dune exec --root . bin/main.exe -- run spike/generics/sort.flan`. The measurement is `spike/generics/measure.ml`,
driven by `bash spike/generics/run.sh` with ocamlfind against the `flan.cmxa` dune already builds, exactly as
`spike/backend` is and for the same reason: nothing under `spike/` is wired into the build.
**The headline is not that it works.** It is that the two costs everyone expects to be the problem — checking and
instantiating — are under the noise floor, and the cost that is real is one nobody named: `C-c C-c` on a generic
function today **silently installs nothing**, and making it install something multiplies the part of the dev loop
that was already the slowest. Measured below.
## The sigil, since it changed under the spike
plan.org says lowercase is a type variable and there is no sigil. That was revised while this was being built, and
this is built against the revision: **`$t` at the binding site, bare `t` at every use**, which is Odin's spelling
(`$T` in the signature, `T` in the body).
```lisp
(defn swap! [xs [$t] i i32 j i32] () ...) ; $t binds
(defn fold [s [$t] init $t f (Fn [$t $t] $t)] t ...) ; later $t are the same variable; t reads it
```
Both spellings are accepted at a use — `resolve_name` strips the sigil before it looks anything up — because that
is one `String.sub` and refusing the sigil at a use would be a second rule to explain. The binding rule is the one
that is enforced: **only a `defn` signature introduces a variable**, and `$t` anywhere else (a struct field, a
global, a `let` annotation) is a refusal that says so.
The decision costs one function and one `match` arm, both in `check.ml`. The reader already treats `$` as an
ordinary symbol character, so `$t` arrives as `Ast.Tname "$t"` with no change to `reader.ml`, `parse.ml` or
`ast.ml`, and changing the sigil to anything else is changing one character in `resolve_name` and one in
`signature_tyvars`. Nothing else in the compiler knows the character means anything.
The revision's reasoning holds up in the code. `signature_tyvars` scans for the sigil and puts the bare names in
`env.tyvars`; `resolve_name` consults that list and nothing else. So an unknown lowercase type name is still the
unknown-type error it always was, and the old rule's failure mode — a mistyped type name silently becoming a type
parameter, making the function *more* permissive than it was written to be — cannot happen. The near-miss guard at
`check.ml:553` stays where it is and keeps `f65` a typo.
## Question 1 — does it work end to end
Yes, at four shapes, all of them run and checked against their output.
**One variable, one function, two types** (`spike/generics/id.flan`):
```lisp
(defn id [x $t] t x)
(defn main [] ()
(println (id 3)) (println (id 4.5)) (println (id 7)) (println (id true)))
```
prints `3 / 4.5 / 7 / true`, and emits exactly three bodies — `flan.id-i32`, `flan.id-f64`, `flan.id-bool`. Four
calls, three copies: `(id 3)` and `(id 7)` share one, which is the instantiation cache doing its job.
**Through a slice, mutating in place** (`spike/generics/swap.flan`): `(defn swap! [xs [$t] i i32 j i32] () ...)`
called at `[i32]` and `[f64]`, correct both times. The variable is bound *inside* a type constructor here, which
is the `is_polymorphic_type_assignable` walk rather than a name match.
**The one that matters — a generic calling a generic, with the operator passed in** (`spike/generics/sort.flan`):
```lisp
(defn swap! [xs [$t] i i32 j i32] () ...)
(defn sort-by! [s [$t] before? (Fn [$t $t] bool)] ()
(let [i 1]
(while (< i (len s))
(let [j i]
(while (and (> j 0) (before? (at s j) (at s (- j 1))))
(swap! s (- j 1) j)
(set j (- j 1))))
(set i (+ i 1)))))
(defn main [] ()
(let [ns [5 3 9 1] fs [2.5 0.5 1.5]]
(sort-by! (slice ns 0 4) (fn [a b] (< a b)))
(sort-by! (slice fs 0 3) (fn [a b] (> a b)))
...))
```
prints `1 3 5 9` then `2.5 1.5 0.5`, and emits four bodies: `sort-by!-i32`, `sort-by!-f64`, `swap!-i32`,
`swap!-f64`. This is prelude.ml's `sort-i32-by!`/`sort-f32-by!` pair, collapsed, running. Note what had to work
for it: `sort-by!` calls `swap!` at its *own* variable `t`, so the copy of `swap!` is generated when `sort-by!`
is instantiated and not before — instantiation is transitive.
It also forced the one piece of real inference in the spike. Arguments are checked left to right and **each
binding is substituted back into the parameters still to come**, so by the time `(fn [a b] (< a b))` is reached,
`(Fn [$t $t] bool)` has already become `(Fn [i32 i32] bool)` and the literal has the position it needs to take
its types from. Without that the `fn` literal has no types and the call does not check. This is the same
left-to-right operand order Odin gathers its operands in.
**Two variables** (`spike/generics/two-vars.flan`) was out of scope and fell out for free: `(defn fst [a $t b $u]
t a)` at three combinations works, because the substitution is a list and was never written as a single binding.
**The refusal.** `(defn add2 [a $t b $t] t (+ a b))` is rejected *at the definition*, before any call site:
```
spike/generics/reject.flan:1:26: + over the type variable t is refused: an unconstrained type variable supports
only what every type supports, and + is not that (plan.org, Types). Take the operation as a parameter — a
(Fn [t t] ...) — and call it here
1 | (defn add2 [a $t b $t] t (+ a b))
| ^^^^^^^
```
`=` and `<` get the same refusal from the same place. This is what `sort-by!` above is the positive case of: the
comparison it cannot have is the comparison it is given.
## Question 2 — where instantiation belongs in this pipeline
**In the checker, at the call site, which is where Odin puts it.** `check_expr.cpp`'s
`find_or_generate_polymorphic_procedure` runs from call checking: it builds the concrete proc type from the
operands, scans the base entity's `gen_procs` for an `are_types_identical` match, and generates a new `Entity`
only on a miss. `check.ml`'s `generic_call` and `instantiate` are that loop, with `Types.equal` pairwise standing
in for `are_types_identical`.
It belongs there and nowhere else for a reason specific to this pipeline: the call site is the only place the
concrete types exist, and it is the same argument `check.ml` already makes for `SizeOf`/`AlignOf` ("the checker
builds these at the site where the concrete element type is known"). A pass after checking would have to re-derive
every argument type it had just thrown away; a pass before it has nothing to work with.
**What that means for `Tast`: a generic `defn` does not reach the typed IR at all.** Only its instantiations do.
Concretely:
- `collect` puts a generic signature in a new `gsigs` table and **not** in `env.fns`. Nothing can be called at
`t`, so nothing may find it by the ordinary path.
- `build_program`'s pass-two fold skips generic `defn`s. They produce no `Tast.fn`.
- Each instantiation is an ordinary `Tast.fn` appended to the program next to the handler clauses `env.lifted`
already collects, with `fparent = None` — unlike a lifted clause it is reached *by name* from arbitrary call
sites, so it needs a cell, and it gets one automatically: `flan.cell.sort-by!-i32` is in the `--dev` output with
no change to `emit.ml`.
- `Tast` is unchanged. `Types.Var` already existed, and after instantiation no node carries one.
The naming convention is the prelude's own: `id-i32`, `sort-by!-f64`, `keep-i32`, and for constructed types
`slice-i32`, `vec-f32`, `opt-i64`, `arr8-u8`. A generated name reads like the handwritten one it replaces, which
is what a backtrace, a `Reach` edge and a dev-build cell all end up showing. `Types.to_string` cannot serve —
`[i32]` and `(Vec i32)` are not symbols — so there is a second spelling function, `mangle_ty`, and it is a
namespace hazard: see the "no plan" bucket.
## Question 3 — the cost to the dev loop, measured
This is the question the spike exists for, and the answer has two halves: the half that is free, and the half
that is not implemented and will not be free.
`spike/generics/run.sh` sweeps one generic pair (`gswap` + `gsort`, the insertion sort above) called at N distinct
element types, N = 1..8, against the handwritten N-copies program it would replace. Best of three per cell, on an
otherwise idle machine:
```
n check-gen check-mono emit-1 emit-N build-1 build-N fns
1 1.8 1.8 0.1 0.1 19.0 21.3 2
2 1.8 1.8 0.1 0.3 19.6 24.7 4
3 1.9 1.6 0.1 0.4 19.2 28.1 6
4 1.9 1.9 0.1 0.4 18.5 31.9 8
5 2.1 2.1 0.1 0.6 19.3 35.9 10
6 1.8 1.9 0.1 0.7 18.8 39.1 12
7 2.0 1.8 0.1 0.8 18.6 41.9 14
8 1.8 2.0 0.1 0.8 19.0 45.1 16
```
`check-*` is `Check.program_with_env` over the whole accumulated program, which is what `Session.eval` does on
**every** evaluation. `emit-*` is `Emit.redefinition`. `build-*` is `Build.shared` — llc + `ld -shared` — with the
same options `dev.ml` passes (`dev = true`, `-O2`). Under load every column scales by about 3×; the ratios hold.
Read off it:
1. **Checking a generic program costs what checking the handwritten one costs.** 1.8 ms either way, flat in N.
Instantiation — matching, substituting, cache scan, and checking each copy's body — does not show above the
noise, because whole-program checking is dominated by the 1665-line prelude. The instantiation cache is rebuilt
from scratch on every `C-c C-c`, since `Check.program_with_env` makes a fresh `env`, and that is affordable:
there is no persistent cache to invalidate and therefore no staleness to get wrong.
2. **Emitting is free.** 0.1 ms for one body, 0.8 ms for sixteen.
3. **`llc` + `ld` is the whole bill, and it is per body.** 19 ms for one, 45 ms for sixteen — about **+1.7 ms per
extra body**, roughly linear. A redefinition module with one function is ~19 ms; the same redefinition of a
generic used at 8 element types is ~45 ms.
**What the 19 ms is and is not.** It is `Build.shared` alone: `llc` plus `ld -shared`. The ~35 ms the brief
quotes for `C-c C-c` is the whole round trip, and `dev.ml:446` pays several things around this call that are not
in it — `Session.eval`'s read/parse/Load/check (the 1.8 ms column), writing the `.ll` and the `.o`, `deliver` and
the `dlopen` at a frame boundary, and the wire exchange with the editor. So the two numbers are not in conflict;
they are measuring different brackets, and the ~16 ms between them is the part this spike does not change.
**The marginal number is the one that transfers, and it is invariant to which baseline it is added to: +1.7 ms
per extra body.** In the terms the brief asks for: a generic used at two element types adds about 3.5 ms to a
~35 ms loop (one generic that calls another, so four bodies rather than two — 10%); at three types, ~7 ms; at
eight types, ~26 ms, which is a loop of ~61 ms rather than ~35. It stays well under the "redefine a whole file"
cost and is proportional to what changed rather than to the size of the program.
**And the half that is not implemented.** The last line of the sweep is the finding:
```
Session.eval on the generic gswap itself: 2.5 ms, installs=false, fns=[], names=[gswap]
```
`session.ml:eval` computes `fns` as the names in the incoming form that appear in `program.Tast.fns`. A generic
`defn` is not in `Tast.fns` — by design, per question 2 — so `fns` is empty, `installs` is false, and the editor
is told nothing was installed. **Today, `C-c C-c` on a generic function is a no-op that does not lie about it but
does not do anything either.** The fix is not in this lane (`session.ml` is held elsewhere) and is small in
principle: expand a redefined generic name to its instantiations, transitively through generics that call it, and
pass *those* to `Emit.redefinition`. The cells already exist. The cost of doing so is the table above.
Two things that cost nothing and are worth having in writing: the compatibility check (`Session.compatible`) sees
instantiations as ordinary functions and compares their signatures as it always did; and a generic whose
*signature* changes produces differently-named instantiations, so the old ones stay in the process with nothing
calling them — dead, not stale.
## Question 4 — what the whole feature would have to lower
Against what a generic function has to survive, in DISCUSS.md item 15's buckets:
| | |
|---|---|
| **Done in the spike** | one or more type variables in a signature; binding through `[t]`, `(Ptr t)`, `(Option t)`, `(Fn [t] t)` and nesting; return types mentioning a variable; left-to-right binding with substitution into later parameters so an `fn` literal gets its types; the Odin-keyed instantiation cache; generic calling generic, transitively; `(vec-new t)`; the abstract refusal pass for `+`, `-`, `*`, `/`, `%`, `=`, `!=`, `<`, `<=`, `>`, `>=`, the bitwise operators and the shifts; instantiations as ordinary `Tast.fn`s with dev cells and `Reach` edges for free; a depth cap so runaway instantiation refuses instead of hanging |
| **Mechanical** | the remaining builtins that take a *type name* as an argument — `pool-new`, `map-new`, `zeroed`, `uninit`, the casts — each of which reaches `type_named`/`resolve_name` by its own path, exactly as `vec-new` did (one line there fixed `vec-new`; the others are one line each); `hash` and the map key-pair path, which must refuse a `Var` rather than assume; the `fns` expansion in `session.ml` described above |
| **Bulky, not hard** | error messages that say *where* an instantiation came from — Odin's "in instantiation of" note. Today a refusal inside an instantiated body points at the generic's source with no indication which call site asked for that type, and with three or four instantiations that is the difference between a readable refusal and a puzzle. It is a context stack in `ctx` and a `Loc.note` per frame, and it touches every `fail` under an instantiation |
| **Fiddly** | move-only and ownership. `Types.is_move_only (Var _)` is false, but the same variable at `(Vec i32)` is move-only — so the abstract pass **cannot decide ownership at all**, and the dead-set analysis is only sound per instantiation. Today that means a generic body that moves its parameter type-checks abstractly and is caught, if at all, at one instantiation and not another. The rule has to be stated: either ownership is checked only per copy (and the abstract pass skips it, so a generic may be accepted and its instantiation refused), or type variables carry a move-only constraint, which is a constraint system and plan.org says not yet. One smaller thing in the same bucket, found and left alone: the abstract pass over a generic body that calls *another* generic at a concrete type generates that copy and keeps it, so plain `flan emit` can carry a body no call site asked for. It is a valid instantiation and `Reach.link` drops it, so `flan build` and `flan run` are unaffected — but the abstract pass is meant to leave nothing behind and this is the one thing it does |
| **No plan** | (1) **Unbounded instantiation.** `(defn grow [x $t] () (grow [x x]))` asks for a copy at `[2 t]`, which asks for one at `[2 [2 t]]`, forever. Before the cap it did not fail, it *hung* — and since `Session.eval` runs this same code, the thing that hangs is `C-c C-c`, with the dev daemon wedged behind it and no error to show. That is the project's stated priority hanging on three lines of ordinary-looking Flan, so the spike stops it: a depth counter in `env`, refusing past 32 and naming the type it had reached (`spike/generics/runaway.flan`). **The number is arbitrary and the designed refusal — one that names the chain of instantiations rather than the depth it gave up at — is still open.** **Odin has no cap of its own**, so there is no implementation to copy. (2) **Generic structs and containers.** `Types.Named` is a bare string with no parameters, so `(defstruct Pair [a $t b $t])` cannot be spelled at all — a parameterised named type is a change to `Types.t` and therefore to every backend, `Render`, DWARF and the layout calculator. (3) **`println` over a type variable.** plan.org's one compiler-provided exception; the abstract pass rejects it (`no printer for t`), see question 6. (4) **Generics across packages.** `Load` flattens imports into one namespace before checking, so it happens to work here, but a package boundary that is ever a real compilation-unit boundary would need the generic's *body* to cross it — the thing separate compilation cannot do and the reason C++ puts templates in headers |
The "no plan" row's first entry is the one to take seriously: it is not a missing feature, it is a hang, and it is
reachable from three lines of ordinary-looking Flan.
## Question 5 — what collapsing prelude.ml's 34 functions would actually require
Bucketed by what the body needs from the element type, which is readable straight off the sources. `spike/generics/prelude-shapes.flan` is the experiment: the same bodies over `$t`, checked, instantiated and run at `i32`
and `f32`, printing the right answers and emitting `keep-i32`, `fold-i32`, `fold-f32`, `apply!-i32`, `apply!-f32`,
`flip!-i32`, `flip!-f32`.
**Collapse as they are written — nothing but the signature changes.** `swap-i32!`/`swap-f32!`/`swap-bytes!`,
`reverse-i32!`/`reverse-f32!`, `map-i32!`/`map-f32!`, `reduce-i32`/`reduce-f32`, `filter-i32`/`filter-f32`,
`sort-i32-by!`/`sort-f32-by!`. They only move elements, or they already take the operation as a function value.
`filter` is the strongest case and the one that surprised: it allocates — `(vec-new t)`, `push`, returns
`(Vec t)` — and the type-erased container runtime made that work with no changes at all, because `SizeOf`/`AlignOf`
are computed at the instantiation site where the type is concrete. **That is the direct confirmation that
spec-memory.md's type-erased `Vec`/`Map` and monomorphised functions compose**, which is the thing to check before
building either.
**Do not collapse without a signature change.** `sort-i32!`/`sort-f32!`/`sort-bytes!` need `<`;
`index-of-i32`/`index-of-byte` need `=`; `min-i32`/`min-f32`/`max-i32`/`max-f32` need `<`. Under plan.org's
rejection rule every one of them must take the comparison as a `(Fn [t t] bool)` — which means `(sort! xs)`
becomes `(sort-by! xs (fn [a b] (< a b)))` at every call site in the corpus. The functions collapse; the *calls*
get longer. That is the visible cost of "no constraints", and it is a language-ergonomics decision rather than a
compiler one.
**Do not collapse at all, as written.** `sum-i32` returns `i64` and `sum-f32` returns `f64`: each widens its
element with an explicit cast, because there is no implicit widening anywhere in the language. "The wider type
that `t` accumulates into" is not expressible over an unconstrained variable — it is a type-level function, which
is a constraint system or an associated type, and plan.org rules both out for now. A generic `sum` would have to
be `(defn sum [s [$t] init $u add (Fn [$u $t] $u)] u ...)`, at which point it is `reduce` and should just be
`reduce`. Likewise `append-i64!`/`append-f64!`: their bodies are `I64ToBytes` and `F64ToBytes`, two different
primitives, and picking between them per instantiation is exactly the compile-time overloading plan.org says
multimethods are for.
Counted by name, the 27 of the family I could account for split **13 / 9 / 5**:
- 13 collapse cleanly into 6 generics — `swap-i32!` `swap-f32!` `swap-bytes!`, `reverse-i32!` `reverse-f32!`,
`map-i32!` `map-f32!`, `reduce-i32` `reduce-f32`, `filter-i32` `filter-f32`, `sort-i32-by!` `sort-f32-by!`.
- 9 collapse into 4 but change their signatures and every call site — `sort-i32!` `sort-f32!` `sort-bytes!`,
`index-of-i32` `index-of-byte`, `min-i32` `min-f32` `max-i32` `max-f32`.
- 5 do not collapse — `sum-i32` `sum-f32`, `append!` `append-i64!` `append-f64!` — because they are not one
function written twice; they are functions that happen to rhyme.
So the net is on the order of **27 → 15**, not 27 → 6, and the prelude keeps a per-type layer for the numeric
ones.
## Question 6 — what contradicts plan.org
**1. plan.org bundles two decisions that are independent, and the spike had to implement both separately.** It
says parametric polymorphism is "Odin's model", and it says an unconstrained variable's `=`, `<`, `+` and `hash`
are "rejected, not silently instantiated". **Odin does not do the second.** Odin checks a polymorphic body only
per instantiation, so `a + b` over a `$T` compiles there and fails only when — and if — someone instantiates it at
a type without `+`. Getting plan.org's rule instead requires a second pass that type-checks the body with nothing
substituted, which is `check_generic` in this spike: one extra whole-body check per generic `defn`, discarded.
It is cheap and it is worth it, but it is *not* Odin's model and the plan should stop saying it is.
**2. The abstract pass rejects `println` over a type variable**, and plan.org names `println` as "the one
compiler-provided exception: it selects a structural printer at each concrete instantiation". Those two statements
cannot both hold as written: a pass that decides an operator's legality without substituting cannot make an
exception for the one operator whose legality is only decidable after substituting. `(defn show [x $t] () (println
x))` gets `no printer for t` today. The resolution is small but it is a decision, not an oversight: the abstract
pass needs an explicit allow-list of forms it defers to instantiation, `println` being the first member. Every
member of that list is a place where a refusal moves from the definition to a call site, which is exactly what
plan.org's rule was trying to avoid — so the list should stay short and be written down.
**3. The sigil.** Already superseded by the author's revision, and the spike is built to the revision. Recorded
here because plan.org still says "no sigil" and the correction belongs in the record rather than being patched
over: without a binding site there is no way to tell introduction from use, and `check.ml:563` already had the
contradiction in miniature — an unknown *length* name in `[n t]` is an error while an unknown *type* name in the
same brackets became a type parameter.
**4. Ownership is not decidable without the type.** Not contradicted by plan.org, because plan.org does not
mention it; stated here because it is the interaction that will bite. `Types.is_move_only` is a property of the
concrete type, and spec-memory.md's whole dead-set analysis is downstream of it. Every other analysis in the
checker survives abstraction; that one does not.
## `$n` in length position, as asked
Not built, and it does not fall out for free. `(defn rotate [xs [$n i32]] ...)` would let a function be generic
over array length the way Odin's `$N: int` does. The cost, specifically:
- `Ast.len` is `Lint of int64 | Lname of string`, so `$n` parses today as `Lname "$n"` and needs no reader or
parser change — the same free ride the type sigil got.
- But `Types.Array` is `int64 * t`. A length that is a *variable* means either a third case or a `len` type
inside `Types.t`, and `Types.t` is consumed by `emit.ml`'s layout calculator, `x86.ml`, `render.ml`, the DWARF
path and the map key-pair emitter. That is the same "change `Types.t` and every backend" price generic structs
pay, for a smaller prize.
- `bind_ty` gains a length-binding case (`Array (n, p)` against `Array (m, a)` binds `n := m`), `mangle_ty` gains
a number, and `array_len` has to answer "a variable" rather than failing — which means the checker's
compile-time constant folding has to know a length can be symbolic until instantiation.
Everything after the second bullet is the expensive part, and it is expensive for the same reason generic structs
are. If both are wanted, they are one project and should be sequenced together; if only one is, this is the one
to drop.
## Reproducing
`dune test --root .` is green either side of this work. One caveat for anyone reproducing under load:
`test_dev`'s `the daemon never listened` check is timing-sensitive and fails identically at `97cb77d` with
`lib/check.ml` restored from that commit — it is not this lane's. On an idle machine it passes.
```
dune exec --root . bin/main.exe -- run spike/generics/id.flan
dune exec --root . bin/main.exe -- run spike/generics/swap.flan
dune exec --root . bin/main.exe -- run spike/generics/sort.flan
dune exec --root . bin/main.exe -- run spike/generics/two-vars.flan
dune exec --root . bin/main.exe -- run spike/generics/prelude-shapes.flan
dune exec --root . bin/main.exe -- check spike/generics/reject.flan # the refusal
dune exec --root . bin/main.exe -- check spike/generics/runaway.flan # the depth cap
bash spike/generics/run.sh # the sweep
```

412
lib/check.ml
View File

@ -73,6 +73,43 @@ type env = {
because a handler is called from wherever the signal was and cannot be a
branch in the function that established it. *)
mutable lifted : Tast.fn list;
(* ── Generics by monomorphisation (spike, milestone 5) ────────────────
A generic [defn] is *not* in [fns]: its signature mentions type variables
and nothing can be called at it. It lives here, as the AST it was written
as, and every call site turns it into an ordinary function with concrete
types. Odin's model exactly — [find_or_generate_polymorphic_procedure]
keeps the source [Entity] and hangs generated ones off it. *)
generics : (string, Ast.fn) Hashtbl.t;
(* Its signature as *written*: parameter and return types with [Types.Var]
in them. This is the pattern a call site matches its argument types
against to bind the variables. *)
gsigs : (string, string list * Types.t list * Types.t) Hashtbl.t;
(* The instantiation cache. Odin's [gen_procs] list, keyed the way Odin keys
it: a linear scan comparing whole concrete signatures with
[are_types_identical] — here [Types.equal] pairwise. Same types twice
means one copy. *)
insts : (string, (Types.t list * Types.t * string) list ref) Hashtbl.t;
(* The copies themselves, in the order they were generated. They are
ordinary [Tast.fn]s from here down; nothing in a backend knows they were
ever generic. *)
mutable instances : Tast.fn list;
(* The type variables in scope while a generic signature is being resolved.
Empty everywhere else, which is what keeps the lowercase rejection at
[resolve_name] the default. *)
mutable tyvars : string list;
(* What each of them is bound to while one instantiation's body is checked.
[resolve_name] consults it before anything else, so the body resolves
[t] to [i32] and every node under it is concrete. *)
mutable subst : (string * Types.t) list;
(* How many instantiations deep the checker is. A generic that calls itself
at a *larger* type — [(defn grow [x $t] () (grow [x x]))] — asks for a
copy at [[2 t]], which asks for one at [[2 [2 t]]], forever. Without this
the checker does not fail, it hangs, and since [Session.eval] runs the
same code that is the editor hanging with the daemon wedged behind it.
Odin has no cap of its own to copy; the number is arbitrary and the
refusal that names the chain is still to design. *)
mutable depth : int;
}
let new_env () = {
@ -87,6 +124,13 @@ let new_env () = {
fns = Hashtbl.create 32;
globals = Hashtbl.create 16;
lifted = [];
generics = Hashtbl.create 8;
gsigs = Hashtbl.create 8;
insts = Hashtbl.create 8;
instances = [];
tyvars = [];
subst = [];
depth = 0;
}
(* Where a named type was declared, and what it has, as a note.
@ -520,6 +564,33 @@ and near_miss env n =
List.find_opt (fun c -> c <> n && one_edit n c) candidates
and resolve_name env ~seen loc n =
(* ── Type variables, with a sigil at the binding site ─────────────────
[$t] *introduces* a variable and bare [t] uses it, which is Odin's
spelling ([$T] in the signature, [T] in the body). The sigil is read as
an ordinary symbol character, so the whole decision lives here: nothing
in the reader, the parser or the AST knows the character means anything.
Which names are variables is decided before this is ever called —
[signature_tyvars] scans the signature for the sigil and puts the bare
names in [env.tyvars] — so an unknown lowercase name is still the
unknown-type error it always was. That is the point of the sigil: without
one, a mistyped type name silently became a type parameter and made the
function more permissive than it was written to be. *)
let bare = if n <> "" && n.[0] = '$' then String.sub n 1 (String.length n - 1) else n in
match List.assoc_opt bare env.subst with
(* Inside an instantiation: the variable is this concrete type, and every
node checked under it is as concrete as if it had been written out. *)
| Some t -> t
| None ->
if List.mem bare env.tyvars then Types.Var bare
else if n <> bare then
(* A sigil somewhere that is not a [defn] signature: a struct field, a
global, a [let] annotation. There is nowhere for it to bind, so it is
the error rather than a variable with no scope. *)
Loc.failk "check/unbound-type-variable" loc
"%s introduces a type variable, and only a defn signature can — write \
the concrete type here" n
else
match Types.ikind_of_name n with
| Some k -> Types.Int k
| None ->
@ -570,6 +641,139 @@ and array_len env loc = function
fail loc "%s is not a compile-time integer constant, so it cannot be \
an array length" n)
(* ── Generics: the four operations monomorphisation needs ───────────────
Naming a variable, binding one from an argument, substituting the binding
back in, and spelling the result as a symbol. Everything else about the
feature is where these are called from. *)
(* The variables a signature introduces: every [$t] written in it, in the
order written, once each. Only a [defn] signature is scanned, which is what
makes the binding site a *place* and not merely a spelling. *)
let signature_tyvars (fn : Ast.fn) =
let acc = ref [] in
let name loc n =
if n <> "" && n.[0] = '$' then begin
let bare = String.sub n 1 (String.length n - 1) in
if bare = "" then fail loc "$ on its own does not name a type variable";
(* [$i32] would shadow a machine type inside the body and read as one
everywhere else. There is no reason to want it. *)
if List.mem bare Types.primitive_names
|| Types.ikind_of_name bare <> None
|| Types.fkind_of_name bare <> None then
fail loc "%s is a type, so $%s cannot be a type variable" bare bare;
if not (List.mem bare !acc) then acc := bare :: !acc
end
in
let rec ty (t : Ast.texpr) =
match t.Ast.t with
| Ast.Tname n -> name t.Ast.tloc n
| Ast.Tslice e -> ty e
| Ast.Tarray (_, e) -> ty e
| Ast.Tmap (k, v) -> ty k; ty v
(* The head of an application is a constructor — [Ptr], [Option], [Vec] —
and a variable cannot stand there: this spike is generic over types,
not over type constructors. A [$t] inside the arguments is ordinary. *)
| Ast.Tapp (_, args) -> List.iter ty args
| Ast.Tfn (ps, r) -> List.iter ty ps; ty r
in
List.iter (fun (p : Ast.field) -> ty p.Ast.fty) fn.Ast.params;
(match fn.Ast.ret with Some r -> ty r | None -> ());
List.rev !acc
(* Bind the variables in a parameter's written type from the type an argument
turned out to have. Odin's [is_polymorphic_type_assignable], structurally
and with the same rule: a variable already bound must match what it is
bound to, so [(pair 1 2.0)] over [a $t b $t] is a refusal and not a
second instantiation. *)
let rec bind_ty subst (pat : Types.t) (arg : Types.t) =
match pat, arg with
| Types.Var v, a ->
(match List.assoc_opt v !subst with
| None -> subst := (v, a) :: !subst; true
| Some b -> Types.equal a b)
| Types.Slice p, Types.Slice a
| Types.Ptr p, Types.Ptr a
| Types.Vec p, Types.Vec a
| Types.Pool p, Types.Pool a
| Types.Handle p, Types.Handle a
| Types.Option p, Types.Option a -> bind_ty subst p a
| Types.Array (n, p), Types.Array (m, a) -> Int64.equal n m && bind_ty subst p a
| Types.Map (k, v), Types.Map (k', v') ->
bind_ty subst k k' && bind_ty subst v v'
| Types.Fn (ps, r), Types.Fn (ps', r') ->
List.length ps = List.length ps'
&& List.for_all2 (bind_ty subst) ps ps' && bind_ty subst r r'
(* Nothing generic left on the pattern side: this is ordinary type
equality, and [Never] fits anywhere exactly as it does elsewhere. *)
| p, a -> Types.fits ~expected:p ~actual:a
let rec subst_ty subst (t : Types.t) =
match t with
| Types.Var v -> (match List.assoc_opt v subst with Some c -> c | None -> t)
| Types.Slice e -> Types.Slice (subst_ty subst e)
| Types.Array (n, e) -> Types.Array (n, subst_ty subst e)
| Types.Map (k, v) -> Types.Map (subst_ty subst k, subst_ty subst v)
| Types.Ptr e -> Types.Ptr (subst_ty subst e)
| Types.Vec e -> Types.Vec (subst_ty subst e)
| Types.Pool e -> Types.Pool (subst_ty subst e)
| Types.Handle e -> Types.Handle (subst_ty subst e)
| Types.Option e -> Types.Option (subst_ty subst e)
| Types.Fn (ps, r) -> Types.Fn (List.map (subst_ty subst) ps, subst_ty subst r)
| t -> t
(* Does this resolved type still mention a variable? *)
let rec generic_ty (t : Types.t) =
match t with
| Types.Var _ -> true
| Types.Slice e | Types.Array (_, e) | Types.Ptr e | Types.Vec e
| Types.Pool e | Types.Handle e | Types.Option e -> generic_ty e
| Types.Map (k, v) -> generic_ty k || generic_ty v
| Types.Fn (ps, r) -> List.exists generic_ty ps || generic_ty r
| _ -> false
(* The refusal plan.org's Types section asks for, in one place so that every
operator says the same thing: with no constraints a type variable supports
only what *every* type supports, so [=], [<], [+] and [hash] over one are
rejected rather than silently instantiated at whatever type the first call
site happened to use. The way out is the one plan.org names — pass the
operation in as a function value, which is what [sort-i32-by!] already
does with [(Fn [i32 i32] bool)]. *)
let unconstrained loc op (t : Types.t) =
if generic_ty t then
Loc.failk "check/unconstrained-type-variable" loc
"%s over the type variable %s is refused: an unconstrained type \
variable supports only what every type supports, and %s is not that \
(plan.org, Types). Take the operation as a parameter — a (Fn [%s %s] \
...) — and call it here"
op (Types.to_string t) op (Types.to_string t) (Types.to_string t)
(* How a concrete type is spelled inside an instantiation's name. The prelude
already writes this by hand — [filter-i32], [sum-f32], [append-i64] — so a
generated name reads like the handwritten one it replaces, which is what a
backtrace, a [Reach] edge and a dev-build cell all end up showing.
[Types.to_string] cannot serve: [[i32]] and [(Vec i32)] are not symbols. *)
let rec mangle_ty (t : Types.t) =
match t with
| Types.Unit -> "unit"
| Types.Slice e -> "slice-" ^ mangle_ty e
| Types.Array (n, e) -> Printf.sprintf "arr%Ld-%s" n (mangle_ty e)
| Types.Map (k, v) -> Printf.sprintf "map-%s-%s" (mangle_ty k) (mangle_ty v)
| Types.Ptr e -> "ptr-" ^ mangle_ty e
| Types.Vec e -> "vec-" ^ mangle_ty e
| Types.Pool e -> "pool-" ^ mangle_ty e
| Types.Handle e -> "handle-" ^ mangle_ty e
| Types.Option e -> "opt-" ^ mangle_ty e
| Types.Fn (ps, r) ->
Printf.sprintf "fn-%s-to-%s"
(String.concat "-" (List.map mangle_ty ps)) (mangle_ty r)
| t -> Types.to_string t
(* [check_fn] is defined after the expression checker and an instantiation is
made from inside it, so the knot is tied here and closed at the bottom of
the file. One forward reference rather than moving a 90-line function. *)
let check_fn_ref : (env -> Ast.fn -> Tast.fn) ref =
ref (fun _ _ -> assert false)
(* ── Small helpers over the AST ────────────────────────────────────── *)
(* Untyped literals: their machine type comes from context, so when one is an
@ -2512,6 +2716,7 @@ and fold_left_prim ctx ~want loc name p ok what args =
match args with x :: y :: rest -> x, y, rest | _ -> assert false
in
let a, b = binary ctx name loc ~want:(numeric_want want) [ x; y ] in
unconstrained loc name a.Tast.ty;
if not (ok a.Tast.ty) then
fail loc "%s takes %s, found %s" name what (Types.to_string a.Tast.ty);
let ty = a.Tast.ty in
@ -2688,7 +2893,14 @@ and file_guard ctx loc ~path_slot ~op mk_steps =
both callers, so the next kind of type added cannot be added to one of
them. *)
and type_named ctx n =
List.mem n Types.primitive_names
(* A type variable names a type here too, which is what lets [(vec-new t)]
be written in a generic body: inside an instantiation [resolve_name]
answers with the concrete element type, and during the abstract pass it
answers [Var t] and the [Vec] that comes back is a [(Vec t)] — generic,
and refused by anything that needs a size. *)
List.mem n ctx.env.tyvars
|| List.mem_assoc n ctx.env.subst
|| List.mem n Types.primitive_names
|| Hashtbl.mem ctx.env.structs n
|| Hashtbl.mem ctx.env.unions n
|| Hashtbl.mem ctx.env.enums n
@ -2832,6 +3044,7 @@ and named_call ctx ~want loc name args =
| "%" ->
arity loc name 2 args;
let a, b = binary ctx name loc ~want:(numeric_want want) args in
unconstrained loc name a.Tast.ty;
if not (Types.is_numeric a.Tast.ty) then
fail loc "%s takes numbers, found %s" name (Types.to_string a.Tast.ty);
prim Tast.Rem a.Tast.ty [ a; b ]
@ -2851,6 +3064,7 @@ and named_call ctx ~want loc name args =
| "=" | "!=" -> Types.is_equatable a.Tast.ty
| _ -> Types.is_comparable a.Tast.ty
in
unconstrained loc name a.Tast.ty;
if not ok then
fail loc
"%s compares machine numbers; %s has no built-in comparison \
@ -4225,6 +4439,9 @@ and named_call ctx ~want loc name args =
(match lookup ctx name with
| Some b -> call_value ctx ~want loc (mk loc b.bty (Tast.Local b.slot)) args
| None -> assert false)
| _ when Hashtbl.mem ctx.env.gsigs name ->
let vars, params, ret = Hashtbl.find ctx.env.gsigs name in
generic_call ctx ~want loc name vars params ret args
| _ ->
match Hashtbl.find_opt ctx.env.fns name with
| Some (params, ret) ->
@ -4257,6 +4474,131 @@ and named_call ctx ~want loc name args =
(Printf.sprintf "the call %s into an imported package" name) 4
else Loc.failk "check/unknown-function" loc "unknown function %s" name
(* ── A call to a generic function ───────────────────────────────────────
The whole of instantiation, and it is at the call site because the call
site is the only place the concrete types exist. Odin does the same thing
in the same place: [check_expr.cpp]'s
[find_or_generate_polymorphic_procedure] runs from call checking, builds
the concrete proc type from the operands, scans the base entity's
[gen_procs] for an [are_types_identical] match, and generates a new
[Entity] only on a miss. *)
and generic_call ctx ~want loc name vars pats pret args =
if List.length args <> List.length pats then
fail loc "%s takes %d argument%s, given %d" name (List.length pats)
(if List.length pats = 1 then "" else "s") (List.length args);
(* Arguments first, and with no expectation where the parameter's type still
mentions a variable — there is nothing to expect until the argument has
said what it is. So an untyped literal falls to its own default and
[(id 3)] instantiates at i32, which is the one place inference at a
generic call site is weaker than at a monomorphic one.
A variable already bound by an earlier argument is substituted back into
the parameters still to come, so [(sort-by! (slice ns 0 4) (fn [a b] (< a
b)))] works: by the time the [fn] is reached, [(Fn [$t $t] bool)] has
become [(Fn [i32 i32] bool)] and the literal has the position it needs to
take its types from. Left to right, which is the order Odin's operands
are gathered in and the order [map2_lr] already guarantees. *)
let subst = ref [] in
let targs =
map2_lr
(fun p a ->
let p = subst_ty !subst p in
let a = if generic_ty p then check ctx a else check ctx ~want:p a in
if not (bind_ty subst p a.Tast.ty) then
fail a.Tast.loc "%s expects %s here, found %s" name
(Types.to_string p) (Types.to_string a.Tast.ty);
a)
pats args
in
(* Every variable has to be determined by an argument. A return-only
variable has nothing to bind it — there is no explicit instantiation
syntax by design (plan.org) — so it is refused here, where the signature
can be named, rather than producing a copy with a hole in it. *)
List.iter
(fun v ->
if not (List.mem_assoc v !subst) then
fail loc
"%s's type variable $%s is not determined by any argument — a \
generic function is instantiated from its call site, and there is \
no syntax for naming the type" name v)
vars;
let cparams = List.map (subst_ty !subst) pats in
let cret = subst_ty !subst pret in
if List.exists generic_ty cparams || generic_ty cret then
(* One generic function calling another at its *own* variable, seen from
the abstract pass over the caller's body — [sort-by!] calling [swap!]
at [t]. There is no copy to make yet: [t] is not a type. The node is
built so the call still type-checks and is thrown away with the rest of
the abstract pass; the real copy is generated when the caller is
instantiated and the same call site resolves [t] to a concrete type. *)
expect loc ~want (mk loc cret (Tast.Call (name, targs)))
else
let sym = instantiate ctx.env loc name vars !subst cparams cret in
expect loc ~want (mk loc cret (Tast.Call (sym, targs)))
(* Cache or generate, Odin's loop. The key is the whole concrete signature
compared pairwise with [Types.equal] — [are_types_identical] — so calling
at the same type twice makes one copy. *)
and instantiate env loc gname vars subst cparams cret =
let cache =
match Hashtbl.find_opt env.insts gname with
| Some r -> r
| None -> let r = ref [] in Hashtbl.replace env.insts gname r; r
in
let same (ps, r, _) =
List.length ps = List.length cparams
&& List.for_all2 Types.equal ps cparams && Types.equal r cret
in
match List.find_opt same !cache with
| Some (_, _, sym) -> sym
| None ->
let sym =
gname ^ "-"
^ String.concat "-" (List.map (fun v -> mangle_ty (List.assoc v subst)) vars)
in
if Hashtbl.mem env.fns sym then
fail loc
"%s at these types is called %s, and %s is already defined — rename \
one of them" gname sym sym;
(* The entry goes in *before* the body is checked, which is what makes a
recursive generic function terminate: the call to itself at the same
types finds this and does not generate a second copy. *)
if env.depth >= 32 then
fail loc
"%s instantiates itself without end — the copy at (%s) asks for \
another at a larger type, 32 deep and still growing. A generic \
function may call itself, but not at a type built out of its own \
type variable" gname
(String.concat " " (List.map Types.to_string cparams));
cache := (cparams, cret, sym) :: !cache;
Hashtbl.replace env.fns sym (cparams, cret);
let fn = Hashtbl.find env.generics gname in
let saved_subst = env.subst and saved_vars = env.tyvars in
(* Inside the copy there are no variables left: [resolve_name] answers
[t] with the concrete type, so every node the body produces is as
concrete as one written out by hand. *)
env.subst <- List.map (fun v -> (v, List.assoc v subst)) vars;
env.tyvars <- [];
env.depth <- env.depth + 1;
let restore () =
env.subst <- saved_subst; env.tyvars <- saved_vars;
env.depth <- env.depth - 1
in
let tfn =
match !check_fn_ref env { fn with Ast.name = sym } with
| tfn -> restore (); tfn
| exception e ->
restore ();
(* A copy whose body did not check is not a copy. Both entries go back
out, so a second call at the same types is the same refusal again
rather than a cache hit on a function that does not exist. *)
cache := List.filter (fun (_, _, s) -> s <> sym) !cache;
Hashtbl.remove env.fns sym;
raise e
in
env.instances <- tfn :: env.instances;
sym
and is_cast name =
Types.ikind_of_name name <> None || Types.fkind_of_name name <> None
@ -4524,13 +4866,24 @@ let collect env (decls : Ast.decl list) =
Hashtbl.replace env.cases c.Tast.vname (n, c))
cases
| Ast.Defn fn ->
(* A signature that introduces a type variable is a *pattern*, not a
signature: it goes in [gsigs] and the function goes nowhere near
[fns], because nothing can be called at [t]. Every call site turns
it into an ordinary entry. *)
let vars = signature_tyvars fn in
env.tyvars <- vars;
let params =
List.map (fun (p : Ast.field) -> resolve env p.Ast.fty) fn.Ast.params
in
let ret =
match fn.Ast.ret with None -> Types.Unit | Some t -> resolve env t
in
Hashtbl.replace env.fns fn.Ast.name (params, ret)
env.tyvars <- [];
if vars = [] then Hashtbl.replace env.fns fn.Ast.name (params, ret)
else begin
Hashtbl.replace env.generics fn.Ast.name fn;
Hashtbl.replace env.gsigs fn.Ast.name (vars, params, ret)
end
| Ast.Defvar (n, t, _) ->
let ty = match t with
| Some t -> resolve env t
@ -4597,7 +4950,7 @@ let check_finite env =
(* ── Declarations: pass 2, check bodies ────────────────────────────── *)
let check_fn env (fn : Ast.fn) : Tast.fn =
let rec check_fn env (fn : Ast.fn) : Tast.fn =
let params, ret = Hashtbl.find env.fns fn.Ast.name in
let ctx = { env; ret; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = [];
outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false;
@ -4684,6 +5037,35 @@ let check_fn env (fn : Ast.fn) : Tast.fn =
normal path has them spliced into [body] above. *)
ret; body; fdefers = ctx.defers; fparent = None; floc = fn.Ast.nloc }
(* The generic body, checked once with its variables abstract. Nothing is kept
— the [Tast.fn] it produces is thrown away, and so is anything it lifted —
because a generic function has no code: only its instantiations do. What is
kept is the *refusal*: an operator an unconstrained variable does not
support fails here, at the definition, naming the variable, rather than at
whichever call site happened to instantiate it at a type that worked.
The holes in it are real and are the report's business: [println] is
plan.org's one compiler-provided exception and this pass rejects it, and
move-only-ness is not decidable abstractly at all — [Types.is_move_only
(Var _)] is false, but the same variable at [(Vec i32)] is move-only. *)
and check_generic env (fn : Ast.fn) =
let vars, params, ret = Hashtbl.find env.gsigs fn.Ast.name in
let saved_lifted = env.lifted and saved_vars = env.tyvars in
env.tyvars <- vars;
Hashtbl.replace env.fns fn.Ast.name (params, ret);
let finish () =
Hashtbl.remove env.fns fn.Ast.name;
env.lifted <- saved_lifted;
env.tyvars <- saved_vars
in
(match check_fn env fn with
| _ -> finish ()
| exception e -> finish (); raise e)
(* The knot from [instantiate]: a call site makes a copy, and making one is
checking a function. *)
let () = check_fn_ref := check_fn
(* A global of move-only type is refused. The dead set is per function, so two
functions each freeing the same global is a double free nothing here could
see; and within one function a global read does not go through [var]'s move
@ -4809,6 +5191,22 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
check_finite env;
let s = Loc.sink ~on:keep_going in
ignore (Loc.caught s (fun () -> check_main env));
(* Every generic body, checked once with its variables left abstract, and
the result thrown away. This is the pass plan.org's rule needs and Odin
has no equivalent of: Odin checks a polymorphic body only per
instantiation, so [a + b] over a [$T] compiles there and fails only if
nobody ever calls it at a numeric type. plan.org says the opposite — an
unconstrained variable supports only what every type supports, and [=],
[<], [+] and [hash] over one are *rejected, not silently instantiated*.
Rejecting them means type-checking the body with nothing substituted,
which is this, and it is a second pass over the same source. *)
List.iter
(fun (d : Ast.decl) ->
match d.Ast.d with
| Ast.Defn fn when Hashtbl.mem env.gsigs fn.Ast.name ->
ignore (Loc.caught s (fun () -> check_generic env fn))
| _ -> ())
decls;
let globals =
List.filter_map
(fun d -> Option.join (Loc.caught s (fun () -> check_global env d)))
@ -4818,6 +5216,9 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
List.filter_map
(fun (d : Ast.decl) ->
match d.Ast.d with
(* A generic [defn] does not reach the typed IR at all. Only its
instantiations do, and they are collected below. *)
| Ast.Defn fn when Hashtbl.mem env.gsigs fn.Ast.name -> None
| Ast.Defn fn -> Loc.caught s (fun () -> check_fn env fn)
| _ -> None)
decls
@ -4827,6 +5228,11 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
from here down; nothing in the backend knows they were written inside
something else. *)
let fns = fns @ List.rev env.lifted in
(* The copies generics turned into, in the order they were generated. Like a
lifted clause they are ordinary functions from here down — but unlike one
they are reached *by name* from arbitrary call sites, so they carry no
[fparent] and a dev build gives each its own cell. *)
let fns = fns @ List.rev env.instances in
(* Sorted, so the emitted IR is reproducible build to build: a Hashtbl's
fold order is not. *)
let values name tbl =

7
spike/generics/id.flan Normal file
View File

@ -0,0 +1,7 @@
(defn id [x $t] t x)
(defn main [] ()
(println (id 3))
(println (id 4.5))
(println (id 7))
(println (id true)))

171
spike/generics/measure.ml Normal file
View File

@ -0,0 +1,171 @@
(* What redefining a generic function costs the dev loop, measured.
The question the spike exists to answer: C-c C-c on a concrete function is
about 35 ms today, and a generic function that is redefined has to rebuild
*every* instantiation. So the sweep is one generic called at N concrete
types, N = 1..8, against the handwritten N-copies program it replaces, and
the three things a C-c C-c actually pays for are timed separately:
check Check.program_with_env over the whole accumulated program —
which is what Session.eval does on every evaluation, so this is
paid whether the redefined function is generic or not.
emit Emit.redefinition for the fns being installed.
build llc + ld -shared, from Build.shared — the dominant term.
Nothing here modifies the session or the dev loop; it drives the real ones. *)
let tys = [| "i8"; "i16"; "i32"; "i64"; "u8"; "u16"; "u32"; "f32" |]
let time f =
let t0 = Unix.gettimeofday () in
let x = f () in
(x, (Unix.gettimeofday () -. t0) *. 1000.)
(* Best of k, because llc and the linker are processes and the machine is
noisy; a median would hide a systematic cost and a mean would report the
scheduler. *)
let best k f =
let rec go i acc = if i = 0 then acc else
let _, ms = time f in go (i - 1) (min acc ms) in
go k infinity
let generic_src n =
let b = Buffer.create 1024 in
Buffer.add_string b
"(defn gswap [xs [$t] i i32 j i32] ()\n\
\ (let [tmp (at xs i)]\n\
\ (set (at xs i) (at xs j))\n\
\ (set (at xs j) tmp)))\n\n\
(defn gsort [s [$t] before? (Fn [$t $t] bool)] ()\n\
\ (let [i 1]\n\
\ (while (< i (len s))\n\
\ (let [j i]\n\
\ (while (and (> j 0) (before? (at s j) (at s (- j 1))))\n\
\ (gswap s (- j 1) j)\n\
\ (set j (- j 1))))\n\
\ (set i (+ i 1)))))\n\n";
for i = 0 to n - 1 do
Buffer.add_string b (Printf.sprintf "(defvar xs-%s [8 %s])\n" tys.(i) tys.(i))
done;
Buffer.add_string b "\n(defn main [] ()\n";
for i = 0 to n - 1 do
Buffer.add_string b
(Printf.sprintf " (gsort (slice xs-%s 0 8) (fn [a b] (< a b)))\n" tys.(i))
done;
Buffer.add_string b " )\n";
Buffer.contents b
(* The same program as it is written today: one copy of each function per
element type, by hand. This is prelude.ml's shape. *)
let mono_src n =
let b = Buffer.create 1024 in
for i = 0 to n - 1 do
let t = tys.(i) in
Buffer.add_string b
(Printf.sprintf
"(defn mswap-%s [xs [%s] i i32 j i32] ()\n\
\ (let [tmp (at xs i)]\n\
\ (set (at xs i) (at xs j))\n\
\ (set (at xs j) tmp)))\n\n\
(defn msort-%s [s [%s] before? (Fn [%s %s] bool)] ()\n\
\ (let [i 1]\n\
\ (while (< i (len s))\n\
\ (let [j i]\n\
\ (while (and (> j 0) (before? (at s j) (at s (- j 1))))\n\
\ (mswap-%s s (- j 1) j)\n\
\ (set j (- j 1))))\n\
\ (set i (+ i 1)))))\n\n"
t t t t t t t);
Buffer.add_string b (Printf.sprintf "(defvar xs-%s [8 %s])\n\n" t t)
done;
Buffer.add_string b "(defn main [] ()\n";
for i = 0 to n - 1 do
Buffer.add_string b
(Printf.sprintf " (msort-%s (slice xs-%s 0 8) (fn [a b] (< a b)))\n"
tys.(i) tys.(i))
done;
Buffer.add_string b " )\n";
Buffer.contents b
let write path s =
let oc = open_out path in output_string oc s; close_out oc
let dir =
let d = Filename.concat (Filename.get_temp_dir_name ()) "flan-generics-spike" in
(try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
d
let decls_of path =
(Flan.Load.program ~file:path
(Flan.Parse.program (Flan.Reader.read_file path))).Flan.Load.decls
(* Every function the program ended up with whose name starts with one of the
generic names — the instantiations, which is exactly what a redefinition of
the generic would have to rebuild. *)
let instantiations (p : Flan.Tast.program) =
List.filter_map
(fun (f : Flan.Tast.fn) ->
let n = f.Flan.Tast.name in
if String.length n > 6 && String.sub n 0 6 = "gswap-" then Some n
else if String.length n > 6 && String.sub n 0 6 = "gsort-" then Some n
else None)
p.Flan.Tast.fns
let build_ms ir =
let out = Filename.concat dir "redef.so" in
best 3 (fun () ->
ignore
(Flan.Build.shared
~opts:{ Flan.Build.default with dev = true } ~ir ~out ()))
let () =
Printf.printf
"n check-gen check-mono emit-1 emit-N build-1 build-N fns\n";
(try
for n = 1 to 8 do
let gpath = Filename.concat dir (Printf.sprintf "gen%d.flan" n) in
let mpath = Filename.concat dir (Printf.sprintf "mono%d.flan" n) in
write gpath (generic_src n);
write mpath (mono_src n);
let gd = decls_of gpath and md = decls_of mpath in
let check_gen = best 3 (fun () -> ignore (Flan.Check.program_with_env gd)) in
let check_mono = best 3 (fun () -> ignore (Flan.Check.program_with_env md)) in
let p, _ = Flan.Check.program_with_env gd in
let insts = instantiations p in
let one = [ List.hd insts ] in
let ir_one =
Flan.Emit.redefinition ~dev:true ~known:(fun _ -> true) p ~fns:one
in
let ir_all =
Flan.Emit.redefinition ~dev:true ~known:(fun _ -> true) p ~fns:insts
in
let emit1 =
best 3 (fun () ->
ignore (Flan.Emit.redefinition ~dev:true ~known:(fun _ -> true) p ~fns:one))
and emitn =
best 3 (fun () ->
ignore (Flan.Emit.redefinition ~dev:true ~known:(fun _ -> true) p ~fns:insts))
in
let b1 = build_ms ir_one and bn = build_ms ir_all in
Printf.printf "%d %8.1f %10.1f %7.1f %7.1f %8.1f %8.1f %d\n%!"
n check_gen check_mono emit1 emitn b1 bn (List.length insts)
done
with Flan.Loc.Error d -> prerr_endline (Flan.Loc.report d); exit 1);
(* And what the session actually does when the generic itself is redefined.
This is the real C-c C-c path — Session.eval on the form the editor sent
— and what it reports is the finding, not the timing. *)
let gpath = Filename.concat dir "gen4.flan" in
let t, _ = Flan.Session.create ~file:gpath () in
let form =
"(defn gswap [xs [$t] i i32 j i32] ()\n\
\ (let [tmp (at xs i)]\n\
\ (set (at xs i) (at xs j))\n\
\ (set (at xs j) tmp)))\n"
in
let c, ms = time (fun () -> Flan.Session.eval ~origin:gpath t form) in
Printf.printf
"\nSession.eval on the generic gswap itself: %.1f ms, installs=%b, \
fns=[%s], names=[%s]\n"
ms c.Flan.Session.installs
(String.concat " " c.Flan.Session.fns)
(String.concat " " c.Flan.Session.names)

51
spike/generics/prelude-shapes.flan Normal file
View File

@ -0,0 +1,51 @@
;; Which of prelude.ml's per-type families collapse as they are written, and
;; which need their signature changed. Nothing here is installed in the
;; prelude; it is the same bodies, over $t, checked and run.
(defn keep [s [$t] keep? (Fn [$t] bool)] (Vec $t)
(let [v (vec-new t)]
(dotimes [i (len s)]
(when (keep? (at s i))
(push v (at s i))))
v))
(defn apply! [s [$t] f (Fn [$t] $t)] ()
(dotimes [i (len s)]
(set (at s i) (f (at s i)))))
(defn fold [s [$t] init $t f (Fn [$t $t] $t)] t
(let [acc init]
(dotimes [i (len s)]
(set acc (f acc (at s i))))
acc))
(defn flip! [s [$t]] ()
(let [i 0
j (- (len s) 1)]
(while (< i j)
(let [tmp (at s i)]
(set (at s i) (at s j))
(set (at s j) tmp))
(set i (+ i 1))
(set j (- j 1)))))
(defvar ns [5 i32])
(defvar fs [5 f32])
(defn main [] ()
(let [xs (slice ns 0 5)
ys (slice fs 0 5)]
(dotimes [i 5]
(set (at xs i) (+ i 1))
(set (at ys i) (f32 (* 2 (+ i 1)))))
(apply! xs (fn [x] (* x 10)))
(apply! ys (fn [x] (* x (f32 2))))
(flip! xs)
(flip! ys)
(println (fold xs 0 (fn [a b] (+ a b))))
(println (fold ys (f32 0) (fn [a b] (+ a b))))
(let [evens (keep xs (fn [x] (= (% x 20) 0)))]
(println (len evens))
(free evens))
(println (at xs 0))
(println (at ys 0))))

4
spike/generics/reject.flan Normal file
View File

@ -0,0 +1,4 @@
(defn add2 [a $t b $t] t (+ a b))
(defn main [] ()
(println (add2 1 2)))

28
spike/generics/run.sh Normal file
View File

@ -0,0 +1,28 @@
#!/usr/bin/env bash
# The generics spike's measurement, driven by hand with ocamlfind against the
# flan.cmxa dune already builds — the same arrangement spike/backend uses, and
# for the same reason: nothing under spike/ is wired into the build, there is
# no dune file here, and `dune test --root .` cannot see any of it.
#
# The three .flan programs beside this file are run with the ordinary driver:
# dune exec --root . bin/main.exe -- run spike/generics/sort.flan
set -u
here=$(cd "$(dirname "$0")" && pwd)
root=$(cd "$here/../.." && pwd)
cd "$root" || exit 1
dune build --root . lib/flan.cmxa 2>&1 | head -20
out=$(mktemp -d); trap 'rm -rf "$out"' EXIT
ocamlfind ocamlopt -thread -package unix,threads.posix -linkpkg \
-I "$root/_build/default/lib/.flan.objs/byte" \
-I "$root/_build/default/lib/.flan.objs/native" \
-I "$out" -I "$here" \
-o "$out/measure" \
"$root/_build/default/lib/flan.cmxa" \
-cclib -rdynamic -ccopt -L"$root/_build/default/lib" \
"$here/measure.ml" 2>&1 | head -40
test -x "$out/measure" || { echo "build failed"; exit 1; }
"$out/measure"

3
spike/generics/runaway.flan Normal file
View File

@ -0,0 +1,3 @@
(defn grow [x $t] ()
(grow [x x]))
(defn main [] () (grow 1))

25
spike/generics/sort.flan Normal file
View File

@ -0,0 +1,25 @@
;; The shape prelude.ml's sort-i32-by! / sort-f32-by! pair would collapse into:
;; one generic body, the comparison passed in as a function value because an
;; unconstrained type variable has no < of its own.
(defn swap! [xs [$t] i i32 j i32] ()
(let [tmp (at xs i)]
(set (at xs i) (at xs j))
(set (at xs j) tmp)))
(defn sort-by! [s [$t] before? (Fn [$t $t] bool)] ()
(let [i 1]
(while (< i (len s))
(let [j i]
(while (and (> j 0) (before? (at s j) (at s (- j 1))))
(swap! s (- j 1) j)
(set j (- j 1))))
(set i (+ i 1)))))
(defn main [] ()
(let [ns [5 3 9 1]
fs [2.5 0.5 1.5]]
(sort-by! (slice ns 0 4) (fn [a b] (< a b)))
(sort-by! (slice fs 0 3) (fn [a b] (> a b)))
(dotimes [i 4] (println (at ns i)))
(dotimes [i 3] (println (at fs i)))))

19
spike/generics/swap.flan Normal file
View File

@ -0,0 +1,19 @@
;; One generic function over one type variable, called at two concrete types
;; in one program. The sigil binds ($t), a bare use reads it (t).
(defn swap! [xs [$t] i i32 j i32] ()
(let [tmp (at xs i)]
(set (at xs i) (at xs j))
(set (at xs j) tmp)))
(defn main [] ()
(let [ns [10 20 30]
fs [1.5 2.5 3.5]]
(swap! (slice ns 0 3) 0 2)
(swap! (slice fs 0 3) 0 1)
(swap! (slice ns 0 3) 1 2)
(println (at ns 0))
(println (at ns 1))
(println (at ns 2))
(println (at fs 0))
(println (at fs 1))))

5
spike/generics/two-vars.flan Normal file
View File

@ -0,0 +1,5 @@
(defn fst [a $t b $u] t a)
(defn main [] ()
(println (fst 1 2.5))
(println (fst true (i64 9)))
(println (fst 3 false)))