From 9152a8a690166351097eddba0a0f55b6cfca19f4 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 18:39:08 +0100 Subject: [PATCH 01/13] fix(typecheck,bun-esm): generic enum kinds; qualified ctors; sync receiver-first fns Found while probing the Bun-ESM target for a TEA UI runtime: - typecheck: `infer_kind` gave every non-builtin type constructor kind `Type`, so naming a user generic enum applied to arguments in any signature (`fn mk(x: M) -> Box`, `Html`) failed with "Too many arguments for kind". Record each parametric enum's arity, and recover the arity of imported enums from the imported value schemes (the only cross-module type information `check_program` receives). Over-application is still rejected (planted negative test). - bun-esm: a qualified payload constructor `Msg::SetName(s)` lowered to a call on the nullary `({ tag })` object. It now lowers to the emitted constructor binding. - bun-esm: every receiver-first fn was folded into an async class method and its calls rewritten to `(await recv.m(..))`. Struct literals are plain objects, so chained calls failed and `await` leaked into sync callers (e.g. a TEA `update`). Fns are now always emitted as plain sync exports and called directly; the synthesised class remains as an extra JS-facing surface (ref_fields/class_basic unchanged). Tests: test/test_generic_enum_kinds.ml (6), tests/codegen-deno/tea_shape (Bun-ESM harness; 33/33 harnesses pass; dune test main suite 550 OK). Co-Authored-By: Claude Opus 5.5 --- lib/codegen_deno.ml | 27 ++++-- lib/typecheck.ml | 47 ++++++++++- test/test_generic_enum_kinds.ml | 102 +++++++++++++++++++++++ test/test_main.ml | 1 + tests/codegen-deno/tea_shape.affine | 40 +++++++++ tests/codegen-deno/tea_shape.harness.mjs | 14 ++++ 6 files changed, 223 insertions(+), 8 deletions(-) create mode 100644 test/test_generic_enum_kinds.ml create mode 100644 tests/codegen-deno/tea_shape.affine create mode 100644 tests/codegen-deno/tea_shape.harness.mjs diff --git a/lib/codegen_deno.ml b/lib/codegen_deno.ml index 0b677d04..74530443 100644 --- a/lib/codegen_deno.ml +++ b/lib/codegen_deno.ml @@ -77,6 +77,10 @@ type codegen_ctx = { operand — needed to truncate e.g. [abs(a*b) / gcd(a,b)]. Populated in {!generate}. *) int_fns : (string, unit) Hashtbl.t; + (* Variant constructors of enums declared in this program; each is + emitted as a same-named binding (an object when nullary, a factory + otherwise), so a qualified `Enum::Ctor` lowers to that binding. *) + ctors : (string, unit) Hashtbl.t; (* Names bound to a provably-[Int] value in the *current function*: [Int]-typed params plus [let]/assignments whose value is an integer expression. Mutated in source order as statements are emitted (the @@ -110,6 +114,7 @@ let create_ctx host symbols = { local_fns = Hashtbl.create 64; async_fns = Hashtbl.create 32; int_fns = Hashtbl.create 64; + ctors = Hashtbl.create 32; int_vars = Hashtbl.create 16; int_array_vars = Hashtbl.create 16; in_async = false; @@ -1550,6 +1555,10 @@ let rec gen_expr ctx (expr : expr) : string = (match ty.name, ctor.name with | _, "None" -> "None" | _, "Some" -> "Some" | _, "Ok" -> "Ok" | _, "Err" -> "Err" + | _, name when Hashtbl.mem ctx.ctors name -> + (* The emitted binding: correct for nullary (`Msg::Inc`) and + for payload ctors applied as calls (`Msg::SetName(s)`). *) + mangle name | _, name -> Printf.sprintf "({ tag: %S })" name) | ExprSpan (inner, _) -> gen_expr ctx inner | ExprRowRestrict (e, _) -> gen_expr ctx e @@ -2119,6 +2128,9 @@ let generate (host : host_profile) (program : program) (symbols : Symbol.t) : st | _ -> ()) | TopConst { tc_name; _ } -> Hashtbl.replace ctx.local_fns tc_name.name () + | TopType { td_body = TyEnum variants; _ } -> + List.iter (fun (vd : variant_decl) -> + Hashtbl.replace ctx.ctors vd.vd_name.name ()) variants | TopImpl ib -> List.iter (function | ImplFn fd -> @@ -2160,17 +2172,20 @@ let generate (host : host_profile) (program : program) (symbols : Symbol.t) : st Hashtbl.replace tbl k (v :: (try Hashtbl.find tbl k with Not_found -> [])) in List.iter (function | TopFn fd when fd.fd_body <> FnExtern -> + (* The synthesised class is an *additional* JS-facing surface + (`new Point(..)`, `await p.sum_ref()`). Every fn is still + emitted as a plain synchronous export, and AffineScript-level + calls go to that free fn — never rewritten to an async method + call. Struct literals are plain objects, so the old rewrite broke + chained calls (`acc.update(..)` on a literal has no method) and + leaked `await` into sync callers (e.g. a TEA `update`). *) (match receiver_struct ~known:structs fd with | Some (s, rn) -> let js = method_js_name ~struct_name:s fd.fd_name.name in - push methods_of s (rn, js, fd); - Hashtbl.replace ctx.assoc fd.fd_name.name js; - Hashtbl.replace consumed fd.fd_name.name () + push methods_of s (rn, js, fd) | None -> (match returns_struct ~known:structs fd with - | Some s -> - push ctors_of s fd; - Hashtbl.replace consumed fd.fd_name.name () + | Some s -> push ctors_of s fd | None -> ())) | _ -> ()) program.prog_decls; let methods_for s = diff --git a/lib/typecheck.ml b/lib/typecheck.ml index 41ef95c4..778b2f8f 100644 --- a/lib/typecheck.ml +++ b/lib/typecheck.ml @@ -264,6 +264,12 @@ type context = { value-path lowering done by [Resolve.lower_qualified_value_paths] (#178). Populated at [check_program] entry from [prog.prog_imports]. *) + type_arity : (string, int) Hashtbl.t; + (** Number of type parameters of each user-declared parametric enum + (`enum Html` -> 1), so [infer_kind] gives it kind + `Type -> ... -> Type` instead of treating every non-builtin type + constructor as kind `Type` (which rejected `Html` in any + signature with "Too many arguments for kind"). *) mutable in_loop : bool; (** #459: tracks whether the synth/check walker is currently inside a loop body. Set true on entry to a [StmtWhile]/[StmtFor] body, @@ -302,6 +308,7 @@ let create_context (symbols : Symbol.t) : context = declared_effects = Hashtbl.create 16; call_effects = Hashtbl.create 64; module_quals = Hashtbl.create 4; + type_arity = Hashtbl.create 16; in_loop = false; } @@ -452,7 +459,12 @@ let rec infer_kind (ctx : context) (ty : ty) : kind result = begin match name with | "Array" | "Option" | "List" | "Vec" | "Cmd" | "Ref" -> Ok (KArrow (KType, KType)) | "Result" -> Ok (KArrow (KType, KArrow (KType, KType))) - | _ -> Ok KType + | user -> + (match Hashtbl.find_opt ctx.type_arity user with + | Some n -> + let rec arrows k = if k = 0 then KType else KArrow (KType, arrows (k - 1)) in + Ok (arrows n) + | None -> Ok KType) end | TApp (head, args) -> let* k = infer_kind ctx head in @@ -2200,6 +2212,8 @@ let register_type_decl (ctx : context) (td : type_decl) : unit result = let param_names = List.map (fun (tp : type_param) -> tp.tp_name.name) td.td_type_params in + if param_names <> [] then + Hashtbl.replace ctx.type_arity td.td_name.name (List.length param_names); enter_level ctx; let param_tvs = List.map (fun n -> let tv = fresh_tyvar ctx.level in @@ -2429,6 +2443,33 @@ let populate_call_effects (ctx : context) (prog : Ast.program) : unit = ctx.call_effects; Effect_sites.set_async_by_ord async_tbl +(** Learn the arity of every parametric type constructor applied in [ty] + (e.g. `Html` in an imported `text : String -> Html`). Imported + schemes are the only cross-module type information [check_program] + receives, so this is how an imported `enum Html` gets kind + `Type -> Type` in the importer. Builtins keep their fixed kinds. *) +let rec record_type_arities (ctx : context) (ty : ty) : unit = + let go = record_type_arities ctx in + let rec go_row = function + | RExtend (_, t, rest) -> go t; go_row rest + | REmpty | RVar _ -> () + in + match repr ty with + | TApp (TCon name, args) -> + (match name with + | "Array" | "Option" | "List" | "Vec" | "Cmd" | "Ref" | "Result" -> () + | _ -> + if not (Hashtbl.mem ctx.type_arity name) then + Hashtbl.replace ctx.type_arity name (List.length args)); + List.iter go args + | TApp (head, args) -> go head; List.iter go args + | TArrow (a, _, b, _) -> go a; go b + | TTuple ts -> List.iter go ts + | TRecord row | TVariant row -> go_row row + | TForall (_, _, body) | TExists (_, _, body) -> go body + | TRef t | TMut t | TOwn t -> go t + | TVar _ | TCon _ -> () + let check_program ?(import_types : (string, scheme) Hashtbl.t option) (symbols : Symbol.t) (prog : Ast.program) : (context, type_error) Result.t = @@ -2450,7 +2491,9 @@ let check_program ?(import_types : (string, scheme) Hashtbl.t option) | Ast.ImportList _ | Ast.ImportGlob _ -> () ) prog.prog_imports; Option.iter (fun tbl -> - Hashtbl.iter (fun name sc -> Hashtbl.replace ctx.name_types name sc) tbl + Hashtbl.iter (fun name sc -> + Hashtbl.replace ctx.name_types name sc; + record_type_arities ctx sc.sc_body) tbl ) import_types; (* Forward pass: register all types, effects, traits, impls, and function signatures so that mutually recursive declarations resolve. *) diff --git a/test/test_generic_enum_kinds.ml b/test/test_generic_enum_kinds.ml new file mode 100644 index 00000000..d9b4ecb2 --- /dev/null +++ b/test/test_generic_enum_kinds.ml @@ -0,0 +1,102 @@ +(* SPDX-License-Identifier: MPL-2.0 *) +(* Copyright (c) 2026 Jonathan D.A. Jewell *) +(** Kinds of user-declared parametric enums. + + [infer_kind] used to hard-code the kinds of the builtin constructors + (Option, Result, ...) and give every other named type kind [Type], so + naming a user enum applied to arguments anywhere in a signature — + `fn mk(x: M) -> Box` — failed with "Too many arguments for kind". + That made typed UI libraries (`Html`) impossible. These tests pin + the fix in a single module, across a module import, and keep the kind + check honest by planting an over-application that must still fail. *) + +open Affinescript + +(** parse -> resolve (with a loader rooted at [dir]) -> typecheck. *) +let frontend ?(dir = Sys.getcwd ()) (src : string) : (unit, string) result = + let ( let* ) = Result.bind in + let* prog = + try Ok (Parse_driver.parse_string ~file:"" src) + with + | Parse_driver.Parse_error (m, sp) -> + Error (Printf.sprintf "Parse error at %s: %s" (Span.show sp) m) + | e -> Error (Printf.sprintf "Unexpected: %s" (Printexc.to_string e)) + in + let config = { (Module_loader.default_config ()) with current_dir = dir; search_paths = [ dir ] } in + let loader = Module_loader.create config in + let* resolve_ctx, type_ctx = + match Resolve.resolve_program_with_loader prog loader with + | Ok (rc, tc) -> Ok (rc, tc) + | Error (e, _) -> Error ("Resolution error: " ^ Resolve.show_resolve_error e) + in + match + Typecheck.check_program ~import_types:type_ctx.Typecheck.name_types + resolve_ctx.symbols prog + with + | Ok _ -> Ok () + | Error e -> Error ("Type error: " ^ Typecheck.format_type_error e) + +(** Assert [src] type-checks. *) +let passes ?dir src = + match frontend ?dir src with + | Ok () -> () + | Error m -> Alcotest.failf "expected Ok, got: %s" m + +(** Assert [src] is rejected with a message containing [needle]. *) +let fails_with ~needle src = + match frontend src with + | Ok () -> Alcotest.failf "expected a type error mentioning %S, got Ok" needle + | Error m -> + let nl = String.length needle and ml = String.length m in + let rec go i = i + nl <= ml && (String.sub m i nl = needle || go (i + 1)) in + if not (go 0) then Alcotest.failf "expected %S in: %s" needle m + +let generic_return_type () = + passes "pub enum Box { B(M), E }\npub fn mk(x: M) -> Box = B(x);\n" + +let concrete_application_in_signature () = + passes "pub enum Box { B(M), E }\npub fn f(x: Box) -> Int = 1;\n" + +let two_parameter_enum () = + passes + "pub enum Pair { P(A, B) }\n\ + pub fn swap(p: Pair) -> Pair = match p { Pair::P(a, b) => P(b, a) };\n" + +let function_payload () = + passes + "pub enum Attr { On(String, Int -> M) }\n\ + pub fn on_click(f: Int -> M) -> Attr = On(\"click\", f);\n" + +(* Planted negative: the kind check must still reject over-application. *) +let over_application_still_rejected () = + fails_with ~needle:"Too many arguments for kind" + "pub enum Box { B(M), E }\npub fn f(x: Box) -> Int = 1;\n" + +(* Cross-module: the importer only receives value schemes, so the arity of + an imported `enum Html` must be recovered from them. *) +let imported_enum_kind () = + let dir = Filename.concat (Filename.get_temp_dir_name ()) + (Printf.sprintf "as_kinds_%d" (Unix.getpid ())) in + (try Unix.mkdir dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); + let oc = open_out (Filename.concat dir "Html.affine") in + output_string oc + "module Html;\n\ + pub enum Html { Text(String), Node(String, [Html]) }\n\ + pub fn text(s: String) -> Html = Text(s);\n"; + close_out oc; + passes ~dir + "use Html::{Html, text};\n\ + pub enum Msg { Go }\n\ + pub fn view(n: Int) -> Html = text(\"hi\");\n" + +let tests = + [ + Alcotest.test_case "generic return type" `Quick generic_return_type; + Alcotest.test_case "concrete application in signature" `Quick + concrete_application_in_signature; + Alcotest.test_case "two-parameter enum" `Quick two_parameter_enum; + Alcotest.test_case "function payload" `Quick function_payload; + Alcotest.test_case "over-application still rejected" `Quick + over_application_still_rejected; + Alcotest.test_case "imported enum kind" `Quick imported_enum_kind; + ] diff --git a/test/test_main.ml b/test/test_main.ml index 2006c566..8b5cd881 100644 --- a/test/test_main.ml +++ b/test/test_main.ml @@ -14,6 +14,7 @@ let () = ("Effect-sites (#234, ADR-016)", Test_effect_sites.tests); ("TW L13 isolation (#10)", Test_tw_isolation.tests); ("Qualified paths (#228, ADR-014)", Test_qualified_paths.tests); + ("Generic enum kinds", Test_generic_enum_kinds.tests); ("Module mut (#548)", Test_module_mut.tests); ("Int-div on JS-text backend (#478)", Test_int_div_js.tests); ("Deno builtins ↔ stdlib decls consistency", Test_deno_builtins_consistency.tests); diff --git a/tests/codegen-deno/tea_shape.affine b/tests/codegen-deno/tea_shape.affine new file mode 100644 index 00000000..e0d8651a --- /dev/null +++ b/tests/codegen-deno/tea_shape.affine @@ -0,0 +1,40 @@ +// SPDX-License-Identifier: MPL-2.0 +// TEA-shaped program on the Bun-ESM target. Pins two codegen fixes: +// * a qualified payload constructor (`Msg::SetName(s)`) lowers to the +// constructor factory, not a call on a nullary `{ tag }` object; +// * a receiver-first fn (`update(m: Model, msg)`) stays a synchronous free +// function, so it chains on struct *literals* and never leaks `await` +// into a sync caller (the synthesised class is only an extra surface). + +use prelude::*; + +pub enum Msg { + Inc, + SetName(String), + Move(String, Float, Float), + Batch([Msg]) +} + +struct Model { count: Int, name: String, xs: [Float] } + +pub fn init() -> Model = Model #{ count: 0, name: "n", xs: [] }; + +pub fn update(m: Model, msg: Msg) -> Model { + match msg { + Msg::Inc => Model #{ count: m.count + 1, name: m.name, xs: m.xs }, + Msg::SetName(s) => Model #{ count: m.count, name: s, xs: m.xs }, + Msg::Move(id, x, y) => Model #{ count: m.count, name: id, xs: m.xs ++ [x, y] }, + Msg::Batch(ms) => { + let mut acc = m; + for one in ms { + acc = update(acc, one); + } + acc + } + } +} + +pub fn run() -> String { + let m = update(init(), Msg::Batch([Msg::Inc, Msg::Inc, Msg::SetName("z"), Msg::Move("a", 1.5, 2.0)])); + m.name ++ ":" ++ int_to_string(m.count) ++ ":" ++ int_to_string(len(m.xs)) +} diff --git a/tests/codegen-deno/tea_shape.harness.mjs b/tests/codegen-deno/tea_shape.harness.mjs new file mode 100644 index 00000000..7f0a9fcd --- /dev/null +++ b/tests/codegen-deno/tea_shape.harness.mjs @@ -0,0 +1,14 @@ +// SPDX-License-Identifier: MPL-2.0 +// TEA-shaped program: qualified payload ctors + sync receiver-first update. +import assert from "node:assert/strict"; +import { run, init, update, Inc, SetName, Batch, Model } from "./tea_shape.bun.js"; + +assert.equal(run(), "a:2:2", "batched update over qualified payload ctors"); + +const m = update(update(init(), Inc), SetName("q")); +assert.ok(!(m instanceof Promise), "update is synchronous"); +assert.deepEqual({ ...m }, { count: 1, name: "q", xs: [] }, "chains on literals"); +assert.equal(update(init(), Batch([Inc, Inc, Inc])).count, 3, "recursive update in a loop"); +assert.equal(typeof Model, "function", "class surface still synthesised"); + +console.log("tea_shape.harness.mjs OK"); From 7832f473aa14cc615751b108b74994d932f9acd3 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 18:43:13 +0100 Subject: [PATCH 02/13] fix(typecheck,bun-esm): thunk lambdas, parametric extern types, math builtins MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - typecheck: a zero-parameter lambda `fn() => e` was typed as its bare body type in synth mode and checked against the *whole* `() -> T` arrow in check mode, so a thunk could never be passed to a `() -> T` parameter (inline or by name). It is now `Unit -> T` in both modes — the type an explicit `() -> T` already lowers to, and which the zero-argument call rule already consumes. Wrong body types still fail. - typecheck: `extern type Cell` records its arity like a parametric enum, so host-backed generic types can be named in signatures. - bun-esm: lower the stdlib/math.affine header builtins (float, floor, ceil, round, trunc, sqrt, cbrt, pow_float, trig, exp/log family) to `Number`/`Math.*`; they compiled to calls of undefined JS globals. Tests: parametric extern type case in test_generic_enum_kinds; tests/codegen-deno/thunk_math (34/34 Bun-ESM harnesses); WASM corpus 38/38; dune test main suite 551 OK. Co-Authored-By: Claude Opus 5.5 --- lib/codegen_deno.ml | 15 ++++++++++ lib/typecheck.ml | 36 ++++++++++++++++++----- test/test_deno_builtins_consistency.ml | 3 ++ test/test_generic_enum_kinds.ml | 7 +++++ tests/codegen-deno/thunk_math.affine | 21 +++++++++++++ tests/codegen-deno/thunk_math.harness.mjs | 18 ++++++++++++ 6 files changed, 93 insertions(+), 7 deletions(-) create mode 100644 tests/codegen-deno/thunk_math.affine create mode 100644 tests/codegen-deno/thunk_math.harness.mjs diff --git a/lib/codegen_deno.ml b/lib/codegen_deno.ml index 74530443..38fe7957 100644 --- a/lib/codegen_deno.ml +++ b/lib/codegen_deno.ml @@ -1118,6 +1118,21 @@ let () = AffineScript definition exists; the interpreter binds them too), not externs — endsWith/stripSuffix/pathJoin/etc. are NOT here: they are real AffineScript built on `ends_with`/`substring`/`++`. *) + (* ---- numeric builtins (stdlib/math.affine header) ---- + Interpreter builtins with no Bun-ESM lowering compiled to calls of + undefined JS globals (`float(n)` -> ReferenceError). floor/ceil/ + round/trunc return Int, which on JS is a Number with no fraction. *) + b "float" (fun a -> Printf.sprintf "Number(%s)" (arg 0 a)); + List.iter (fun (name, js) -> + b name (fun a -> Printf.sprintf "%s(%s)" js (arg 0 a))) + [ ("floor", "Math.floor"); ("ceil", "Math.ceil"); ("round", "Math.round"); + ("trunc", "Math.trunc"); ("sqrt", "Math.sqrt"); ("cbrt", "Math.cbrt"); + ("sin", "Math.sin"); ("cos", "Math.cos"); ("tan", "Math.tan"); + ("asin", "Math.asin"); ("acos", "Math.acos"); ("atan", "Math.atan"); + ("exp", "Math.exp"); ("log", "Math.log"); ("log10", "Math.log10"); + ("log2", "Math.log2") ]; + b "atan2" (fun a -> Printf.sprintf "Math.atan2(%s, %s)" (arg 0 a) (arg 1 a)); + b "pow_float" (fun a -> Printf.sprintf "Math.pow(%s, %s)" (arg 0 a) (arg 1 a)); b "len" (fun a -> Printf.sprintf "((%s).length)" (arg 0 a)); b "slice" (fun a -> Printf.sprintf "((%s).slice(%s, %s))" (arg 0 a) (arg 1 a) (arg 2 a)); diff --git a/lib/typecheck.ml b/lib/typecheck.ml index 778b2f8f..cc841fdb 100644 --- a/lib/typecheck.ml +++ b/lib/typecheck.ml @@ -1016,6 +1016,13 @@ let rec synth (ctx : context) (expr : expr) : ty result = in (q, param_ty) ) elam_params param_tys in + (* A zero-parameter lambda `fn() => e` is a thunk: type it + `Unit -> T`, the same type an explicit `() -> T` annotation lowers + to (see the zero-argument [ExprApp] case, which consumes either + form). Typing it as the bare `T` made it impossible to pass a thunk + to a `() -> T` parameter. *) + let param_qty_pairs = + if elam_params = [] then [ (Types.QOmega, ty_unit) ] else param_qty_pairs in let ty = List.fold_right (fun (q, param_ty) acc -> TArrow (param_ty, q, acc, eff) ) param_qty_pairs body_ty in @@ -1620,12 +1627,22 @@ and check (ctx : context) (expr : expr) (expected : ty) : unit result = (p.p_name.name, Hashtbl.find_opt ctx.name_types p.p_name.name) ) elam_params in let* () = peel_arrows expected elam_params in - (* Now check the body against the final return type *) - let final_ret = List.fold_left (fun ty _ -> - match repr ty with - | TArrow (_, _, ret, _) -> ret - | _ -> ty - ) expected elam_params in + (* Now check the body against the final return type. A zero-parameter + lambda checked against `() -> T` (= `Unit -> T`) consumes the unit + parameter: its body has type `T`. *) + let* final_ret = + if elam_params = [] then + match repr expected with + | TArrow (param_ty, _, ret, _) -> + let* () = unify_or_err param_ty ty_unit in + Ok ret + | _ -> Ok expected + else + Ok (List.fold_left (fun ty _ -> + match repr ty with + | TArrow (_, _, ret, _) -> ret + | _ -> ty + ) expected elam_params) in let* () = check ctx elam_body final_ret in (* Restore *) List.iter (fun (n, old_sc) -> @@ -2244,7 +2261,12 @@ let register_type_decl (ctx : context) (td : type_decl) : unit result = Ok (TCon td.td_name.name) | TyExtern -> (* Opaque host-supplied type. Register a TCon so user code can name it - in signatures; the body is intentionally absent. *) + in signatures; the body is intentionally absent. A parametric one + (`extern type Cell`) records its arity for [infer_kind], like a + parametric enum. *) + if td.td_type_params <> [] then + Hashtbl.replace ctx.type_arity td.td_name.name + (List.length td.td_type_params); Ok (TCon td.td_name.name) in Hashtbl.replace ctx.type_env td.td_name.name ty; diff --git a/test/test_deno_builtins_consistency.ml b/test/test_deno_builtins_consistency.ml index a9cddb91..788bdd53 100644 --- a/test/test_deno_builtins_consistency.ml +++ b/test/test_deno_builtins_consistency.ml @@ -83,6 +83,9 @@ let codegen_only_names = [ "len"; "panic"; "get"; "set"; "slice"; "show"; "error"; "make_ref"; "int_to_string"; "float_to_string"; "string_to_int"; "parse_int"; "parse_float"; "int_to_char"; "char_to_int"; + (* stdlib/math.affine header builtins (resolver-level, no extern decl); + the rest of that family is registered in a loop the regex skips. *) + "float"; "atan2"; "pow_float"; "string_length"; "string_sub"; "string_get"; "string_find"; "string_char_code_at"; "string_from_char_code"; "to_lowercase"; "to_uppercase"; "trim"; diff --git a/test/test_generic_enum_kinds.ml b/test/test_generic_enum_kinds.ml index d9b4ecb2..ce6a4fec 100644 --- a/test/test_generic_enum_kinds.ml +++ b/test/test_generic_enum_kinds.ml @@ -67,6 +67,12 @@ let function_payload () = "pub enum Attr { On(String, Int -> M) }\n\ pub fn on_click(f: Int -> M) -> Attr = On(\"click\", f);\n" +let parametric_extern_type () = + passes + "pub extern type Cell;\n\ + pub extern fn cell_new(v: T) -> Cell;\n\ + pub fn mk() -> Cell = cell_new(1);\n" + (* Planted negative: the kind check must still reject over-application. *) let over_application_still_rejected () = fails_with ~needle:"Too many arguments for kind" @@ -96,6 +102,7 @@ let tests = concrete_application_in_signature; Alcotest.test_case "two-parameter enum" `Quick two_parameter_enum; Alcotest.test_case "function payload" `Quick function_payload; + Alcotest.test_case "parametric extern type" `Quick parametric_extern_type; Alcotest.test_case "over-application still rejected" `Quick over_application_still_rejected; Alcotest.test_case "imported enum kind" `Quick imported_enum_kind; diff --git a/tests/codegen-deno/thunk_math.affine b/tests/codegen-deno/thunk_math.affine new file mode 100644 index 00000000..b9647cc6 --- /dev/null +++ b/tests/codegen-deno/thunk_math.affine @@ -0,0 +1,21 @@ +// SPDX-License-Identifier: MPL-2.0 +// Zero-parameter lambdas are `() -> T` thunks (pass inline, pass by name, +// call later), and the stdlib/math.affine builtins lower on Bun-ESM. + +use prelude::*; +use math::{to_float}; + +pub extern fn host_later(f: () -> Unit) -> Unit; +pub extern fn host_note(s: String) -> Unit; + +pub fn force(f: () -> Int) -> Int = f() + 1; + +pub fn inline_thunk() -> Int = force(fn() => 41); + +pub fn named_thunk() -> Unit { + let f = fn() => host_note("ran"); + host_later(f) +} + +pub fn geometry(x: Float, y: Float) -> Float = + sqrt(x * x + y * y) + to_float(floor(2.7)) + to_float(round(0.5)) + atan2(0.0, 1.0); diff --git a/tests/codegen-deno/thunk_math.harness.mjs b/tests/codegen-deno/thunk_math.harness.mjs new file mode 100644 index 00000000..8dc89314 --- /dev/null +++ b/tests/codegen-deno/thunk_math.harness.mjs @@ -0,0 +1,18 @@ +// SPDX-License-Identifier: MPL-2.0 +// Thunk typing + numeric builtin lowering on Bun-ESM. +import assert from "node:assert/strict"; + +const notes = []; +const later = []; +globalThis.host_note = (s) => notes.push(s); +globalThis.host_later = (f) => later.push(f); +const m = await import("./thunk_math.bun.js"); + +assert.equal(m.inline_thunk(), 42, "inline thunk passed to () -> Int"); +m.named_thunk(); +assert.equal(notes.length, 0, "thunk not run eagerly"); +later.forEach((f) => f()); +assert.deepEqual(notes, ["ran"], "named thunk runs when called"); +assert.equal(m.geometry(3, 4), 5 + 2 + 1 + 0, "sqrt/floor/round/atan2/float lower to Math"); + +console.log("thunk_math.harness.mjs OK"); From 5e0279e28a758af1f9f1cd8a274424605e1bf9c6 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 18:44:42 +0100 Subject: [PATCH 03/13] feat(module_loader): $AFFINESCRIPT_PATH package search path Colon-separated directories searched after the current directory and the stdlib, so third-party AffineScript packages (affinescript-tea first) can be imported from outside the importing program's directory. Previously the loader's search_paths was always empty with no way to set it. Test: test/test_module_search_path.ml (absent without the path, found with it; empty entries ignored). dune test main suite 553 OK. Co-Authored-By: Claude Opus 5.5 --- lib/module_loader.ml | 10 ++++++- test/test_main.ml | 1 + test/test_module_search_path.ml | 46 +++++++++++++++++++++++++++++++++ 3 files changed, 56 insertions(+), 1 deletion(-) create mode 100644 test/test_module_search_path.ml diff --git a/lib/module_loader.ml b/lib/module_loader.ml index d1cd07e9..64ff198c 100644 --- a/lib/module_loader.ml +++ b/lib/module_loader.ml @@ -108,10 +108,18 @@ let discover_stdlib () = else "./stdlib" (* preserves the historical default error path *) (** Create default configuration *) +(** Directories listed in [$AFFINESCRIPT_PATH] (colon-separated, empty + entries ignored): where third-party packages such as affinescript-tea + live. Searched after the current directory and the stdlib. *) +let env_search_paths () : string list = + match Sys.getenv_opt "AFFINESCRIPT_PATH" with + | None -> [] + | Some v -> List.filter (fun d -> d <> "") (String.split_on_char ':' v) + let default_config () : config = { stdlib_path = discover_stdlib (); - search_paths = []; + search_paths = env_search_paths (); current_dir = Sys.getcwd (); } diff --git a/test/test_main.ml b/test/test_main.ml index 8b5cd881..3a212926 100644 --- a/test/test_main.ml +++ b/test/test_main.ml @@ -15,6 +15,7 @@ let () = ("TW L13 isolation (#10)", Test_tw_isolation.tests); ("Qualified paths (#228, ADR-014)", Test_qualified_paths.tests); ("Generic enum kinds", Test_generic_enum_kinds.tests); + ("Module search path ($AFFINESCRIPT_PATH)", Test_module_search_path.tests); ("Module mut (#548)", Test_module_mut.tests); ("Int-div on JS-text backend (#478)", Test_int_div_js.tests); ("Deno builtins ↔ stdlib decls consistency", Test_deno_builtins_consistency.tests); diff --git a/test/test_module_search_path.ml b/test/test_module_search_path.ml new file mode 100644 index 00000000..fdf84840 --- /dev/null +++ b/test/test_module_search_path.ml @@ -0,0 +1,46 @@ +(* SPDX-License-Identifier: MPL-2.0 *) +(* Copyright (c) 2026 Jonathan D.A. Jewell *) +(** [$AFFINESCRIPT_PATH]: colon-separated directories the module loader + searches after the current directory and the stdlib, so third-party + packages (affinescript-tea, ...) can be imported from outside the + importing program's directory. *) + +open Affinescript + +(** A fresh temp directory holding one module file [name].affine. *) +let module_dir name body = + let dir = Filename.concat (Filename.get_temp_dir_name ()) + (Printf.sprintf "as_path_%s_%d" name (Unix.getpid ())) in + (try Unix.mkdir dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); + let oc = open_out (Filename.concat dir (name ^ ".affine")) in + output_string oc body; + close_out oc; + dir + +(** Run [f] with [$AFFINESCRIPT_PATH] set to [v], restoring it afterwards. *) +let with_path v f = + let old = Sys.getenv_opt "AFFINESCRIPT_PATH" in + Unix.putenv "AFFINESCRIPT_PATH" v; + Fun.protect f ~finally:(fun () -> + Unix.putenv "AFFINESCRIPT_PATH" (Option.value old ~default:"")) + +let parses_entries () = + with_path "/a::/b:" (fun () -> + Alcotest.(check (list string)) "empty entries dropped" [ "/a"; "/b" ] + (Module_loader.env_search_paths ())) + +let finds_module_on_path () = + let dir = module_dir "PathLib" "module PathLib;\npub fn seven() -> Int = 7;\n" in + let loader () = Module_loader.create (Module_loader.default_config ()) in + with_path "" (fun () -> + Alcotest.(check bool) "absent without the path" true + (Module_loader.find_module_file (loader ()) [ "PathLib" ] = None)); + with_path dir (fun () -> + Alcotest.(check bool) "found via AFFINESCRIPT_PATH" true + (Module_loader.find_module_file (loader ()) [ "PathLib" ] <> None)) + +let tests = + [ + Alcotest.test_case "parses entries" `Quick parses_entries; + Alcotest.test_case "finds module on path" `Quick finds_module_on_path; + ] From 9d4e00b114106948ea2ca86690b1a1d82772b821 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 18:54:42 +0100 Subject: [PATCH 04/13] fix(ast): find_free_vars walks loops, assignments and pattern binders Statements other than `let` and expression statements were skipped, so a name used only inside a `for`/`while` body (or an assignment) was never reported free. Import flattening then dropped the private helper it named: a public `create` calling `apply_attr` in a for-loop compiled to `ReferenceError: apply_attr is not defined` on Bun-ESM. The same walker drives closure conversion, which could likewise miss a capture. Also bind every variable of a destructuring `let` and of match-arm patterns (and walk guards), instead of only plain `PatVar` lets. dune test main suite 553 OK; Bun-ESM 34/34; WASM 38/38. Co-Authored-By: Claude Opus 5.5 --- lib/ast.ml | 46 ++++++++++++++++++++++++++++++++++++---------- 1 file changed, 36 insertions(+), 10 deletions(-) diff --git a/lib/ast.ml b/lib/ast.ml index dd3b5114..45aa3365 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -554,6 +554,22 @@ let fn_body_contains_return : fn_body -> bool = function undefined `h`). Like the other walkers in this module it is deliberately conservative: constructs it does not inspect contribute [] rather than a wrong answer. *) +(** Variables bound by a pattern. *) +let rec pattern_binders (pat : pattern) : string list = + match pat with + | PatWildcard _ | PatLit _ -> [] + | PatVar id -> [id.name] + | PatTuple pats -> List.concat_map pattern_binders pats + | PatRecord (fields, _) -> + List.concat_map (fun (id, pat_opt) -> + match pat_opt with + | Some p -> pattern_binders p + | None -> [id.name] + ) fields + | PatCon (_, pats) -> List.concat_map pattern_binders pats + | PatOr (p1, p2) -> pattern_binders p1 @ pattern_binders p2 + | PatAs (id, pat) -> id.name :: pattern_binders pat + let rec find_free_vars (bound_vars : string list) (expr : expr) : string list = match expr with | ExprLit _ -> [] @@ -574,10 +590,7 @@ let rec find_free_vars (bound_vars : string list) (expr : expr) : string list = | ExprLet lb -> let rhs_free = find_free_vars bound_vars lb.el_value in (* Add bound variable to scope for body *) - let new_bound = match lb.el_pat with - | PatVar id -> id.name :: bound_vars - | _ -> bound_vars - in + let new_bound = pattern_binders lb.el_pat @ bound_vars in let body_free = match lb.el_body with | Some e -> find_free_vars new_bound e | None -> [] @@ -596,14 +609,22 @@ let rec find_free_vars (bound_vars : string list) (expr : expr) : string list = match stmt with | StmtLet sl -> let rhs_free = find_free_vars bound sl.sl_value in - let new_bound = match sl.sl_pat with - | PatVar id -> id.name :: bound - | _ -> bound - in + let new_bound = pattern_binders sl.sl_pat @ bound in (new_bound, acc_free @ rhs_free) | StmtExpr e -> (bound, acc_free @ find_free_vars bound e) - | _ -> (bound, acc_free) + (* Loops and assignments were skipped entirely, so a name used only + inside a `for`/`while` body was never reported: import flattening + then dropped the helper it called (`ReferenceError: apply_attr is + not defined`), and closure conversion could miss a capture. *) + | StmtAssign (lhs, _, rhs) -> + (bound, acc_free @ find_free_vars bound lhs @ find_free_vars bound rhs) + | StmtWhile (cond, body) -> + (bound, acc_free @ find_free_vars bound cond + @ find_free_vars bound (ExprBlock body)) + | StmtFor (pat, iter, body) -> + (bound, acc_free @ find_free_vars bound iter + @ find_free_vars (pattern_binders pat @ bound) (ExprBlock body)) ) (bound_vars, []) blk.blk_stmts in (* The tail expression is in scope of the block's own `let` bindings, so its free vars must exclude them — use the @@ -617,7 +638,12 @@ let rec find_free_vars (bound_vars : string list) (expr : expr) : string list = free @ expr_free | ExprMatch m -> find_free_vars bound_vars m.em_scrutinee @ - List.concat (List.map (fun arm -> find_free_vars bound_vars arm.ma_body) m.em_arms) + List.concat (List.map (fun arm -> + let arm_bound = pattern_binders arm.ma_pat @ bound_vars in + (match arm.ma_guard with + | Some g -> find_free_vars arm_bound g + | None -> []) + @ find_free_vars arm_bound arm.ma_body) m.em_arms) | ExprReturn e_opt -> (match e_opt with Some e -> find_free_vars bound_vars e | None -> []) | ExprTuple exprs | ExprArray exprs -> From c23c4e397b32373563f995ad3b158eadd0991d78 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 19:09:07 +0100 Subject: [PATCH 05/13] fix(typecheck,resolve,bun-esm): record update typing, imported types, lambdas in methods Found porting nexia-list's UI to AffineScript (a multi-module TEA app): - typecheck: `S #{ ..base, f: v }` ignored the spread when typing, so the result was only the explicit fields and an update could never produce the struct it started from. Now: a closed base keeps every field, each explicit field must match the base's type (an update cannot change a field's type) and new fields extend it; an open or not-yet-known base is constrained to have the explicit fields and the result is its own type (extending an open row there failed the row occurs check). - typecheck/resolve: an imported struct was an opaque name in the importer, because imports carry only value schemes, so its fields could not be read. A module now records each monomorphic type definition under a reserved `name_types` key (NUL-prefixed, disjoint from identifiers), the import paths copy it for imported type symbols (aliases honoured), and `check_program` installs it in the importer's type environment. Local declarations still win. - bun-esm: a lambda inside a synthesised (async) class method inherited the async context, emitting `(x) => (await ...)`, which is a SyntaxError in V8/browsers (Bun's parser accepts it, which hid the bug). Lambda bodies are now emitted in a non-async context. Tests: test/test_records_and_imports.ml (7, incl. wrong-field-type and unknown-imported-field negatives); tests/codegen-deno/method_lambda (fails with the SyntaxError when the lambda fix is reverted). dune test main 560 OK; Bun-ESM 35/35; WASM 38/38. Co-Authored-By: Claude Opus 5.5 --- lib/codegen_deno.ml | 7 +- lib/resolve.ml | 16 +++- lib/typecheck.ml | 80 +++++++++++++++- test/test_main.ml | 1 + test/test_records_and_imports.ml | 96 ++++++++++++++++++++ tests/codegen-deno/method_lambda.affine | 13 +++ tests/codegen-deno/method_lambda.harness.mjs | 7 ++ 7 files changed, 215 insertions(+), 5 deletions(-) create mode 100644 test/test_records_and_imports.ml create mode 100644 tests/codegen-deno/method_lambda.affine create mode 100644 tests/codegen-deno/method_lambda.harness.mjs diff --git a/lib/codegen_deno.ml b/lib/codegen_deno.ml index 38fe7957..85a02a63 100644 --- a/lib/codegen_deno.ml +++ b/lib/codegen_deno.ml @@ -1563,7 +1563,12 @@ let rec gen_expr ctx (expr : expr) : string = | ExprContinue _ -> iife ctx "continue;" | ExprLambda { elam_params; elam_body; elam_ret_ty = _ } -> let ps = List.map (fun (p : param) -> mangle p.p_name.name) elam_params in - "((" ^ String.concat ", " ps ^ ") => " ^ gen_expr ctx elam_body ^ ")" + (* A lambda is a plain (non-async) arrow, so its body must not inherit + the enclosing async context: inside a synthesised (async) method, + `(x) => (await ...)` is a SyntaxError in browsers — Bun's parser + happens to accept it, which hid the bug. *) + "((" ^ String.concat ", " ps ^ ") => " + ^ gen_expr { ctx with in_async = false } elam_body ^ ")" | ExprTry { et_body; et_catch; et_finally } -> gen_try ctx et_body et_catch et_finally | ExprVariant (ty, ctor) -> diff --git a/lib/resolve.ml b/lib/resolve.ml index 4269eca9..9828ecc9 100644 --- a/lib/resolve.ml +++ b/lib/resolve.ml @@ -598,6 +598,17 @@ let lookup_source_scheme | Some sc -> Some sc | None -> Hashtbl.find_opt source_name_types sym.Symbol.sym_name +(** For an imported type symbol, carry its definition (recorded by the + source module under [Typecheck.type_def_key]) so the importer can use the + type's structure — e.g. read an imported struct's fields. *) +let import_type_def ~dest_name_types ~source_name_types + (sym : Symbol.symbol) (bound_name : string) : unit = + if sym.Symbol.sym_kind = Symbol.SKType then + Option.iter (fun sc -> + Hashtbl.replace dest_name_types (Typecheck.type_def_key bound_name) sc) + (Hashtbl.find_opt source_name_types + (Typecheck.type_def_key sym.Symbol.sym_name)) + (** Import symbols from a resolved module into the current context. [dest_name_types] is the destination type checker's name-keyed scheme map; @@ -621,7 +632,9 @@ let import_resolved_symbols Option.iter (fun scheme -> Hashtbl.replace dest_types sym.Symbol.sym_id scheme; Hashtbl.replace dest_name_types sym.Symbol.sym_name scheme - ) (lookup_source_scheme source_types source_name_types sym) + ) (lookup_source_scheme source_types source_name_types sym); + import_type_def ~dest_name_types ~source_name_types sym + sym.Symbol.sym_name | _ -> () (* Private symbols not imported *) ) source_symbols.all_symbols @@ -646,6 +659,7 @@ let import_specific_items let alias = Option.map (fun id -> id.name) item.ii_alias in let _ = Symbol.register_import dest_symbols sym alias in let bound_name = Option.value alias ~default:sym.Symbol.sym_name in + import_type_def ~dest_name_types ~source_name_types sym bound_name; Option.iter (fun scheme -> Hashtbl.replace dest_types sym.Symbol.sym_id scheme; Hashtbl.replace dest_name_types bound_name scheme diff --git a/lib/typecheck.ml b/lib/typecheck.ml index cc841fdb..de6f05bc 100644 --- a/lib/typecheck.ml +++ b/lib/typecheck.ml @@ -1103,7 +1103,55 @@ let rec synth (ctx : context) (expr : expr) : ty result = let kinds = List.map (fun (name, (_off, is_f64)) -> (name, is_f64)) layout in cell_record_sites := (rec_node, kinds) :: !cell_record_sites | _ -> ()); - Ok (TRecord row) + begin match er_spread with + | None -> Ok (TRecord row) + | Some base -> + (* Functional update `#{ ..base, f: v }`: the result has every field + of [base], with each explicitly given field replacing the base's + (same type — a struct update cannot change a field's type) and + any field the base lacks added. The spread used to be ignored, so + the result was typed as only the explicit fields and an update + could never produce the struct it started from. *) + let* base_ty = synth ctx base in + let rec follow (r : row) : row = + match r with + | RVar { contents = RLink r' } -> follow r' + | _ -> r + in + let explicit = List.rev field_tys in + let rec closed (r : row) : bool = + match follow r with + | REmpty -> true + | RExtend (_, _, rest) -> closed rest + | RVar _ -> false + in + begin match repr base_ty with + | TRecord brow when closed brow -> + let rec update_row (r : row) (seen : string list) : (row * string list) result = + match follow r with + | RExtend (l, t, rest) -> + let* () = match List.assoc_opt l explicit with + | Some nt -> unify_or_err t nt + | None -> Ok () + in + let* (rest', seen') = update_row rest (l :: seen) in + Ok (RExtend (l, t, rest'), seen') + | tail -> Ok (tail, seen) + in + let* (updated, base_labels) = update_row brow [] in + let added = List.filter (fun (l, _) -> not (List.mem l base_labels)) explicit in + Ok (TRecord (List.fold_right (fun (l, t) acc -> RExtend (l, t, acc)) added updated)) + | _ -> + (* An open or not-yet-known base: it must have the explicitly + updated fields (same types), and the result is the base's own + type. Extending an open row here would make it contain itself + (row occurs check). *) + let expected = TRecord (List.fold_right (fun (l, t) acc -> RExtend (l, t, acc)) + explicit (fresh_rowvar ctx.level)) in + let* () = unify_or_err base_ty expected in + Ok base_ty + end + end (* Field access — first try record-field projection, then trait method lookup *) | ExprField (obj, { name = field; _ }) as field_node -> @@ -2198,6 +2246,20 @@ let check_fn_decl (ctx : context) (fd : fn_decl) : unit result = Ok () (** Register a type declaration in the context. *) +(** Reserved [name_types] key under which a module records the definition + of its type [name], so importers can name the type with its structure + (an imported struct's fields; imports otherwise carry only value + schemes). The NUL byte keeps it disjoint from every identifier. *) +let type_def_key (name : string) : string = "\000type:" ^ name + +(** Inverse of [type_def_key]: the type name, if [key] is one. *) +let type_of_def_key (key : string) : string option = + let pfx = "\000type:" in + let n = String.length pfx in + if String.length key > n && String.sub key 0 n = pfx + then Some (String.sub key n (String.length key - n)) + else None + let register_type_decl (ctx : context) (td : type_decl) : unit result = let* ty = match td.td_body with | TyAlias te -> @@ -2270,6 +2332,12 @@ let register_type_decl (ctx : context) (td : type_decl) : unit result = Ok (TCon td.td_name.name) in Hashtbl.replace ctx.type_env td.td_name.name ty; + (* Export the definition for importers (see [type_def_key]). Only + monomorphic definitions: a generic struct/alias body mentions its + parameters, which have no meaning outside this declaration. *) + if td.td_type_params = [] then + Hashtbl.replace ctx.name_types (type_def_key td.td_name.name) + { sc_tyvars = []; sc_effvars = []; sc_rowvars = []; sc_body = ty }; Ok () (** Register an effect declaration. *) @@ -2514,8 +2582,14 @@ let check_program ?(import_types : (string, scheme) Hashtbl.t option) ) prog.prog_imports; Option.iter (fun tbl -> Hashtbl.iter (fun name sc -> - Hashtbl.replace ctx.name_types name sc; - record_type_arities ctx sc.sc_body) tbl + match type_of_def_key name with + | Some ty_name -> + (* An imported type's definition. Local declarations, registered in + the forward pass below, replace it. *) + Hashtbl.replace ctx.type_env ty_name sc.sc_body + | None -> + Hashtbl.replace ctx.name_types name sc; + record_type_arities ctx sc.sc_body) tbl ) import_types; (* Forward pass: register all types, effects, traits, impls, and function signatures so that mutually recursive declarations resolve. *) diff --git a/test/test_main.ml b/test/test_main.ml index 3a212926..4bc13ef3 100644 --- a/test/test_main.ml +++ b/test/test_main.ml @@ -16,6 +16,7 @@ let () = ("Qualified paths (#228, ADR-014)", Test_qualified_paths.tests); ("Generic enum kinds", Test_generic_enum_kinds.tests); ("Module search path ($AFFINESCRIPT_PATH)", Test_module_search_path.tests); + ("Record update + imported types", Test_records_and_imports.tests); ("Module mut (#548)", Test_module_mut.tests); ("Int-div on JS-text backend (#478)", Test_int_div_js.tests); ("Deno builtins ↔ stdlib decls consistency", Test_deno_builtins_consistency.tests); diff --git a/test/test_records_and_imports.ml b/test/test_records_and_imports.ml new file mode 100644 index 00000000..82aaaaaf --- /dev/null +++ b/test/test_records_and_imports.ml @@ -0,0 +1,96 @@ +(* SPDX-License-Identifier: MPL-2.0 *) +(* Copyright (c) 2026 Jonathan D.A. Jewell *) +(** Record update typing and imported type definitions. + + - `S #{ ..base, f: v }` used to ignore the spread when typing, so the + result had only the explicit fields and an update could never produce + the struct it started from. + - An imported struct was an opaque name in the importer (imports carry + value schemes only), so its fields could not be read. *) + +open Affinescript + +(** parse -> resolve (loader rooted at [dir]) -> typecheck. *) +let frontend ?(dir = Sys.getcwd ()) (src : string) : (unit, string) result = + let ( let* ) = Result.bind in + let* prog = + try Ok (Parse_driver.parse_string ~file:"" src) + with + | Parse_driver.Parse_error (m, sp) -> + Error (Printf.sprintf "Parse error at %s: %s" (Span.show sp) m) + | e -> Error (Printf.sprintf "Unexpected: %s" (Printexc.to_string e)) + in + let config = { (Module_loader.default_config ()) with current_dir = dir; search_paths = [ dir ] } in + let loader = Module_loader.create config in + let* resolve_ctx, type_ctx = + match Resolve.resolve_program_with_loader prog loader with + | Ok (rc, tc) -> Ok (rc, tc) + | Error (e, _) -> Error ("Resolution error: " ^ Resolve.show_resolve_error e) + in + match + Typecheck.check_program ~import_types:type_ctx.Typecheck.name_types + resolve_ctx.symbols prog + with + | Ok _ -> Ok () + | Error e -> Error ("Type error: " ^ Typecheck.format_type_error e) + +(** Assert [src] type-checks. *) +let passes ?dir src = + match frontend ?dir src with + | Ok () -> () + | Error m -> Alcotest.failf "expected Ok, got: %s" m + +(** Assert [src] is rejected. *) +let fails src = + match frontend src with + | Ok () -> Alcotest.fail "expected a type error, got Ok" + | Error _ -> () + +let p = "struct P { a: Int, b: String }\n" + +let update_keeps_struct_type () = passes (p ^ "pub fn f(q: P) -> P = P #{ ..q, a: 2 };\n") +let spread_only () = passes (p ^ "pub fn f(q: P) -> P = P #{ ..q };\n") +let untouched_field_readable () = + passes (p ^ "pub fn f(q: P) -> String { let r = P #{ ..q, a: 2 }; r.b }\n") +let update_cannot_change_field_type () = fails (p ^ "pub fn f(q: P) -> P = P #{ ..q, a: \"x\" };\n") +let update_through_destructured_tuple () = + passes (p ^ "fn mk(q: P) -> (P, Int) = (q, 1);\n\ + pub fn f(q: P) -> P { let (r, n) = mk(q); P #{ ..r, a: n } }\n") + +(** A temp directory holding [name].affine with [body]. *) +let module_dir name body = + let dir = Filename.concat (Filename.get_temp_dir_name ()) + (Printf.sprintf "as_rec_%s_%d" name (Unix.getpid ())) in + (try Unix.mkdir dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); + let oc = open_out (Filename.concat dir (name ^ ".affine")) in + output_string oc body; + close_out oc; + dir + +let imported_struct_fields () = + let dir = module_dir "Shapes" + "module Shapes;\npub struct Point { x: Float, y: Float }\n\ + pub fn origin() -> Point = Point #{ x: 0.0, y: 0.0 };\n" in + passes ~dir + "use Shapes::{Point, origin};\n\ + pub fn sum(p: Point) -> Float = p.x + p.y;\n\ + pub fn moved() -> Point { let o = origin(); Point #{ ..o, x: 1.0 } }\n" + +let imported_struct_unknown_field_rejected () = + let dir = module_dir "Shapes2" + "module Shapes2;\npub struct Point { x: Float, y: Float }\n" in + match frontend ~dir "use Shapes2::{Point};\npub fn f(p: Point) -> Float = p.z;\n" with + | Ok () -> Alcotest.fail "expected unknown field to be rejected" + | Error _ -> () + +let tests = + [ + Alcotest.test_case "update keeps struct type" `Quick update_keeps_struct_type; + Alcotest.test_case "spread only" `Quick spread_only; + Alcotest.test_case "untouched field readable" `Quick untouched_field_readable; + Alcotest.test_case "update cannot change field type" `Quick update_cannot_change_field_type; + Alcotest.test_case "update through destructured tuple" `Quick update_through_destructured_tuple; + Alcotest.test_case "imported struct fields" `Quick imported_struct_fields; + Alcotest.test_case "imported struct unknown field rejected" `Quick + imported_struct_unknown_field_rejected; + ] diff --git a/tests/codegen-deno/method_lambda.affine b/tests/codegen-deno/method_lambda.affine new file mode 100644 index 00000000..7947f5ea --- /dev/null +++ b/tests/codegen-deno/method_lambda.affine @@ -0,0 +1,13 @@ +// SPDX-License-Identifier: MPL-2.0 +// A lambda inside a receiver-first fn: the fn is also synthesised as an +// (async) class method, and the lambda body must not inherit that async +// context — `(x) => (await ...)` is a SyntaxError in V8/browsers. + +use prelude::*; + +struct Box { items: [Int], label: String } + +pub fn make() -> Box = Box #{ items: [1, 2, 3], label: "b" }; + +pub fn describe(b: Box) -> [String] = + map(b.items, fn(i) => if i > 1 { b.label } else { "small" }); diff --git a/tests/codegen-deno/method_lambda.harness.mjs b/tests/codegen-deno/method_lambda.harness.mjs new file mode 100644 index 00000000..2181bc3b --- /dev/null +++ b/tests/codegen-deno/method_lambda.harness.mjs @@ -0,0 +1,7 @@ +// SPDX-License-Identifier: MPL-2.0 +// Importing the module at all proves it parses under V8 (Node). +import assert from "node:assert/strict"; +import { make, describe } from "./method_lambda.bun.js"; + +assert.deepEqual(describe(make()), ["small", "b", "b"]); +console.log("method_lambda.harness.mjs OK"); From f069138c0da1e3d5f8b6888d599fe1874d87a789 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 19:14:20 +0100 Subject: [PATCH 06/13] fix(module_loader): carry directly-imported enums when flattening An enum's constructors reached an importer's flattened (non-Wasm) output only if some carried *function* constructed them; patterns do not count. So `use Geometry::{Up}` + `Some(Up)` compiled to a reference to an undefined `Up` (a ReferenceError at the first keypress in nexia-list's port). Public enums named in a `use M::{...}` list (by type or by any constructor), and all public enums for `use M`/globs, are now carried; enums made only of the preamble's Option/Result constructors never are. The Bun-ESM corpus runner now puts the corpus on AFFINESCRIPT_PATH so fixtures can be multi-module. Test: imported_ctor + DirLib (fails with `ReferenceError: North is not defined` without this change). dune main 560 OK; Bun-ESM 36/36; WASM 38/38; native Bun 1/1. Co-Authored-By: Claude Opus 5.5 --- lib/module_loader.ml | 27 ++++++++++++++++++++ tests/codegen-deno/DirLib.affine | 13 ++++++++++ tests/codegen-deno/imported_ctor.affine | 10 ++++++++ tests/codegen-deno/imported_ctor.harness.mjs | 9 +++++++ tools/run_codegen_deno_tests.sh | 5 +++- 5 files changed, 63 insertions(+), 1 deletion(-) create mode 100644 tests/codegen-deno/DirLib.affine create mode 100644 tests/codegen-deno/imported_ctor.affine create mode 100644 tests/codegen-deno/imported_ctor.harness.mjs diff --git a/lib/module_loader.ml b/lib/module_loader.ml index 64ff198c..d1f74d03 100644 --- a/lib/module_loader.ml +++ b/lib/module_loader.ml @@ -447,6 +447,33 @@ let flatten_imports (loader : t) (prog : program) : program = (fun (n, dk) -> (bound_name_of n, rename_decl (bound_name_of n) dk)) (direct @ extras) in + (* Public enums the importer names directly. A constructor in the + import list (`use Geometry::{Up, Down}`) or a type name the + importer constructs was only carried when some carried *function* + happened to construct it, so `Some(Up)` in the importer compiled + to a reference to an undefined `Up`. Enums made only of the + preamble's Option/Result constructors are never carried (every + non-Wasm backend's runtime preamble already defines those). *) + let preamble_only = [ "Some"; "None"; "Ok"; "Err" ] in + let public_enums = List.filter_map (fun decl -> + match decl with + | TopType ({ td_body = TyEnum variants; _ } as td) + when (td.td_vis = Public || td.td_vis = PubCrate) + && List.exists (fun (vd : variant_decl) -> + not (List.mem vd.vd_name.name preamble_only)) variants -> + Some (td.td_name.name, + List.map (fun (vd : variant_decl) -> vd.vd_name.name) variants, + decl) + | _ -> None) lm.mod_program.prog_decls in + let named = match imp with + | ImportList (_, items) -> + List.filter (fun (ty, ctors, _) -> + List.exists (fun item -> + let n = item.ii_name.name in n = ty || List.mem n ctors) items) + public_enums + | ImportSimple _ | ImportGlob _ -> public_enums + in + List.iter (fun (ty, _, decl) -> add_imported ty (`Type decl)) named; List.iter (fun (name, decl_kind) -> add_imported name decl_kind) select ) prog.prog_imports; let imported_decls = diff --git a/tests/codegen-deno/DirLib.affine b/tests/codegen-deno/DirLib.affine new file mode 100644 index 00000000..e2413923 --- /dev/null +++ b/tests/codegen-deno/DirLib.affine @@ -0,0 +1,13 @@ +// SPDX-License-Identifier: MPL-2.0 +// Library half of the imported_ctor fixture: an enum and a function that only +// *matches* on it (patterns do not reference constructors, so nothing here +// causes the enum to be carried into an importer's flattened output). +module DirLib; + +pub enum Dir { North, South, Step(Int) } + +pub fn name(d: Dir) -> String = match d { + Dir::North => "north", + Dir::South => "south", + Dir::Step(n) => "step " ++ int_to_string(n) +}; diff --git a/tests/codegen-deno/imported_ctor.affine b/tests/codegen-deno/imported_ctor.affine new file mode 100644 index 00000000..03f9c0a9 --- /dev/null +++ b/tests/codegen-deno/imported_ctor.affine @@ -0,0 +1,10 @@ +// SPDX-License-Identifier: MPL-2.0 +// Constructors of an imported enum, named directly in the import list, must +// exist in the flattened output (they compiled to undefined references when +// no carried function happened to construct them). +use prelude::*; +use DirLib::{Dir, North, South, Step, name}; + +pub fn pick(up: Bool) -> Option = if up { Some(North) } else { Some(Step(3)) }; + +pub fn both() -> String = name(North) ++ "," ++ name(Step(0 - 3)) ++ "," ++ name(South); diff --git a/tests/codegen-deno/imported_ctor.harness.mjs b/tests/codegen-deno/imported_ctor.harness.mjs new file mode 100644 index 00000000..4e6e0b31 --- /dev/null +++ b/tests/codegen-deno/imported_ctor.harness.mjs @@ -0,0 +1,9 @@ +// SPDX-License-Identifier: MPL-2.0 +// Imported enum constructors are emitted and usable. +import assert from "node:assert/strict"; +import { pick, both } from "./imported_ctor.bun.js"; + +assert.equal(pick(true).value.tag, "North"); +assert.equal(pick(false).value.tag, "Step"); +assert.equal(both(), "north,step -3,south"); +console.log("imported_ctor.harness.mjs OK"); diff --git a/tools/run_codegen_deno_tests.sh b/tools/run_codegen_deno_tests.sh index ae769c9b..ba14a14f 100755 --- a/tools/run_codegen_deno_tests.sh +++ b/tools/run_codegen_deno_tests.sh @@ -31,7 +31,10 @@ compile_failures=() for src in "$TEST_DIR"/*.affine; do out="${src%.affine}.bun.js" echo "Compiling $(basename "$src") -> $(basename "$out")" - if ! "${COMPILE_CMD[@]}" "$src" -o "$out" --bun-esm; then + # The corpus directory is on the module path so multi-module fixtures + # (e.g. imported_ctor + DirLib) resolve their sibling modules. + if ! AFFINESCRIPT_PATH="$TEST_DIR${AFFINESCRIPT_PATH:+:$AFFINESCRIPT_PATH}" \ + "${COMPILE_CMD[@]}" "$src" -o "$out" --bun-esm; then compile_failures+=("$(basename "$src")") fi done From efa86835384c4ee0640c695d6e4746846f306c1c Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 19:34:03 +0100 Subject: [PATCH 07/13] fix(bun-esm,typecheck): Int division in loops; generic externs used before declaration MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - bun-esm (#478 follow-up): OCaml evaluates `^` operands right to left, so a `while`/`for` body's tail expression was generated before its statements. The int-tracking for `Int / Int` truncation then saw the tail's assignments (`lo = mid + 1`) before the `let mid = ...` they depend on, forgot `lo` was an Int, and emitted float division: a binary search computed `(lo + hi) / 2 = 2.5`. Block parts are now generated in source order. Fixture int_div_loop fails (1 vs 3) without this. - typecheck: the forward pass bound every function to a fresh, ungeneralised type variable, so a generic extern used before its declaration had its type fixed by the first use and a second instantiation failed (`TypeMismatch (Int, Bool)`). Extern signatures are complete, so their generalised schemes are now registered in the forward pass (after all types). Ordinary generic fns keep the old behaviour (their effects are inferred) — a documented follow-up. dune main 561 OK; Bun-ESM 37/37; WASM 38/38; native Bun 1/1. Co-Authored-By: Claude Opus 5.5 --- lib/codegen_deno.ml | 23 ++++++++++++------- lib/typecheck.ml | 11 +++++++++ test/test_generic_enum_kinds.ml | 7 ++++++ tests/codegen-deno/int_div_loop.affine | 25 +++++++++++++++++++++ tests/codegen-deno/int_div_loop.harness.mjs | 12 ++++++++++ 5 files changed, 70 insertions(+), 8 deletions(-) create mode 100644 tests/codegen-deno/int_div_loop.affine create mode 100644 tests/codegen-deno/int_div_loop.harness.mjs diff --git a/lib/codegen_deno.ml b/lib/codegen_deno.ml index 85a02a63..2a315bf8 100644 --- a/lib/codegen_deno.ml +++ b/lib/codegen_deno.ml @@ -1887,11 +1887,16 @@ and gen_stmt ctx (stmt : stmt) : string = | _ -> ()); js | StmtWhile (cond, body) -> - "while (" ^ gen_expr ctx cond ^ ") { " - ^ String.concat " " (List.map (gen_stmt ctx) body.blk_stmts) - ^ (match body.blk_expr with - | Some e -> " " ^ gen_stmt_expr ctx e | None -> "") - ^ " }" + (* Generate strictly in source order: OCaml evaluates `^` operands + right to left, which generated the block's tail before its + statements — so int-tracking (#478) saw the tail's assignments + before the `let`s they depend on, and `(lo + hi) / 2` lost its + truncation. *) + let cond_js = gen_expr ctx cond in + let stmts_js = String.concat " " (List.map (gen_stmt ctx) body.blk_stmts) in + let tail_js = match body.blk_expr with + | Some e -> " " ^ gen_stmt_expr ctx e | None -> "" in + "while (" ^ cond_js ^ ") { " ^ stmts_js ^ tail_js ^ " }" | StmtFor (pat, iter, body) -> (* The iterable is evaluated in the outer scope, so emit it first. *) let iter_str = gen_expr ctx iter in @@ -1911,9 +1916,11 @@ and gen_stmt ctx (stmt : stmt) : string = | _ -> fun () -> () in let body_js = - String.concat " " (List.map (gen_stmt ctx) body.blk_stmts) - ^ (match body.blk_expr with - | Some e -> " " ^ gen_stmt_expr ctx e | None -> "") + (* Source order (see StmtWhile): statements before the tail. *) + let stmts_js = String.concat " " (List.map (gen_stmt ctx) body.blk_stmts) in + let tail_js = match body.blk_expr with + | Some e -> " " ^ gen_stmt_expr ctx e | None -> "" in + stmts_js ^ tail_js in restore (); "for (const " ^ pat_str ^ " of " ^ iter_str ^ ") { " ^ body_js ^ " }" diff --git a/lib/typecheck.ml b/lib/typecheck.ml index de6f05bc..d14334f7 100644 --- a/lib/typecheck.ml +++ b/lib/typecheck.ml @@ -2616,6 +2616,17 @@ let check_program ?(import_types : (string, scheme) Hashtbl.t option) Ok () | _ -> Ok () ) (Ok ()) prog.prog_decls in + (* Extern functions are fully described by their signatures, so register + their generalised schemes now (after every type is known) rather than + the fresh monomorphic placeholder above: a generic extern used before + its declaration otherwise had its type fixed by the first use, and a + second instantiation failed (`TypeMismatch (Int, Bool)`). *) + let* () = List.fold_left (fun acc decl -> + let* () = acc in + match decl with + | TopFn fd when fd.fd_body = FnExtern -> check_fn_decl ctx fd + | _ -> Ok () + ) (Ok ()) prog.prog_decls in (* #559: trait coherence — now that every impl is registered, reject overlapping impls of the same trait (self types that unify). Done before the check pass so an ambiguous instance base is reported up front. *) diff --git a/test/test_generic_enum_kinds.ml b/test/test_generic_enum_kinds.ml index ce6a4fec..8e9cf64d 100644 --- a/test/test_generic_enum_kinds.ml +++ b/test/test_generic_enum_kinds.ml @@ -73,6 +73,11 @@ let parametric_extern_type () = pub extern fn cell_new(v: T) -> Cell;\n\ pub fn mk() -> Cell = cell_new(1);\n" +let generic_extern_used_before_declaration () = + passes + "pub fn both() -> Bool { let a = mk(1); let b = mk(true); b[0] }\n\ + pub extern fn mk(v: A) -> [A];\n" + (* Planted negative: the kind check must still reject over-application. *) let over_application_still_rejected () = fails_with ~needle:"Too many arguments for kind" @@ -103,6 +108,8 @@ let tests = Alcotest.test_case "two-parameter enum" `Quick two_parameter_enum; Alcotest.test_case "function payload" `Quick function_payload; Alcotest.test_case "parametric extern type" `Quick parametric_extern_type; + Alcotest.test_case "generic extern used before declaration" `Quick + generic_extern_used_before_declaration; Alcotest.test_case "over-application still rejected" `Quick over_application_still_rejected; Alcotest.test_case "imported enum kind" `Quick imported_enum_kind; diff --git a/tests/codegen-deno/int_div_loop.affine b/tests/codegen-deno/int_div_loop.affine new file mode 100644 index 00000000..8f959c0f --- /dev/null +++ b/tests/codegen-deno/int_div_loop.affine @@ -0,0 +1,25 @@ +// SPDX-License-Identifier: MPL-2.0 +// #478 regression: integer division inside a loop whose body ends in a +// tail-position `if` that reassigns the operands (a binary search). The +// block tail used to be generated before its statements, so the operands +// were forgotten as Int and `(lo + hi) / 2` became float division. + +pub fn lower_bound(xs: [Int], x: Int) -> Int { + let mut lo = 0; + let mut hi = len(xs); + while lo < hi { + let mid = (lo + hi) / 2; + if xs[mid] < x { lo = mid + 1; } else { hi = mid; } + } + lo +} + +pub fn halves(n: Int) -> Int { + let mut steps = 0; + let mut k = n; + for _x in [1, 2, 3, 4, 5, 6, 7, 8] { + let half = k / 2; + if half > 0 { k = half; steps = steps + 1; } else { k = 0; } + } + steps +} diff --git a/tests/codegen-deno/int_div_loop.harness.mjs b/tests/codegen-deno/int_div_loop.harness.mjs new file mode 100644 index 00000000..f41ca1ef --- /dev/null +++ b/tests/codegen-deno/int_div_loop.harness.mjs @@ -0,0 +1,12 @@ +// SPDX-License-Identifier: MPL-2.0 +// Integer division in loop bodies truncates (#478). +import assert from "node:assert/strict"; +import { lower_bound, halves } from "./int_div_loop.bun.js"; + +const xs = [1, 3, 5, 7, 9, 11]; +assert.equal(lower_bound(xs, 7), 3); +assert.equal(lower_bound(xs, 8), 4); +assert.equal(lower_bound(xs, 0), 0); +assert.equal(lower_bound(xs, 99), 6); +assert.equal(halves(100), 6); +console.log("int_div_loop.harness.mjs OK"); From ac4afa4854dd57625ab0b41a48caf2da27af943f Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 19:36:07 +0100 Subject: [PATCH 08/13] fix(typecheck): scope a function body's let-bindings, not just its params check_fn_decl restored only parameter bindings after checking a body, so a block-local `let node = ...` overwrote the module-level `node` in name_types, and importers saw the local's type as the module's export (`Expected a function type, got Node` when affinescript-tea's `node` helper was imported after its keyed diff gained a local `node`). The name table is now snapshotted after the function's own recursive binding and restored wholesale after the body. Test: local binding does not shadow export (fails without the fix). dune main 562 OK; Bun-ESM 37/37; WASM 38/38. Co-Authored-By: Claude Opus 5.5 --- lib/typecheck.ml | 22 +++++++++++----------- test/test_records_and_imports.ml | 10 ++++++++++ 2 files changed, 21 insertions(+), 11 deletions(-) diff --git a/lib/typecheck.ml b/lib/typecheck.ml index d14334f7..4c1a80f4 100644 --- a/lib/typecheck.ml +++ b/lib/typecheck.ml @@ -2199,12 +2199,15 @@ let check_fn_decl (ctx : context) (fd : fn_decl) : unit result = ) param_tys fd.fd_params ret_ty in (* Bind the function name (allows recursion) *) bind_var ctx fd.fd_name.name fn_ty; + (* Everything the body binds — parameters and block-local `let`s — is + scoped to it. Only parameters used to be restored, so a local + `let node = ...` overwrote the module-level `node` in [name_types], + and importers saw the local's type as the module's export. Snapshot + here and restore the whole table after the body. *) + let scope_snapshot = Hashtbl.copy ctx.name_types in (* Bind parameters *) - let old = List.map2 (fun (p : param) ty -> - let old = Hashtbl.find_opt ctx.name_types p.p_name.name in - bind_var ctx p.p_name.name ty; - (p.p_name.name, old) - ) fd.fd_params param_tys in + List.iter2 (fun (p : param) ty -> bind_var ctx p.p_name.name ty) + fd.fd_params param_tys; (* issue #59 — effect inference spine: infer this body's effect row into a fresh accumulator, then (only if a row was explicitly declared) require the inferred row to be a subset of it. An @@ -2219,12 +2222,9 @@ let check_fn_decl (ctx : context) (fd : fn_decl) : unit result = | FnExpr e -> check ctx e ret_ty end in - (* Restore parameter bindings *) - List.iter (fun (n, old_sc) -> - match old_sc with - | Some sc -> Hashtbl.replace ctx.name_types n sc - | None -> Hashtbl.remove ctx.name_types n - ) old; + (* Restore every binding the body introduced (see [scope_snapshot]). *) + Hashtbl.reset ctx.name_types; + Hashtbl.iter (fun n sc -> Hashtbl.replace ctx.name_types n sc) scope_snapshot; let inferred_eff = ctx.current_eff in ctx.current_eff <- saved_eff; let* () = diff --git a/test/test_records_and_imports.ml b/test/test_records_and_imports.ml index 82aaaaaf..7ffffd65 100644 --- a/test/test_records_and_imports.ml +++ b/test/test_records_and_imports.ml @@ -83,6 +83,14 @@ let imported_struct_unknown_field_rejected () = | Ok () -> Alcotest.fail "expected unknown field to be rejected" | Error _ -> () +(* A function-local binding must not replace the module-level binding of + the same name in what importers see. *) +let local_binding_does_not_shadow_export () = + let dir = module_dir "Shadow" + "module Shadow;\npub fn node(x: Int) -> Int = x + 1;\n\ + pub fn uses() -> Bool { let node = true; node }\n" in + passes ~dir "use Shadow::{node};\npub fn f() -> Int = node(41);\n" + let tests = [ Alcotest.test_case "update keeps struct type" `Quick update_keeps_struct_type; @@ -93,4 +101,6 @@ let tests = Alcotest.test_case "imported struct fields" `Quick imported_struct_fields; Alcotest.test_case "imported struct unknown field rejected" `Quick imported_struct_unknown_field_rejected; + Alcotest.test_case "local binding does not shadow export" `Quick + local_binding_does_not_shadow_export; ] From 7c8ea316202327c8b384df09aacd03572a3854e7 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 19:46:38 +0100 Subject: [PATCH 09/13] fix(module_loader): flatten imports transitively Flattening carried an imported module's own declarations but not what that module imported, so a program importing Router.on_url_change (whose body calls Tea.subs) emitted an undefined `subs`. An imported module's imports are now flattened first (with a cycle guard), so the dependency closure reaches across modules. Fixture chain_import -> ChainLib -> DirLib fails with `ReferenceError: name is not defined` without this change. dune main 562 OK; Bun-ESM 38/38; WASM 38/38. Co-Authored-By: Claude Opus 5.5 --- lib/module_loader.ml | 19 +++++++++++++++++-- tests/codegen-deno/ChainLib.affine | 8 ++++++++ tests/codegen-deno/chain_import.affine | 7 +++++++ tests/codegen-deno/chain_import.harness.mjs | 7 +++++++ 4 files changed, 39 insertions(+), 2 deletions(-) create mode 100644 tests/codegen-deno/ChainLib.affine create mode 100644 tests/codegen-deno/chain_import.affine create mode 100644 tests/codegen-deno/chain_import.harness.mjs diff --git a/lib/module_loader.ml b/lib/module_loader.ml index d1f74d03..e6833358 100644 --- a/lib/module_loader.ml +++ b/lib/module_loader.ml @@ -277,7 +277,8 @@ let clear_cache (loader : t) : unit = this function retains the same last-import policy as a defensive fallback for callers that flatten an already-loaded program directly. Local decls in [prog.prog_decls] always win over imported ones. *) -let flatten_imports (loader : t) (prog : program) : program = +let rec flatten_imports_from (visiting : string list list) (loader : t) + (prog : program) : program = (* Local-decl names suppress same-named imports of any kind. *) let local_name_list = List.filter_map (function @@ -310,7 +311,16 @@ let flatten_imports (loader : t) (prog : program) : program = in match Hashtbl.find_opt loader.loaded mod_path with | None -> () - | Some lm -> + | Some lm0 -> + (* Flatten the imported module's own imports first, so the closure + below can reach what *it* uses from other modules: `Nav` importing + `Router.on_url_change`, whose body calls `Tea.subs`, emitted an + undefined `subs`. [visiting] stops an import cycle. *) + let lm = + if List.mem mod_path visiting then lm0 + else { lm0 with mod_program = + flatten_imports_from (mod_path :: visiting) loader lm0.mod_program } + in let public_decls = List.filter_map (fun decl -> match decl with | TopFn fd when fd.fd_vis = Public || fd.fd_vis = PubCrate -> @@ -498,3 +508,8 @@ let flatten_imports (loader : t) (prog : program) : program = Re-introducing type-carrying for *user-defined* cross-module enums would need per-backend constructor dedup first. *) { prog with prog_decls = imported_decls @ prog.prog_decls } + +(** Inline the declarations [prog]'s imports need (transitively) into [prog], + for the backends that compile one flattened program. *) +let flatten_imports (loader : t) (prog : program) : program = + flatten_imports_from [] loader prog diff --git a/tests/codegen-deno/ChainLib.affine b/tests/codegen-deno/ChainLib.affine new file mode 100644 index 00000000..b576e26a --- /dev/null +++ b/tests/codegen-deno/ChainLib.affine @@ -0,0 +1,8 @@ +// SPDX-License-Identifier: MPL-2.0 +// Middle module of the chain_import fixture: re-uses DirLib. +module ChainLib; + +use DirLib::{Dir, North, Step, name}; + +pub fn describe_north() -> String = "it is " ++ name(North); +pub fn describe_steps(n: Int) -> String = name(Step(n)); diff --git a/tests/codegen-deno/chain_import.affine b/tests/codegen-deno/chain_import.affine new file mode 100644 index 00000000..27c72868 --- /dev/null +++ b/tests/codegen-deno/chain_import.affine @@ -0,0 +1,7 @@ +// SPDX-License-Identifier: MPL-2.0 +// Transitive imports: this program imports only ChainLib, whose functions +// call DirLib's. Flattening used to stop at the first hop, so DirLib's +// `name` was undefined in the emitted module. +use ChainLib::{describe_north, describe_steps}; + +pub fn both() -> String = describe_north() ++ ";" ++ describe_steps(2); diff --git a/tests/codegen-deno/chain_import.harness.mjs b/tests/codegen-deno/chain_import.harness.mjs new file mode 100644 index 00000000..411e2cdc --- /dev/null +++ b/tests/codegen-deno/chain_import.harness.mjs @@ -0,0 +1,7 @@ +// SPDX-License-Identifier: MPL-2.0 +// Transitively imported functions are emitted. +import assert from "node:assert/strict"; +import { both } from "./chain_import.bun.js"; + +assert.equal(both(), "it is north;step 2"); +console.log("chain_import.harness.mjs OK"); From 7eddd39bae78e0f79c75be4292c03bff4adc0d93 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 20:15:44 +0100 Subject: [PATCH 10/13] fix(bun-esm): emit enum constructor bindings before top-level consts; stricter negative tests Review follow-up (CodeRabbit on #777): - Since qualified constructors lower to their binding (`Msg::Inc` -> `Inc`), a top-level const naming a variant of an enum declared later in the file read the binding in its temporal dead zone (ReferenceError). Enum bindings are now emitted before the source-order pass. Fixture const_before_enum fails with `Cannot access 'Fast' before initialization` without this. - test_records_and_imports: negative tests now require a *type* error (a parse/resolution failure no longer counts), the unknown-imported-field test checks the field is named, and the field-type-change test returns `String` from `r.a` so only validating the update can reject it. dune main 562 OK; Bun-ESM 39/39; WASM 38/38. Co-Authored-By: Claude Opus 5.5 --- lib/codegen_deno.ml | 8 ++++++ test/test_records_and_imports.ml | 27 +++++++++++++------ tests/codegen-deno/const_before_enum.affine | 13 +++++++++ .../const_before_enum.harness.mjs | 8 ++++++ 4 files changed, 48 insertions(+), 8 deletions(-) create mode 100644 tests/codegen-deno/const_before_enum.affine create mode 100644 tests/codegen-deno/const_before_enum.harness.mjs diff --git a/lib/codegen_deno.ml b/lib/codegen_deno.ml index 2a315bf8..426ed16f 100644 --- a/lib/codegen_deno.ml +++ b/lib/codegen_deno.ml @@ -2238,8 +2238,16 @@ let generate (host : host_profile) (program : program) (symbols : Symbol.t) : st Hashtbl.replace emitted_class s () end in + (* Enum constructor bindings first: a qualified constructor lowers to its + binding (`Msg::Inc` -> `Inc`), and the checker lets a top-level `const` + name a variant declared later in the file — emitting in source order + would read the binding in its temporal dead zone (ReferenceError). *) + List.iter (function + | TopType ({ td_body = TyEnum _; _ } as td) -> gen_type_decl ctx td + | _ -> ()) program.prog_decls; List.iter (fun top -> match top with + | TopType { td_body = TyEnum _; _ } -> () (* emitted above *) | TopFn fd when fd.fd_body <> FnExtern -> if not (Hashtbl.mem consumed fd.fd_name.name) then gen_function ctx fd diff --git a/test/test_records_and_imports.ml b/test/test_records_and_imports.ml index 7ffffd65..a78b6977 100644 --- a/test/test_records_and_imports.ml +++ b/test/test_records_and_imports.ml @@ -40,11 +40,20 @@ let passes ?dir src = | Ok () -> () | Error m -> Alcotest.failf "expected Ok, got: %s" m -(** Assert [src] is rejected. *) -let fails src = - match frontend src with +(** Assert [src] is rejected by the *type checker* (a parse or resolution + error would hide whether field typing ran), with a message containing + every string in [needles]. *) +let fails ?dir ?(needles = []) src = + match frontend ?dir src with | Ok () -> Alcotest.fail "expected a type error, got Ok" - | Error _ -> () + | Error m -> + let has n = + let nl = String.length n and ml = String.length m in + let rec go i = i + nl <= ml && (String.sub m i nl = n || go (i + 1)) in + go 0 + in + if not (has "Type error") then Alcotest.failf "expected a type error, got: %s" m; + List.iter (fun n -> if not (has n) then Alcotest.failf "expected %S in: %s" n m) needles let p = "struct P { a: Int, b: String }\n" @@ -52,7 +61,11 @@ let update_keeps_struct_type () = passes (p ^ "pub fn f(q: P) -> P = P #{ ..q, a let spread_only () = passes (p ^ "pub fn f(q: P) -> P = P #{ ..q };\n") let untouched_field_readable () = passes (p ^ "pub fn f(q: P) -> String { let r = P #{ ..q, a: 2 }; r.b }\n") -let update_cannot_change_field_type () = fails (p ^ "pub fn f(q: P) -> P = P #{ ..q, a: \"x\" };\n") +(* The result type is `String` (read from `r.a`), which the old + spread-ignoring typing would also accept: rejection here comes only from + validating the incompatible update itself. *) +let update_cannot_change_field_type () = + fails (p ^ "pub fn f(q: P) -> String { let r = P #{ ..q, a: \"x\" }; r.a }\n") let update_through_destructured_tuple () = passes (p ^ "fn mk(q: P) -> (P, Int) = (q, 1);\n\ pub fn f(q: P) -> P { let (r, n) = mk(q); P #{ ..r, a: n } }\n") @@ -79,9 +92,7 @@ let imported_struct_fields () = let imported_struct_unknown_field_rejected () = let dir = module_dir "Shapes2" "module Shapes2;\npub struct Point { x: Float, y: Float }\n" in - match frontend ~dir "use Shapes2::{Point};\npub fn f(p: Point) -> Float = p.z;\n" with - | Ok () -> Alcotest.fail "expected unknown field to be rejected" - | Error _ -> () + fails ~dir ~needles:[ "z" ] "use Shapes2::{Point};\npub fn f(p: Point) -> Float = p.z;\n" (* A function-local binding must not replace the module-level binding of the same name in what importers see. *) diff --git a/tests/codegen-deno/const_before_enum.affine b/tests/codegen-deno/const_before_enum.affine new file mode 100644 index 00000000..782a5fc7 --- /dev/null +++ b/tests/codegen-deno/const_before_enum.affine @@ -0,0 +1,13 @@ +// SPDX-License-Identifier: MPL-2.0 +// A top-level const naming a variant of an enum declared later in the file: +// the constructor binding must exist before the const is evaluated. + +pub const DEFAULT: Mode = Mode::Fast; +pub const START: Mode = Mode::Slow(3); + +pub enum Mode { Fast, Slow(Int) } + +pub fn describe(m: Mode) -> String = match m { + Mode::Fast => "fast", + Mode::Slow(n) => "slow " ++ int_to_string(n) +}; diff --git a/tests/codegen-deno/const_before_enum.harness.mjs b/tests/codegen-deno/const_before_enum.harness.mjs new file mode 100644 index 00000000..cf008969 --- /dev/null +++ b/tests/codegen-deno/const_before_enum.harness.mjs @@ -0,0 +1,8 @@ +// SPDX-License-Identifier: MPL-2.0 +// Enum bindings are emitted before top-level consts (no TDZ ReferenceError). +import assert from "node:assert/strict"; +import { DEFAULT, START, describe } from "./const_before_enum.bun.js"; + +assert.equal(describe(DEFAULT), "fast"); +assert.equal(describe(START), "slow 3"); +console.log("const_before_enum.harness.mjs OK"); From 267192811ceccf61b0be8ae638b89bba90060b64 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 20:35:14 +0100 Subject: [PATCH 11/13] fix(module_loader): memoise transitive flattening; assert field-not-found Review follow-up (CodeRabbit on #777): a module shared by several import paths (a diamond) was re-flattened once per path, which grows exponentially with depth; completed flattened programs are now cached for the duration of one flatten_imports call (the cycle guard is unchanged). The imported-struct negative test now asserts the specific "Field 'z' not found" diagnostic. dune main 562 OK; Bun-ESM 39/39; WASM 38/38. Co-Authored-By: Claude Opus 5.5 --- lib/module_loader.ml | 20 ++++++++++++++++---- test/test_records_and_imports.ml | 3 ++- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/lib/module_loader.ml b/lib/module_loader.ml index e6833358..4b43b91b 100644 --- a/lib/module_loader.ml +++ b/lib/module_loader.ml @@ -277,7 +277,9 @@ let clear_cache (loader : t) : unit = this function retains the same last-import policy as a defensive fallback for callers that flatten an already-loaded program directly. Local decls in [prog.prog_decls] always win over imported ones. *) -let rec flatten_imports_from (visiting : string list list) (loader : t) +let rec flatten_imports_from + (cache : (string list, program) Hashtbl.t) + (visiting : string list list) (loader : t) (prog : program) : program = (* Local-decl names suppress same-named imports of any kind. *) let local_name_list = @@ -318,8 +320,18 @@ let rec flatten_imports_from (visiting : string list list) (loader : t) undefined `subs`. [visiting] stops an import cycle. *) let lm = if List.mem mod_path visiting then lm0 - else { lm0 with mod_program = - flatten_imports_from (mod_path :: visiting) loader lm0.mod_program } + else + (* Memoised per flatten call: a module shared by several import + paths (a diamond) is flattened once, not once per path. *) + let flat = match Hashtbl.find_opt cache mod_path with + | Some p -> p + | None -> + let p = flatten_imports_from cache (mod_path :: visiting) loader + lm0.mod_program in + Hashtbl.replace cache mod_path p; + p + in + { lm0 with mod_program = flat } in let public_decls = List.filter_map (fun decl -> match decl with @@ -512,4 +524,4 @@ let rec flatten_imports_from (visiting : string list list) (loader : t) (** Inline the declarations [prog]'s imports need (transitively) into [prog], for the backends that compile one flattened program. *) let flatten_imports (loader : t) (prog : program) : program = - flatten_imports_from [] loader prog + flatten_imports_from (Hashtbl.create 8) [] loader prog diff --git a/test/test_records_and_imports.ml b/test/test_records_and_imports.ml index a78b6977..c7bb0f04 100644 --- a/test/test_records_and_imports.ml +++ b/test/test_records_and_imports.ml @@ -92,7 +92,8 @@ let imported_struct_fields () = let imported_struct_unknown_field_rejected () = let dir = module_dir "Shapes2" "module Shapes2;\npub struct Point { x: Float, y: Float }\n" in - fails ~dir ~needles:[ "z" ] "use Shapes2::{Point};\npub fn f(p: Point) -> Float = p.z;\n" + fails ~dir ~needles:[ "Field 'z' not found" ] + "use Shapes2::{Point};\npub fn f(p: Point) -> Float = p.z;\n" (* A function-local binding must not replace the module-level binding of the same name in what importers see. *) From c62b0d19b95c92dc47b778acf73a6588aa267297 Mon Sep 17 00:00:00 2001 From: "coderabbitai[bot]" <136622811+coderabbitai[bot]@users.noreply.github.com> Date: Mon, 5 Oct 2026 20:22:01 +0000 Subject: [PATCH 12/13] docs(compiler): expand docstrings for type checking, import resolution, and JavaScript code generation --- lib/ast.ml | 27 ++++++++++++----------- lib/codegen_deno.ml | 19 ++++++++++++++++ lib/module_loader.ml | 21 +++++++++++++++--- lib/resolve.ml | 15 +++++++++---- lib/typecheck.ml | 52 ++++++++++++++++++++++++++++++++++++++------ 5 files changed, 107 insertions(+), 27 deletions(-) diff --git a/lib/ast.ml b/lib/ast.ml index 45aa3365..d4a94508 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -541,19 +541,6 @@ let fn_body_contains_return : fn_body -> bool = function | FnExpr e -> expr_contains_return e | FnBlock b -> block_contains_return b -(** Free variables of an expression. - - Returns the names used in [expr] but not bound within it; [bound_vars] - lists the names already bound by the enclosing scope (parameters, let - bindings). - - Shared by every pass that needs to know what a body refers to: wasm - codegen, and [Module_loader]'s `use`-list flattening, which uses it to - pull in helpers a selective import never names (`use Dom::{div}` needs - `div`'s own helper `h`; omitting it emitted a module that called an - undefined `h`). Like the other walkers in this module it is deliberately - conservative: constructs it does not inspect contribute [] rather than a - wrong answer. *) (** Variables bound by a pattern. *) let rec pattern_binders (pat : pattern) : string list = match pat with @@ -570,6 +557,20 @@ let rec pattern_binders (pat : pattern) : string list = | PatOr (p1, p2) -> pattern_binders p1 @ pattern_binders p2 | PatAs (id, pat) -> id.name :: pattern_binders pat +(** Free variables of an expression. + + Returns the names used in [expr] but not bound within it; [bound_vars] + lists the names already bound by the enclosing scope (parameters, let + bindings). + + Shared by every pass that needs to know what a body refers to: wasm + codegen, and [Module_loader]'s `use`-list flattening, which uses it to + pull in helpers a selective import never names (`use Dom::{div}` needs + `div`'s own helper `h`; omitting it emitted a module that called an + undefined `h`). Like the other walkers in this module it is deliberately + partial: unhandled constructs, record spreads, shorthand record fields + and qualified constructors contribute no names. The result may contain + duplicates. *) let rec find_free_vars (bound_vars : string list) (expr : expr) : string list = match expr with | ExprLit _ -> [] diff --git a/lib/codegen_deno.ml b/lib/codegen_deno.ml index 426ed16f..cba9648c 100644 --- a/lib/codegen_deno.ml +++ b/lib/codegen_deno.ml @@ -103,6 +103,8 @@ type codegen_ctx = { in_async : bool; } +(** Create an empty emission context for [host], sharing [symbols] and + allocating fresh output and name tables. *) let create_ctx host symbols = { host; output = Buffer.create 1024; @@ -1420,6 +1422,12 @@ let enter_fn_scope ctx (params : param list) : codegen_ctx = call whose head is a known [extern fn] lowers via {!deno_builtins}. ============================================================================ *) +(** Render an expression as JavaScript using the names and host in [ctx]. + Lambdas are synchronous arrows; known qualified constructors refer to + their emitted bindings. Nested statements can update integer tracking. + + @raise Failure for unsupported handlers, resumptions or Bun host calls, + or when a builtin lowering receives too few arguments. *) let rec gen_expr ctx (expr : expr) : string = match expr with | ExprLit lit -> gen_literal lit @@ -1839,6 +1847,10 @@ and gen_try_stmt ctx body catch finally = in "try { " ^ b ^ " } " ^ c ^ f +(** Render a JavaScript statement and update [ctx]'s integer tracking for + subsequent statements. Loop bodies are processed before their tails so + integer division uses the bindings available at each point. + Exceptions from [gen_expr] propagate to the caller. *) and gen_stmt ctx (stmt : stmt) : string = match stmt with | StmtLet { sl_pat = PatWildcard _; sl_value; _ } -> @@ -2134,6 +2146,13 @@ let gen_type_decl ctx (td : type_decl) : unit = a bare struct/alias/extern type carries no runtime value. *) emit_line ctx (Printf.sprintf "// type %s" td.td_name.name) +(** Return a complete JavaScript ES module with the selected host runtime. + Imports must already be flattened. Enum bindings precede other + declarations, and synthesised classes supplement the free functions; + a receiver parameter alone does not make a free function asynchronous. + If a top-level function is named [main], the module awaits its invocation. + Emission exceptions, including [Failure] from [gen_expr], propagate; + [codegen_bun] and [codegen_deno] convert them to [Error] results. *) let generate (host : host_profile) (program : program) (symbols : Symbol.t) : string = let ctx = create_ctx host symbols in (* Register extern names so calls lower via the builtin table, and diff --git a/lib/module_loader.ml b/lib/module_loader.ml index 4b43b91b..938abcb1 100644 --- a/lib/module_loader.ml +++ b/lib/module_loader.ml @@ -107,7 +107,6 @@ let discover_stdlib () = if user_share <> "" && stdlib_dir_valid user_share then user_share else "./stdlib" (* preserves the historical default error path *) -(** Create default configuration *) (** Directories listed in [$AFFINESCRIPT_PATH] (colon-separated, empty entries ignored): where third-party packages such as affinescript-tea live. Searched after the current directory and the stdlib. *) @@ -116,6 +115,10 @@ let env_search_paths () : string list = | None -> [] | Some v -> List.filter (fun d -> d <> "") (String.split_on_char ':' v) +(** Create a configuration using the discovered stdlib, [$AFFINESCRIPT_PATH] + and the current working directory. + + @raise Sys_error if the current working directory cannot be obtained. *) let default_config () : config = { stdlib_path = discover_stdlib (); @@ -276,7 +279,17 @@ let clear_cache (loader : t) : unit = Glob/glob collisions are rejected by the resolver before code generation; this function retains the same last-import policy as a defensive fallback for callers that flatten an already-loaded program directly. Local decls - in [prog.prog_decls] always win over imported ones. *) + in [prog.prog_decls] always win over imported ones. + + Selective imports also carry referenced helpers, including private ones, + and their enum dependencies. Public enums named by type or constructor + are included; enums containing only [Some], [None], [Ok] and [Err] are + excluded from this direct selection because the runtime supplies them. + + [cache] memoises flattened dependencies for this traversal and is updated + in place. [visiting] lists module paths already being traversed; a cycle + uses the cached module's original declarations without further recursion. + Imported declarations are prepended; [prog.prog_imports] is retained. *) let rec flatten_imports_from (cache : (string list, program) Hashtbl.t) (visiting : string list list) (loader : t) @@ -522,6 +535,8 @@ let rec flatten_imports_from { prog with prog_decls = imported_decls @ prog.prog_decls } (** Inline the declarations [prog]'s imports need (transitively) into [prog], - for the backends that compile one flattened program. *) + for the backends that compile one flattened program. Uses only modules + already loaded in [loader]; missing modules are silently skipped. + See [flatten_imports_from] for selection and name precedence. *) let flatten_imports (loader : t) (prog : program) : program = flatten_imports_from (Hashtbl.create 8) [] loader prog diff --git a/lib/resolve.ml b/lib/resolve.ml index 9828ecc9..70ef2f9b 100644 --- a/lib/resolve.ml +++ b/lib/resolve.ml @@ -600,7 +600,9 @@ let lookup_source_scheme (** For an imported type symbol, carry its definition (recorded by the source module under [Typecheck.type_def_key]) so the importer can use the - type's structure — e.g. read an imported struct's fields. *) + type's structure — e.g. read an imported struct's fields. The destination + key uses [bound_name], which may be an alias, and replaces any existing + definition. Non-type symbols and missing definitions leave it unchanged. *) let import_type_def ~dest_name_types ~source_name_types (sym : Symbol.symbol) (bound_name : string) : unit = if sym.Symbol.sym_kind = Symbol.SKType then @@ -613,7 +615,9 @@ let import_type_def ~dest_name_types ~source_name_types [dest_name_types] is the destination type checker's name-keyed scheme map; populating it here is what makes imported functions visible to a freshly - created [Typecheck.check_program] (which keys lookups on name, not sym_id). *) + created [Typecheck.check_program] (which keys lookups on name, not sym_id). + Only [Public] and [PubCrate] symbols are imported, under their original + names; [_alias] is ignored. Available type definitions are copied too. *) let import_resolved_symbols (dest_symbols : Symbol.t) (dest_types : (Symbol.symbol_id, Types.scheme) Hashtbl.t) @@ -638,8 +642,11 @@ let import_resolved_symbols | _ -> () (* Private symbols not imported *) ) source_symbols.all_symbols -(** Import specific items from resolved symbols. See - [import_resolved_symbols] for the role of [dest_name_types]. *) +(** Import specific items from resolved symbols, honouring item aliases for + both value schemes and type definitions. See [import_resolved_symbols] + for the role of [dest_name_types]. Returns [VisibilityError] for an item + outside [Public] or [PubCrate], or [UndefinedVariable] for a missing name, + paired with the item's span. Imports made before an error remain installed. *) let import_specific_items (dest_symbols : Symbol.t) (dest_types : (Symbol.symbol_id, Types.scheme) Hashtbl.t) diff --git a/lib/typecheck.ml b/lib/typecheck.ml index 4c1a80f4..98aaaff1 100644 --- a/lib/typecheck.ml +++ b/lib/typecheck.ml @@ -295,6 +295,9 @@ let unify_eff_or_err (e1 : eff) (e2 : eff) : unit result = (** {1 Context management} *) +(** Create an empty typing context sharing [symbols], with fresh inference + state and registries. Builtins are installed separately by + [register_builtins]. *) let create_context (symbols : Symbol.t) : context = { var_types = Hashtbl.create 128; @@ -448,6 +451,10 @@ let lookup_var (ctx : context) (name : string) : ty result = (** {1 Kind checking} *) +(** Infer a kind using builtin kinds and user arities recorded in [ctx]. + Unregistered type names and unbound variables default to [KType]. + Applications return the remaining kind after consuming their arguments; + argument kind mismatches and over-application return [NotImplemented]. *) let rec infer_kind (ctx : context) (ty : ty) : kind result = match repr ty with | TVar r -> @@ -886,7 +893,13 @@ let record_cell_layout (row : row) : (string * (int * bool)) list option = (** {1 Expression synthesis (mode ⇒)} *) -(** Synthesize a type for an expression. *) +(** Synthesise an expression's type, updating inference state and recording + sites for later elaboration. Zero-parameter lambdas have type [Unit -> T]. + Record updates unify replaced fields with their existing types and add + new fields to closed rows; an open base is constrained to contain the + updated fields and retains its type. Typing and unification errors are + returned; annotation lowering can propagate [Module_resolution_error] + or [Effect_validation_error]. *) let rec synth (ctx : context) (expr : expr) : ty result = match expr with (* Literals *) @@ -1640,7 +1653,11 @@ and check_stmt (ctx : context) (stmt : stmt) : unit result = (** {1 Checking mode (mode ⇐)} *) -(** Check that an expression has the expected type. *) +(** Check that an expression has the expected type, constraining inference + variables in place. A zero-parameter lambda checked against an arrow + requires a [Unit] argument and checks its body against the return type. + Returns typing or unification errors and propagates annotation-lowering + exceptions as in [synth]. *) and check (ctx : context) (expr : expr) (expected : ty) : unit result = match expr with (* Lambda against arrow type: check mode is more precise. @@ -2109,7 +2126,13 @@ let register_builtins (ctx : context) : unit = TApp (TCon "Cmd", [cmd_tv2]), EPure)) -(** Check a top-level function declaration. *) +(** Check a top-level function's signature and body, then bind its generalised + scheme in [ctx]. Externs register their signature without a body check. + On success, parameter and body-local names do not escape into the module. + Kind, body and unification errors are returned; inferred effects outside + an explicit effect row return [EffectNotDeclared]. Annotation lowering + can raise [Module_resolution_error] or [Effect_validation_error]. + An error may leave partially updated context state. *) let check_fn_decl (ctx : context) (fd : fn_decl) : unit result = (* #135 slice 7: register the explicit `` type parameters as fresh, generalizable unification variables before lowering param/return @@ -2245,14 +2268,14 @@ let check_fn_decl (ctx : context) (fd : fn_decl) : unit result = restore_tp (); Ok () -(** Register a type declaration in the context. *) (** Reserved [name_types] key under which a module records the definition of its type [name], so importers can name the type with its structure (an imported struct's fields; imports otherwise carry only value schemes). The NUL byte keeps it disjoint from every identifier. *) let type_def_key (name : string) : string = "\000type:" ^ name -(** Inverse of [type_def_key]: the type name, if [key] is one. *) +(** Extract the non-empty type name from a [type_def_key] key, or [None] + if the prefix is absent or the name is empty. *) let type_of_def_key (key : string) : string option = let pfx = "\000type:" in let n = String.length pfx in @@ -2260,6 +2283,11 @@ let type_of_def_key (key : string) : string option = then Some (String.sub key n (String.length key - n)) else None +(** Register a type definition and any enum constructor schemes in [ctx]. + Parametric enums and extern types record their arities; declarations + without type parameters also export a definition under [type_def_key]. + Returns kind-checking errors. Annotation lowering can propagate + [Module_resolution_error] or [Effect_validation_error]. *) let register_type_decl (ctx : context) (td : type_decl) : unit result = let* ty = match td.td_body with | TyAlias te -> @@ -2533,11 +2561,13 @@ let populate_call_effects (ctx : context) (prog : Ast.program) : unit = ctx.call_effects; Effect_sites.set_async_by_ord async_tbl -(** Learn the arity of every parametric type constructor applied in [ty] +(** Record previously unknown arities of type constructors applied in [ty] (e.g. `Html` in an imported `text : String -> Html`). Imported schemes are the only cross-module type information [check_program] receives, so this is how an imported `enum Html` gets kind - `Type -> Type` in the importer. Builtins keep their fixed kinds. *) + `Type -> Type` in the importer. Builtins keep their fixed kinds, and + existing entries in [ctx.type_arity] are preserved. Row variables are + not followed, including linked row variables. *) let rec record_type_arities (ctx : context) (ty : ty) : unit = let go = record_type_arities ctx in let rec go_row = function @@ -2560,6 +2590,14 @@ let rec record_type_arities (ctx : context) (ty : ty) : unit = | TRef t | TMut t | TOwn t -> go t | TVar _ | TCon _ -> () +(** Check declarations, trait coherence and quantities in a fresh context. + [import_types] supplies value schemes and definitions keyed by + [type_def_key]; local declarations can replace imported bindings. + Generic extern signatures are generalised before bodies are checked. + On success, returns the context and publishes call-effect information + through [Effect_sites]. Typing also records sites for later elaboration. + Returns the first error encountered, converting [Effect_validation_error] + and [Module_resolution_error] to [UnknownEffect] and [UnknownModule]. *) let check_program ?(import_types : (string, scheme) Hashtbl.t option) (symbols : Symbol.t) (prog : Ast.program) : (context, type_error) Result.t = From e3eaef18b3ee757634f24951afa6ae9cb6dbec96 Mon Sep 17 00:00:00 2001 From: "Jonathan D.A. Jewell" <6759885+hyperpolymath@users.noreply.github.com> Date: Mon, 5 Oct 2026 21:41:46 +0100 Subject: [PATCH 13/13] Update lib/module_loader.ml Co-authored-by: coderabbitai[bot] <136622811+coderabbitai[bot]@users.noreply.github.com> Signed-off-by: Jonathan D.A. Jewell <6759885+hyperpolymath@users.noreply.github.com> --- lib/module_loader.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/module_loader.ml b/lib/module_loader.ml index 938abcb1..d70ed911 100644 --- a/lib/module_loader.ml +++ b/lib/module_loader.ml @@ -281,8 +281,11 @@ let clear_cache (loader : t) : unit = for callers that flatten an already-loaded program directly. Local decls in [prog.prog_decls] always win over imported ones. - Selective imports also carry referenced helpers, including private ones, - and their enum dependencies. Public enums named by type or constructor + Selective imports carry referenced helpers, including private ones, when + [find_free_vars] detects them. That walker is partial: dependencies + referenced only in record spreads, shorthand record fields or qualified + constructors may be omitted. Public enums named directly by type or + constructor in a selective import are included; enums containing only [Some], [None], [Ok] and [Err] are excluded from this direct selection because the runtime supplies them.