diff --git a/TODO.org b/TODO.org index f395baa5..1584ed26 100644 --- a/TODO.org +++ b/TODO.org @@ -1006,13 +1006,10 @@ at all, which is what the diagnosis predicted. A =map= that *changes* the elemen type is the one shape that did not come with them: one copy per ordered pair of types rather than per type. -** NEXT CFn in a struct or a fixed array -Decided 2026-09-25: allowed. A call through a null =CFn= is a named runtime condition on both backends, and parks in a dev build. -A zeroed function value is a null pointer, so a function value is refused in any -position zero-initialisation would conjure one — =CFn= included. An =(Option -(CFn ...))= field is already legal. A table of function pointers is exactly what -=CFn= is for, and the objection is about zero-initialisation rather than about -capture. +** DONE CFn in a struct or a fixed array +CLOSED: [2026-09-25] +A zeroed =CFn= is admitted everywhere and a call through a null one signals +=NullCall= before its arguments run. =(Fn ...)= stays refused in those positions. ** DONE Structural compatibility is identical layout Same fields, same types, same order, so structural compatibility is "the same diff --git a/docs/BUILT.md b/docs/BUILT.md index 567337f6..e84407e9 100644 --- a/docs/BUILT.md +++ b/docs/BUILT.md @@ -4336,8 +4336,9 @@ implemented. refusal's witness now runs. The escape refusal that replaced it is gone too; see "Escape: only an escaping closure's environment is the collector's".* - **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 +- **A position that would zero an `(Fn ...)`** (`fn-in-struct.flan`): a struct field, a global, a fixed array's element, + `(zeroed)`. A `(CFn ...)` is admitted in all four: every call through one tests for null and signals `NullCall` + (`fn-cfn-table.flan`). 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 diff --git a/lib/check.ml b/lib/check.ml index 4bb9018c..27cd37a2 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -1134,12 +1134,19 @@ let fn_sig (t : Types.t) = let callable_ty t = fn_sig t <> None +(* A (CFn ...) is not on the list: it is one code address, and every call + through one tests for null and signals NullCall (see [Emit.null_check]), so + a zeroed one is an empty slot rather than a crash. That is what lets a table + of function pointers be a struct or a fixed array. An (Fn ...) stays + refused: a call through one is not tested, and (Option (Fn ...)) is the + field that holds one. *) let rec no_zeroed_fn loc what (t : Types.t) = match t with - | Types.Fn _ | Types.CFn _ -> + | Types.Fn _ -> fail loc "%s cannot be %s — it would be zeroed, and a zeroed function value is a \ - null pointer. Pass it as a parameter, or hold it in a let" + null pointer. Pass it as a parameter, hold it in a let, or store a \ + (CFn ...) if it captures nothing" what (Types.to_string t) | Types.Array (_, e) -> no_zeroed_fn loc what e | _ -> () @@ -10685,6 +10692,14 @@ and ordinary_call ctx ~want loc name args = match capture ctx loc name with | Some b -> call_value ctx ~want loc (mk loc b.bty (Tast.Local b.slot)) args | None -> assert false) + (* A global holding a function value — a (CFn ...) table entry's cousin, + since a global is one of the zeroed positions a CFn may sit in. Called + by its name the way a local one is. *) + | _ when (match Hashtbl.find_opt ctx.env.globals name with + | Some (ty, _) -> callable_ty ty + | None -> false) -> + let ty, _ = Hashtbl.find ctx.env.globals name in + call_value ctx ~want loc (mk loc ty (Tast.Global name)) args | _ when Hashtbl.mem ctx.env.gsigs name -> private_ref ctx loc name; let vars, params, ret = Hashtbl.find ctx.env.gsigs name in diff --git a/lib/emit.ml b/lib/emit.ml index 3572b27b..5d1e8d59 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3132,6 +3132,9 @@ and call_ptr ?at f ret callee args = code, Some ("ptr " ^ env) | _ -> c, None in + (match callee.Tast.ty, at with + | Types.CFn _, Some loc -> null_check f loc callee.Tast.ty code + | _ -> ()); 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 Option.iter (mark_call f) at; @@ -3139,6 +3142,19 @@ and call_ptr ?at f ret callee args = if at <> None then clear_call f; r +(* A (CFn ...) may be a zeroed field, array element or global, and a zeroed + one is a null address. Tested before the arguments are evaluated, so a + call that is not going to be made runs none of them — the x86 backend + tests at the same point. [flan_null_call] signals [NullCall] and returns + only when something transferred, the shape of a bounds failure. *) +and null_check f loc ty code = + let ok = fresh f in + ins f "%s = icmp ne ptr %s, null" ok code; + signal_block f loc ~guard:(fun () -> guard f) ok (fun id n -> + let tys = fst (fi_bytes f.md (Types.to_string ty ^ "\000")) in + ins f "call void @flan_null_call(ptr %s, i64 %d, ptr %s, ptr %s)" + id n tys xfer_param) + (* The code address behind one of the three [fnref]s, which is the same string whether it is wanted as a bare [(Ptr ())] or as the first word of a function value. @@ -4875,6 +4891,9 @@ declare void @flan_arith_error(ptr, i64, i32, i64, i64, ptr) cold ; as C strings, then the cell and the channel. Signals StaleCall; returns when ; something answered. declare void @flan_stale_call(ptr, ptr, ptr, ptr, ptr) cold +; A call through a (CFn ...) holding null: the site, the value's type as a C +; string and the channel. Signals NullCall; returns when something answered. +declare void @flan_null_call(ptr, i64, ptr, ptr) cold declare ptr @flan_context_allocator() declare ptr @flan_context_use(ptr, i64) declare void @flan_context_value(ptr) diff --git a/lib/prelude.ml b/lib/prelude.ml index 8d201c41..050013ae 100644 --- a/lib/prelude.ml +++ b/lib/prelude.ml @@ -197,6 +197,17 @@ let source = {flan| ;; nothing a handler supplies makes the old arguments fit the new body. (defstruct StaleCall :parent Error [callee string compiled string current string]) +;; A call through a (CFn ...) that holds no function. A CFn may be a struct +;; field, a fixed array's element or a global, and each of those starts out +;; zeroed, which for a function value is no address at all. Every call +;; through one tests first and signals this instead of jumping to nothing. +;; `type` is the value's type as written, "(CFn [i32] i32)". +;; +;; Signalled from the runtime — flan_null_call in runtime/flan_rt.c — so +;; **this field is a C struct that has to agree with this one**. No restart is +;; established at the call, BoundsError's decision for BoundsError's reason. +(defstruct NullCall :parent Error [type string]) + ;; What a generic function signals when no method answers. `generic` is the ;; name written at the defgeneric or defmulti, and `value` is what the ;; dispatch actually produced -- the class of the first argument for a diff --git a/lib/x86.ml b/lib/x86.ml index bcf1ae79..247b537b 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -1916,6 +1916,9 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = | Types.Fn _ -> Some (Aint (shift c 8, Types.Ptr (Types.Mut, Types.Unit))) | _ -> None in + (match callee.Tast.ty with + | Types.CFn _ -> null_check f e.Tast.loc callee.Tast.ty c + | _ -> ()); call_flan f ?env ~at:e.Tast.loc ~target:(`Loc c) ~args ~rty:t dst | Tast.Do body -> block f body dst t | Tast.Let (bs, body) -> @@ -2702,6 +2705,26 @@ and elements f (base : loc) (ty : Types.t) (is : Tast.expr list) : loc = That is also the answer to "does a bounds trap run defers": an answered one does, because it leaves through the innermost pad; an unanswered one still does not, because it is a die inside C. Identical on both backends. *) +(* [Emit.null_check]: a (CFn ...) holding null is not called. Tested before + the arguments, as the LLVM backend does, and [flan_null_call] returns only + when something transferred. *) +and null_check f (loc : Loc.t) ty (c : loc) = + load_loc f ~reg:rax c ty; + test_rr f.b ~a:rax ~c:rax; + let ok = new_label f "fnok" in + jcc_lbl f.b ~cc:cc_ne ok; + note f "A null (CFn ...): the site, the type as a C string and the channel."; + str_args f ~preg:rdi ~nreg:rsi (Loc.to_string loc); + let tys, _ = fi_bytes f (Types.to_string ty ^ "\000") in + lea f.b ~dst:rdx ~mm:(Sym (tys, 0)); + chan_into f ~reg:rcx; + mark_at f loc; + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_null_call"; + guard f; + ud2 f.b; + lbl f.b ok + and bounds_call f sym (loc : Loc.t) (extra : int list) = note f (Printf.sprintf "Out of bounds: the location string, the operands, and this frame's channel, \ diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index b759c63a..c50278a0 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1538,6 +1538,51 @@ void flan_stale_call(const char *site, const char *callee, const char *want, rt_die(); } +/* ── A call through a null (CFn ...) ─────────────────────────────────── + * + * A (CFn ...) may sit in a struct field, a fixed array or a global, all of + * which zero-initialise, and a zeroed one is a null address. Every call + * through a CFn value tests it first and lands here on null, so the call is + * not made. It signals NullCall with `error` — BoundsError's shape and its + * decision about restarts: no value a handler supplies turns into a function + * to call, so what answers it is a restart the program already has, or the + * break loop in a dev build. + * + * `type` is copied and never freed, for flan_stale_call's reason: the text + * lives in the image of the module that compiled the call, which may be a + * thunk that is unloaded once it returns. Must agree with the prelude's + * (defstruct NullCall :parent Error [type string]). */ + +typedef struct { flan_slice type; } flan_nullcall_cond; + +static const uint8_t flan_nullcall_name[] = "NullCall"; +#define FLAN_NULLCALL_NAMELEN 8 + +static void nullcall_sentence(const char *ty) { + rt_sentence("this call is through a %s that holds no function — a field, " + "an array element or a global of that type starts out empty. " + "Store a function in it before calling it, or hold it as an " + "(Option %s) and match on it", + ty, ty); +} + +void flan_null_call(const uint8_t *loc, int64_t loclen, const char *ty, + void *xfer) { + flan_nullcall_cond c; + flan_condesc d; + uint32_t chain[2]; + c.type = flan_stale_copy(ty); + nullcall_sentence(ty); + rt_condesc(&d, chain, flan_nullcall_name, FLAN_NULLCALL_NAMELEN, loc, + loclen); + flan_signal(&d, &c, xfer); + if (*(void **)xfer != NULL) return; + nullcall_sentence(ty); /* in full; see flan_bounds_signal */ + if (rt_error_break(&d, &c, xfer)) return; + rt_print_sentence(loc, loclen); + rt_die(); +} + /* ── Allocators, spec-memory.md ──────────────────────────────────────── * * One type-erased procedure plus an opaque data pointer, which is Odin's diff --git a/test/programs/fn-cfn-table.flan b/test/programs/fn-cfn-table.flan new file mode 100644 index 00000000..3d796620 --- /dev/null +++ b/test/programs/fn-cfn-table.flan @@ -0,0 +1,55 @@ +;; A (CFn ...) in the places that zero-initialise: a struct field, a fixed +;; array's element and a global. A table of bare code addresses is what the +;; narrow function type is for, and the zero is the only objection there ever +;; was — a zeroed CFn is a null address. So a call through one tests it first +;; and signals NullCall rather than jumping to nothing. +;; +;; With no argument the empty calls are answered and the program carries on; +;; with "1" nothing answers and it dies, with the site and the type. + +(defn double [x i32] i32 (* x 2)) +(defn negate [x i32] i32 (- 0 x)) + +(defstruct Ops [name string run (CFn [i32] i32)]) + +(defonce table [3 (CFn [i32] i32)]) +(defonce hook (CFn [i32] i32)) +(defonce evaluated i32 0) +(defonce caught i32 0) +(defonce seen string "") + +(defn arg [x i32] i32 + (set evaluated (+ evaluated 1)) + x) + +(defn try-call [f (CFn [i32] i32) x i32] () + (restart-case + (do (print (f (arg x))) (println "")) + (continue [] (println "empty")))) + +(defn main [args [string]] i32 + (set (at table 0) double) + (set (at table 2) negate) + (let [ops (Ops {.name "half-built"})] + (if (> (length args) 1) + ;; Unanswered: the process dies at the call. + (do (print ((at table 1) 5)) (println "") 0) + (do + (handler-bind + [(NullCall [c] + (set caught (+ caught 1)) + (set seen (.type c)) + (invoke-restart 'continue))] + (dotimes [i 3] (try-call (at table i) 7)) ; 14, empty, -7 + (try-call (.run ops) 1) ; empty + (try-call hook 2) ; empty + (set hook double) + (try-call hook 2)) ; 4 + ;; The argument of a call that is not made is never evaluated. + (print evaluated) (println "") ; 3 + (print caught) (println "") ; 3 + (println seen) ; (CFn [i32] i32) + ;; And a filled field calls as any CFn does. + (let [full (Ops {.name "full" .run negate})] + (print ((.run full) 9)) (println "")) ; -9 + 0)))) diff --git a/test/programs/fn-in-struct.flan b/test/programs/fn-in-struct.flan index 0baf66ce..bc7ab3dd 100644 --- a/test/programs/fn-in-struct.flan +++ b/test/programs/fn-in-struct.flan @@ -9,10 +9,8 @@ ;; the collector and may be kept anywhere, and (Option (Fn ...)) is the field ;; that holds one — see fn-escape.flan. ;; -;; Which means a (CFn ...) field is refused too, and for the zero alone — -;; a table of function pointers is exactly what that type is for, and nothing -;; about capture stands in its way. An (Option (CFn ...)) field is already -;; legal and is the shape that works; TODO.org, "CFn in a struct or a fixed array", carries the rest as its own item. +;; A (CFn ...) field is not refused: every call through one tests for null and +;; signals NullCall, so its zero is an empty slot — fn-cfn-table.flan. (defstruct Ops [run (Fn [i32] i32)]) (defn main [] i32 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index d41fa573..35c127fd 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -4663,6 +4663,35 @@ level "1" outputs ~dev:true "the two function types, dev" "programs/fn-cfn.flan" fn_ptr_out; + (* A CFn in a struct field, a fixed array and a global, each zeroed until + stored into. A call through an empty one signals NullCall, before its + arguments run; answered, the program carries on, and unanswered it dies + naming the site and the type — on both backends. *) + let cfn_table_out = + "14\nempty\n-7\nempty\nempty\n4\n3\n3\n(CFn [i32] i32)\n-9\n" + in + outputs "a CFn table" "programs/fn-cfn-table.flan" cfn_table_out; + outputs ~x86:true "a CFn table, --x86" "programs/fn-cfn-table.flan" + cfn_table_out; + outputs ~dev:true "a CFn table, dev" "programs/fn-cfn-table.flan" + cfn_table_out; + List.iter + (fun x86 -> + let exe = compile ~x86 "programs/fn-cfn-table.flan" in + let code, text = run exe (Some "1") in + if code <> 134 + || not (contains text "programs/fn-cfn-table.flan:") + || not (contains text "this call is through a (CFn [i32] i32) \ + that holds no function") + then begin + incr failures; + Printf.printf "FAIL an unanswered empty CFn call dies%s\n \ + got: %S (exit %d)\n" + (if x86 then ", --x86" else "") text code + end; + (try Sys.remove exe with Sys_error _ -> ())) + [ false; true ]; + (* Two signatures that flatten to one string under [mangle_ty], which is how the thunk memo used to be keyed. Keyed on the name, the second widening reuses the first's thunk at the wrong arity — a miscompile diff --git a/test/test_flan.ml b/test/test_flan.ml index d4013662..24cfbe01 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -3595,6 +3595,23 @@ let () = "(defn h [x i32] i32 x) (defn g [i i32] (Fn [i32] i32) h)\n\ (defn f [] i32 (let [a (array-gen [2] g)] 0))" ~needle:"a fixed array's element cannot be (Fn [i32] i32)"; + (* A (CFn ...) is not refused in any of them: a call through one tests for + null and signals NullCall, so its zero is an empty slot. *) + accepts "a CFn struct field" + "(defstruct Ops [run (CFn [i32] i32)])\n\ + (defn f [o Ops] i32 ((.run o) 1))"; + accepts "a fixed array of CFn" + "(defonce tbl [4 (CFn [i32] i32)])\n(defn f [] i32 ((at tbl 0) 1))"; + accepts "a CFn global with no initialiser" + "(defonce hook (CFn [] ()))\n(defn f [] () (hook))"; + accepts "(zeroed) at a CFn" + "(defn f [] i32 (let [g (the (CFn [i32] i32) (zeroed))] (g 1)))"; + accepts "an array-gen of CFn" + "(defn h [x i32] i32 x) (defn g [i i32] (CFn [i32] i32) h)\n\ + (defn f [] i32 (let [a (array-gen [2] g)] ((at a 1) 3)))"; + rejects_check "an Fn struct field is still refused" + "(defstruct Ops [run (Fn [i32] i32)])" + ~needle:"the field run cannot be (Fn [i32] i32)"; (* The inline form, the design's canonical one. An fn normally takes its types from a (Fn ...) want, and this position has none — the *form*