From e24aee51205b527c9431893505962f1b50e0b503 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 22:19:27 +0700 Subject: [PATCH 1/3] A prelude function may call a prelude macro, and the fix was not ordering --- BUILT.md | 51 +++++++++++++++++++++++++++ NEXT.md | 12 ++++--- lib/macro.ml | 87 ++++++++++++++++++++++++++++++++++++++++++++--- lib/prelude.ml | 36 ++++++++++++++------ test/test_flan.ml | 50 +++++++++++++++++++++++++++ 5 files changed, 217 insertions(+), 19 deletions(-) diff --git a/BUILT.md b/BUILT.md index 3d41ea2..0e8dea6 100644 --- a/BUILT.md +++ b/BUILT.md @@ -2733,6 +2733,57 @@ Tests: `programs/strings.flan`, `programs/format.flan`, `programs/algorithms.fla `-O2` and `-O0`, and `strings.flan` also in a dev build — the one that checks a container's recorded allocator epoch, so it is what would catch one of these `Vec`s being used after the arena under it was released. +## A prelude function may call a prelude macro, and why the fix was not ordering + +The handoff said the prelude is never macro-expanded — `Macro.program` runs over the file being compiled and the +prelude arrives later through `Check.program`'s prepend — and that the fix was to move the prepend before expansion. +**Both halves of that are wrong, and the measurement is one command.** + +Put `(clamp prec 0 9)` back into `format-f64`, print `names` and `List.length extra` on entry to `Macro.compile`, and +compile any program that calls a macro. The compiler prints `names=[clamp,unless] extra=0` and *then* the arity error +at `:1103`. So `compile` was entered: the prelude does reach the expander. The error is raised by the +`Check.program` **inside** `compile`, where `building` is true and expansion is off. + +That is the real shape, and it is a **cycle, not an ordering**: a macro module is compiled *from* the prelude, so a +prelude function that calls a macro would have to be compiled into the very module that expands it. Moving the +prepend earlier changes which pass sees the prelude first and leaves the cycle exactly where it was. + +Two things break it, and the second is the one that matters. + +**The prelude's macros are dropped from `mine`.** `Macro.program` collected every `defmacro` in the forms it was given +and handed them back as `extra` — the forms a macro module is built *in addition to* the prelude. When the forms it +was given *are* the prelude, that is the prelude's macros declared twice, refused as a redefinition. They are already +in `prelude`, which is where the module gets them from. + +**`Macro.reduce`: for that one build, the prelude is smaller.** Every `defn` that names a macro is dropped, and then +every `defn` that names a dropped one, to a fixpoint — a function calling something unbuildable is as unbuildable as +the thing it calls. `Prelude.bootstrap` is the hook, a ref rather than a parameter because the readers are +`Check.program` and `Parse.prelude_types` and neither can be told. + +Only `defn`s are dropped, and that restriction is load-bearing rather than tidy. `Parse.prelude_types` **memoises**, +and it can be forced for the first time inside a bootstrap build; a reduced set of types cached there would be wrong +for every compile afterwards. A `defstruct`, `defunion`, `defalias`, `defenum` or `defvar` therefore stays whatever it +names. + +**The one restriction that stays, and now names itself.** A prelude macro may not call a macro — the module that +expands it is compiled from the prelude, so there is no earlier module for its own call to have been expanded by. +That was already recorded and accepted; what it used to do was fail as an unknown name somewhere inside a clang +driver. `reduce` checks it directly and refuses with the macro's name and the reason. + +`format-f64` is written `(clamp prec 0 9)` now, which is the living proof and also the only place in the prelude that +exercises it. The expansion is `(min 9 (max 0 prec))`, so nothing about the output moved — the point is that the call +compiles at all. + +**What it costs.** The prelude names a macro now, so `Macro.program`'s short-circuit — the reason a build using no +macro pays nothing — no longer fires for the prelude, and every `Check.program` dlopens a macro module. The module is +disk-cached under a digest of the prelude source with an empty `extra`, so it is one `.so` shared by every build and +every process; `dune test` is unchanged at 20 seconds. The first build after a prelude edit pays one clang driver. + +**What was not done.** The two expansions are still separate — the prelude is expanded against the prelude's macros, +the file against the prelude's plus its own. That is not a gap, and it is worth stating so the next lane does not +"fix" it: a file macro is never visible to the prelude, and a prelude macro is already visible to the file, so the two +passes cannot disagree. Expanding them together would buy one fewer `dlopen` and nothing else. + ## `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 diff --git a/NEXT.md b/NEXT.md index bdfa208..87d325f 100644 --- a/NEXT.md +++ b/NEXT.md @@ -577,11 +577,13 @@ them wants a language decision. Two smaller findings, both written down beside the code that ran into them: -- **The prelude is never macro-expanded.** `macro.ml`'s pass runs over the file being compiled; the prelude reaches - the checker through `Check.program`'s own prepend and never goes through the expander. So a prelude *function* - calling a prelude *macro* resolves the macro's underlying `defn` — the one taking a `[Form]` — and reports an arity - error. `format-f64` writes `(min 9 (max 0 prec))` where it wanted `clamp`. This is next to, and not the same as, - "a prelude macro may not call a macro" below. +- ~~**The prelude is never macro-expanded.**~~ **Fixed, and the diagnosis above was wrong in both halves** — see + [`BUILT.md`](BUILT.md), "A prelude function may call a prelude macro". The prelude *does* reach the expander; the + arity error came from the `Check.program` *inside* `Macro.compile`, where expansion is off. It is a cycle and not + an ordering — a macro module is compiled from the prelude — so moving the prepend would have changed nothing. What + fixed it is `Macro.reduce`, which makes the prelude smaller for that one build, plus dropping the prelude's own + macros from the forms fed back as `extra`. `format-f64` is `(clamp prec 0 9)` now. "A prelude macro may not call a + macro" stands and names itself when violated. - **A returned `Vec` is a move, and the dead set spans the function**, so an early `(return v)` on one branch kills the binding for the `v` at the foot of another. `replace-bytes` guards its empty-needle case with an `if` rather diff --git a/lib/macro.ml b/lib/macro.ml index 2ff0ea9..916999b 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -65,17 +65,84 @@ let key (extra : Form.t list) = before the build was entered. *) let building = ref false +(* ── The bootstrap, and what a prelude macro may not call ─────────── + [Check.program] prepends the prelude to every program, this one included, so + the module that expands the prelude's macros is compiled *from* the prelude. + A prelude function that calls a macro therefore cannot be compiled into it: + the call is a name nothing defines yet. That is a cycle and not an ordering + mistake — no amount of moving the prepend around removes it. + + It is broken at one level, which is the restriction already recorded and + kept: a macro module is built from the prelude with every [defn] that + depends on a macro *removed*. Directly or transitively, because a function + calling a dropped one is as unbuildable as the dropped one itself. + + Only [defn]s are dropped. A [defstruct], [defunion], [defalias], [defenum] + or [defvar] stays whatever it names, so [Parse.prelude_types] sees the same + set of types during a bootstrap build as outside one — it memoises, and a + reduced answer cached there would be wrong for every later compile. + + A [defmacro] that lands in the dropped set is the violation of the rule, and + it is refused here by name rather than reaching clang as an unknown symbol. *) + +let head_name (f : Form.t) = + match f.Form.v with + | Form.List ({ Form.v = Form.Sym h; _ } :: { Form.v = Form.Sym n; _ } :: _) -> + Some (h, n) + | _ -> None + +let reduce (forms : Form.t list) : Form.t list = + let macros = macros_in forms in + (* Fixpoint: a form is out once it names something already out. Bounded by + the number of forms, since the set only grows. *) + let out = ref macros in + let changed = ref true in + while !changed do + changed := false; + List.iter + (fun f -> + match head_name f with + | Some (("defn" | "defmacro"), n) when not (List.mem n !out) -> + if names_macro !out f then begin out := n :: !out; changed := true end + | _ -> ()) + forms + done; + (* The macros themselves are in [out] by construction; a macro that is there + for any *other* reason called one, which is the thing that cannot work. *) + List.iter + (fun f -> + match head_name f with + | Some ("defmacro", n) when names_macro macros f -> + Loc.fail f.Form.loc + "the prelude macro %s calls a macro, and a prelude macro may not: \ + the module that expands it is compiled from the prelude, so the \ + call would have to be expanded by a module that does not exist \ + yet. Call a function instead" + n + | _ -> ()) + forms; + List.filter + (fun f -> + match head_name f with + | Some ("defn", n) -> not (List.mem n !out) + | _ -> true) + forms + let compile (names : string list) (extra : Form.t list) : loaded = let out = Filename.concat (Build.cachedir ()) ("flan-macros-" ^ key extra ^ ".so") in if not (Sys.file_exists out) then begin building := true; + Prelude.bootstrap := reduce; Fun.protect - ~finally:(fun () -> building := false) + ~finally:(fun () -> + building := false; + Prelude.bootstrap := (fun fs -> fs)) (fun () -> - (* [Check.program] prepends the prelude itself, so only the file's - own defmacros go in here. *) + (* [Check.program] prepends the prelude itself — reduced, for the one + build that cannot have all of it — so only the file's own defmacros + go in here. *) let p = Check.program (Parse.program extra) in (* Written beside the final name and renamed, so a second process reading the cache never sees a half-written object. *) @@ -186,7 +253,19 @@ let program (forms : Form.t list) : Form.t list = if !building then forms else let prelude = Lazy.force prelude_macros in - let mine = List.filter_map (fun f -> Option.map (fun n -> (n, f)) (macro_name f)) forms in + (* The prelude's own macros are dropped from [mine], and the reason is that + these forms may *be* the prelude: [Check.program] prepends it, so a + prelude macro handed back as [extra] would be declared twice and refused + as a redefinition. They are already in [prelude], which is where the + module gets them from. *) + let mine = + List.filter_map + (fun f -> + match macro_name f with + | Some n when not (List.mem n prelude) -> Some (n, f) + | _ -> None) + forms + in let all = prelude @ List.map fst mine in (* The common case by a wide margin, and the reason a build that uses no macro pays nothing: a file that calls none costs one scan and no diff --git a/lib/prelude.ml b/lib/prelude.ml index d2b50bf..9d8b1d8 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -1111,14 +1111,13 @@ let source = {flan| ;; is almost always a literal, so a refusal would be a run-time condition for a ;; mistake visible in the source. ;; -;; The clamp is written out as (min 9 (max 0 prec)) and not as the `clamp` -;; macro two hundred lines up, and that is a limit rather than a preference: -;; **the prelude is not macro-expanded**. macro.ml's pass runs over the file -;; being compiled, and the prelude reaches the checker through Check.program's -;; own prepend, having never been through the expander — so a prelude function -;; calling a prelude macro resolves the macro's underlying defn, which takes -;; one [Form] argument, and the report is an arity error at the call. It is -;; written down in NEXT.md beside the other macro gaps. +;; It is the `clamp` macro two hundred lines up, and this is the call that +;; proves a prelude function may call a prelude macro — which it could not +;; until macro.ml grew its bootstrap reduction. The cycle it breaks: a macro +;; module is compiled *from* the prelude, so a prelude function calling a macro +;; would have to be compiled into the very module that expands it. For that one +;; build the prelude drops every defn that reaches a macro, this one included. +;; A prelude *macro* may still not call a macro, and says so by name. ;; ;; Three inputs do not have decimal expansions and are named before the cast ;; that would be undefined on them: NaN, which fails every comparison and is @@ -1132,7 +1131,7 @@ let source = {flan| ;; caller that needs the sign of a zero should not be reading it out of text. (defn format-f64 [x f64 prec i32] (Vec u8) (let [b (vec-new u8) - p (min 9 (max 0 prec))] + p (clamp prec 0 9)] (cond (not (= x x)) (append! (addr b) (bytes "nan")) @@ -1392,4 +1391,21 @@ let source = {flan| let file = "" -let forms () = Reader.read_all ~file source +(* The bootstrap hook, and the whole of why a prelude function may now call a + prelude macro. + + [Check.program] prepends this file to every program, and a macro module is + built by running [Check.program] over the prelude — so a prelude function + that calls a macro cannot be compiled *into the very module that would + expand it*. That is a cycle, not an ordering mistake, and it is broken by + making the prelude smaller for exactly the one build that cannot afford it: + while a macro module is being built, [Macro] installs a reduction here that + drops every [defn] depending, directly or transitively, on a macro. A + *macro* that lands in that set is refused by name — see [Macro.reduce]. + + A ref rather than a parameter because the readers are [Check.program] and + [Parse.prelude_types], neither of which can be told, and because [Macro] + sits above both and cannot be depended on from here. *) +let bootstrap : (Form.t list -> Form.t list) ref = ref (fun fs -> fs) + +let forms () = !bootstrap (Reader.read_all ~file source) diff --git a/test/test_flan.ml b/test/test_flan.ml index 06025e1..9307230 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1476,6 +1476,56 @@ let () = | _ -> false | exception Cjson.Bad _ -> true); + (* ── The prelude's own macro calls, and the bootstrap that allows them ── + A macro module is compiled *from* the prelude, so a prelude function that + calls a prelude macro cannot be in the module that would expand it. The + answer is [Macro.reduce]: for that one build the prelude loses every defn + depending on a macro, directly or transitively. These check the reduction + itself, since the thing it prevents is a cycle and a cycle does not show + up as a wrong answer — it shows up as a build that cannot start. *) + let names_of forms = + List.filter_map + (fun (f : Form.t) -> + match f.Form.v with + | Form.List ({ Form.v = Form.Sym ("defn" | "defmacro"); _ } + :: { Form.v = Form.Sym n; _ } :: _) -> Some n + | _ -> None) + forms + in + let reduced = names_of (Macro.reduce (Prelude.forms ())) in + let full = names_of (Prelude.forms ()) in + check "the reduced prelude drops a defn that calls a macro" + (List.mem "format-f64" full && not (List.mem "format-f64" reduced)); + (* The macros survive — they are what the module is being built to export — + and so does everything that does not reach one, which is almost all of it. *) + check "the reduced prelude keeps the macros themselves" + (List.mem "clamp" reduced && List.mem "unless" reduced); + check "the reduced prelude keeps a defn that calls no macro" + (List.mem "join" reduced && List.mem "split" reduced); + + (* Transitively: a caller of a dropped function is as unbuildable as the + function, so it goes too. Written against a synthetic prelude rather than + the real one, which has no such chain today. *) + let synth src = Reader.read_all ~file:"" src in + let chain = + synth + "(defmacro m [args] `(do))\n\ + (defn a [] Unit (m))\n\ + (defn b [] Unit (a))\n\ + (defn c [] Unit (do))\n" + in + check "the reduction is transitive" + (names_of (Macro.reduce chain) = [ "m"; "c" ]); + + (* And the one rule that stays: a prelude macro may not call a macro. It used + to fail as an unknown name inside a clang build; it names itself now. *) + let ring = synth "(defmacro m [args] `(do))\n(defmacro n [args] (m args))\n" in + check "a prelude macro calling a macro is refused by name" + (match Macro.reduce ring with + | _ -> false + | exception Loc.Error (_, m) -> + contains m "the prelude macro n calls a macro"); + (* ── The acceptance program checks end to end ──────────────────── *) accepts "calc-me.flan type checks" (In_channel.with_open_bin "../calc-me.flan" In_channel.input_all); From 772d1d5b184d3a8c3d833292a1f4963861b6de8d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 22:24:05 +0700 Subject: [PATCH 2/3] A cursor over the block, because nothing walked it --- BUILT.md | 45 +++++++++++++++ NEXT.md | 10 ++-- lib/check.ml | 42 ++++++++++++++ lib/emit.ml | 4 ++ lib/prelude.ml | 17 +++--- runtime/flan_rt.c | 52 +++++++++++++++++ test/programs/map-iter.flan | 109 ++++++++++++++++++++++++++++++++++++ test/test_acceptance.ml | 15 +++++ 8 files changed, 281 insertions(+), 13 deletions(-) create mode 100644 test/programs/map-iter.flan diff --git a/BUILT.md b/BUILT.md index 0e8dea6..eae583e 100644 --- a/BUILT.md +++ b/BUILT.md @@ -2733,6 +2733,51 @@ Tests: `programs/strings.flan`, `programs/format.flan`, `programs/algorithms.fla `-O2` and `-O0`, and `strings.flan` also in a dev build — the one that checks a container's recorded allocator epoch, so it is what would catch one of these `Vec`s being used after the arena under it was released. +## `map-next!`, the one thing a Map could not do + +`flan_map_len`, `_get`, `_put`, `_has`, `_clone`, `_reserve` and `_free` was the runtime's entire map surface, and +every one of them addresses a *single* entry by hashing it. Nothing walked the block, so a map's keys and its values +could not be read out at all — the only item on the second tier's list that was blocked on nothing but a missing +function. + +`flan_map_next` is that function and `map-next!` is the builtin over it. + +``` +(let [cur (i64 0) k 0 v 0] + (while (map-next! m (addr cur) (addr k) (addr v)) + ...)) +``` + +**The cursor is a slot index the caller owns, and there is no iterator struct** because there is nothing for one to +hold. A map has no tombstones — removal is deferred (`spec-memory.md`) — so a slot is either empty or occupied and the +position is the whole of the state. The cursor starts at 0, comes back one past the entry just answered, and is left +at `cap` by the call that answers false, so a spent cursor keeps answering false rather than wrapping. + +**Three out-pointers and not a returned pair**, because there are no tuples. An `(Option K)` would answer half an +entry and make the value cost a second hash of the key just handed back. The `!` is the cursor: it is the argument +that is written through on the way out. + +**It is the one map entry point that carries neither a hash nor an equality function.** Walking asks nothing about a +key. The two sizes are still there, because the runtime is type-erased and the block geometry is computed from them. + +**The layout, restated, because it is the thing to get wrong here.** `data` is *one* allocation laid out +keys | values | hashes | scratch, each run cell-packed to a cache line — the arrangement the Valgrind lane described +while explaining why a probe overrun is not observable. A key is reached through `flan_cell_at` and never as +`ks + i * ksize`. The hashes are the exception `flan_map_clone` already relies on: an 8-byte element packs 8 to a +64-byte cell with nothing left over, so `g.hs[i]` is the right index and a flat one. + +**Order is block order**, which is the hash's order and not the insertion's, and it changes when the map grows. +`programs/map-iter.flan` is therefore written entirely in sums, counts and lengths — every claim in it is order-free, +which is the contract rather than a weakness of the test. A caller that wants an order sorts what it collected. The +cases that would catch a real mistake: a string key with a struct value, whose two runs have different element sizes +and different packing and so would break if one geometry were used for both; and a 500-entry map, which is several +grows past the minimum and walks a block whose layout has nothing to do with how the entries went in. + +**`map-keys` and `map-values` are still refused, and the reason changed.** The refusal block at the foot of +`prelude.ml` said "a Map iterator"; that is wrong now. What a prelude `defn` cannot write is +`(defn map-keys [m {K V}] (Vec K))` — it has to name its types and there is no `K`. That is generics. The loop is +three lines at the call site, where `K` is known, and that is where it stays. + ## A prelude function may call a prelude macro, and why the fix was not ordering The handoff said the prelude is never macro-expanded — `Macro.program` runs over the file being compiled and the diff --git a/NEXT.md b/NEXT.md index 87d325f..86a6c31 100644 --- a/NEXT.md +++ b/NEXT.md @@ -552,11 +552,11 @@ Tests: `programs/strings.flan`, `programs/format.flan`, `programs/algorithms.fla **What could not be built, and why each one could not.** All four want a compiler or runtime change, and none of them wants a language decision. -- **`Map` keys and values.** The only item on the list above that could not be built at all. `len` reaches a Map and - `get`/`put`/`has-key?` address one entry, but nothing walks the block: `flan_map_len`, `_get`, `_put`, `_has`, - `_clone`, `_reserve` and `_free` is the runtime's whole map surface, with no iterator among them. It wants one - runtime function — `flan_map_next` over the open-addressed block, taking a cursor — and one builtin in `check.ml` - to emit the key and value sizes at the call site. It is *not* a generics problem, and it is a small job. +- ~~**`Map` keys and values.**~~ **Iteration is built** — `flan_map_next` and the `map-next!` builtin, exactly the + shape this described. See [`BUILT.md`](BUILT.md), "`map-next!`, the one thing a Map could not do". + `map-keys`/`map-values` as *prelude functions* stay refused, and the reason is now generics rather than the + iterator: a `defn` has to name its types and `(defn map-keys [m {K V}] (Vec K))` has no `K`. The loop is three + lines at the call site, where `K` is known. - **`map`, `filter`, `reduce`, and a sort taking a comparator.** Blocked on **function values**, not on generics, which is the sharper statement than the one this list made. `Types.Fn` exists; `check.ml` refuses it with "a diff --git a/lib/check.ml b/lib/check.ml index 2bf97d3..772ad6b 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -2871,6 +2871,48 @@ and named_call ctx ~want loc name args = [ mk loc oty (Tast.If (cond, some, none)) ]))) | _ -> assert false) + (* (map-next! m (addr cur) (addr k) (addr v)) -> bool, and the whole of map + iteration. Before it there was no way to read a map's keys or its values + at all: every other map operation addresses one entry by hashing it, and + nothing walked the block. + + Three out-pointers rather than a returned pair, because there are no + tuples and a (Option K) would answer only half of an entry — the value + would then cost a second hash of the key just answered. The cursor is an + i64 the caller owns and the loop reads as one: + + (let [cur 0 k 0 v 0] + (while (map-next! m (addr cur) (addr k) (addr v)) + ...)) + + It is *not* a generic (map-keys m): a Vec of them needs a signature naming + K, and a prelude defn cannot be written at every K. That one is generics, + not iteration, and it stays refused for that reason. + + No hash and no equality pair go with it — walking asks nothing about a + key — so this is the one map entry point whose signature carries neither, + and the sizes are still needed because the runtime is type-erased. *) + | "map-next!" -> + arity loc name 4 args; + (match args with + | [ target; cur; k; v ] -> + let target = borrowed ctx target (fun () -> check ctx target) in + let kt, vt = map_kv loc "map-next!" target.Tast.ty in + let cur = check ctx ~want:(Types.Ptr (Types.Int Types.I64)) cur in + let k = check ctx ~want:(Types.Ptr kt) k in + let v = check ctx ~want:(Types.Ptr vt) v in + let found = + rt loc (Types.Int Types.I8) "flan_map_next" + [ target; cur; k; v; size_of loc kt; size_of loc vt; here loc ] + in + expect loc ~want + (mk loc Types.Bool + (Tast.Prim + (Tast.Ne, + [ found; + mk loc (Types.Int Types.I8) (Tast.Int (0L, Types.I8)) ]))) + | _ -> 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. *) diff --git a/lib/emit.ml b/lib/emit.ml index 27f34cf..a979463 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -2273,6 +2273,10 @@ 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) +; The cursor step. No hash and no equality pair: walking the block asks +; nothing about a key, which is why this is the one map entry point whose +; signature does not carry them. +declare i8 @flan_map_next(ptr, ptr, ptr, ptr, i64, i64, 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 diff --git a/lib/prelude.ml b/lib/prelude.ml index 9d8b1d8..022f5eb 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -1203,14 +1203,15 @@ let source = {flan| ;; map, filter, reduce Function values. See the head of the slice-algorithm ;; sort-by section: check.ml refuses a function type outright, ;; and there is nothing in the language to pass. -;; map-keys, map-values A Map iterator. `len` reaches a Map and `get`, -;; `put` and `has-key?` address one entry, but there is -;; no entry point in the runtime that walks the block — -;; flan_map_len, _get, _put, _has, _clone, _reserve and -;; _free is the whole surface. This is the one item on -;; NEXT.md's second-tier list that could not be built -;; here at all, and it wants one runtime function and -;; one builtin rather than anything from the language. +;; map-keys, map-values Generics — and the reason changed, which is the +;; point of naming them separately. It used to be the +;; missing Map iterator; `map-next!` is that iterator +;; and walking a map is expressible now. What a defn +;; still cannot say is (defn map-keys [m {K V}] (Vec K)): +;; a prelude function has to name its types, and there +;; is no K. The loop is three lines at the call site, +;; where K is known, and that is where it stays until +;; there are generics. ;; ;; Builder Not refused — declined. strings.Builder in Odin ;; wraps a [dynamic]u8; here the (Vec u8) *is* that and diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index e38f01d..6f38c55 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1695,6 +1695,58 @@ int64_t flan_map_len(flan_map *m, const uint8_t *loc, int64_t loclen) { return m->len; } +/* The cursor step, and the whole of iteration. + * + * Everything else in this file addresses *one* entry: get, put and has each + * hash a key and probe. Nothing walked the block, so a map's keys and its + * values could not be read out at all, and this is the one function that + * changes it. + * + * The cursor is a slot index the caller owns, and the contract is the one a + * slot index gives for free: it starts at 0, it is written back one past the + * entry just answered, and a 0 answer leaves it at [cap] so calling again is + * still 0. There is no iterator struct because there is nothing for one to + * hold — a map has no tombstones (removal is deferred), so no state beyond the + * position is needed to know where to resume. + * + * Invalidated by anything that moves the block, exactly as a Vec's slice is: + * a put that grows rehashes into a new block and every index before it means a + * different entry. The epoch check below catches a released arena and nothing + * catches a resize, which is the same bargain [as-slice] already makes. + * + * The layout is the one the geometry describes and is worth restating because + * it is the thing most likely to be got wrong here: [data] is *one* allocation + * laid out keys | values | hashes | scratch, each run cell-packed, so a key is + * reached through [flan_cell_at] and never by [ks + i * ksize]. The hashes are + * the exception the clone loop already relies on — an 8-byte element packs 8 + * to a 64-byte cell with nothing left over, so a flat index is the right + * index. Order is block order, which is the hash's order and not the + * insertion's; two maps holding the same entries may walk them differently. */ +int8_t flan_map_next(flan_map *m, int64_t *cursor, void *kout, void *vout, + int64_t ksize, int64_t vsize, + const uint8_t *loc, int64_t loclen) { + flan_map_geom g; + int64_t cap, i; + flan_map_check(m, loc, loclen); + if (!m->data || m->len == 0) return 0; + cap = flan_map_cap(m); + i = *cursor; + if (i < 0) i = 0; + if (i >= cap) { *cursor = cap; return 0; } + flan_map_geometry(m, ksize, vsize, cap, &g); + for (; i < cap; i++) { + if (g.hs[i] == 0) continue; + memcpy(kout, flan_cell_at(g.ks, ksize, g.kepc, g.kcell, g.kshift, i), + (size_t)ksize); + memcpy(vout, flan_cell_at(g.vs, vsize, g.vepc, g.vcell, g.vshift, i), + (size_t)vsize); + *cursor = i + 1; + return 1; + } + *cursor = cap; + return 0; +} + /* 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, diff --git a/test/programs/map-iter.flan b/test/programs/map-iter.flan new file mode 100644 index 0000000..c5718c1 --- /dev/null +++ b/test/programs/map-iter.flan @@ -0,0 +1,109 @@ +;; Walking a map, which is what flan_map_next exists for. Every other map +;; operation addresses one entry by hashing it; this is the only thing that +;; reads the block in order. +;; +;; Block order is the hash's order and not the insertion's, so nothing here +;; may depend on which entry comes first: the checks are a sum, a count and a +;; membership test, all of them order-free. That is not a weakness of the test, +;; it is the contract — a caller that wants an order sorts what it collected. + +(defn sum-and-count [] Unit + (let [m (map-new i32 i32)] + (put m 1 10) + (put m 2 20) + (put m 3 30) + (put m 4 40) + (let [cur (i64 0) + k 0 + v 0 + keys 0 + vals 0 + n 0] + (while (map-next! m (addr cur) (addr k) (addr v)) + (set keys (+ keys k)) + (set vals (+ vals v)) + (set n (+ n 1))) + (print n) (print " ") (print keys) (print " ") (print vals) (println "")) + (free m))) + +;; A map that never allocated has no block at all, and one that allocated and +;; holds nothing has a block of nothing but zeroed hashes. Both walk zero +;; times, and they are different code paths to get there. +(defn the-empty-cases [] Unit + (let [m (map-new i32 i32) + cur (i64 0) + k 0 + v 0 + n 0] + (while (map-next! m (addr cur) (addr k) (addr v)) + (set n (+ n 1))) + (print "never allocated: ") (print n) (println "") + (reserve m 64) + (set cur (i64 0)) + (while (map-next! m (addr cur) (addr k) (addr v)) + (set n (+ n 1))) + (print "allocated and empty: ") (print n) (println "") + (free m))) + +;; A cursor left past the end keeps answering false rather than wrapping, so a +;; second loop over a spent cursor is empty and not a repeat. +(defn a-spent-cursor [] Unit + (let [m (map-new i32 i32)] + (put m 5 50) + (put m 6 60) + (let [cur (i64 0) k 0 v 0 n 0] + (while (map-next! m (addr cur) (addr k) (addr v)) + (set n (+ n 1))) + (while (map-next! m (addr cur) (addr k) (addr v)) + (set n (+ n 1))) + (print "spent: ") (print n) (println "")) + (free m))) + +;; A string key and a struct value: the key run and the value run have +;; different element sizes and different cell packing, so this is the case that +;; would catch the two runs being indexed with one geometry. +(defstruct Point [x i32 y i32]) + +(defn wider-entries [] Unit + (let [m (map-new string Point)] + (put m "a" (Point {.x 1 .y 2})) + (put m "bb" (Point {.x 3 .y 4})) + (put m "ccc" (Point {.x 5 .y 6})) + (let [cur (i64 0) + k "" + v (Point {}) + chars 0 + xs 0 + ys 0] + (while (map-next! m (addr cur) (addr k) (addr v)) + (set chars (+ chars (len k))) + (set xs (+ xs (.x v))) + (set ys (+ ys (.y v)))) + (print chars) (print " ") (print xs) (print " ") (print ys) (println "")) + (free m))) + +;; Growth past the 75% threshold rehashes into a new block, so this walks a map +;; whose layout is nothing like its insertion order and at a capacity several +;; doublings past the minimum. +(defn after-growth [] Unit + (let [m (map-new i64 i64)] + (dotimes [i 500] + (put m (i64 i) (* (i64 i) 2))) + (let [cur (i64 0) + k (i64 0) + v (i64 0) + n 0 + doubled 0] + (while (map-next! m (addr cur) (addr k) (addr v)) + (set n (+ n 1)) + (when (= v (* k 2)) (set doubled (+ doubled 1)))) + (print n) (print " ") (print doubled) (print " ") (print (len m)) (println "")) + (free m))) + +(defn main [] i32 + (sum-and-count) + (the-empty-cases) + (a-spent-cursor) + (wider-entries) + (after-growth) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index d2574fc..5691f24 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1763,6 +1763,21 @@ ERR@7 unexpected token: not the kind the caller was reading body behind an indirection cell, so it is the build that would notice. *) outputs ~dev:true "maps, dev" "programs/maps.flan" maps_out; + (* Iteration, which no map could do at all until flan_map_next. Every case + here is order-free on purpose — block order is the hash's order, not the + insertion's — so the numbers are sums, counts and lengths and never a + first entry. The string-keyed, struct-valued map is the one that would + catch the key and value runs being indexed with a single geometry, since + their element sizes and cell packing differ; and the 500-entry map is + several grows past the minimum, so it walks a block whose layout has + nothing to do with the order the entries went in. *) + let map_iter_out = + "4 10 100\nnever allocated: 0\nallocated and empty: 0\nspent: 2\n\ + 6 9 12\n500 500 500\n" + in + outputs "map iteration" "programs/map-iter.flan" map_iter_out; + outputs ~opt:"-O0" "map iteration, -O0" "programs/map-iter.flan" map_iter_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, From a9f903a63d7533b98166f4b5ffbe0ea813995160 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 12 Sep 2026 22:41:41 +0700 Subject: [PATCH 3/3] A bare name is the function, and capture is the part that is not built --- BUILT.md | 122 +++++++++++++ NEXT.md | 28 +-- lib/check.ml | 299 +++++++++++++++++++++++++++----- lib/emit.ml | 93 +++++++--- lib/prelude.ml | 119 +++++++++++-- lib/reach.ml | 7 + lib/render.ml | 6 + lib/tast.ml | 43 +++-- test/programs/fn-capture.flan | 11 ++ test/programs/fn-extern.flan | 13 ++ test/programs/fn-in-struct.flan | 9 + test/programs/fn-no-type.flan | 8 + test/programs/fn-values.flan | 88 ++++++++++ test/programs/higher-order.flan | 50 ++++++ test/test_acceptance.ml | 62 ++++++- test/test_flan.ml | 46 ++++- 16 files changed, 896 insertions(+), 108 deletions(-) create mode 100644 test/programs/fn-capture.flan create mode 100644 test/programs/fn-extern.flan create mode 100644 test/programs/fn-in-struct.flan create mode 100644 test/programs/fn-no-type.flan create mode 100644 test/programs/fn-values.flan create mode 100644 test/programs/higher-order.flan diff --git a/BUILT.md b/BUILT.md index eae583e..34efb28 100644 --- a/BUILT.md +++ b/BUILT.md @@ -2700,6 +2700,11 @@ constant-folds a `powf` of two literals and leaves nothing to link. ### What could not be built, and why it is not "no generics" Four things on NEXT.md's list did not land, and the interesting part is that the reason differs in each case. +**Three of the four have since landed** — see "`map-next!`, the one thing a Map could not do", "Function values, with +no capture" and "A prelude function may call a prelude macro" below — and each was fixed by the thing named here +rather than by generics, which is the argument this list was making. The fourth, the path-insensitive dead set, is +still open. Kept as written because the diagnoses are what the later lanes worked from, and one of them turned out to +be wrong in a way worth being able to see: the prelude *was* reaching the expander. - **`Map` keys and values** need a **map iterator**, and there is none. `flan_map_len`, `_get`, `_put`, `_has`, `_clone`, `_reserve`, `_free` is the runtime's entire map surface; nothing walks the open-addressed block. One @@ -2733,6 +2738,123 @@ Tests: `programs/strings.flan`, `programs/format.flan`, `programs/algorithms.fla `-O2` and `-O0`, and `strings.flan` also in a dev build — the one that checks a container's recorded allocator epoch, so it is what would catch one of these `Vec`s being used after the arena under it was released. +## Function values, with no capture, and why that was the whole blocker + +`map`, `filter`, `reduce` and `sort-by` could not be written, and the previous lane's sharpening of the reason was +right: **function values, not generics**. Generics alone would not have fixed it — without something to pass there is +nothing to be generic over — and function values alone did fix it, which is the evidence. The prelude gained all four +the same day, without generics, and is still one copy per element type, which is the half generics would remove. + +### The shape, and why it was not invented here + +The compiler has built and called function values internally since the Map landed. A `handler-bind` clause is lowered +to a function of its own, its address goes into a `flan_handler`, and the runtime calls it back through +`h->fn(condition, xfer)`; a Map's hash and equality pair is the same arrangement, reached as Odin reaches +`Map_Info`'s two contextless `proc` fields. **The surface feature is that machinery given a name**, not a second one +beside it. `check_fn` is `check_handler_bind`'s clause lifting with the parameters coming from the type instead of +from the condition, and `emit`'s indirect call is the callee expression handed to the same `call_through` a direct +call already went through. + +### A bare name is the function + +``` +(map double xs) +``` + +and not Common Lisp's `#'double`. **This is a Lisp-1 — one top-level namespace, enforced, so a `defn` and a `defvar` +cannot share a name** — which is exactly what makes the bare name safe to read: there is no second binding of +`double` it could have meant instead, so the sharp quote would be punctuation answering a question the language does +not ask. + +A `Types.Fn` is one pointer. There is no environment beside it, so the type resolves to `ptr` and lays out as eight +bytes, and a call through one is byte-for-byte the call a name would have produced — a Flan function's emitted +signature is its parameters followed by the transfer channel whether it was reached by name or by pointer. That is +why a handler established across a `fold` still catches a signal raised by the function the fold was handed: +`programs/fn-values.flan` does exactly that, and it is the case that would fail if an indirect call skipped the +guard. + +### `fn` literals take their types from the position + +`Ast.Fn` carries parameter *names* and no types — that is the surface syntax, not an omission — so an `fn` is +checkable exactly where something says what is wanted. An argument position does, because `named_call` already +threads the callee's parameter type into each argument; a bare `(let [f (fn [x] x)])` does not, and is refused saying +so (`programs/fn-no-type.flan`). A name already written as a `defn` goes anywhere, because it carries its own +signature. + +### What was built, and what was refused by name + +**Built:** a written `(Fn [T ...] R)` annotation; a `defn`'s name in value position; an `fn` literal; a call through +a value, both by the name it is bound to and through a computed head; returning one. Four refusal sites, all four +implemented. + +**Refused, each with its own reason and its own program:** + +- **Capture does not exist** (`fn-capture.flan`). An `fn` is lifted into a function of its own and handed nothing but + its parameters; a reference to a local of the enclosing function is refused by name. This is the same refusal a + handler clause has always carried, and the two now share one message with the construct's name in it. + `spec-memory.md`'s capture cases, and **escaping closures with them, stay deferred** — deliberately, and this is + what keeps a function value a bare code address that cannot outlive anything. +- **An `fn` with nothing to say what it takes** (`fn-no-type.flan`), above. +- **A position that would zero one** (`fn-in-struct.flan`): a struct field, a global, a fixed array's element, + `(zeroed)`. ZII fills an omitted field with all-bytes-zero, and **a zeroed function value is a null pointer, which + is the one kind of zero that is not a value the type can have** — every other type's zero is one: `0`, `false`, an + empty slice, `None`, a union's first case. A parameter, a return type and a `let` binding are not on the list + because none of them is ever conjured, and an `(Option (Fn ...))` is not either, because a `None`'s tag is what + nobody may look past. Nor are a `(Vec (Fn ...))` or a `Map` with function values: the Vec runtime never zeroes + past its length and `flan_map_alloc` zeroes only the hash run, so neither conjures an element nobody pushed or + put. A function value as a map *key* is refused already, by `Types.keyable` — hashing an address is a different + operation from hashing what it points at. +- **A foreign function's address** (`fn-extern.flan`). A Flan function's signature ends with the transfer channel and + a C one does not, and an aggregate crossing the boundary is flattened by a generated shim the raw symbol knows + nothing about. Wrap it in a `defn` and pass that. + +### `Fnval`, and the one thing a dev build cannot do + +`Tast.FnAddr` had two `fnref` cases and now has three. `Flanfn` and `Rtfn` are the compiler's own uses and want the +*symbol*, always — a lifted handler clause and a hash pair have no indirection cell to load from. **`Fnval` is a +function value someone wrote, and in a dev build it is the cell's contents rather than the symbol**, so a value taken +after a redefinition is the new body. Splitting the case rather than overloading `Flanfn` is what keeps that true +without breaking the two paths that must not take it. + +What that does *not* give: a value taken *before* a redefinition and called after it is still the old body. Once the +address is in a slot there is nothing left to re-resolve, and the honest fix is a trampoline per function, which is a +cost every program would pay for a case no one has hit. Named here rather than papered over. + +The two lifted-function name sequences are counted **per kind** — `fn/OWNER/N` and `handler/OWNER/N/TYPE` — +rather than off one list. Sharing a counter would rename every `fn` in a function the moment a `handler-bind` was +added above one, which is a rename for a body that did not change, in exactly the names a redefinition module emits. + +`Tast.CallPtr` is its own node for the same kind of reason. Everything that walks this IR treats `Call`'s string as a +*link-time* edge — `Reach` roots the callee, `Dev` finds the cell, `Emit` may load it — and none of those are +questions an indirect call can answer. `Reach` gains the `Fnval` edge, and that edge is load-bearing: a name used as +a value is never a `Call`, so without it the one function a program passes to `map` is the one function the link +drops. + +### A user-written allocator: still refused, and now for two different reasons + +NEXT.md said it needed "a defn's name in value position". **It has that now, and it is still two things short**, +neither of them a function-value question: + +1. The runtime calls `a->proc(a, mode, p, old_size, size, align)` — six C arguments and no transfer channel — and + every Flan function value's signature ends with one. It is the same mismatch a foreign function's address is + refused for, pointing the other way. +2. `Allocator` is opaque and pointer-width, so there is nowhere for a program to put the `flan_allocator` that + pointer would have to point at. + +The refusal message says both, and `programs/user-allocator.flan` is the row that holds it. `(arena-new ...)` over a +backing buffer remains the parameterised allocator that does exist. + +### The prelude's four + +`map-i32!`/`map-f32!`, `filter-i32`/`filter-f32`, `reduce-i32`/`reduce-f32` and `sort-i32-by!`/`sort-f32-by!`. Two +rules, both inherited rather than invented: the in-place ones write back into the slice they were handed, because a +slice is non-owning and transforming a thing you already own should not allocate; and `filter` allocates and the +caller frees, like everything in the building tier. + +**A `map` that changes the element type is the one shape that did not come with them** — it is one copy per *ordered +pair* of types rather than per type, which is where a per-type family stops being honest. That entry is what is left +in `prelude.ml`'s refusal block where `map, filter, reduce, sort-by` used to be, and its reason is generics. + ## `map-next!`, the one thing a Map could not do `flan_map_len`, `_get`, `_put`, `_has`, `_clone`, `_reserve` and `_free` was the runtime's entire map surface, and diff --git a/NEXT.md b/NEXT.md index 86a6c31..c0d6657 100644 --- a/NEXT.md +++ b/NEXT.md @@ -558,12 +558,16 @@ them wants a language decision. iterator: a `defn` has to name its types and `(defn map-keys [m {K V}] (Vec K))` has no `K`. The loop is three lines at the call site, where `K` is known. -- **`map`, `filter`, `reduce`, and a sort taking a comparator.** Blocked on **function values**, not on generics, - which is the sharper statement than the one this list made. `Types.Fn` exists; `check.ml` refuses it with "a - function type is not implemented yet — milestone 5"; and there is nothing else in the language to pass. Generics on - top of that is what would make them one copy rather than one per element type, but without function values there is - nothing to be generic *over*. `sort-f32!` and `sort-bytes!` are the concrete answer in the meantime, and `sum-i32` - and `sum-f32` already are `reduce` with the `+` written in. +- ~~**`map`, `filter`, `reduce`, and a sort taking a comparator.**~~ **All four are in the prelude.** The diagnosis + was right and is now evidenced: **function values, not generics** — they arrived with no generics at all. See + [`BUILT.md`](BUILT.md), "Function values, with no capture". They are one copy per element type (i32 and f32), which + is the half generics would remove, and a `map` that *changes* the element type is the one shape that did not come + with them — one copy per ordered pair of types rather than per type. + + **Capture is not built and escaping closures stay deferred.** An `fn` is lifted into a function of its own and + handed nothing but its parameters; a reference to an enclosing local is refused by name. That is what keeps a + function value a bare code address with no environment, and it is the next thing to want if a callback needs + state — `spec-memory.md`'s cases 1 and 2 are still the design to build from. - **`(vec-new [u8])` is refused**, so a `(Vec [u8])` can only be made where the *context* names the type. `check.ml`'s `vec_new_elem` accepts a single bare symbol naming a type and nothing else, and a `let` has no type @@ -654,11 +658,13 @@ run one lane at a time; item 4 is disjoint and runs alongside any of them. **`Result`/`try`** follows, being another union. - **Generics are deliberately NOT here.** They feel adjacent and are not urgent, and today is the evidence: `Vec` and - `Map` were the obvious customer and needed none — they are type-erased, with the compiler emitting sizes and the - hash/equality pair per call site, which is Odin's design. The remaining customers are user-written allocators and - escaping closures, and both actually want **function values**, which is a separate milestone-5 feature. Leave - generics until something concrete needs them. + **Generics are deliberately NOT here** — and function values landing has *sharpened* the case rather than made it, + which is the useful update. `Vec` and `Map` needed none, being type-erased. Function values needed none. What + needs them is now concrete and small: the prelude's `map!`/`filter`/`reduce`/`sort-by!` are **two copies each**, + i32 and f32, differing in nothing but the element type; `map-keys`/`map-values` cannot be written at all because + a `defn` must name its types and `(defn map-keys [m {K V}] (Vec K))` has no `K`; and a `map` from `[i32]` to + `[f32]` would be one copy per ordered pair. A user-written allocator is *not* on this list any more — it wants + a C-shaped callback and somewhere to put a `flan_allocator`, neither of which is a type parameter. 6. **`Handle` and the pool.** A reference to something that can die, that reports that it died rather than silently resolving to whatever reused the slot. Wanted on its own terms for entities referred to across frames, and it is the diff --git a/lib/check.ml b/lib/check.ml index 772ad6b..b07e489 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -163,7 +163,11 @@ type ctx = { locals can be refused for the reason it is really refused for rather than as an unknown name. *) outer : (string * binding) list; - mutable in_handler : bool; + (* Set on the context of a body the checker lifted into a function of its + own — a handler clause, or an [fn] literal — and naming which, so the + refusal below says why the enclosing function's locals are not there. Both + are the same gap: capture does not exist. *) + mutable outer_what : string option; (* True wherever handler or restart frames established by this function are on the stack. A [return] from there would leave them pointing into a frame that has gone, so it is refused — the same rule as [defer] inside a @@ -258,14 +262,23 @@ let lookup ctx name = List.assoc_opt name ctx.scope for the reason it is really refused for, rather than as a name nobody has heard of. *) let captured ctx loc name = - if ctx.in_handler && List.mem_assoc name ctx.outer then + match ctx.outer_what with + | Some what when List.mem_assoc name ctx.outer -> + let why = + if String.equal what "a handler" then + "a handler runs from wherever the signal was. Use a global, or pass \ + it on the condition" + else + "an fn is lifted into a function of its own and is handed nothing but \ + its parameters. Pass it in, or use a global" + in raise (Loc.Error (loc, Printf.sprintf - "a handler cannot see %s: it is a local of the function that \ - established the handler, and a handler runs from wherever the \ - signal was. Use a global, or pass it on the condition." name)) + "%s cannot see %s: it is a local of the enclosing function, and \ + %s." what name why)) + | _ -> () let scoped ctx f = let saved = ctx.scope in @@ -339,23 +352,56 @@ let map_type loc (k : Types.t) (v : Types.t) = (Types.to_string k); Types.Map (k, v) +(* The positions a function value may not be written in, and the one reason + they are all the same position: something zeroes it. + + ZII is the language's rule — an omitted struct field, a fixed array's + elements, a [defvar] with no initialiser are all all-bytes-zero — and a + zeroed function value is a null pointer with a signature on it, which is the + one kind of zero that cannot be used for anything. Every other type's zero + is a value: 0, false, an empty slice, [None], a union's first case. So these + are refused where they are written rather than left to crash at the call. + + A parameter, a return type, a [let] binding and an [(Option (Fn ...))] are + not on the list: none of them is ever conjured, and an [Option]'s zero is a + [None] whose tag nobody may look past. *) +let rec no_zeroed_fn loc what (t : Types.t) = + match t with + | Types.Fn _ -> + fail loc + "%s cannot be %s: it would be zeroed, and a zeroed function value is \ + a null pointer — every other type's zero is a value it can have, and \ + this one is not. Pass it as a parameter, or hold it in a let" + what (Types.to_string t) + | Types.Array (_, e) -> no_zeroed_fn loc what e + | _ -> () + 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.Tarray (l, e) -> + let e = resolve env ~seen e in + no_zeroed_fn loc "a fixed array's element" e; + Types.Array (array_len env loc l, e) (* {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 - above, which is the same shape of not-yet. *) - | Ast.Tfn _ -> unimplemented loc "a function type" 5 + (* (Fn [T ...] R): a function value, which is one code address and no + environment beside it. There is no capture — [check_fn] refuses a + reference to an enclosing local by name — so this is a pointer with a + signature and nothing about it can dangle. + + Where one may be *written* is narrower than where the type resolves, and + the two rules live apart on purpose: this is what the spelling means, and + [no_zeroed_fn] is where a position that would zero one is refused. A + parameter, a return type and a let binding are the positions that work. *) + | Ast.Tfn (ps, r) -> + Types.Fn (List.map (resolve env ~seen) ps, resolve env ~seen r) | Ast.Tapp (name, args) -> (match name, args with | "Ptr", [ a ] -> Types.Ptr (resolve env ~seen a) @@ -677,7 +723,7 @@ let hash_ty = Types.Int Types.U64 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; loops = []; + defers = []; outer = []; outer_what = None; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } @@ -796,7 +842,8 @@ and struct_key_pair env loc n = 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)) + | Tast.Flanfn s | Tast.Fnval s -> + mk loc hash_ty (Tast.Call (s, args)) in mk loc Types.Unit (Tast.Set (Tast.Plocal acc, @@ -832,7 +879,8 @@ and struct_key_pair env loc n = 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)) + | Tast.Flanfn s | Tast.Fnval 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 ])) @@ -998,7 +1046,7 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr = "some early-returns None, so the enclosing function must return an \ Option; this one returns %s" (Types.to_string other)) | Ast.Unwrap (Ast.Utry, _) -> unimplemented loc "try (Result)" 6 - | Ast.Fn _ -> unimplemented loc "fn values" 5 + | Ast.Fn (params, body) -> check_fn ctx ~want loc params body | Ast.Dotimes (label, name, count, body) -> check_dotimes ctx ~want loc label name count body (* (signal c) : Unit, always — spec-conditions.md §1. A handler that returns @@ -1185,10 +1233,27 @@ and var ctx loc ~want name = "%s is a case of the union %s, and a union value names both — \ write %s.%s" name uname uname c.Tast.vname | None -> - if Hashtbl.mem ctx.env.fns name then - unimplemented loc - (Printf.sprintf "the function value %s (a name used as a value)" name) 5 - else begin captured ctx loc name; fail loc "unknown name %s" name end + (* A bare function name *is* the function. This is a Lisp-1 — one + top-level namespace, enforced, so a defn and a defvar cannot share + a name — and that is exactly what makes (map double xs) safe to + read: there is no second binding of [double] for it to have meant + instead, so Common Lisp's #'double would be punctuation answering + a question this language does not ask. *) + (match Hashtbl.find_opt ctx.env.fns name with + | Some (params, ret) -> + (* A foreign function is in [fns] too, and its emitted signature + is C's: no transfer channel, and an aggregate flattened by the + shim. Nothing could call the resulting pointer correctly, so it + is refused for what it is rather than handed out. *) + if Hashtbl.mem ctx.env.externs name then + fail loc + "%s is a foreign function, and its address is not a Flan \ + function value: a Flan function's signature ends with the \ + transfer channel and a C one does not. Wrap it in a defn \ + and pass that" name; + expect loc ~want + (mk loc (Types.Fn (params, ret)) (Tast.FnAddr (Tast.Fnval name))) + | None -> captured ctx loc name; fail loc "unknown name %s" name) (* Reading a move-only local. Every read is a move unless the site said it was a borrow, which is the conservative direction: passing one to a function, @@ -1248,6 +1313,98 @@ and block ctx ?want ?(defer_ok = false) loc body = let body, ty = go body in mk loc ty (Tast.Do body) +(* (fn [x y] BODY...) — a function value, lifted into a function of its own. + + The same arrangement a handler clause already uses, and deliberately so: + this compiler has built and called function values internally since the Map + landed, and the surface feature is that machinery given a name rather than a + second one invented beside it. + + **No capture, and that is the scope of this milestone.** The body sees its + parameters and the program's globals and nothing else; a reference to a + local of the enclosing function is refused by name (see [captured]) rather + than resolved to something it did not mean. That is what makes the value a + bare code address with no environment behind it, which in turn is what makes + it safe to pass down, return, and store: there is nothing that can outlive + anything. spec-memory.md's capture cases, and escaping closures with them, + stay deferred. + + **The parameter types come from the position.** [Ast.Fn] carries names and + no types — that is the surface syntax, not an omission here — so an fn is + checkable exactly where something says what is wanted. An argument position + does, because [named_call] threads the callee's parameter type into each + argument; a bare [(let [f (fn [x] x)])] does not, and is refused saying so. *) +and check_fn ctx ~want loc (params : string list) body = + let pts, ret = + match want with + | Some (Types.Fn (ps, r)) when List.length ps = List.length params -> ps, r + | Some (Types.Fn (ps, r)) -> + fail loc + "this fn has %d parameter%s and %s was wanted here" + (List.length params) + (if List.length params = 1 then "" else "s") + (Types.to_string (Types.Fn (ps, r))) + | Some other when other <> Types.Never -> + fail loc "expected %s, found an fn" (Types.to_string other) + | _ -> + fail loc + "nothing here says what this fn's parameters are — an fn takes its \ + types from the position it is written in, so it goes in an argument \ + whose parameter is a (Fn [T ...] R), and a name already written as a \ + defn goes anywhere" + in + (* Its own frame and its own empty scope, with [outer] kept only so that a + reference to the enclosing function's locals is refused for the reason it + is really refused for. *) + let fctx = + { env = ctx.env; ret; slots = 0; slot_tys = []; slot_names = []; + scope = []; defers = []; outer = ctx.scope; + outer_what = Some "an fn"; in_frames = None; loops = []; + in_defer = false; defer_ok = false; defer_block = "a nested form"; + dead = []; borrow = false; owner = ctx.owner } + in + List.iter2 + (fun n t -> ignore (bind fctx n t ~assignable:false)) params pts; + let fbody = map_lr (fun e -> check fctx e) body in + (* The same rule an ordinary defn's body follows: the last form is the + answer, and it has to be the declared return type. *) + let fbody = + match List.rev fbody with + | [] -> fbody + | last :: rest -> + List.rev (expect last.Tast.loc ~want:(Some ret) last :: rest) + in + (* Named after the function it was written in and numbered within it, which + is the handler clause's rule and is stable for the same reason: a + redefinition module emits the lifted functions belonging to the bodies it + replaces, and an index into the whole program's list could not say which + those were. *) + let fname = + (* Counted per *kind*, not over everything this function has lifted. A + handler clause and an fn share one list, and a shared counter would + renumber every fn in a function the moment a handler-bind was added + above one — a rename for a body that did not change, in the names a + redefinition module emits. Two counters, two stable sequences. *) + let mine = + List.filter + (fun (l : Tast.fn) -> + l.Tast.fparent = Some ctx.owner + && String.length l.Tast.name >= 3 + && String.sub l.Tast.name 0 3 = "fn/") + ctx.env.lifted + in + Printf.sprintf "fn/%s/%d" ctx.owner (List.length mine) + in + ctx.env.lifted <- + { Tast.name = fname; params = pts; + slots = Array.of_list (List.rev fctx.slot_tys); + snames = Array.of_list (List.rev fctx.slot_names); + ret; body = fbody; fdefers = []; + fparent = Some ctx.owner; floc = loc } + :: ctx.env.lifted; + expect loc ~want + (mk loc (Types.Fn (pts, ret)) (Tast.FnAddr (Tast.Fnval fname))) + (* A handler runs where the *signal* was, not where it was established, so it cannot be a branch in the function that wrote it: it is lifted into a function of its own and reached through a pointer. @@ -1278,7 +1435,7 @@ and check_handler_bind ctx ?want loc clauses body = the enclosing one. *) let hctx = { env = ctx.env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; - scope = []; defers = []; outer = ctx.scope; in_handler = true; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } + scope = []; defers = []; outer = ctx.scope; outer_what = Some "a handler"; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } in (* The condition crosses as a pointer, because the handler runs while the signalling frame is still alive and there is nothing to copy. @@ -1302,12 +1459,17 @@ and check_handler_bind ctx ?want loc clauses body = stable against an unrelated handler-bind being added elsewhere, which an index into the whole program's lifted list would not be. *) let fname = - Printf.sprintf "handler/%s/%d/%s" ctx.owner - (List.length - (List.filter - (fun (l : Tast.fn) -> l.Tast.fparent = Some ctx.owner) - ctx.env.lifted)) - name + (* Per kind, for the reason [check_fn] gives: an fn lifted out of + the same function must not shift this sequence. *) + let mine = + List.filter + (fun (l : Tast.fn) -> + l.Tast.fparent = Some ctx.owner + && String.length l.Tast.name >= 8 + && String.sub l.Tast.name 0 8 = "handler/") + ctx.env.lifted + in + Printf.sprintf "handler/%s/%d/%s" ctx.owner (List.length mine) name in ctx.env.lifted <- { Tast.name = fname; params = [ Types.Ptr ty ]; @@ -1989,8 +2151,26 @@ and indexed ctx (target : Tast.expr) (idx : Ast.expr list) = and check_call ctx ~want loc (head : Ast.expr) (args : Ast.expr list) = match head.Ast.e with | Ast.Var name -> named_call ctx ~want loc name args - | _ -> - unimplemented loc "calling something other than a named function" 5 + (* A computed head: ((choose k) 3). The head is an ordinary expression and + the only thing asked of it is that it be a function. *) + | _ -> call_value ctx ~want loc (check ctx head) args + +(* The indirect call, once the callee is checked. Shared by the computed head + above and by a name that resolved to a local or a parameter of function + type, which is the shape every caller of [map] has. *) +and call_value ctx ~want loc (callee : Tast.expr) args = + match callee.Tast.ty with + | Types.Fn (params, ret) -> + if List.length args <> List.length params then + fail loc "this function value takes %d argument%s, given %d" + (List.length params) + (if List.length params = 1 then "" else "s") + (List.length args); + let args = map2_lr (fun p a -> check ctx ~want:p a) params args in + expect loc ~want (mk loc ret (Tast.CallPtr (callee, args))) + | other -> + fail loc "this is a %s and not a function, so it cannot be called" + (Types.to_string other) and arity loc name n args = if List.length args <> n then @@ -2404,7 +2584,9 @@ and named_call ctx ~want loc name args = | "zeroed" -> arity loc name 0 args; (match want with - | Some ty when ty <> Types.Never -> mk loc ty (Tast.Zero ty) + | Some ty when ty <> Types.Never -> + no_zeroed_fn loc "this" ty; + mk loc ty (Tast.Zero ty) | _ -> fail loc "zeroed needs to know the type it is zeroing — use it where one is \ @@ -2467,19 +2649,26 @@ and named_call ctx ~want loc name args = (* Every one of these is an ordinary named call, which is the whole of the escape NEXT.md describes: [check_call] already routes a named call through here, so none of the four function-value refusals is anywhere near it. *) - (* A *user-written* allocator is the one thing in this tier that does need - milestone 5, and it is refused by name rather than left as an unknown - one. "Here is my proc, make an Allocator from it" needs a defn's name in - value position, which is the refusal a few hundred lines below this. The - built-in set needs nothing from milestone 5 because its procedures are C - symbols the emitter names and no Flan type mentions them. *) + (* A *user-written* allocator, and the reason it is still refused now that + function values exist. NEXT.md said it needed "a defn's name in value + position"; it has that, and it is still two things short, both of them + nameable and neither of them a function-value question any more. + + The built-in set needs none of it: heap-allocator and arena-new are C + symbols the emitter names, and no Flan type mentions them. *) | "make-allocator" | "allocator-from" | "allocator" -> fail loc - "a user-written allocator is not implemented yet — milestone 5. It needs \ - a defn's name in value position, which is a function value; the \ - built-in allocators (heap-allocator, arena-new) need none of that \ - because their procedures are runtime symbols and no Flan type names \ - them" + "a user-written allocator is not implemented yet, and a defn's name in \ + value position — which is what this used to wait for — is no longer \ + what is missing. Two things are. The runtime calls an allocator as \ + proc(a, mode, p, old, size, align): six C arguments and no transfer \ + channel, and every Flan function value's signature ends with one, so \ + the pointer would be called with the wrong shape (the same mismatch a \ + foreign function's address is refused for). And Allocator is opaque \ + and pointer-width, so there is nowhere for a program to put the \ + flan_allocator the pointer would have to point at. Use \ + (arena-new ...) with a backing buffer, which is the parameterised \ + allocator that does exist" | "heap-allocator" -> arity loc name 0 args; expect loc ~want @@ -3392,6 +3581,22 @@ and named_call ctx ~want loc name args = prim (Tast.Cast target) target [ a ] (* ── ordinary calls ────────────────────────────────────────────── *) + (* A local or a parameter holding a function value, called by the name it is + bound to — which is what the body of [map] looks like. It is checked + before the global function table and after every builtin: a binding + shadows a defn of the same name (one namespace, ordinary lexical + scoping), and nothing shadows [+]. A local of any *other* type falls + through to the table, so a program that shadows a function name with an + i32 and then calls the function still means the function. *) + | _ when (match lookup ctx name with + | Some b -> (match b.bty with Types.Fn _ -> true | _ -> false) + | None -> false) -> + (* The binding the guard already found, read directly. Going back through + [check] would repeat the lookup and walk the move and capture paths for + a type that is neither move-only nor capturable. *) + (match lookup ctx name with + | Some b -> call_value ctx ~want loc (mk loc b.bty (Tast.Local b.slot)) args + | None -> assert false) | _ -> match Hashtbl.find_opt ctx.env.fns name with | Some (params, ret) -> @@ -3536,7 +3741,10 @@ let collect env (decls : Ast.decl list) = in while fold_consts () do () done; let field (f : Ast.field) : Tast.field = - { Tast.fname = f.Ast.fname; fty = resolve env f.Ast.fty } + let fty = resolve env f.Ast.fty in + no_zeroed_fn f.Ast.fty.Ast.tloc + (Printf.sprintf "the field %s" f.Ast.fname) fty; + { Tast.fname = f.Ast.fname; fty } in (* Constants with no declared type are inferred from their value, which needs every other signature in hand — so they are deferred to a pass of their @@ -3704,7 +3912,7 @@ let collect env (decls : Ast.decl list) = run without swallowing it. *) let infer (_, v) = (check { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } v).Tast.ty + outer = []; outer_what = None; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } v).Tast.ty in let pending = ref (List.rev !untyped) in let rec settle () = @@ -3757,7 +3965,7 @@ let check_finite env = let 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 = []; in_handler = false; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; + outer = []; outer_what = None; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = fn.Ast.name } in List.iter2 (fun (p : Ast.field) ty -> @@ -3836,6 +4044,7 @@ let check_fn env (fn : Ast.fn) : Tast.fn = this — an allocator is a copyable opaque handle — which is what makes the handler-owns-the-arena shape in exhausted.flan expressible. *) let no_move_only_global loc n (ty : Types.t) = + no_zeroed_fn loc (Printf.sprintf "the global %s" n) ty; if Types.is_move_only ty then fail loc "the global %s is %s, which is move-only, and ownership of a global \ @@ -3846,7 +4055,7 @@ let no_move_only_global loc n (ty : Types.t) = let check_global env (d : Ast.decl) : Tast.global option = let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } in + outer = []; outer_what = None; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } in match d.Ast.d with | Ast.Defvar (n, _, init) -> let ty, _ = Hashtbl.find env.globals n in @@ -3978,7 +4187,7 @@ let expression env (e : Ast.expr) : Tast.expr * Types.t array * string option array = let ctx = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; - outer = []; in_handler = false; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } + outer = []; outer_what = None; in_frames = None; loops = []; in_defer = false; defer_ok = false; defer_block = "a nested form"; dead = []; borrow = false; owner = "" } in let t = check ctx e in (t, Array.of_list (List.rev ctx.slot_tys), diff --git a/lib/emit.ml b/lib/emit.ml index a979463..f668f2d 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -96,6 +96,11 @@ let rec ll (t : Types.t) = (* An [Allocator] is a pointer to the runtime's [flan_allocator] and never a copy of one: see Types. Opaque here in the same sense [ptr] is. *) | Types.Alloc -> "ptr" + (* A function value is a code address and nothing else. There is no + environment beside it — capture does not exist (check.ml refuses it by + name) — so it is one pointer, the same width as any other, and a backend + needs to know no more about it than that. *) + | Types.Fn _ -> "ptr" (* ptr + len + cap + allocator, and two more words the runtime owns: see flan_rt.c's (Vec T) header for why they are in every build. Nothing in this file reads a field of one — every operation is a runtime call taking @@ -109,8 +114,8 @@ let rec ll (t : Types.t) = 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.Fn _ | Types.Var _ -> - (* The checker rejects each of these by name — nothing reaches here. *) + | Types.Var _ -> + (* The checker rejects it by name — nothing reaches here. *) failwith ("no layout for " ^ Types.to_string t) let is_void (t : Types.t) = match t with Types.Unit | Types.Never -> true | _ -> false @@ -260,6 +265,7 @@ let rec lay m (t : Types.t) : int * int = | Types.Enum _ -> 4, 4 | Types.Ptr _ -> 8, 8 | Types.Alloc -> 8, 8 + | Types.Fn _ -> 8, 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 @@ -288,8 +294,7 @@ let rec lay m (t : Types.t) : int * int = in s, a | None -> failwith ("no layout for struct " ^ n)) - | Types.Fn _ | Types.Var _ -> - failwith ("no layout for " ^ Types.to_string t) + | Types.Var _ -> failwith ("no layout for " ^ Types.to_string t) (* Size, alignment, and the offset of every member. *) and lay_fields m tys = @@ -455,7 +460,19 @@ let rec dty m d (t : Types.t) : int = ("allocator", Types.Alloc); ("gen", Types.Int Types.I64); ("epoch", Types.Int Types.I64) ] |> fun n -> ignore k; ignore v; n - | Types.Fn _ | Types.Var _ -> + (* A pointer to code, and lldb is told exactly that and no more. DWARF + has DW_TAG_subroutine_type for the signature behind it, and spelling + one out here would buy a reader nothing they cannot get from the + function it points at — [p f] answers with an address either way, and + the address is what resolves to a symbol. The name carries the + signature, which is where it is actually legible. *) + | Types.Fn _ -> + dnode d + (Printf.sprintf + "!DIDerivedType(tag: DW_TAG_pointer_type, name: \"%s\", \ + baseType: null, size: 64)" + (Types.to_string t)) + | Types.Var _ -> failwith ("no debug type for " ^ Types.to_string t) in Hashtbl.replace d.dtys key n; @@ -797,12 +814,22 @@ and value_at f (e : Tast.expr) : string = 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 + (* A function value someone wrote, which is the one [FnAddr] that is not the + symbol. In a dev build it is the cell's contents, so that a value taken + after a redefinition is the new body — the same load a direct call to the + same name would do, at the point the *address* is taken rather than at the + call. What that does not give is a value taken before a redefinition and + called after it: that one is still the old body, because there is nothing + left to re-resolve once the address is in a slot. Named in BUILT.md rather + than papered over with a trampoline. *) + | Tast.FnAddr (Tast.Fnval n) -> body_of f n | Tast.Addr p -> fst (place f p) | Tast.Prim (p, args) -> prim f e p args | Tast.Call (name, args) -> (match Hashtbl.find_opt f.md.externs name with | Some sym -> extern_call f e.Tast.ty ("@" ^ sym) args | None -> call f e.Tast.ty name args) + | Tast.CallPtr (callee, args) -> call_ptr f e.Tast.ty callee args | Tast.Do body -> block f body | Tast.Let (bs, body) -> List.iter @@ -1110,27 +1137,51 @@ and block f body = List.iter (fun e -> last := value f e) body; !last +(* The current body of a named Flan function, as something callable. A release + build is the symbol; a dev build is whatever the indirection cell holds, and + there are two spellings of that because a function this module emitted has + its cell as a symbol and one it does not has only a cached address. *) +and body_of f flan = + if not f.md.dev then fname flan + else if f.md.known flan then begin + let p = fresh f in + ins f "%s = load ptr, ptr %s" p (cellname flan); + p + end else begin + (* The cell itself is not a symbol here; its address was looked up by + name at install time and cached. *) + let c = fresh f in + ins f "%s = load ptr, ptr %s" c (cellptr flan); + let p = fresh f in + ins f "%s = load ptr, ptr %s" p c; + p + end + and call f ret flan args = let vs = map_lr (fun (a : Tast.expr) -> let v = value f a in Printf.sprintf "%s %s" (ll a.Tast.ty) v) args in (* The cell is loaded *after* the arguments, so a redefinition that lands between two calls still cannot land in the middle of one. *) - let callee = - if not f.md.dev then fname flan - else if f.md.known flan then begin - let p = fresh f in - ins f "%s = load ptr, ptr %s" p (cellname flan); - p - end else begin - (* The cell itself is not a symbol here; its address was looked up by - name at install time and cached. *) - let c = fresh f in - ins f "%s = load ptr, ptr %s" c (cellptr flan); - let p = fresh f in - ins f "%s = load ptr, ptr %s" p c; - p - end - in + let callee = body_of f flan in + call_through f ret callee vs + +(* A call through a function value. Identical to the direct case once the + callee is in hand — a Flan function's signature is its parameters followed + by the transfer channel whether it was reached by name or by pointer — so + the guard after it is the same guard, and a [return] out of a callee taken + as a value transfers exactly as one out of a callee named does. + + The callee is evaluated *before* the arguments, which is the order it is + written in and the order a reader expects; the direct case is the other way + round for a reason that does not apply here (there is no cell to keep out of + the middle of an argument list). *) +and call_ptr f ret callee args = + let c = value f callee in + let vs = map_lr (fun (a : Tast.expr) -> + let v = value f a in Printf.sprintf "%s %s" (ll a.Tast.ty) v) args in + call_through f ret c vs + +and call_through f ret callee vs = let t = fresh f in ins f "%s = call %s %s(%s)" t (ll ret) callee (String.concat ", " (vs @ [ "ptr " ^ xfer_param ])); diff --git a/lib/prelude.ml b/lib/prelude.ml index 022f5eb..03b6c48 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -103,14 +103,13 @@ let source = {flan| ;; allocating tier is further down, and a caller sorts a Vec by sorting ;; (as-slice v). ;; -;; **map, filter, reduce and a sort taking a comparator are not here, and they -;; are not blocked on generics.** They are blocked on *function values*: each -;; of them takes a callable as an argument, Types.Fn exists but check.ml -;; refuses it with "a function type is not implemented yet — milestone 5", and -;; there is nothing else in the language to pass. Generics on top of that is -;; what would make them one copy instead of one per element type; without -;; either, the honest form is the concrete fold, which is what sum-i32 and -;; sum-f32 below already are — (reduce + 0) with the + written in. +;; **map, filter, reduce and a sort taking a comparator are here now**, in a +;; section of their own after the f32 family. They were blocked on *function +;; values* and not on generics, which is why they arrived without generics: +;; a (Fn [T ...] R) is an ordinary parameter type. What they are still one +;; copy per element type for *is* generics — sum-i32 and sum-f32 are the same +;; shape and the same argument — so the set is the same i32 and f32 the rest of +;; this family covers. (defn swap-i32! [s [i32] i i32 j i32] (let [t (at s i)] @@ -244,6 +243,99 @@ let source = {flan| (set t (+ t (f64 (at s i))))) t)) +;; ── The ones that take a function ───────────────────────────────────── +;; +;; map, filter, reduce and a comparator sort, which were the four the previous +;; tier could not write. The blocker was function values and not generics, and +;; the difference shows in what arrived and what did not: these take a +;; (Fn [T ...] R) as an ordinary parameter and needed nothing else, and they +;; are still one copy per element type because *that* is the generics half. +;; +;; Two rules, both inherited rather than invented here: +;; +;; 1. **The in-place ones stay in place.** map! writes back into the slice it +;; was handed, for the same reason sort-i32! does — a slice is non-owning, +;; and transforming a thing you already own should not allocate. A map that +;; produces a *different* element type is not here: it would be one copy per +;; ordered pair of types, which is the point at which a per-type family +;; stops being honest. +;; 2. **filter allocates and the caller frees**, like everything in the +;; building tier: (free v), or let a (free-all a) take the region. +;; +;; The function is passed by name — this is a Lisp-1, so a bare defn name is +;; the function — or written inline as an (fn [x] ...), whose parameter types +;; come from the parameter it is being passed to. It may not capture: an fn is +;; lifted into a function of its own and sees its parameters and the globals +;; and nothing else. + +(defn map-i32! [s [i32] f (Fn [i32] i32)] + (dotimes [i (len s)] + (set (at s i) (f (at s i))))) + +(defn map-f32! [s [f32] f (Fn [f32] f32)] + (dotimes [i (len s)] + (set (at s i) (f (at s i))))) + +;; The general fold, of which sum-i32 is the special case with the + written +;; in. The accumulator comes first in the step, which is the order that reads +;; as (f acc x) and the order Odin's slice.reduce uses. +(defn reduce-i32 [s [i32] init i32 f (Fn [i32 i32] i32)] i32 + (let [acc init] + (dotimes [i (len s)] + (set acc (f acc (at s i)))) + acc)) + +(defn reduce-f32 [s [f32] init f32 f (Fn [f32 f32] f32)] f32 + (let [acc init] + (dotimes [i (len s)] + (set acc (f acc (at s i)))) + acc)) + +;; A new Vec holding the elements the predicate kept, in the order they were +;; in. Owned by the caller. +(defn filter-i32 [s [i32] keep? (Fn [i32] bool)] (Vec i32) + (let [v (vec-new i32)] + (dotimes [i (len s)] + (when (keep? (at s i)) + (push v (at s i)))) + v)) + +(defn filter-f32 [s [f32] keep? (Fn [f32] bool)] (Vec f32) + (let [v (vec-new f32)] + (dotimes [i (len s)] + (when (keep? (at s i)) + (push v (at s i)))) + v)) + +;; The same insertion sort sort-i32! is, with the one comparison it had written +;; in replaced by the one it is told. before? answers "does a come before b", +;; so passing (fn [a b] (< a b)) is ascending and reversing it is descending — +;; and a caller wanting a key rather than an order writes the comparison. +;; +;; It is stable exactly as sort-i32! is: the loop stops the moment before? says +;; no, so equal elements never swap past each other. A before? that is not a +;; strict weak ordering — one answering true for both (a b) and (b a) — is the +;; caller's mistake and shows up as an order, not as a loop: the inner while is +;; bounded by j reaching 0 whatever the comparison says. +(defn sort-i32-by! [s [i32] before? (Fn [i32 i32] bool)] + (let [i 1] + (while (< i (len s)) + (let [j i] + ;; `and` short-circuits, so (at s -1) is never evaluated at j = 0. + (while (and (> j 0) (before? (at s j) (at s (- j 1)))) + (swap-i32! s (- j 1) j) + (set j (- j 1)))) + (set i (+ i 1))))) + +(defn sort-f32-by! [s [f32] before? (Fn [f32 f32] bool)] + (let [i 1] + (while (< i (len s)) + (let [j i] + (while (and (> j 0) (before? (at s j) (at s (- j 1)))) + (swap-f32! s (- j 1) j) + (set j (- j 1)))) + (set i (+ i 1))))) + ;; ── Bytes ───────────────────────────────────────────────────────────── ;; ;; Over [u8] and not over string, so (bytes s) is what a caller writes and one @@ -1200,9 +1292,14 @@ let source = {flan| ;; allocation one. format-f64 above is the piece of it ;; that was actually wanted, and `print`/`println` are ;; already the structural walk over any one value. -;; map, filter, reduce Function values. See the head of the slice-algorithm -;; sort-by section: check.ml refuses a function type outright, -;; and there is nothing in the language to pass. +;; map that changes the Generics, and only that. map!, filter, reduce and +;; element type sort-by! landed the day function values did — see +;; "The ones that take a function" above — at i32 and +;; f32, the two element types the rest of that family +;; covers. A map from [i32] to [f32] is the one shape +;; that did not come with them, because it is one copy +;; per *ordered pair* of types rather than per type, +;; which is where a per-type family stops being honest. ;; map-keys, map-values Generics — and the reason changed, which is the ;; point of naming them separately. It used to be the ;; missing Map iterator; `map-next!` is that iterator diff --git a/lib/reach.ml b/lib/reach.ml index 1a59826..331f4cf 100644 --- a/lib/reach.ml +++ b/lib/reach.ml @@ -45,8 +45,15 @@ let rec expr_refs f (e : Tast.expr) = a map loses the two functions its every lookup calls through. *) | Tast.FnAddr (Tast.Flanfn n) -> f n | Tast.FnAddr (Tast.Rtfn _) -> () + (* A function value, and the *only* thing that keeps it linked. A name used + as a value is never a [Call], so without this edge the one function a + program passes to [map] is the one function the link drops. *) + | Tast.FnAddr (Tast.Fnval n) -> f n | Tast.Prim (_, es) -> gos es | Tast.Call (n, es) -> f n; gos es + (* No name to root: whatever this calls was reached as a value, and the + [FnAddr] that produced it is somewhere in the callee expression. *) + | Tast.CallPtr (callee, es) -> go callee; gos es | Tast.Do es -> gos es | Tast.Let (bs, body) -> List.iter (fun (_, v) -> go v) bs; gos body | Tast.If (c, t, e') -> go c; go t; go e' diff --git a/lib/render.ml b/lib/render.ml index 43344bf..09a4486 100644 --- a/lib/render.ml +++ b/lib/render.ml @@ -122,6 +122,12 @@ let rec render c depth (e : Tast.expr) : Tast.expr list = does not own, and the walk is what [as-slice] is for: (print (as-slice v)) prints the elements and says at the call site that it borrowed. *) | Types.Vec _ -> [ lit "" ] + (* A function value is a code address, and printing the address would make + an inspection depend on where the image loaded. The signature is what a + reader can act on, so that is what is shown — and the inspector reaches + every local of a stopped frame, so a frame holding one has to render + rather than refuse. *) + | Types.Fn _ as ft -> [ lit ("<" ^ Types.to_string ft ^ ">") ] | Types.Option t -> let tag = { Tast.e = Tast.Field (e, 0); ty = Types.Int Types.I8; loc } in let some = { Tast.e = Tast.Field (e, 1); ty = t; loc } in diff --git a/lib/tast.ml b/lib/tast.ml index a350965..40181fe 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -72,17 +72,28 @@ and expr_kind = | Local of int (* slot index into the frame *) | 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. *) + | Call of string * expr list (* a call naming its callee *) + (* The address of a function the compiler emitted, by symbol. Which symbol + table, and whether the surface language can see it, is [fnref]'s job. + + Two unrelated consumers, and the difference between them is the whole + reason [fnref] has three cases rather than two. The compiler's own uses — + the Map's hash and equality pair (Odin's [Map_Info] is two contextless + [proc] fields reached exactly this way) and a handler-bind clause's + symbol — want the *symbol*, always, and carry the Flan type [Alloc]. A + function *value* someone wrote wants the body that is current, which in a + dev build is not the symbol but whatever the indirection cell holds, and + carries the Flan type [Fn]. *) | FnAddr of fnref + (* A call through a function value: the callee is an expression of type + [Fn], not a name. Its own node rather than a [Call] with an expression in + the name slot, because everything that walks this IR treats [Call]'s + string as a *link-time* edge — [Reach] roots the callee, [Dev] finds the + cell to redefine, [Emit] may load that cell — and none of those are + questions an indirect call can answer. Keeping them apart means each of + those readers keeps working on the direct case unchanged and says + explicitly what it does with the indirect one. *) + | CallPtr of expr * expr list | Do of expr list | Let of (int * expr) list * expr list | If of expr * expr * expr @@ -173,7 +184,17 @@ and expr_kind = 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 +(* [Flanfn] is a function this compiler emitted, named by its mangled symbol, + and always the symbol itself. [Rtfn] is a C entry point in flan_rt.c, spelled + as written. [Fnval] is also a Flan function this compiler emitted, but as a + *value* someone asked for by writing its name — and it is a separate case + because a dev build must answer it with the current body rather than with the + original symbol, which means a load from the indirection cell. The first two + must never take that path: a lifted handler clause and a hash pair have no + cell to load from. The three are interchangeable at a 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 | Fnval of string and sigkind = Ssignal | Serror diff --git a/test/programs/fn-capture.flan b/test/programs/fn-capture.flan new file mode 100644 index 0000000..7b9975f --- /dev/null +++ b/test/programs/fn-capture.flan @@ -0,0 +1,11 @@ +;; Capture does not exist. An fn is lifted into a function of its own and is +;; handed nothing but its parameters, so a reference to a local of the +;; enclosing function is refused by name rather than resolved to something it +;; did not mean. spec-memory.md's capture cases, and escaping closures with +;; them, are deferred; this is the refusal that says so where it happens. +(defn use [f (Fn [] i32)] i32 (f)) + +(defn main [] i32 + (let [n 7] + (println (use (fn [] n)))) + 0) diff --git a/test/programs/fn-extern.flan b/test/programs/fn-extern.flan new file mode 100644 index 0000000..1cf2882 --- /dev/null +++ b/test/programs/fn-extern.flan @@ -0,0 +1,13 @@ +;; A foreign function's address is not a Flan function value. A Flan +;; function's emitted signature ends with the transfer channel and a C one +;; does not, so nothing could call the resulting pointer correctly — and an +;; aggregate crossing the boundary is flattened by a generated shim, which the +;; raw symbol knows nothing about. Refused for what it is, with the wrapper +;; named as the way to get one. +(declare c-abs [n i32] i32 "abs") + +(defn use [f (Fn [i32] i32)] i32 (f 3)) + +(defn main [] i32 + (println (use c-abs)) + 0) diff --git a/test/programs/fn-in-struct.flan b/test/programs/fn-in-struct.flan new file mode 100644 index 0000000..510b9b6 --- /dev/null +++ b/test/programs/fn-in-struct.flan @@ -0,0 +1,9 @@ +;; ZII fills an omitted field with all-bytes-zero, and a zeroed function value +;; is a null pointer — the one kind of zero that is not a value the type can +;; have. Every other type's zero is one: 0, false, an empty slice, None, a +;; union's first case. So it is refused where the field is written rather than +;; left to crash at the call, and the same rule covers a global, a fixed +;; array's element and (zeroed). +(defstruct Ops [run (Fn [i32] i32)]) + +(defn main [] i32 0) diff --git a/test/programs/fn-no-type.flan b/test/programs/fn-no-type.flan new file mode 100644 index 0000000..2189b49 --- /dev/null +++ b/test/programs/fn-no-type.flan @@ -0,0 +1,8 @@ +;; An fn carries parameter names and no types — that is the surface syntax — +;; so it takes them from the position it is written in. An argument position +;; says what is wanted, because the callee's signature is threaded into every +;; argument; a let binding does not, and is refused saying so. +(defn main [] i32 + (let [f (fn [x] (* x 2))] + (println (f 3))) + 0) diff --git a/test/programs/fn-values.flan b/test/programs/fn-values.flan new file mode 100644 index 0000000..212e595 --- /dev/null +++ b/test/programs/fn-values.flan @@ -0,0 +1,88 @@ +;; Function values, the non-escaping kind: a code address and no environment +;; beside it. Capture does not exist, so nothing here can outlive anything. +;; +;; This is a Lisp-1 — one top-level namespace, enforced — so a bare function +;; name *is* the function and there is no #' to write. + +(defn double [x i32] i32 (* x 2)) +(defn negate [x i32] i32 (- 0 x)) +(defn square [x i32] i32 (* x x)) + +;; The shape map/filter/reduce want: the function arrives as a parameter, is +;; called, and is never stored. +(defn each! [xs [i32] f (Fn [i32] i32)] Unit + (dotimes [i (len xs)] + (set (at xs i) (f (at xs i))))) + +(defn fold [xs [i32] f (Fn [i32] i32)] i32 + (let [t 0] + (dotimes [i (len xs)] + (set t (+ t (f (at xs i))))) + t)) + +;; A comparator, which is the other half of what was blocked: a sort that is +;; told the order rather than having it written in. Insertion sort, because the +;; point here is the parameter and not the algorithm. +(defn sort-by! [xs [i32] before? (Fn [i32 i32] bool)] Unit + (dotimes [i (len xs)] + (let [j i] + (while (and (> j 0) (before? (at xs j) (at xs (- j 1)))) + (swap-i32! xs j (- j 1)) + (set j (- j 1)))))) + +(defn ascending [a i32 b i32] bool (< a b)) +(defn descending [a i32 b i32] bool (> a b)) + +;; Returning one. A function value is a link-time constant with no environment, +;; so handing it back up is no different from handing it down. +(defn pick [up bool] (Fn [i32 i32] bool) + (if up ascending descending)) + +;; A function value calling another, and the transfer channel crossing an +;; indirect call: a callee reached by pointer signals exactly as one reached by +;; name, and the handler is established across the call. +(defstruct TooBig [n i32]) + +(defn checked [x i32] i32 + (when (> x 100) (signal (TooBig {.n x}))) + x) + +(defvar seen i32) + +;; A handler-bind and an fn literal in *one* function, which is the case that +;; would catch the two lifted-function name sequences sharing a counter: both +;; are lifted out of [handles] and both are numbered within it. +(defn handles [] Unit + (handler-bind [(TooBig [c] (set seen (+ seen (.n c))))] + (let [xs [5 200 7 300]] + (println (fold (slice xs 0 4) checked)) + (println (fold (slice xs 0 4) (fn [x] (min x 10)))))) + (print "seen ") (print seen) (println "")) + +(defn main [] i32 + (let [xs [1 2 3 4]] + ;; A name in value position, passed down. + (each! (slice xs 0 4) double) + (print (at xs 0)) (print " ") (print (at xs 3)) (println "") + ;; 2 + 4 + 6 + 8 negated + (println (fold (slice xs 0 4) negate)) + ;; An fn literal, whose parameter types come from the position it is in. + (println (fold (slice xs 0 4) (fn [x] (+ x 1)))) + ;; A let binding of function type, called by the name it is bound to. + (let [f square] + (println (f 9)))) + + ;; A comparator, and the same slice sorted both ways. + (let [ys [3 1 4 1 5 9 2 6] + s (slice ys 0 8)] + (sort-by! s ascending) + (print (at s 0)) (print " ") (print (at s 7)) (println "") + (sort-by! s descending) + (print (at s 0)) (print " ") (print (at s 7)) (println "") + ;; A returned function value, and a computed head calling it. + (sort-by! s (pick true)) + (print (at s 0)) (println "") + (println ((pick false) 1 2))) + + (handles) + 0) diff --git a/test/programs/higher-order.flan b/test/programs/higher-order.flan new file mode 100644 index 0000000..08db084 --- /dev/null +++ b/test/programs/higher-order.flan @@ -0,0 +1,50 @@ +;; The prelude's function-taking family: map!, filter, reduce and a comparator +;; sort. These were the four the second tier could not write, and they arrived +;; the day function values did — so what this checks is that they are ordinary +;; prelude functions, called the ordinary way, with the function passed by +;; name or written inline. + +(defn triple [x i32] i32 (* x 3)) +(defn odd? [x i32] bool (= (% x 2) 1)) +(defn adds [a i32 b i32] i32 (+ a b)) +(defn longer-first [a i32 b i32] bool (> a b)) +(defn halve [x f32] f32 (/ x 2.0)) +(defn big? [x f32] bool (> x 1.0)) + +(defn main [] i32 + ;; map! writes back into the slice it was handed. + (let [xs [1 2 3 4] + s (slice xs 0 4)] + (map-i32! s triple) + (print (at s 0)) (print " ") (print (at s 3)) (println "") + + ;; reduce, with the accumulator first in the step. The prelude's own + ;; sum-i32 is this with the + written in. + (print (reduce-i32 s 0 adds)) (println "") + ;; ... and an fn literal, whose parameter types come from the parameter. + (print (reduce-i32 s 1 (fn [a b] (* a b)))) (println "") + + ;; filter allocates and the caller frees. + (let [v (filter-i32 s odd?)] + (print (len v)) (print " ") (print (at v 0)) (println "") + (free v)) + + ;; A comparator sort, both directions off the same slice. + (sort-i32-by! s longer-first) + (print (at s 0)) (print " ") (print (at s 3)) (println "") + (sort-i32-by! s (fn [a b] (< a b))) + (print (at s 0)) (print " ") (print (at s 3)) (println "")) + + ;; The f32 half of the family, which is the same code at the other element + ;; type — the copy that generics would remove. + (let [ys [(f32 4.0) (f32 1.0) (f32 8.0) (f32 2.0)] + t (slice ys 0 4)] + (map-f32! t halve) + (print (at t 0)) (print " ") (print (at t 2)) (println "") + (print (reduce-f32 t 0.0 (fn [a b] (+ a b)))) (println "") + (let [w (filter-f32 t big?)] + (print (len w)) (println "") + (free w)) + (sort-f32-by! t (fn [a b] (> a b))) + (print (at t 0)) (print " ") (print (at t 3)) (println "")) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 5691f24..95a4fbe 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1254,12 +1254,15 @@ let () = and this row is what says so. *) refuses "nth is not a name" "programs/nth-gone.flan" "unknown function nth"; - (* The one thing in the allocator tier that really does need milestone 5, - refused by name and with the reason rather than as an unknown function. - NEXT.md's escape is that the *built-in* set needs nothing from milestone - 5; this row is the other half of that claim. *) + (* Still the one thing in the allocator tier that does not work, and the + reason changed when function values landed: it *has* a defn's name in + value position now. What it does not have is a way to be called — the + runtime calls proc(a, mode, p, old, size, align), six C arguments with + no transfer channel, and every Flan function value's signature ends with + one — or anywhere to put the flan_allocator, Allocator being opaque and + pointer-width. Two reasons, both named, neither a function value. *) refuses "a user-written allocator" "programs/user-allocator.flan" - "a defn's name in value position"; + "is no longer what is missing"; (* Move-only, spec-memory.md. Each of these would otherwise be a double free or a use-after-free at run time, and each is refused at the second use with the first one's location in the message. *) @@ -1847,6 +1850,55 @@ ERR@7 unexpected token: not the kind the caller was reading outputs ~opt:"-O0" "macros, -O0" "programs/macros.flan" macros_out; outputs ~dev:true "macros, dev" "programs/macros.flan" macros_out; + (* Function values, the non-escaping kind. Three opt levels because the + indirect call is the one shape LLVM is most likely to devirtualise: at + -O2 a name passed straight down becomes a direct call and the pointer + vanishes, so -O0 is what proves there is a real load and a real + [call ptr] behind it, and a dev build is what proves the value is read + out of the indirection cell rather than frozen as a symbol. + + The two lines worth naming. A *returned* function value, called through + a computed head, is the case that would fail if the value were anything + other than a link-time constant. And the handler-bind around a fold + whose element function signals is the case that would fail if an + indirect call skipped the transfer guard — a callee reached by pointer + has to answer a signal exactly as one reached by name. *) + let fn_values_out = + "2 8\n-20\n24\n81\n1 9\n9 1\n1\nfalse\n512\n32\nseen 500\n" + in + outputs "function values" "programs/fn-values.flan" fn_values_out; + outputs ~opt:"-O0" "function values, -O0" "programs/fn-values.flan" + fn_values_out; + outputs ~dev:true "function values, dev" "programs/fn-values.flan" + fn_values_out; + + (* The prelude's four, which is the point of the whole lane: map!, filter, + reduce and a comparator sort were blocked on function values and not on + generics, so they arrived without generics — and are still one copy per + element type, which is the generics half. The f32 rows are that copy. + -O0 as well, because filter allocates and the -O2 run can fold a + predicate over four literals into nothing. *) + let higher_order_out = + "3 12\n30\n1944\n2 3\n12 3\n3 12\n2 4\n7.5\n2\n4 0.5\n" + in + outputs "the prelude's map, filter, reduce and sort-by" + "programs/higher-order.flan" higher_order_out; + outputs ~opt:"-O0" "the prelude's map, filter, reduce and sort-by, -O0" + "programs/higher-order.flan" higher_order_out; + + (* What function values do *not* include, each refused by name. Capture is + the headline: an fn is lifted into a function of its own and handed + nothing but its parameters, so spec-memory.md's capture cases and + escaping closures with them stay deferred. *) + refuses "an fn cannot capture" "programs/fn-capture.flan" + "cannot see n"; + refuses "an fn with no type to take" "programs/fn-no-type.flan" + "nothing here says what this fn"; + refuses "a function value would be zeroed" "programs/fn-in-struct.flan" + "it would be zeroed"; + refuses "a foreign function's address" "programs/fn-extern.flan" + "is not a Flan function value"; + (* The exit criterion plan.org set for milestone 5: a special form moved out of the compiler and into the prelude, with the corpus that was written against the special form unchanged. *) diff --git a/test/test_flan.ml b/test/test_flan.ml index 9307230..761458e 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -948,12 +948,19 @@ let () = "(defstruct V [x f32]) (declare f [v V] \"c_f\")" ~needle:"cannot cross to C"; rejects_check "an extern may not return a struct" "(defstruct V [x f32]) (declare f [] V \"c_f\")" ~needle:"cannot cross to C"; - rejects_check "fn values are milestone 5" "(defn f [] (fn [x] x))" - ~needle:"milestone 5"; + (* Function values landed; what stayed refused is what they do not include. + An fn takes its parameter types from the position it is written in, and a + defn's body that just answers one says nothing about them. *) + rejects_check "an fn with nothing to say what it takes" + "(defn f [] (fn [x] x))" ~needle:"nothing here says what this fn"; rejects_check "type variables are milestone 5" "(defn f [x a])" ~needle:"milestone 5"; - rejects_check "a function name as a value is milestone 5" - "(defn g []) (defn f [] i32 g)" ~needle:"milestone 5"; + (* The other half: a name in value position now *works*, and the arity is + checked against the function it names. *) + rejects_check "a function value at the wrong arity" + "(defn g [x i32] i32 x) (defn u [f (Fn [i32] i32)] i32 (f 1 2)) \ + (defn f [] i32 (u g))" + ~needle:"takes 1 argument, given 2"; rejects_check "a struct cannot contain itself by value" "(defstruct Node [next Node])" ~needle:"contains itself by value"; @@ -1476,6 +1483,37 @@ let () = | _ -> false | exception Cjson.Bad _ -> true); + (* ── Lifted function names, and why they are counted per kind ──────── + A handler clause and an fn literal are both lifted into functions of their + own, and both are numbered within the function they came out of. One + shared counter would mean that adding a handler-bind above an existing fn + renamed the fn — a rename for a body that did not change, in exactly the + names a dev redefinition module emits and matches on. These check that + each sequence is stable against the other. *) + let lifted_names src = + List.filter_map + (fun (f : Tast.fn) -> + match f.Tast.fparent with Some _ -> Some f.Tast.name | None -> None) + (Check.program (Parse.program (read src))).Tast.fns + in + let with_handler = + "(defstruct Boom [n i32]) (defvar hit i32) \ + (defn u [f (Fn [i32] i32)] i32 (f 1)) \ + (defn m [] i32 \ + (handler-bind [(Boom [c] (set hit (.n c)))] (u (fn [x] x))) 0)" + in + let without_handler = + "(defstruct Boom [n i32]) (defvar hit i32) \ + (defn u [f (Fn [i32] i32)] i32 (f 1)) \ + (defn m [] i32 (u (fn [x] x)) 0)" + in + check "an fn keeps its number when a handler-bind is added beside it" + (List.mem "fn/m/0" (lifted_names with_handler) + && List.mem "fn/m/0" (lifted_names without_handler)); + check "and the handler clause has a sequence of its own" + (List.exists + (fun n -> contains n "handler/m/0/Boom") (lifted_names with_handler)); + (* ── The prelude's own macro calls, and the bootstrap that allows them ── A macro module is compiled *from* the prelude, so a prelude function that calls a prelude macro cannot be in the module that would expand it. The