From b3101b65425818a1ebb2bf136ba90830915bbd68 Mon Sep 17 00:00:00 2001 From: Claude Date: Mon, 9 Nov 2026 14:49:29 +0000 Subject: [PATCH] fix: multi-module programs check, evaluate and compile (found running kyq) Checking and running metadatastician/kyq, the estate's KYAML processor, turned up six faults, each now pinned by a test in test/test_module_root_flatten.ml that fails without its fix: - Module root: a file declaring `module A.B;` in .../A/ resolved imports from .../A/, so `use A.C;` looked for .../A/A/C.affine. The CLI now roots the search above the declared path's directories when they match (Module_loader.module_root_dir); otherwise the file's own directory, as before (#642). - A file found for `A.B` that declares `module A;` was accepted as `A.B`, so `use A.Nonexistent::*` type-checked. It is now a ModuleDeclMismatch load error. - A missing transitive dependency was reported as the importer's own import being undefined; the missing module is now named. - `eval` interpreted the unflattened program, so no imported function was bound. It now flattens like `compile`. Flattening also emitted a selected function before the private helpers it calls and carried no helpers for glob or plain imports; every import kind now carries them, in the imported module's declaration order. - The interpreter had no `++` on arrays and no `==`/`!=` beyond Int, Float, String and Bool, all of which the checker accepts. - Bun-ESM compiled a `return` in a match arm of a `let` initializer as a return from the match's IIFE (H2). `let` initializers and function and lambda tails are now lowered to statements; a match used as an argument or operand with a `return` in an arm is refused at compile time. `expr_contains_return` now sees match arms. H7 (interpreter `let mut`) and H1 (interpreter early return) are not addressed. docs/COMPLETION-PLAN.adoc: H2 narrowed, H20-H22 recorded. dune test: 573 OK; the 33 walker-* failures need the tree-sitter CLI and fail identically on 9167b04. With this change all 11 kyq source, test and bench files type-check, and kyq's 20 tests pass under Bun-ESM. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01P4yFkxW5Heb8p2YW7ZYs9F --- bin/main.ml | 40 +++-- docs/COMPLETION-PLAN.adoc | 7 +- lib/ast.ml | 9 ++ lib/codegen_deno.ml | 109 ++++++++++++- lib/interp.ml | 11 ++ lib/module_loader.ml | 234 ++++++++++++++++++---------- lib/resolve.ml | 6 +- test/test_main.ml | 1 + test/test_module_root_flatten.ml | 257 +++++++++++++++++++++++++++++++ 9 files changed, 564 insertions(+), 110 deletions(-) create mode 100644 test/test_module_root_flatten.ml diff --git a/bin/main.ml b/bin/main.ml index ffdacd2a..0ee9586d 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -177,13 +177,21 @@ let parse_file (face : Affinescript.Face.face) path = CLI used the process CWD as [current_dir], so compiling `src/Main.affine` could not find a sibling `src/Helper.affine` even though the module loader already supported relative sibling paths (#642). *) -let loader_config_for_file path = +let loader_config_for_file ?prog path = let absolute_path = if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path else path in let config = Affinescript.Module_loader.default_config () in - { config with current_dir = Filename.dirname absolute_path } + let mod_path = + Option.bind prog (fun (p : Affinescript.Ast.program) -> + Option.map (List.map (fun (id : Affinescript.Ast.ident) -> id.name)) + p.prog_module) + in + { config with + current_dir = + Affinescript.Module_loader.module_root_dir + ~file_dir:(Filename.dirname absolute_path) mod_path } (** Type-check a file. With [--json], emits a structured diagnostic report on stderr. *) @@ -196,7 +204,7 @@ let check_file face json path = let resolve_refs = ref [] in begin try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in (match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, span) -> @@ -244,7 +252,7 @@ let check_file face json path = end else begin try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in (match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, _span) -> @@ -294,7 +302,7 @@ let eval_file face json path = let add d = diags := d :: !diags in begin try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in (match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, span) -> @@ -316,7 +324,8 @@ let eval_file face json path = | Error (err, span) -> add (Affinescript.Json_output.of_quantity_error (err, span)) | Ok () -> - (match Affinescript.Interp.eval_program prog with + (match Affinescript.Interp.eval_program + (Affinescript.Module_loader.flatten_imports loader prog) with | Ok env -> (* Auto-call main() if defined — entry point for TEA apps and scripts *) (match Affinescript.Value.lookup_env "main" env with @@ -337,7 +346,7 @@ let eval_file face json path = end else begin try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in (match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, _span) -> @@ -365,7 +374,8 @@ let eval_file face json path = (Affinescript.Face.format_quantity_error face err); `Error (false, "Quantity error") | Ok () -> - (match Affinescript.Interp.eval_program prog with + (match Affinescript.Interp.eval_program + (Affinescript.Module_loader.flatten_imports loader prog) with | Ok env -> (* Auto-call main() if defined — entry point for TEA apps and scripts *) (match Affinescript.Value.lookup_env "main" env with @@ -519,7 +529,7 @@ let compile_file face json wasm_gc vscode_ext vscode_adapter vscode_no_lc let add d = diags := d :: !diags in begin try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in (match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, span) -> @@ -744,7 +754,7 @@ let compile_file face json wasm_gc vscode_ext vscode_adapter vscode_no_lc end else begin try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in (match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, _span) -> @@ -1037,7 +1047,7 @@ let lint_file face json path = let add d = diags := d :: !diags in begin try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in (match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, span) -> @@ -1057,7 +1067,7 @@ let lint_file face json path = end else begin try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in (match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, _span) -> @@ -1096,7 +1106,7 @@ let compile_to_wasm_module face path : (Affinescript.Wasm.wasm_module, string) Result.t = try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, _span) -> @@ -1160,7 +1170,7 @@ let verify_file face path = let face = resolve_face face path in try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in (match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, _span) -> @@ -1688,7 +1698,7 @@ let preview_cafe_cmd = let run_pipeline_for_query face path = try let prog = parse_with_face face path in - let loader_config = loader_config_for_file path in + let loader_config = loader_config_for_file ~prog path in let loader = Affinescript.Module_loader.create loader_config in match Affinescript.Resolve.resolve_program_with_loader prog loader with | Error (e, _span) -> diff --git a/docs/COMPLETION-PLAN.adoc b/docs/COMPLETION-PLAN.adoc index 66341247..bca696a0 100644 --- a/docs/COMPLETION-PLAN.adoc +++ b/docs/COMPLETION-PLAN.adoc @@ -85,7 +85,7 @@ Results were consistent, but they do not prove CI is green. | Memory reclamation. try/catch. | Bun-ESM (`lib/codegen_deno.ml`) -| Basic programs are correct. A `return` inside a match arm returns 100 instead of 99 (IIFE at `:1575`). aLib conformance is 100 of 103 vectors. +| Basic programs are correct. A `return` inside a match arm is correct in a `let` initializer, a function or lambda tail, and nested statement position; as an argument or operand it is refused at compile time rather than miscompiled (H2, 2026-11-09). aLib conformance is 100 of 103 vectors. | — | — @@ -200,7 +200,7 @@ Results were consistent, but they do not prove CI is green. All were observed by RUN unless marked otherwise. The maps confirm that H1–H4 and H9 are absent from `docs/SOUNDNESS.adoc`. H5–H8, H10, H12 and H13 were not checked against the ledger. H11 already has a drafted issue (`issues-drafts/06`, referenced from the AFFIRMATION). H14, H15 and H19 belong to typed-wasm, not the AffineScript ledger. . H1. Interpreter early `return` has no non-local exit (`lib/interp.ml:262`). -. H2. Bun-ESM `return` in expression position is lowered as an IIFE (`lib/codegen_deno.ml:1575`). +. H2. Bun-ESM `return` in expression position is lowered as an IIFE (`lib/codegen_deno.ml:1575`). *Narrowed 2026-11-09:* `let` initializers and function and lambda tails are now lowered to statements, so the `return` leaves the function; a match used as an argument or operand with a `return` in an arm is refused loudly. Anchor: `test/test_module_root_flatten.ml`. . H3. The JS-text backend drops block returns (`lib/js_codegen.ml`). The Lua backend emits invalid code. . H4. Non-exhaustive match compiles to "return 0" on core WASM. . H5. Effect rows are not checked against performed operations or callee rows. @@ -218,6 +218,9 @@ All were observed by RUN unless marked otherwise. The maps confirm that H1–H4 . H17. The lexer accepts the bad escape `\q`, and an empty `match` parses (conformance invalid cases 010 and 011). . H18. The interpreter fails when dereferencing refs returned through calls ("Expected reference type"). The session lead reproduced this on two #554 fixtures. . H19 (typed-wasm). No L5 index guard: `get_player_hp(0,150)` reads an adjacent region. `where` constraints are discarded. Malformed `session` blocks are silently ignored. +. H20 (found and fixed 2026-11-09, checking and running metadatastician/kyq). A module file found for `A.B` that declares `module A;` was accepted as `A.B`, so `use A.Nonexistent::*` type-checked and imported `A`'s exports; it is now a `ModuleDeclMismatch` load error. Anchor: `test/test_module_root_flatten.ml`. +. H21 (found and fixed 2026-11-09). `eval` ran the unflattened program, so no imported function was bound at run time; flattening also emitted a selected function before the private helpers it calls and carried no helpers for glob or plain imports. `eval` now flattens, every import kind carries its helpers, and they are emitted in the imported module's declaration order. Anchor: `test/test_module_root_flatten.ml`. +. H22 (found and fixed 2026-11-09). The interpreter had no `++` on arrays and no `==`/`!=` beyond Int, Float, String and Bool, though the checker accepts them; it now uses the structural `Value.value_eq`. H7 (`let mut`) is unchanged. Anchor: `test/test_module_root_flatten.ml`. == 2. Target architecture diff --git a/lib/ast.ml b/lib/ast.ml index d4a94508..2e2b7822 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -523,6 +523,15 @@ let rec expr_contains_return (e : expr) : bool = | ExprUnary (_, x) -> expr_contains_return x | ExprApp (f, args) -> expr_contains_return f || List.exists expr_contains_return args + (* A `return` in a match arm (`Err(e) => return Err(e)`) is the common + early-exit shape; without this arm it was invisible, and the Bun-ESM + backend compiled it into a `return` from the match's IIFE instead of + from the function. *) + | ExprMatch { em_scrutinee; em_arms } -> + expr_contains_return em_scrutinee + || List.exists (fun arm -> + (match arm.ma_guard with Some g -> expr_contains_return g | None -> false) + || expr_contains_return arm.ma_body) em_arms | _ -> false and block_contains_return (blk : block) : bool = diff --git a/lib/codegen_deno.ml b/lib/codegen_deno.ml index 991e74cb..380159ee 100644 --- a/lib/codegen_deno.ml +++ b/lib/codegen_deno.ml @@ -1434,6 +1434,15 @@ let enter_fn_scope ctx (params : param list) : codegen_ctx = call whose head is a known [extern fn] lowers via {!deno_builtins}. ============================================================================ *) +(* Fresh temporaries for `let` initializers lowered to statements. *) +let let_tmp_counter = ref 0 + +(* Initializer shapes {!gen_assign_tail} can lower to statements. *) +let rec lowers_to_statements = function + | ExprSpan (e, _) -> lowers_to_statements e + | ExprMatch _ | ExprIf _ | ExprBlock _ -> true + | _ -> false + (** 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. @@ -1587,8 +1596,15 @@ let rec gen_expr ctx (expr : expr) : string = 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 ^ ")" + let lctx = { ctx with in_async = false } in + if lowers_to_statements elam_body && expr_contains_return elam_body then + (* A `return` in the body returns from the lambda: emit a block + body so it is not swallowed by an IIFE (see {!gen_match}). *) + "((" ^ String.concat ", " ps ^ ") => { " + ^ gen_return_tail lctx elam_body ^ " })" + else + "((" ^ String.concat ", " ps ^ ") => " + ^ gen_expr lctx elam_body ^ ")" | ExprTry { et_body; et_catch; et_finally } -> gen_try ctx et_body et_catch et_finally | ExprVariant (ty, ctor) -> @@ -1651,6 +1667,21 @@ and gen_pattern ctx (pat : pattern) : string = | PatOr (p, _) -> gen_pattern ctx p and gen_match ctx scrutinee arms = + (* As an expression the match is an IIFE, so a `return` in an arm would + leave the IIFE, not the enclosing function, and the function would + carry on with the returned value as the match's result: silently wrong + output. `let` initializers and tail/statement position are lowered to + statements and handled correctly; any other position (an argument, an + operand) is refused here rather than miscompiled. *) + if List.exists (fun arm -> + expr_contains_return arm.ma_body + || (match arm.ma_guard with + | Some g -> expr_contains_return g | None -> false)) arms + then + failwith + "a `return` inside a match arm is not supported when the match is \ + used as a sub-expression (an argument or operand); bind the match \ + to a `let` first"; let scrutinee_str = gen_expr ctx scrutinee in let scrut_var = "__scrut" in let rec gen_arms = function @@ -1844,6 +1875,58 @@ and gen_match_stmt ctx scrut arms = in "{ const " ^ sv ^ " = " ^ gen_expr ctx scrut ^ "; " ^ arms_js arms ^ " }" +(* Statements that evaluate [e] and hand its value to [sink], which turns a + JS expression into a statement (`x = v;` or `return v;`). A `return` + anywhere along a tail path stays a real function return, which the IIFE + expression form cannot express. Used for `let` initializers and for + function and lambda bodies that contain an early return. *) +and gen_tail_to ctx (sink : string -> string) e = + match e with + | ExprSpan (inner, _) -> gen_tail_to ctx sink inner + | ExprReturn _ -> gen_stmt_expr ctx e + | ExprBlock blk -> + let b = Buffer.create 64 in + List.iter (fun s -> + Buffer.add_string b (gen_stmt ctx s); + Buffer.add_char b ' ') blk.blk_stmts; + (match blk.blk_expr with + | Some tail -> Buffer.add_string b (gen_tail_to ctx sink tail) + | None -> Buffer.add_string b (sink "Unit")); + "{ " ^ Buffer.contents b ^ " }" + | ExprIf { ei_cond; ei_then; ei_else } -> + let elseb = match ei_else with + | Some el -> gen_tail_to ctx sink el + | None -> sink "Unit" + in + "if (" ^ gen_expr ctx ei_cond ^ ") { " ^ gen_tail_to ctx sink ei_then + ^ " } else { " ^ elseb ^ " }" + | ExprMatch { em_scrutinee; em_arms } -> + incr let_tmp_counter; + let sv = Printf.sprintf "__scrut_%d" !let_tmp_counter in + let rec arms_js = function + | [] -> "throw new Error(\"non-exhaustive match\");" + | arm :: rest -> + let cond = gen_pattern_test sv arm.ma_pat in + let binds = gen_pattern_bindings sv arm.ma_pat in + let guard = match arm.ma_guard with + | Some g -> " && (" ^ gen_expr ctx g ^ ")" | None -> "" in + "if (" ^ cond ^ guard ^ ") { " ^ binds + ^ gen_tail_to ctx sink arm.ma_body ^ " } else " ^ arms_js rest + in + "{ const " ^ sv ^ " = " ^ gen_expr ctx em_scrutinee ^ "; " + ^ arms_js em_arms ^ " }" + | other -> sink (gen_expr ctx other) + +and gen_assign_tail ctx target e = + gen_tail_to ctx (fun v -> target ^ " = " ^ v ^ ";") e + +(* A function or lambda body's tail: statements when it holds an early + return, else the plain `return ;`. *) +and gen_return_tail ctx e = + if lowers_to_statements e && expr_contains_return e then + gen_tail_to ctx (fun v -> "return " ^ v ^ ";") e + else "return " ^ gen_expr ctx e ^ ";" + and gen_try_stmt ctx body catch finally = let b = gen_stmt_seq ctx body in let c = match catch with @@ -1874,8 +1957,22 @@ and gen_stmt ctx (stmt : stmt) : string = gen_expr ctx sl_value ^ ";" | StmtLet { sl_pat; sl_value; sl_mut; sl_quantity = _; sl_ty = _ } -> let kw = if sl_mut then "let" else "const" in - let js = kw ^ " " ^ gen_pattern ctx sl_pat ^ " = " - ^ gen_expr ctx sl_value ^ ";" in + let js = + if lowers_to_statements sl_value && expr_contains_return sl_value then begin + (* `let x = match e { A(v) => v, B(err) => return f(err) };` + As an expression the match is an IIFE, and the arm's `return` + left the IIFE, not the function: the IIFE's result was then + bound to `x` and the function carried on. Lower the + initializer to statements that assign a temporary, so the + `return` is a real function return. *) + incr let_tmp_counter; + let tmp = Printf.sprintf "__let_tmp_%d" !let_tmp_counter in + "let " ^ tmp ^ "; " ^ gen_assign_tail ctx tmp sl_value ^ " " + ^ kw ^ " " ^ gen_pattern ctx sl_pat ^ " = " ^ tmp ^ ";" + end else + kw ^ " " ^ gen_pattern ctx sl_pat ^ " = " + ^ gen_expr ctx sl_value ^ ";" + in (* Track an [Int]-bound name for the rest of this body (#478). A block statement's scope is the enclosing function, which {!enter_fn_scope} already bounds, so no restore is needed here. *) @@ -1961,11 +2058,11 @@ let visibility_is_public = function let gen_body ctx (fb : fn_body) : unit = match fb with | FnExpr e -> - emit_line ctx ("return " ^ gen_expr ctx e ^ ";") + emit_line ctx (gen_return_tail ctx e) | FnBlock block -> List.iter (fun s -> emit_line ctx (gen_stmt ctx s)) block.blk_stmts; (match block.blk_expr with - | Some e -> emit_line ctx ("return " ^ gen_expr ctx e ^ ";") + | Some e -> emit_line ctx (gen_return_tail ctx e) | None -> ()) | FnExtern -> () diff --git a/lib/interp.ml b/lib/interp.ml index bc6b8c6d..2b0edc96 100644 --- a/lib/interp.ml +++ b/lib/interp.ml @@ -555,6 +555,17 @@ and eval_binop (op : binary_op) (left : value) (right : value) : value result = | (VFloat a, VFloat b) -> binop_float op a b | (VString a, VString b) -> binop_string op a b | (VBool a, VBool b) -> binop_bool op a b + (* The checker accepts `++` on arrays, `==`/`!=` at every type and the + relational operators on Char; without these arms such well-typed + programs stopped with "Type mismatch in binary operation" at run + time (kyq's line splitter, `out ++ [cur]` and `ch == '\n'`). *) + | (VArray a, VArray b) when op = OpConcat -> Ok (VArray (Array.append a b)) + | (VChar a, VChar b) when op = OpLt -> Ok (VBool (a < b)) + | (VChar a, VChar b) when op = OpLe -> Ok (VBool (a <= b)) + | (VChar a, VChar b) when op = OpGt -> Ok (VBool (a > b)) + | (VChar a, VChar b) when op = OpGe -> Ok (VBool (a >= b)) + | _ when op = OpEq -> Ok (VBool (Value.value_eq left right)) + | _ when op = OpNe -> Ok (VBool (not (Value.value_eq left right))) | _ -> Error (TypeMismatch "Type mismatch in binary operation") (** Apply function to arguments *) diff --git a/lib/module_loader.ml b/lib/module_loader.ml index d70ed911..6a46364b 100644 --- a/lib/module_loader.ml +++ b/lib/module_loader.ml @@ -14,6 +14,11 @@ type load_error = | ModuleParseError of string * string (** File path and parse error *) | ModuleCycle of string list (** Circular dependency detected *) | InvalidModulePath of string list + | ModuleDeclMismatch of string list * string list * string + (** Requested path, the path the file declares, and the file. A file + found for [A.B] that declares [module A;] is not module [A.B]: + the language has no nested module declarations, so accepting it + would bind [A]'s exports under a name that does not exist. *) [@@deriving show] (** Helper for Result bind *) @@ -126,6 +131,32 @@ let default_config () : config = current_dir = Sys.getcwd (); } +(** The directory module paths are resolved from, for a root file in + [file_dir] that declares [mod_path]. + + A file that declares [module A.B.C;] and sits in [.../A/B/] belongs to + the package rooted two directories up, so [use A.D;] must find + [.../A/D.affine], not [.../A/B/A/D.affine]. When the declared path's + leading segments match the file's trailing directories the root is the + directory above them; otherwise (no declaration, a one-segment name, or + a layout that does not match) it is [file_dir], which keeps sibling + imports working (#642). *) +let module_root_dir ~(file_dir : string) (mod_path : string list option) + : string = + match mod_path with + | None | Some [] | Some [_] -> file_dir + | Some segs -> + let parents = List.rev (List.tl (List.rev segs)) in + let rec strip dir = function + | [] -> Some dir + | seg :: rest -> + if Filename.basename dir = seg then strip (Filename.dirname dir) rest + else None + in + match strip file_dir (List.rev parents) with + | Some root -> root + | None -> file_dir + (** Convert module path to file path candidates For module path ["Math", "Geometry"], try: @@ -199,6 +230,14 @@ let rec load_module (loader : t) (mod_path : string list) : (loaded_module, load match parse_module_file file_path with | Error e -> Error e | Ok prog -> + let declared = + Option.map (List.map (fun (id : ident) -> id.name)) prog.prog_module + in + match declared with + | Some d when d <> mod_path -> + Hashtbl.remove loader.loading mod_path; + Error (ModuleDeclMismatch (mod_path, d, file_path)) + | _ -> (* Load dependencies first (imports) *) let* () = load_dependencies loader prog.prog_imports in @@ -358,15 +397,123 @@ let rec flatten_imports_from Some (tc_name.name, `Const decl) | _ -> None ) lm.mod_program.prog_decls in + (* Transitive closure. A selected declaration's body may call + helpers of the same module that the import list never names: + `use Dom::{div}` pulls in `div`, whose body calls `h`. Leaving + `h` out of the flattened program produced + `ReferenceError: h is not defined` in the emitted module + (tests/codegen-deno/dom_startup_error). Private helpers are + pulled in too — a public wrapper may delegate to one. *) + let module_value_decls = + List.filter_map (fun decl -> + match decl with + | TopFn fd when fd.fd_body <> FnExtern -> + Some (fd.fd_name.name, `Fn fd) + | TopConst { tc_name; _ } as d -> + Some (tc_name.name, `Const d) + | _ -> None + ) lm.mod_program.prog_decls + in + (* Constructors of this module's own enums, keyed by constructor + name. An inlined wrapper body can name a constructor + (`text` returns `VText(content)`) and the constructor exists + only where the enum is declared. Option/Result constructors + are excluded: every non-wasm preamble already defines + Some/None/Ok/Err, and re-emitting them is the duplicate-`const` + crash that reverted type-carrying in #138 — this narrows the + carry to user enums a backend preamble cannot supply. *) + let preamble_ctors = [ "Some"; "None"; "Ok"; "Err" ] in + let ctor_decls = Hashtbl.create 16 in + List.iter (fun decl -> + match decl with + | TopType td -> + (match td.td_body with + | TyEnum variants -> + List.iter (fun (vd : variant_decl) -> + if not (List.mem vd.vd_name.name preamble_ctors) then + Hashtbl.replace ctor_decls vd.vd_name.name + (td.td_name.name, decl) + ) variants + | _ -> ()) + | _ -> ()) lm.mod_program.prog_decls; + let by_name = Hashtbl.create 16 in + List.iter (fun (n, d) -> Hashtbl.replace by_name n d) module_value_decls; + (* Close a selection over the helpers its bodies reference, then emit + it in this module's own declaration order. Declarations must + precede their uses (the checker rejects a forward reference, and + the interpreter binds each function in an environment that holds + only what came before it), so the order a selection was gathered + in is not an order a consumer can use: `api` selected first and + its helper `h` carried second left `h` unbound under `eval`. + Every import kind needs the closure: a glob or a plain `use` + carries the module's public declarations, whose bodies call + private helpers just as a selected item's do. *) + let close_over direct = + let seen = Hashtbl.create 16 in + List.iter (fun (n, _) -> Hashtbl.replace seen n ()) direct; + let rec close pending acc = + match pending with + | [] -> List.rev acc + | (_, dk) :: rest -> + let free = match dk with + | `Fn fd -> + let params = + List.map (fun (p : param) -> p.p_name.name) fd.fd_params + in + (match fd.fd_body with + | FnExtern -> [] + | FnExpr e -> find_free_vars params e + | FnBlock b -> find_free_vars params (ExprBlock b)) + | `Const (TopConst { tc_value; _ }) -> find_free_vars [] tc_value + | `Const _ | `Type _ -> [] + in + let (pending, acc) = + List.fold_left (fun (pending, acc) name -> + if Hashtbl.mem seen name then (pending, acc) + else begin + Hashtbl.replace seen name (); + match Hashtbl.find_opt by_name name with + | Some dep -> ((name, dep) :: pending, (name, dep) :: acc) + | None -> + (* A constructor name: carry the enum it belongs to, + once per type. *) + (match Hashtbl.find_opt ctor_decls name with + | Some (td_name, decl) when not (Hashtbl.mem seen td_name) -> + Hashtbl.replace seen td_name (); + ((td_name, `Type decl) :: pending, + (td_name, `Type decl) :: acc) + | _ -> (pending, acc)) + end + ) (rest, acc) free + in + close pending acc + in + let extras = close direct [] in + let position = Hashtbl.create 32 in + List.iteri (fun i decl -> + let name = match decl with + | TopFn fd -> Some fd.fd_name.name + | TopConst { tc_name; _ } -> Some tc_name.name + | TopType td -> Some td.td_name.name + | _ -> None + in + Option.iter (fun n -> + if not (Hashtbl.mem position n) then Hashtbl.replace position n i) + name) lm.mod_program.prog_decls; + let pos (n, _) = + Option.value (Hashtbl.find_opt position n) ~default:max_int + in + List.stable_sort (fun a b -> compare (pos a) (pos b)) (direct @ extras) + in let select = match imp with - | ImportGlob _ -> public_decls + | ImportGlob _ -> close_over public_decls | ImportSimple _ -> (* `use Foo` brings the namespace into scope but doesn't import specific symbols. For codegens that need them inlined we still include all public top-level bindings — same as glob. The resolver determines what's referenceable; codegen just needs the bodies present. *) - public_decls + close_over public_decls | ImportList (_, items) -> (* The name a directly-named item is imported under (alias honoured). *) @@ -400,90 +547,9 @@ let rec flatten_imports_from |> Option.map (fun (_, found) -> (target, found)) ) items in - (* Transitive closure. A selected declaration's body may call - helpers of the same module that the import list never names: - `use Dom::{div}` pulls in `div`, whose body calls `h`. Leaving - `h` out of the flattened program produced - `ReferenceError: h is not defined` in the emitted module - (tests/codegen-deno/dom_startup_error). Private helpers are - pulled in too — a public wrapper may delegate to one. *) - let module_value_decls = - List.filter_map (fun decl -> - match decl with - | TopFn fd when fd.fd_body <> FnExtern -> - Some (fd.fd_name.name, `Fn fd) - | TopConst { tc_name; _ } as d -> - Some (tc_name.name, `Const d) - | _ -> None - ) lm.mod_program.prog_decls - in - (* Constructors of this module's own enums, keyed by constructor - name. An inlined wrapper body can name a constructor - (`text` returns `VText(content)`) and the constructor exists - only where the enum is declared. Option/Result constructors - are excluded: every non-wasm preamble already defines - Some/None/Ok/Err, and re-emitting them is the duplicate-`const` - crash that reverted type-carrying in #138 — this narrows the - carry to user enums a backend preamble cannot supply. *) - let preamble_ctors = [ "Some"; "None"; "Ok"; "Err" ] in - let ctor_decls = Hashtbl.create 16 in - List.iter (fun decl -> - match decl with - | TopType td -> - (match td.td_body with - | TyEnum variants -> - List.iter (fun (vd : variant_decl) -> - if not (List.mem vd.vd_name.name preamble_ctors) then - Hashtbl.replace ctor_decls vd.vd_name.name - (td.td_name.name, decl) - ) variants - | _ -> ()) - | _ -> ()) lm.mod_program.prog_decls; - let by_name = Hashtbl.create 16 in - List.iter (fun (n, d) -> Hashtbl.replace by_name n d) module_value_decls; - let seen = Hashtbl.create 16 in - List.iter (fun (n, _) -> Hashtbl.replace seen n ()) direct; - let rec close pending acc = - match pending with - | [] -> List.rev acc - | (_, dk) :: rest -> - let free = match dk with - | `Fn fd -> - let params = - List.map (fun (p : param) -> p.p_name.name) fd.fd_params - in - (match fd.fd_body with - | FnExtern -> [] - | FnExpr e -> find_free_vars params e - | FnBlock b -> find_free_vars params (ExprBlock b)) - | `Const (TopConst { tc_value; _ }) -> find_free_vars [] tc_value - | `Const _ | `Type _ -> [] - in - let (pending, acc) = - List.fold_left (fun (pending, acc) name -> - if Hashtbl.mem seen name then (pending, acc) - else begin - Hashtbl.replace seen name (); - match Hashtbl.find_opt by_name name with - | Some dep -> ((name, dep) :: pending, (name, dep) :: acc) - | None -> - (* A constructor name: carry the enum it belongs to, - once per type. *) - (match Hashtbl.find_opt ctor_decls name with - | Some (td_name, decl) when not (Hashtbl.mem seen td_name) -> - Hashtbl.replace seen td_name (); - ((td_name, `Type decl) :: pending, - (td_name, `Type decl) :: acc) - | _ -> (pending, acc)) - end - ) (rest, acc) free - in - close pending acc - in - let extras = close direct [] in List.map (fun (n, dk) -> (bound_name_of n, rename_decl (bound_name_of n) dk)) - (direct @ extras) + (close_over direct) in (* Public enums the importer names directly. A constructor in the import list (`use Geometry::{Up, Down}`) or a type name the diff --git a/lib/resolve.ml b/lib/resolve.ml index 70ef2f9b..38508cd8 100644 --- a/lib/resolve.ml +++ b/lib/resolve.ml @@ -783,7 +783,7 @@ and resolve_imports_with_loader Ok () | Error e -> Error e end - | Error (Module_loader.ModuleNotFound _) -> + | Error (Module_loader.ModuleNotFound missing) when missing = path_strs -> let id = List.hd (List.rev path) in Error (UndefinedModule id, id.span) | Error e -> @@ -807,7 +807,7 @@ and resolve_imports_with_loader items | Error e -> Error e end - | Error (Module_loader.ModuleNotFound _) -> + | Error (Module_loader.ModuleNotFound missing) when missing = path_strs -> let id = List.hd (List.rev path) in Error (UndefinedModule id, id.span) | Error e -> @@ -865,7 +865,7 @@ and resolve_imports_with_loader Ok ()) | Error e -> Error e end - | Error (Module_loader.ModuleNotFound _) -> + | Error (Module_loader.ModuleNotFound missing) when missing = path_strs -> let id = List.hd (List.rev path) in Error (UndefinedModule id, id.span) | Error e -> diff --git a/test/test_main.ml b/test/test_main.ml index 4bc13ef3..d9304a2e 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); + ("Module root, decl match, flattening, interp binops, Bun-ESM return-in-arm", Test_module_root_flatten.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); diff --git a/test/test_module_root_flatten.ml b/test/test_module_root_flatten.ml new file mode 100644 index 00000000..61bcf5ba --- /dev/null +++ b/test/test_module_root_flatten.ml @@ -0,0 +1,257 @@ +(* SPDX-License-Identifier: MPL-2.0 *) +(* Copyright (c) 2026 Jonathan D.A. Jewell *) +(** Regressions found by checking and running a real multi-module program + (metadatastician/kyq, the estate's KYAML processor) with the compiler: + + - a file in a package sub-directory could not import its siblings by + their full module path, because modules were looked up from the + file's own directory; + - a file found for [A.B] that declares [module A;] was accepted as + [A.B], so a non-existent submodule imported [A]'s exports; + - a missing transitive dependency was reported as the importer's own + import being undefined; + - flattening carried an imported function before the private helpers it + calls (and carried no helpers at all for glob and plain imports), so + the interpreter could not find them; + - the interpreter had no [++] on arrays and no [==] on chars, records, + tuples or variants, all of which the checker accepts; + - the Bun-ESM backend compiled a [return] in a match arm of a [let] + initializer into a return from the match's IIFE. *) + +open Affinescript + +let fresh_dir tag = + let dir = Filename.concat (Filename.get_temp_dir_name ()) + (Printf.sprintf "as_root_%s_%d" tag (Unix.getpid ())) in + (try Unix.mkdir dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); + dir + +let write_file dir rel body = + let path = Filename.concat dir rel in + let parent = Filename.dirname path in + (try Unix.mkdir parent 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); + let oc = open_out path in + output_string oc body; + close_out oc + +let loader_in dir = + Module_loader.create + { (Module_loader.default_config ()) with current_dir = dir } + +(* ---- module_root_dir ---------------------------------------------------- *) + +let root_cases () = + let check name expected file_dir path = + Alcotest.(check string) name expected + (Module_loader.module_root_dir ~file_dir path) + in + check "A.B in .../A is rooted above A" "/p/src" "/p/src/Kyaml" + (Some [ "Kyaml"; "Ijson" ]); + check "A.B.C in .../A/B is rooted above A" "/p/src" "/p/src/Kyaml/Lint" + (Some [ "Kyaml"; "Lint"; "RequiredFields" ]); + check "one-segment name keeps the file's directory" "/p/src" "/p/src" + (Some [ "Main" ]); + check "no declaration keeps the file's directory" "/p/src/x" "/p/src/x" None; + check "a layout that does not match keeps the file's directory" + "/p/tests" "/p/tests" (Some [ "Kyaml"; "Parser"; "Test" ]) + +(* ---- declared path must match the requested path ------------------------ *) + +let decl_mismatch_rejected () = + let dir = fresh_dir "mismatch" in + write_file dir "P.affine" "module P;\npub fn p() -> Int { 1 }\n"; + (match Module_loader.load_module (loader_in dir) [ "P"; "Nope" ] with + | Error (Module_loader.ModuleDeclMismatch (want, got, _)) -> + Alcotest.(check (list string)) "requested" [ "P"; "Nope" ] want; + Alcotest.(check (list string)) "declared" [ "P" ] got + | Error e -> + Alcotest.failf "expected ModuleDeclMismatch, got %s" + (Module_loader.show_load_error e) + | Ok _ -> Alcotest.fail "P.Nope must not load from P.affine"); + match Module_loader.load_module (loader_in dir) [ "P" ] with + | Ok _ -> () + | Error e -> Alcotest.failf "P itself must load: %s" + (Module_loader.show_load_error e) + +(* ---- a missing dependency is named, not blamed on the importer ---------- *) + +let missing_dependency_named () = + let dir = fresh_dir "missingdep" in + write_file dir "Q.affine" + "module Q;\nuse NoSuchModule::*;\npub fn q() -> Int { 1 }\n"; + let prog = + Parse_driver.parse_string ~file:"" + "module Importer;\nuse Q::*;\npub fn main() -> Int { q() }\n" + in + match Resolve.resolve_program_with_loader prog (loader_in dir) with + | Ok _ -> Alcotest.fail "a missing dependency must not resolve" + | Error (Resolve.UndefinedModule id, _) -> + Alcotest.failf "the error blames `%s`, not the missing NoSuchModule" + id.name + | Error (e, _) -> + let msg = Resolve.show_resolve_error e in + Alcotest.(check bool) ("names NoSuchModule: " ^ msg) true + (Str.string_match (Str.regexp ".*NoSuchModule") msg 0) + +(* ---- flattening carries helpers, in declaration order ------------------- *) + +let helper_module = + "module P.M;\n\ + fn helper(s: String) -> Int { 7 }\n\ + pub fn api(s: String) -> Int {\n\ + \ let x = helper(s);\n\ + \ x\n\ + }\n" + +let eval_main dir src = + let prog = Parse_driver.parse_string ~file:"" src in + let ld = loader_in dir in + match Resolve.resolve_program_with_loader prog ld with + | Error (e, _) -> Alcotest.failf "resolve: %s" (Resolve.show_resolve_error e) + | Ok _ -> + let flat = Module_loader.flatten_imports ld prog in + (match Interp.eval_program flat with + | Error e -> Alcotest.failf "eval: %s" (Value.show_eval_error e) + | Ok env -> + (match Value.lookup_env "main" env with + | Error _ -> Alcotest.fail "no main" + | Ok main_fn -> + (match Interp.apply_function main_fn [] with + | Ok v -> v + | Error e -> Alcotest.failf "run: %s" (Value.show_eval_error e)))) + +let flatten_carries_helpers import_line () = + let dir = fresh_dir "flatten" in + write_file dir "P/M.affine" helper_module; + let src = + "module D;\n" ^ import_line ^ "\npub fn main() -> Int { api(\"a\") }\n" + in + match eval_main dir src with + | Value.VInt 7 -> () + | v -> Alcotest.failf "expected 7, got %s" (Value.show_value v) + +(* ---- interpreter binary operators the checker accepts ------------------- *) + +let binop_cases () = + let ok name expected got = + match got with + | Ok v -> Alcotest.(check bool) name true (Value.value_eq v expected) + | Error e -> Alcotest.failf "%s: %s" name (Value.show_eval_error e) + in + let open Value in + ok "array ++ array" + (VArray [| VInt 1; VInt 2 |]) + (Interp.eval_binop Ast.OpConcat (VArray [| VInt 1 |]) (VArray [| VInt 2 |])); + ok "char == char" (VBool true) (Interp.eval_binop Ast.OpEq (VChar 'a') (VChar 'a')); + ok "char != char" (VBool true) (Interp.eval_binop Ast.OpNe (VChar 'a') (VChar 'b')); + ok "char < char" (VBool true) (Interp.eval_binop Ast.OpLt (VChar 'a') (VChar 'b')); + ok "tuple == tuple" (VBool false) + (Interp.eval_binop Ast.OpEq (VTuple [ VInt 1; VInt 2 ]) (VTuple [ VInt 1; VInt 3 ])); + ok "variant == variant" (VBool true) + (Interp.eval_binop Ast.OpEq (VVariant ("A", Some (VInt 1))) + (VVariant ("A", Some (VInt 1)))) + +(* ---- Bun-ESM: return in a match arm of a let initializer ---------------- *) + +let return_in_arm_src = {| +module retarm; + +pub type R = Good(Int) | Bad(Int) + +pub fn f(r: R) -> Int { + let v = match r { + Good(n) => n, + Bad(e) => return e + 100 + }; + v + 1 +} + +pub fn tail(r: R) -> Int { + let k = 1; + match r { Good(n) => n + k, Bad(e) => return e + 200 } +} + +pub fn lam(r: R) -> Int { + let g = |x: Int| -> Int { match r { Good(n) => n + x, Bad(e) => return e + 300 } }; + g(0) + 1 +} +|} + +let return_in_operand_src = {| +module retop; + +pub type R = Good(Int) | Bad(Int) + +pub fn f(r: R) -> Int { + let v = 1 + match r { Good(n) => n, Bad(e) => return e }; + v +} +|} + +let node_available () = Sys.command "node --version > /dev/null 2>&1" = 0 + +let run_node js = + let dir = fresh_dir "retarm" in + let file = Filename.concat dir "retarm.mjs" in + let oc = open_out file in + output_string oc js; + close_out oc; + let ic = Unix.open_process_in ("node " ^ Filename.quote file ^ " 2>&1") in + let out = In_channel.input_all ic in + ignore (Unix.close_process_in ic); + String.trim out + +let return_in_match_arm () = + if not (node_available ()) then + Alcotest.fail + "node is not on PATH. This test is a gate, not an optional extra: \ + it runs the emitted Bun-ESM module (CI installs node 20)."; + let prog = Parse_driver.parse_string ~file:"" return_in_arm_src in + let ld = Module_loader.create (Module_loader.default_config ()) in + match Resolve.resolve_program_with_loader prog ld with + | Error (e, _) -> Alcotest.failf "resolve: %s" (Resolve.show_resolve_error e) + | Ok (rctx, _) -> + let flat = Module_loader.flatten_imports ld prog in + (match Codegen_deno.codegen_deno flat rctx.symbols with + | Error e -> Alcotest.failf "deno codegen: %s" e + | Ok js -> + let out = + run_node + (js ^ "\nconsole.log(f(Good(1)), f(Bad(5)), tail(Good(1)), \ + tail(Bad(5)), lam(Good(1)), lam(Bad(5)));\n") in + (* f: Good(1) binds v = 1 and gives 2; Bad(5) returns 105 from f (the + old IIFE lowering bound 105 to v and printed 106). tail and lam: + the early return leaves the function, or the lambda. *) + Alcotest.(check string) "let, tail and lambda positions" + "2 105 2 205 2 306" out) + +let return_in_operand_refused () = + let prog = Parse_driver.parse_string ~file:"" return_in_operand_src in + let ld = Module_loader.create (Module_loader.default_config ()) in + match Resolve.resolve_program_with_loader prog ld with + | Error (e, _) -> Alcotest.failf "resolve: %s" (Resolve.show_resolve_error e) + | Ok (rctx, _) -> + (match Codegen_deno.codegen_deno prog rctx.symbols with + | Ok _ -> + Alcotest.fail + "a return in a match arm used as an operand must be refused, not \ + compiled to a return from an IIFE" + | Error msg -> + Alcotest.(check bool) ("refusal names the cause: " ^ msg) true + (Str.string_match (Str.regexp ".*return. inside a match arm") msg 0)) + +let tests = + [ + Alcotest.test_case "module_root_dir" `Quick root_cases; + Alcotest.test_case "declared path must match" `Quick decl_mismatch_rejected; + Alcotest.test_case "missing dependency is named" `Quick missing_dependency_named; + Alcotest.test_case "list import carries private helper" `Quick + (flatten_carries_helpers "use P.M::{api};"); + Alcotest.test_case "glob import carries private helper" `Quick + (flatten_carries_helpers "use P.M::*;"); + Alcotest.test_case "interp binops the checker accepts" `Quick binop_cases; + Alcotest.test_case "Bun-ESM: return in a let-initializer match arm" `Quick + return_in_match_arm; + Alcotest.test_case "Bun-ESM: return in an operand match is refused" `Quick + return_in_operand_refused; + ]