From 1ba035397d76191834f66617490fe46d1db5b1eb Mon Sep 17 00:00:00 2001 From: "shoney.arickathil" Date: Wed, 12 Aug 2026 14:40:07 +0200 Subject: [PATCH] =?UTF-8?q?feat(compiler):=20iteration=205=20Tasks=201-4?= =?UTF-8?q?=20=E2=80=94=20modules,=20language=20surface,=20switch,=20typed?= =?UTF-8?q?ef=20records=20+=20enum=20variants?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Modules: `use`/`pub`, directory-as-module, per-module symbol resolution (a flat first-wins merge silently ran the wrong `pub fn` body), six reserved stdlib namespaces typed UNKNOWN-BUT-RESERVED. - Surface: `and`/`or` (own precedence tier, short-circuit, Bool-only), `${}` interpolation desugared at parse time, `const`, break/continue with drop-correct exits, do-while, inline-fn rejection. - switch expr/stmt: required `default` over scalars/Text, arm unification, EQ/EQS+JZ lowering, per-arm drop scopes with N-way JOIN-DROP; `default` sorted last by a shared lowering order (textual order made arms dead). - typedef records: structural, same shape = one class entry; `?name: T` nullable-by-shape; emit_ctor fills omitted defaults; `type` as field name. - Enum variants: all-bare unions = int ordinals; any-payload = one class entry per variant, tag IS the header class_id (no header field, no format bump); exhaustive switch without `default`; arity checked both directions. - Payload escape modeled as move-out (pointer-kind fields only — a scalar escape is a copy); caller reaps owned heap temps passed by borrow: two unbounded LSan-blind leaks, 10.5 MB -> 1.5 MB flat over 300k iterations. - Fixed en route, each with a RED repro: dead E209 builtin-arg check and `int_to_text` missing from both types.ml builtin tables (both segfaulted wovm), multi-file phantom double-report, emit_ctor's field temp clobbering dst in tail position (pre-existing), warnings swallowed without an error. - Two fenced VM builtins: `int_to_text` (13), `variant_tag` (14). - 14+565 unit (was 14+401), corpus 71 (was 32) plain and under wovm_asan, wovm-test + cli_smoke green. Log-watcher 307 -> 93 diagnostics (85 E101 / 4 E207 / 1 E208 / 3 W202); the 5 non-E101 residuals await Task 7 grammar. --- compiler/bin/main.ml | 93 +- compiler/src/ast.ml | 180 +- compiler/src/disasm.ml | 2 + compiler/src/dump.ml | 92 +- compiler/src/emit.ml | 1259 ++++++++++++- compiler/src/lexer.ml | 106 +- compiler/src/owner.ml | 371 +++- compiler/src/parser.ml | 647 ++++++- compiler/src/token.ml | 49 + compiler/src/types.ml | 1607 ++++++++++++++++- .../driver/module-unused-use/unused.wo | 9 + .../driver/multifile-single-report/a.wo | 3 + .../driver/multifile-single-report/b.wo | 9 + compiler/test/runner.ml | 1351 +++++++++++++- .../compiler/nullable-types-implementation.md | 61 +- docs/plan/oop-vm/00-wob-format.md | 66 +- docs/plan/oop-vm/01-error-catalog.md | 59 +- docs/plan/oop-vm/02-corpus.md | 29 + docs/plan/oop-vm/08-builtin-surface.md | 84 + runtime/src/builtin.c | 28 + runtime/src/loader.c | 3 +- runtime/src/wob.h | 16 +- scripts/oop-e2e.sh | 48 +- .../lang-and-non-bool-operand/fixture.code | 1 + .../lang-and-non-bool-operand/fixture.wo | 10 + .../lang-break-outside-loop/fixture.code | 1 + .../lang-break-outside-loop/fixture.wo | 9 + .../lang-builtin-arg-type-freefn/fixture.code | 1 + .../lang-builtin-arg-type-freefn/fixture.wo | 20 + .../lang-builtin-arg-type-method/fixture.code | 1 + .../lang-builtin-arg-type-method/fixture.wo | 17 + .../lang-builtin-arg-type/fixture.code | 1 + .../lang-builtin-arg-type/fixture.wo | 11 + .../lang-builtin-arity/fixture.code | 1 + .../lang-builtin-arity/fixture.wo | 9 + .../lang-inline-fn-rejected/fixture.code | 1 + .../lang-inline-fn-rejected/fixture.wo | 11 + .../lang-interp-malformed-expr/fixture.code | 1 + .../lang-interp-malformed-expr/fixture.wo | 11 + .../lang-multifile-single-report/fixture.code | 1 + .../lang-multifile-single-report/fixture.wo | 15 + .../other/helper.wo | 8 + .../lang-switch-arm-mismatch/fixture.code | 1 + .../lang-switch-arm-mismatch/fixture.wo | 16 + .../fixture.code | 1 + .../fixture.wo | 20 + .../fixture.code | 1 + .../fixture.wo | 19 + .../fixture.code | 1 + .../fixture.wo | 18 + .../lang-switch-missing-default/fixture.code | 1 + .../lang-switch-missing-default/fixture.wo | 15 + .../fixture.code | 1 + .../fixture.wo | 19 + .../compile-fail/lang-use-collision/a/a.wo | 3 + .../compile-fail/lang-use-collision/b/b.wo | 3 + .../lang-use-collision/fixture.code | 1 + .../lang-use-collision/fixture.wo | 11 + .../lang-use-private-access/fixture.code | 1 + .../lang-use-private-access/fixture.wo | 8 + .../lang-use-private-access/secret/secret.wo | 7 + .../lang-use-stdlib-not-linked/fixture.code | 1 + .../lang-use-stdlib-not-linked/fixture.wo | 12 + .../lang-use-unknown-module/fixture.code | 1 + .../lang-use-unknown-module/fixture.wo | 8 + .../lang-variant-arity/fixture.code | 1 + .../lang-variant-arity/fixture.wo | 10 + .../lang-variant-cross-union-eq/fixture.code | 1 + .../lang-variant-cross-union-eq/fixture.wo | 12 + .../lang-variant-missing-variant/fixture.code | 1 + .../lang-variant-missing-variant/fixture.wo | 16 + .../fixture.code | 1 + .../lang-variant-nullable-subject/fixture.wo | 21 + .../run/emit-ctor-tail-position/fixture.out | 3 + .../run/emit-ctor-tail-position/fixture.wo | 35 + .../run/lang-and-or-short-circuit/fixture.out | 3 + .../run/lang-and-or-short-circuit/fixture.wo | 26 + .../run/lang-break-owned-drop/fixture.out | 2 + .../run/lang-break-owned-drop/fixture.wo | 159 ++ tests/corpus/run/lang-const-usage/fixture.out | 3 + tests/corpus/run/lang-const-usage/fixture.wo | 26 + tests/corpus/run/lang-continue/fixture.out | 5 + tests/corpus/run/lang-continue/fixture.wo | 24 + .../run/lang-ctor-temp-arg-drop/fixture.out | 1 + .../run/lang-ctor-temp-arg-drop/fixture.wo | 159 ++ tests/corpus/run/lang-do-while/fixture.out | 2 + tests/corpus/run/lang-do-while/fixture.wo | 14 + .../corpus/run/lang-interp-string/fixture.out | 3 + .../corpus/run/lang-interp-string/fixture.wo | 13 + .../run/lang-switch-arm-drop/fixture.out | 4 + .../run/lang-switch-arm-drop/fixture.wo | 166 ++ .../lang-switch-class-arm-leak/fixture.out | 3 + .../run/lang-switch-class-arm-leak/fixture.wo | 161 ++ .../lang-switch-default-not-last/fixture.out | 3 + .../lang-switch-default-not-last/fixture.wo | 27 + tests/corpus/run/lang-switch-stmt/fixture.out | 3 + tests/corpus/run/lang-switch-stmt/fixture.wo | 27 + .../corpus/run/lang-switch-value/fixture.out | 9 + tests/corpus/run/lang-switch-value/fixture.wo | 38 + .../run/lang-typedef-record/fixture.out | 5 + .../corpus/run/lang-typedef-record/fixture.wo | 23 + .../run/lang-typedef-structural/fixture.out | 2 + .../run/lang-typedef-structural/fixture.wo | 19 + .../run/lang-use-crossmodule/fixture.out | 1 + .../run/lang-use-crossmodule/fixture.wo | 11 + .../run/lang-use-crossmodule/greet/greet.wo | 8 + .../lang-use-local-shadows-alias/fixture.out | 1 + .../lang-use-local-shadows-alias/fixture.wo | 22 + .../secret/secret.wo | 7 + .../run/lang-use-qualified-dispatch/a/a.wo | 3 + .../run/lang-use-qualified-dispatch/b/b.wo | 3 + .../lang-use-qualified-dispatch/fixture.out | 2 + .../lang-use-qualified-dispatch/fixture.wo | 16 + .../run/lang-variant-arm-drop/fixture.out | 7 + .../run/lang-variant-arm-drop/fixture.wo | 193 ++ .../run/lang-variant-bare-union/fixture.out | 3 + .../run/lang-variant-bare-union/fixture.wo | 27 + .../lang-variant-payload-escape/fixture.out | 2 + .../lang-variant-payload-escape/fixture.wo | 174 ++ .../run/lang-variant-payload/fixture.out | 3 + .../run/lang-variant-payload/fixture.wo | 35 + .../lang-variant-scalar-payload/fixture.out | 2 + .../lang-variant-scalar-payload/fixture.wo | 20 + 123 files changed, 7866 insertions(+), 176 deletions(-) create mode 100644 compiler/test/fixtures/driver/module-unused-use/unused.wo create mode 100644 compiler/test/fixtures/driver/multifile-single-report/a.wo create mode 100644 compiler/test/fixtures/driver/multifile-single-report/b.wo create mode 100644 tests/corpus/compile-fail/lang-and-non-bool-operand/fixture.code create mode 100644 tests/corpus/compile-fail/lang-and-non-bool-operand/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-break-outside-loop/fixture.code create mode 100644 tests/corpus/compile-fail/lang-break-outside-loop/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-builtin-arg-type-freefn/fixture.code create mode 100644 tests/corpus/compile-fail/lang-builtin-arg-type-freefn/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-builtin-arg-type-method/fixture.code create mode 100644 tests/corpus/compile-fail/lang-builtin-arg-type-method/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-builtin-arg-type/fixture.code create mode 100644 tests/corpus/compile-fail/lang-builtin-arg-type/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-builtin-arity/fixture.code create mode 100644 tests/corpus/compile-fail/lang-builtin-arity/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-inline-fn-rejected/fixture.code create mode 100644 tests/corpus/compile-fail/lang-inline-fn-rejected/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-interp-malformed-expr/fixture.code create mode 100644 tests/corpus/compile-fail/lang-interp-malformed-expr/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-multifile-single-report/fixture.code create mode 100644 tests/corpus/compile-fail/lang-multifile-single-report/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-multifile-single-report/other/helper.wo create mode 100644 tests/corpus/compile-fail/lang-switch-arm-mismatch/fixture.code create mode 100644 tests/corpus/compile-fail/lang-switch-arm-mismatch/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-switch-builtin-subject-int-case/fixture.code create mode 100644 tests/corpus/compile-fail/lang-switch-builtin-subject-int-case/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-switch-int-subject-text-case/fixture.code create mode 100644 tests/corpus/compile-fail/lang-switch-int-subject-text-case/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-switch-int-subject-variant-case/fixture.code create mode 100644 tests/corpus/compile-fail/lang-switch-int-subject-variant-case/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-switch-missing-default/fixture.code create mode 100644 tests/corpus/compile-fail/lang-switch-missing-default/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-switch-text-subject-int-case/fixture.code create mode 100644 tests/corpus/compile-fail/lang-switch-text-subject-int-case/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-use-collision/a/a.wo create mode 100644 tests/corpus/compile-fail/lang-use-collision/b/b.wo create mode 100644 tests/corpus/compile-fail/lang-use-collision/fixture.code create mode 100644 tests/corpus/compile-fail/lang-use-collision/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-use-private-access/fixture.code create mode 100644 tests/corpus/compile-fail/lang-use-private-access/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-use-private-access/secret/secret.wo create mode 100644 tests/corpus/compile-fail/lang-use-stdlib-not-linked/fixture.code create mode 100644 tests/corpus/compile-fail/lang-use-stdlib-not-linked/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-use-unknown-module/fixture.code create mode 100644 tests/corpus/compile-fail/lang-use-unknown-module/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-variant-arity/fixture.code create mode 100644 tests/corpus/compile-fail/lang-variant-arity/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-variant-cross-union-eq/fixture.code create mode 100644 tests/corpus/compile-fail/lang-variant-cross-union-eq/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-variant-missing-variant/fixture.code create mode 100644 tests/corpus/compile-fail/lang-variant-missing-variant/fixture.wo create mode 100644 tests/corpus/compile-fail/lang-variant-nullable-subject/fixture.code create mode 100644 tests/corpus/compile-fail/lang-variant-nullable-subject/fixture.wo create mode 100644 tests/corpus/run/emit-ctor-tail-position/fixture.out create mode 100644 tests/corpus/run/emit-ctor-tail-position/fixture.wo create mode 100644 tests/corpus/run/lang-and-or-short-circuit/fixture.out create mode 100644 tests/corpus/run/lang-and-or-short-circuit/fixture.wo create mode 100644 tests/corpus/run/lang-break-owned-drop/fixture.out create mode 100644 tests/corpus/run/lang-break-owned-drop/fixture.wo create mode 100644 tests/corpus/run/lang-const-usage/fixture.out create mode 100644 tests/corpus/run/lang-const-usage/fixture.wo create mode 100644 tests/corpus/run/lang-continue/fixture.out create mode 100644 tests/corpus/run/lang-continue/fixture.wo create mode 100644 tests/corpus/run/lang-ctor-temp-arg-drop/fixture.out create mode 100644 tests/corpus/run/lang-ctor-temp-arg-drop/fixture.wo create mode 100644 tests/corpus/run/lang-do-while/fixture.out create mode 100644 tests/corpus/run/lang-do-while/fixture.wo create mode 100644 tests/corpus/run/lang-interp-string/fixture.out create mode 100644 tests/corpus/run/lang-interp-string/fixture.wo create mode 100644 tests/corpus/run/lang-switch-arm-drop/fixture.out create mode 100644 tests/corpus/run/lang-switch-arm-drop/fixture.wo create mode 100644 tests/corpus/run/lang-switch-class-arm-leak/fixture.out create mode 100644 tests/corpus/run/lang-switch-class-arm-leak/fixture.wo create mode 100644 tests/corpus/run/lang-switch-default-not-last/fixture.out create mode 100644 tests/corpus/run/lang-switch-default-not-last/fixture.wo create mode 100644 tests/corpus/run/lang-switch-stmt/fixture.out create mode 100644 tests/corpus/run/lang-switch-stmt/fixture.wo create mode 100644 tests/corpus/run/lang-switch-value/fixture.out create mode 100644 tests/corpus/run/lang-switch-value/fixture.wo create mode 100644 tests/corpus/run/lang-typedef-record/fixture.out create mode 100644 tests/corpus/run/lang-typedef-record/fixture.wo create mode 100644 tests/corpus/run/lang-typedef-structural/fixture.out create mode 100644 tests/corpus/run/lang-typedef-structural/fixture.wo create mode 100644 tests/corpus/run/lang-use-crossmodule/fixture.out create mode 100644 tests/corpus/run/lang-use-crossmodule/fixture.wo create mode 100644 tests/corpus/run/lang-use-crossmodule/greet/greet.wo create mode 100644 tests/corpus/run/lang-use-local-shadows-alias/fixture.out create mode 100644 tests/corpus/run/lang-use-local-shadows-alias/fixture.wo create mode 100644 tests/corpus/run/lang-use-local-shadows-alias/secret/secret.wo create mode 100644 tests/corpus/run/lang-use-qualified-dispatch/a/a.wo create mode 100644 tests/corpus/run/lang-use-qualified-dispatch/b/b.wo create mode 100644 tests/corpus/run/lang-use-qualified-dispatch/fixture.out create mode 100644 tests/corpus/run/lang-use-qualified-dispatch/fixture.wo create mode 100644 tests/corpus/run/lang-variant-arm-drop/fixture.out create mode 100644 tests/corpus/run/lang-variant-arm-drop/fixture.wo create mode 100644 tests/corpus/run/lang-variant-bare-union/fixture.out create mode 100644 tests/corpus/run/lang-variant-bare-union/fixture.wo create mode 100644 tests/corpus/run/lang-variant-payload-escape/fixture.out create mode 100644 tests/corpus/run/lang-variant-payload-escape/fixture.wo create mode 100644 tests/corpus/run/lang-variant-payload/fixture.out create mode 100644 tests/corpus/run/lang-variant-payload/fixture.wo create mode 100644 tests/corpus/run/lang-variant-scalar-payload/fixture.out create mode 100644 tests/corpus/run/lang-variant-scalar-payload/fixture.wo diff --git a/compiler/bin/main.ml b/compiler/bin/main.ml index 4c38ecf..4ca9688 100644 --- a/compiler/bin/main.ml +++ b/compiler/bin/main.ml @@ -166,13 +166,24 @@ let build_lookup (sources : (string * string) list) : Woc_lib.Diag.source_lookup List.iter (fun (f, src) -> Hashtbl.replace tbl f src) sources; fun f -> Hashtbl.find_opt tbl f +(* Pre-existing defect, fixed here (haxe-parity Task 1, modules): this + used to gate printing on `has_error` alone, so a collector holding + *only* warnings (no error at all — e.g. WO-W201's gc-suggestion, or + this task's own WO-W202 unused-`use`) printed nothing and exited 0, + indistinguishable from a collector with zero diagnostics. A warning + nobody ever sees is a dead feature, not a working one — this task's + own unused-`use` warning needs to actually reach stderr to be worth + having, which is what surfaced this. Still exits 0 whenever nothing + is an error (unchanged contract); the only behavior change is that a + warning-only run now also prints, matching what "diagnostics, if + any, print to stderr" (this file's own usage_msg) already promised. *) let finish (collector : Woc_lib.Diag.Collector.t) (lookup : Woc_lib.Diag.source_lookup) : unit = - if Woc_lib.Diag.Collector.has_error collector then begin - prerr_string (Woc_lib.Diag.Collector.render_all collector lookup); - prerr_newline (); - exit 1 - end - else exit 0 + let text = Woc_lib.Diag.Collector.render_all collector lookup in + if text <> "" then begin + prerr_string text; + prerr_newline () + end; + exit (Woc_lib.Diag.Collector.exit_code collector) (* ---- Cross-file symbol resolution (Task 8) --------------------------- @@ -206,11 +217,12 @@ let merge_symbols (syms_list : Woc_lib.Types.symbols list) : Woc_lib.Types.symbo interfaces = SM.union keep_first acc.interfaces s.interfaces; free_fns = SM.union keep_first acc.free_fns s.free_fns; typedefs = SM.union keep_first acc.typedefs s.typedefs; + unions = SM.union keep_first acc.unions s.unions; modules = acc.modules @ s.modules; }) Woc_lib.Types.{ classes = SM.empty; interfaces = SM.empty; free_fns = SM.empty; - typedefs = SM.empty; modules = []; + typedefs = SM.empty; unions = SM.empty; modules = []; } syms_list @@ -273,19 +285,64 @@ let check_symbol_collisions (collector : Woc_lib.Diag.Collector.t) syms.interfaces)) per_file -let typecheck_all (collector : Woc_lib.Diag.Collector.t) - (parsed : (string * Woc_lib.Ast.program) list) : Woc_lib.Types.symbols = +(* ---- module identity (haxe-parity Task 1, modules) -------------------- + + A file's module is its directory, relative to the root `woc` was + pointed at — exactly the directory structure discover_dir above + already walks, just not thrown away this time. "." denotes the root + module itself (Filename.dirname's own convention for a name with no + directory part — reused rather than inventing a second sentinel). A + single-file invocation (root is not a directory — the bare-path + `woc ` form) has exactly one file and therefore exactly one + module: "." unconditionally, since there is no sibling directory + structure to differ from. *) +let module_of_file ~(root : string) (file : string) : string = + if not (Sys.is_directory root) then "." + else + let root_norm = + if String.length root > 0 && root.[String.length root - 1] = '/' then + String.sub root 0 (String.length root - 1) + else root + in + let prefix = root_norm ^ "/" in + let plen = String.length prefix in + let rel = + if String.length file >= plen && String.sub file 0 plen = prefix then + String.sub file plen (String.length file - plen) + else file (* defensive: discover_dir always builds full = Filename.concat root rel', so this never triggers *) + in + Filename.dirname rel + +(* Returns the existing global, flat-merged `syms` (owner.ml's and most of + emit.ml's own view — unchanged by this task) alongside the new + per-module tables (CRITICAL 1 review finding: the emitter needs these + too, for the one place a flat merge is the wrong answer — see + Types.module_symbols' own doc comment). *) +let typecheck_all (collector : Woc_lib.Diag.Collector.t) ~(root : string) + (parsed : (string * Woc_lib.Ast.program) list) : + Woc_lib.Types.symbols * (string, Woc_lib.Types.symbols) Hashtbl.t = let per_file_syms = List.map (fun (f, prog) -> (f, Woc_lib.Types.collect_declarations ~file:f prog collector)) parsed in check_symbol_collisions collector per_file_syms; + let module_of = module_of_file ~root in + Woc_lib.Types.check_modules collector ~module_of per_file_syms parsed; + let module_syms = Woc_lib.Types.module_symbols ~module_of per_file_syms in let syms = merge_symbols (List.map snd per_file_syms) in - List.iter - (fun (f, prog) -> Woc_lib.Types.typecheck_program ~file:f prog syms collector) - parsed; - syms + (* `~file_syms` (hotfix, multi-file double-report): `per_file_syms` and + `parsed` are both `List.map`s over the same original file list, in + the same order, so pairing them positionally is exact -- each + file's own collect_declarations output goes with that same file's + own prog. `syms` (the merged table) is still passed through + separately for cross-file resolution; see typecheck_program's own + doc comment for what narrows and what doesn't. *) + List.iter2 + (fun (f, prog) (_, file_syms) -> + Woc_lib.Types.typecheck_program ~file:f ~module_of ~module_syms ~file_syms prog syms collector) + parsed per_file_syms; + (syms, module_syms) let dump_tokens path = let sources = discover_and_read path in @@ -316,7 +373,7 @@ let dump_owner path = let collector = Woc_lib.Diag.Collector.create () in let multi = List.length sources > 1 in let parsed = parse_all collector sources in - let syms = typecheck_all collector parsed in + let syms, _module_syms = typecheck_all collector ~root:path parsed in List.iter (fun (f, prog) -> let tables = Woc_lib.Owner.analyze ~file:f prog syms collector in @@ -332,7 +389,7 @@ let check_only path = let sources = discover_and_read path in let collector = Woc_lib.Diag.Collector.create () in let parsed = parse_all collector sources in - let syms = typecheck_all collector parsed in + let syms, _module_syms = typecheck_all collector ~root:path parsed in List.iter (fun (f, prog) -> ignore (Woc_lib.Owner.analyze ~file:f prog syms collector)) parsed; finish collector (build_lookup sources) @@ -348,14 +405,16 @@ let compile_image path = let sources = discover_and_read path in let collector = Woc_lib.Diag.Collector.create () in let parsed = parse_all collector sources in - let syms = typecheck_all collector parsed in + let syms, module_syms = typecheck_all collector ~root:path parsed in let units = List.map (fun (f, prog) -> { Woc_lib.Emit.file = f; prog; tables = Woc_lib.Owner.analyze ~file:f prog syms collector }) parsed in - let image = Woc_lib.Emit.emit ~syms collector units in + let image = + Woc_lib.Emit.emit ~syms ~module_of:(module_of_file ~root:path) ~module_syms collector units + in (collector, build_lookup sources, image) let write_file path contents = diff --git a/compiler/src/ast.ml b/compiler/src/ast.ml index 2741a5f..c39f8d4 100644 --- a/compiler/src/ast.ml +++ b/compiler/src/ast.ml @@ -136,6 +136,13 @@ type field = { `+`/`-`, tighter than comparison — this ladder's ordering). *) type unop = Neg +(* `And`/`Or` (haxe-parity Task 2): real keywords, spelled as words, not + `&&`/`||` — the spec amendment's own wording. `Bool`-typed operands + only (types.ml wires this through, no truthiness); short-circuit, + lowered to compare-and-jump on the existing JZ/JMP opcodes (emit.ml), + no new opcode. Own precedence level, looser than every comparison — + see parser.ml's ladder doc for the exact ordering (`or` loosest, then + `and`, then comparison). *) type binop = | Add | Sub @@ -149,6 +156,8 @@ type binop = | Le | Gt | Ge + | And + | Or type expr = { id : int; @@ -190,6 +199,35 @@ and expr_kind = | Binary of binop * expr * expr | Ctor of string * (string * expr) list | DbStub of Token.t list + (* haxe-parity Task 2: one `${expr}` interpolation site, produced only + by the string-interpolation desugar (parser.ml) — never written + directly by a parse rule the way every other expr_kind is. Its + *textification* (pass through if already Text, `int_to_text` if + Int, a diagnostic for anything else) is a type-directed decision + deferred to emit.ml, since the parser has no type information yet; + "desugars at parse time to concatenation" covers the chain SHAPE + (a `Binary(Concat, ...)` of StrLit/Interp segments), not this one + leaf's textification. *) + | Interp of expr + (* haxe-parity Task 3: `switch subject { case v1, v2: ... + default: }`. One construct for both positions (the brief's + own words: "statement position is the expression with a discarded + value") — `stmt` has no separate switch node; a bare `switch {...}` + statement is simply this same node wrapped in `ExprStmt`, exactly + like a bare `select ...` call already is. Arms carry a `stmt list` + body (not a single `expr`) because the sample's own sites do — + `case "tail_log": if args == nil { return err(...); } ... return + self.tools.tail_log(...);` is not reducible to one expression — so + `expr`/`stmt` must be mutually recursive from here down (this is + the one place `expr_kind` reaches into `stmt`; every other node + above predates this task and never needed to). `values = []` means + `default` (`is_default = true`); a `case` always has at least one + value, and — the sample's own `alias_of`/cron.wo shape, + `case "@daily", "@midnight": ...` — may have more than one, + matching on any of them. No guards, no ranges: the sample never + uses either, so neither is grammar here (YAGNI, recorded in the + task report). *) + | Switch of expr * switch_arm list (* ---- statements (Task 5) --------------------------------------------- @@ -210,7 +248,7 @@ and expr_kind = else-block whose sole statement is itself an `If` — rather than a third `else_body` shape, so dump.ml's block-rendering code (already written once, for `then_body`) renders the chain for free. *) -type stmt = { +and stmt = { s_id : int; s_pos : pos; s_kind : stmt_kind; @@ -242,6 +280,76 @@ and stmt_kind = } | Return of expr option | ExprStmt of expr + (* haxe-parity Task 2: loop control. Both reuse owner.ml's scope-end + drop machinery (see Owner.DBreak/DContinue) so an owned value still + alive in the loop body is dropped at the jump, not left to leak; + emit.ml refuses to lower either one outside a loop (WO-E403 — + "cannot lower", the same convention as every other construct with + no legal target, since nothing upstream tracks loop nesting as a + parse- or type-error). *) + | Break + | Continue + (* `do { body } while cond` — body runs at least once, then the + condition gates repeating it. Lowered onto the same JZ/JMP pair + `while`/`for` already use, just reordered (parser.ml/emit.ml). *) + | DoWhile of { + body : stmt list; + cond : expr; + } + +(* haxe-parity Task 3: one arm of a `switch`. `values = []` iff + `is_default`; a `case` arm's `values` is never empty (parser + contract, mirrored — not re-checked — by every later stage). No + per-arm `id`: nothing downstream keys a side table on "this specific + arm" independent of the `Switch` expr that owns it (the shared + `Switch.id` is the drop-scope/branch-join node for every arm, one + per-arm string label telling them apart — exactly how `If`'s THEN/ + ELSE already share `s_id` and differ only by label). *) +and switch_arm = { + arm_pos : pos; + values : expr list; + is_default : bool; + body : stmt list; +} + +(* haxe-parity Task 3 (review fix, Critical 1): the arm order a + switch's own lowering actually walks — `default` moved to the end, + regardless of where it sits in the source. `default` has no + comparison of its own (it matches unconditionally); lowering the + arms in raw *source* order therefore made any `case` arm written + after a `default` permanently unreachable dead code (nothing ever + jumps into it, and `default`'s own body jumps straight to the + switch's exit, never falling through) — a real, reviewer-reproduced + bug, not a theoretical one. Both `owner.ml` (`analyze_switch`, + whose drop-scope/JOIN-DROP tables are keyed "ARM" by this order) + and `emit.ml` (`emit_switch`, the compare-and-jump chain itself) + call this SAME function rather than each re-deriving the reorder + independently — the two-file fix the review flagged, done once so + the "ARM" indices the two files hand each other can never drift + apart. `List.partition` is stable (documented in the stdlib): every + `case` arm keeps its own relative order, and — malformed, not + otherwise rejected — more than one `default` would too, all pushed + after every `case`. *) +let switch_lowering_order (arms : switch_arm list) : switch_arm list = + let cases, defaults = List.partition (fun (a : switch_arm) -> not a.is_default) arms in + cases @ defaults + +(* haxe-parity Task 2: `const NAME = ` — a compile-time value, + substituted for every unshadowed `Ident NAME` reference by a + dedicated post-parse pass (parser.ml's own const-substitution step, + run at the end of `parse`) rather than threaded through + typecheck/owner/emit as a new resolvable name: after substitution a + const reference simply *is* the literal expr it names, so every later + stage needs zero const-specific code. `value` is restricted by the + parser to a literal (`IntLit`/`StrLit`/`BoolLit`, optionally + `Unary(Neg, IntLit)`) — never a general expression, matching the + brief's own "= literal", not "= expr". *) +type const_decl = { + id : int; + pos : pos; + name : string; + value : expr; +} (* A signature shared shape (name/params/ret) appears twice: as an interface method (no body) and as a class/type/free-fn method (body @@ -266,6 +374,15 @@ type method_decl = { (* Task 4 captured this as a verbatim token span (brace-depth counter only); Task 5 parses it for real. *) body : stmt list; + (* haxe-parity Task 1 (modules): true only for a top-level free `fn` + parsed with a leading `pub` marker. method_decl is shared with + class methods (Task 4's own design — see this file's module doc), + but `pub` is a Task-1-scoped, top-level-declaration-only marker + (classes, interfaces, free fns); method-level visibility is a + different, not-yet-designed question, so parse_method always + passes `pub = false` for a class body's own methods — this field + is meaningful only when the surrounding decl is `Fn`. *) + pub : bool; } (* `@table(name: "...", index: [a, b], index: [c])` — optional storage @@ -287,10 +404,31 @@ type class_decl = { deliberate divergence from rt's plan-13 asymmetry, where a plain `type`'s `fn` was skip-discarded — see parser.ml's module doc). *) is_class : bool; + (* haxe-parity Task 4: true for `typedef Name = { ... }` — a + STRUCTURAL record alias, reusing this same node (same field + grammar, same downstream ctor/field machinery) rather than a + parallel decl kind. What the flag changes downstream: two records + with the same shape are the SAME type (emit.ml dedups them onto one + class-table entry; types.ml's arm unification compares shapes, not + names). A record body is fields only — the parser never puts a + method or const inside one, so `methods`/`consts` are always [] + here. `is_class` is false whenever this is true. *) + is_record : bool; is_gc : bool; (* @gc — reference semantics, spec section 3/4 *) table : table_cfg option; (* @table(...) — absent unless annotated *) fields : field list; methods : method_decl list; + (* haxe-parity Task 2: class-level `const NAME = literal` (bare, no + `static` — `static const` is Task 7's syntax, deliberately not + handled here so it falls through to a clean parse error, counted + against the gap until Task 7 lands). Scoped to this class's own + methods only by the same post-parse substitution pass that handles + top-level consts — see const_decl's own doc comment. *) + consts : const_decl list; + (* haxe-parity Task 1 (modules): `pub` marker — false (private to the + declaring module) unless the declaration was written `pub class`/ + `pub type`. *) + pub : bool; } type interface_decl = { @@ -298,11 +436,51 @@ type interface_decl = { pos : pos; name : string; methods : method_sig list; (* signatures only — no fields, no bodies *) + pub : bool; (* haxe-parity Task 1 — see class_decl.pub *) +} + +(* haxe-parity Task 1 (modules): `use fs` (a reserved stdlib namespace) + or `use shared/util` (project-relative, slash-separated path + segments naming another discovered module's directory). `segments` + is never empty — the parser requires at least one identifier. *) +type use_decl = { + id : int; + pos : pos; + segments : string list; +} + +(* haxe-parity Task 4: one variant of a union declaration + (`type Name = A | B | C(field: Type, ...)`). `v_fields` is the + payload, in declaration order — [] for a bare variant. No per-variant + `id`: like switch_arm, nothing downstream keys a side table on "this + specific variant" independent of the union that owns it (a variant's + identity downstream is (union, ordinal) — its tag). *) +type variant_decl = { + v_pos : pos; + v_name : string; + v_fields : (string * field_ty) list; +} + +(* haxe-parity Task 4: `type Name = V1 | V2 | ...` — a tagged union. + All-bare unions (every `v_fields` empty) lower to plain integer tags + (the variant's ordinal), no heap object and no class-table entry; + a union with at least one payload variant lowers every variant to a + small heap object whose class-table entry the compiler generates + (docs/plan/oop-vm/00-wob-format.md, "enum payload variants"). *) +type union_decl = { + id : int; + pos : pos; + name : string; + variants : variant_decl list; + pub : bool; } type decl = | Class of class_decl | Interface of interface_decl | Fn of method_decl (* free (non-method) top-level function *) + | Use of use_decl + | Const of const_decl (* haxe-parity Task 2: top-level `const NAME = literal` *) + | Union of union_decl (* haxe-parity Task 4: `type Name = A | B | ...` *) type program = { decls : decl list } diff --git a/compiler/src/disasm.ml b/compiler/src/disasm.ml index 690c075..2d7efe5 100644 --- a/compiler/src/disasm.ml +++ b/compiler/src/disasm.ml @@ -67,6 +67,8 @@ let builtin_name = function | 10 -> "map_set" | 11 -> "map_get" | 12 -> "map_has" + | 13 -> "int_to_text" + | 14 -> "variant_tag" | n -> Printf.sprintf "builtin%d" n let kind_name = function diff --git a/compiler/src/dump.ml b/compiler/src/dump.ml index b5a22ba..723772f 100644 --- a/compiler/src/dump.ml +++ b/compiler/src/dump.ml @@ -27,6 +27,12 @@ let kind_label (k : Token.kind) : string = | Token.Ident s -> Printf.sprintf "IDENT(%s)" s | Token.Int n -> Printf.sprintf "INT(%d)" n | Token.Str s -> Printf.sprintf "STR(%s)" s + | Token.InterpStr segs -> + let part_str = function + | Token.SText s -> Printf.sprintf "TEXT(%s)" s + | Token.SExpr s -> Printf.sprintf "EXPR(%s)" s + in + Printf.sprintf "INTERP_STR(%s)" (String.concat "," (List.map part_str segs)) | Token.KwType -> "KW_TYPE" | Token.KwClass -> "KW_CLASS" | Token.KwInterface -> "KW_INTERFACE" @@ -44,6 +50,19 @@ let kind_label (k : Token.kind) : string = | Token.KwFalse -> "KW_FALSE" | Token.KwInsert -> "KW_INSERT" | Token.KwSelect -> "KW_SELECT" + | Token.KwUse -> "KW_USE" + | Token.KwPub -> "KW_PUB" + | Token.KwBreak -> "KW_BREAK" + | Token.KwContinue -> "KW_CONTINUE" + | Token.KwDo -> "KW_DO" + | Token.KwConst -> "KW_CONST" + | Token.KwAnd -> "KW_AND" + | Token.KwOr -> "KW_OR" + | Token.KwInline -> "KW_INLINE" + | Token.KwSwitch -> "KW_SWITCH" + | Token.KwCase -> "KW_CASE" + | Token.KwDefault -> "KW_DEFAULT" + | Token.KwTypedef -> "KW_TYPEDEF" | Token.LBrace -> "LBRACE" | Token.RBrace -> "RBRACE" | Token.LParen -> "LPAREN" @@ -168,6 +187,8 @@ let binop_str : Ast.binop -> string = function | Ast.Le -> "<=" | Ast.Gt -> ">" | Ast.Ge -> ">=" + | Ast.And -> "and" + | Ast.Or -> "or" (* Raw token span shared by both DbStub renderings below: a statement- position DbStub (dump_stmt) and an expression-position one nested @@ -198,6 +219,20 @@ let rec expr_str (e : Ast.expr) : string = (String.concat ", " (List.map (fun (fname, fval) -> Printf.sprintf "%s: %s" fname (expr_str fval)) fields)) | Ast.DbStub toks -> Printf.sprintf "DB_STUB(%s)" (dbstub_tokens_str toks) + | Ast.Interp inner -> Printf.sprintf "INTERP(%s)" (expr_str inner) + (* haxe-parity Task 3: arm bodies are `stmt list`, not one `expr` — no + golden AST/bc fixture pins a switch (direct assertions instead, see + runner.ml, same convention haxe-parity Task 2 used), so this is a + one-line-per-arm-header summary ("readable enough to eyeball", this + file's own module-doc contract), not a full unparse of every arm's + statements. *) + | Ast.Switch (subject, arms) -> + let arm_str (a : Ast.switch_arm) = + if a.Ast.is_default then "default: ..." + else Printf.sprintf "case %s: ..." (String.concat ", " (List.map expr_str a.Ast.values)) + in + Printf.sprintf "SWITCH %s { %s }" (expr_str subject) + (String.concat " " (List.map arm_str arms)) (* dump_stmt — one line per statement (LINE:COL KIND detail), matching dump_field/dump_method_sig's "one descriptive line" convention; @@ -235,12 +270,25 @@ let rec dump_stmt (s : Ast.stmt) : string list = | Ast.ExprStmt { Ast.kind = Ast.DbStub toks; _ } -> [ Printf.sprintf "%s DB_STUB %s" (pos_str s.Ast.s_pos) (dbstub_tokens_str toks) ] | Ast.ExprStmt e -> [ Printf.sprintf "%s EXPR %s" (pos_str s.Ast.s_pos) (expr_str e) ] + | Ast.Break -> [ Printf.sprintf "%s BREAK" (pos_str s.Ast.s_pos) ] + | Ast.Continue -> [ Printf.sprintf "%s CONTINUE" (pos_str s.Ast.s_pos) ] + | Ast.DoWhile { body; cond } -> + Printf.sprintf "%s DO" (pos_str s.Ast.s_pos) :: indent_block body + @ [ Printf.sprintf "%s WHILE %s" (pos_str s.Ast.s_pos) (expr_str cond) ] (* [header; body statements...] — body lines are already indented two spaces; callers nesting this under a class add one more level of indent uniformly, same as before Task 5. *) +(* `pub` (haxe-parity Task 1, modules) prefixes the header when set; a + plain (non-pub) declaration renders byte-identical to every + pre-Task-1 golden fixture — this is additive, never a reformat of + the unmarked case. *) +let pub_prefix (pub : bool) : string = if pub then "PUB " else "" + let dump_method (m : Ast.method_decl) : string list = - let header = Printf.sprintf "%s METHOD %s" (pos_str m.pos) (sig_str m.name m.params m.ret) in + let header = + Printf.sprintf "%s %sMETHOD %s" (pos_str m.pos) (pub_prefix m.pub) (sig_str m.name m.params m.ret) + in let body_lines = List.concat_map (fun s -> List.map (fun l -> " " ^ l) (dump_stmt s)) m.body in header :: body_lines @@ -261,24 +309,56 @@ let annotations_header (is_gc : bool) (table : Ast.table_cfg option) : string = in gc_part ^ table_part +(* haxe-parity Task 2: `CONST NAME = ` — top-level or (bare) + class-level. *) +let dump_const (c : Ast.const_decl) : string = + Printf.sprintf "%s CONST %s = %s" (pos_str c.pos) c.name (expr_str c.value) + let dump_class (c : Ast.class_decl) : string list = - let kw = if c.is_class then "CLASS" else "TYPE" in + let kw = if c.is_record then "TYPEDEF" else if c.is_class then "CLASS" else "TYPE" in let header = - Printf.sprintf "%s %s %s%s" (pos_str c.pos) kw c.name (annotations_header c.is_gc c.table) + Printf.sprintf "%s %s%s %s%s" (pos_str c.pos) (pub_prefix c.pub) kw c.name + (annotations_header c.is_gc c.table) in let field_lines = List.map (fun f -> " " ^ dump_field f) c.fields in + let const_lines = List.map (fun cd -> " " ^ dump_const cd) c.consts in let method_lines = List.concat_map (fun m -> List.map (fun l -> " " ^ l) (dump_method m)) c.methods in - (header :: field_lines) @ method_lines + (header :: field_lines) @ const_lines @ method_lines let dump_interface (i : Ast.interface_decl) : string list = - let header = Printf.sprintf "%s INTERFACE %s" (pos_str i.pos) i.name in + let header = Printf.sprintf "%s %sINTERFACE %s" (pos_str i.pos) (pub_prefix i.pub) i.name in let method_lines = List.map (fun m -> " " ^ dump_method_sig m) i.methods in header :: method_lines +(* USE , segments joined by '/' exactly as written in source + (`use shared/util` -> "shared/util") — no resolution performed here, + this is a syntax-level dump like every other dump_* function. *) +let dump_use (u : Ast.use_decl) : string list = + [ Printf.sprintf "%s USE %s" (pos_str u.pos) (String.concat "/" u.segments) ] + +(* UNION Name = A | B(f: T) — one line, variants rendered inline the + same "readable enough to eyeball" way expr_str renders expressions + (haxe-parity Task 4). *) +let dump_union (u : Ast.union_decl) : string list = + let variant_str (v : Ast.variant_decl) = + match v.Ast.v_fields with + | [] -> v.Ast.v_name + | fs -> + Printf.sprintf "%s(%s)" v.Ast.v_name + (String.concat ", " + (List.map (fun (n, ty) -> Printf.sprintf "%s: %s" n (field_ty_str ty)) fs)) + in + [ Printf.sprintf "%s %sUNION %s = %s" (pos_str u.Ast.pos) (pub_prefix u.Ast.pub) u.Ast.name + (String.concat " | " (List.map variant_str u.Ast.variants)) + ] + let dump_decl : Ast.decl -> string list = function | Ast.Class c -> dump_class c | Ast.Interface i -> dump_interface i | Ast.Fn f -> dump_method f + | Ast.Const c -> [ dump_const c ] + | Ast.Use u -> dump_use u + | Ast.Union u -> dump_union u let dump_ast (prog : Ast.program) : string = let lines = List.concat_map dump_decl prog.decls in @@ -413,6 +493,8 @@ let dump_owner (t : Owner.tables) : string = | Owner.DBranchJoin label -> Printf.sprintf "%s JOIN-DROP %s %s" pos label (drop_items_str d.Owner.dr_items) | Owner.DLiveMask -> Printf.sprintf "%s LIVE-MASK %s" pos (drop_items_str d.Owner.dr_items) + | Owner.DBreak -> Printf.sprintf "%s BREAK %s" pos (drop_items_str d.Owner.dr_items) + | Owner.DContinue -> Printf.sprintf "%s CONTINUE %s" pos (drop_items_str d.Owner.dr_items) in let rc_line (r : Owner.rc_site) = Printf.sprintf "%s %s %s %s" (owner_pos_str r.Owner.rc_pos) diff --git a/compiler/src/emit.ml b/compiler/src/emit.ml index 74ed96c..97e8696 100644 --- a/compiler/src/emit.ml +++ b/compiler/src/emit.ml @@ -137,6 +137,16 @@ let unguardable_code = Diag.emitter_prefix ^ "04" (nothing declared, nothing to contradict `Int`). *) let entry_return_code = Diag.emitter_prefix ^ "05" +(* WO-E406 (haxe-parity Task 1, modules) — a call through a reserved + stdlib alias (`use fs`/`proc`/`net`/`time`/`json`/`env`) survived + typechecking (types.ml accepts it as UNKNOWN-BUT-RESERVED: no + E207/E225/arity check, since the six namespaces' members arrive in + plan 9) and reached emission. There is nothing to lower it to yet — + no signature, no builtin id — so this is the one place that still + says so, and only if such a call actually survives this far; `use fs` + declared and never called never reaches this code at all. *) +let stdlib_not_linked_code = Diag.emitter_prefix ^ "06" + (* ============================================================ Format constants (mirror of runtime/src/wob.h — never diverge) ============================================================ *) @@ -195,6 +205,19 @@ let b_map_new = 9 let b_map_set = 10 let b_map_get = 11 let b_map_has = 12 +(* haxe-parity Task 2: the one fenced VM addition this task takes — + string interpolation's Int-to-Text conversion (`"${count} lines"`). + runtime/src/wob.h WO_B_INT_TO_TEXT = 13. *) +let b_int_to_text = 13 + +(* haxe-parity Task 4: the one fenced VM addition of the enum-payload + work — reads a variant object's tag (the object header's own + class_id; docs/plan/oop-vm/00-wob-format.md "enum payload variants") + so a switch over a payload union can compare tags without a per-arm + allocation. runtime/src/wob.h WO_B_VARIANT_TAG = 14. Compiler- + internal: never a source-callable name (not in is_builtin_name / + types.ml's builtin_signatures — 08-builtin-surface.md is unchanged). *) +let b_variant_tag = 14 let ins_abc op a b c = op lor (a lsl 8) lor (b lsl 16) lor (c lsl 24) let ins_abx op a bx = op lor (a lsl 8) lor (bx lsl 16) @@ -321,6 +344,38 @@ type pctx = { lookup, never in the emitted table *) p_method_id : int SM.t; p_methods : methrec array; + (* haxe-parity Task 1 (modules): file -> that file's own `use` edges. + Front-door module visibility is already fully decided by + types.ml's check_modules before the emitter ever runs — this + exists only for the two things emission itself still needs to + know: (1) a stdlib-reserved alias reaching a real call site here + is WO-E406 (nothing to lower it to, see that code's doc comment), + and (2) which alias names a project module at all (as opposed to a + receiver expression), so a qualified call can be resolved against + that module's own symbols below rather than p_syms' flat merge. *) + p_uses : (string, Types.use_edge list) Hashtbl.t; + (* haxe-parity Task 1 (modules), CRITICAL 1 review fix: p_syms.free_fns + is one flat table, first-wins merged across the *whole* discovered + tree regardless of module (main.ml's merge_symbols, unchanged by + this task) — exactly right for `main`/every other pre-Task-1 + lookup, and exactly wrong the instant two different modules declare + a same-named `pub fn` and a qualified call means to pick between + them: the flat merge already silently dropped one, so looking a + qualified call's callee up there can return the *wrong module's* + body no matter how carefully the call site names its alias. A + qualified call therefore resolves through *this* table instead — + module id -> that module's own, unmerged-with-anyone-else `symbols` + (built by Types.module_symbols, the same per-module grouping + types.ml's own resolver uses) — never through p_syms for that one + purpose. `p_module_of` (file -> module id) is what turns a bare + call's *own* file into the same key, so an own-module bare call to + a name that happens to collide with some other module's same-named + `pub fn` resolves correctly too (see free_fn_key's doc comment). *) + p_module_syms : (string, Types.symbols) Hashtbl.t; + p_module_of : string -> string; + (* every free-fn name declared by more than one distinct module — see + free_fn_key's doc comment. *) + p_colliding : (string, unit) Hashtbl.t; (* constant pool, deduplicated *) p_kints : (int, int) Hashtbl.t; p_ktexts : (string, int) Hashtbl.t; @@ -352,6 +407,22 @@ let const_text (p : pctx) (s : string) : int = Per-method lowering state ============================================================ *) +(* haxe-parity Task 2: one enclosing loop's own backpatch lists. + `break`/`continue` inside the loop's body emit a blind `JMP 0` at + their own site (their own drops already ran, from Owner's + v_break/v_continue tables) and record that instruction's pc here; + the loop that pushed this frame patches every recorded pc once it + knows the real target — `lf_breaks` always to "right after the whole + loop" (same target `JZ`'s own exit uses), `lf_continues` to wherever + *that* loop shape re-enters its own condition check (`while`: the + top; `for`: right before the increment; `do...while`: right before + the condition). *) +type loop_frame = { + lf_node : int; + mutable lf_breaks : int list; + mutable lf_continues : int list; +} + type fstate = { f_file : string; f_fn : string; @@ -395,6 +466,13 @@ type fstate = { when the last instruction is not a terminator. *) mutable f_maxjmp : int; mutable f_over : bool; (* WO-E401 already reported for this method *) + (* haxe-parity Task 2: innermost-first stack of enclosing loop + backpatch frames — see loop_frame's own doc comment. Empty outside + any loop, which is exactly how emit_break/emit_continue detect a + `break`/`continue` with no legal target (WO-E403, "cannot lower" — + the same convention as every other construct nothing upstream + tracks loop nesting to reject earlier). *) + mutable f_loops : loop_frame list; } (* ---- per-unit views of the four owner tables ---- *) @@ -404,6 +482,12 @@ type views = { v_scope : (int * string, Owner.drop_item list) Hashtbl.t; v_join : (int * string, Owner.drop_item list) Hashtbl.t; v_return : (int, Owner.drop_item list) Hashtbl.t; + (* haxe-parity Task 2: DBreak/DContinue's own views, by the + break/continue statement's own node id — mirrors v_return exactly, + just bounded to the enclosing loop instead of the whole function + (owner.ml's live_holders_upto). *) + v_break : (int, Owner.drop_item list) Hashtbl.t; + v_continue : (int, Owner.drop_item list) Hashtbl.t; v_overwrite : (int, unit) Hashtbl.t; v_mask : (int, Owner.drop_item list) Hashtbl.t; (* holder decl nodes: every declaring node the DROPS table ever names. @@ -426,7 +510,8 @@ type views = { let build_views (t : Owner.tables) : views = let v = { v_move = Hashtbl.create 16; v_scope = Hashtbl.create 16; v_join = Hashtbl.create 16; - v_return = Hashtbl.create 16; v_overwrite = Hashtbl.create 16; v_mask = Hashtbl.create 16; + v_return = Hashtbl.create 16; v_break = Hashtbl.create 16; v_continue = Hashtbl.create 16; + v_overwrite = Hashtbl.create 16; v_mask = Hashtbl.create 16; v_holder = Hashtbl.create 16; v_rc = Hashtbl.create 16; v_res = Hashtbl.create 16; v_res_used = Hashtbl.create 16 } in @@ -443,6 +528,8 @@ let build_views (t : Owner.tables) : views = | Owner.DScope label -> Hashtbl.replace v.v_scope (d.Owner.dr_node, label) items | Owner.DBranchJoin label -> Hashtbl.replace v.v_join (d.Owner.dr_node, label) items | Owner.DReturn -> Hashtbl.replace v.v_return d.Owner.dr_node items + | Owner.DBreak -> Hashtbl.replace v.v_break d.Owner.dr_node items + | Owner.DContinue -> Hashtbl.replace v.v_continue d.Owner.dr_node items | Owner.DOverwrite -> Hashtbl.replace v.v_overwrite d.Owner.dr_node () | Owner.DLiveMask -> Hashtbl.replace v.v_mask d.Owner.dr_node items) t.Owner.drops; @@ -634,6 +721,62 @@ let field_of (p : pctx) (cid : int) (fname : string) : (int * Ast.field_ty) opti let free_fn (p : pctx) (n : string) : Types.free_fn_info option = Types.StringMap.find_opt n p.p_syms.Types.free_fns +(* haxe-parity Task 1 (modules): is `alias` one of file `f_file`'s own + `use` edges? Returns the edge so the caller can tell stdlib apart + from a project module (Types.use_edge.ue_is_stdlib). *) +let use_edge_for (p : pctx) ~(file : string) (alias : string) : Types.use_edge option = + match Hashtbl.find_opt p.p_uses file with + | None -> None + | Some edges -> List.find_opt (fun (u : Types.use_edge) -> u.Types.ue_alias = alias) edges + +(* haxe-parity Task 1 (modules), CRITICAL 1 review fix: computed once per + `emit` call (below) and threaded through pctx (p_colliding) rather + than kept as an `emit`-local, since free_fn_key (right below) is + needed by emit_call, part of the emit_expr/emit_call mutually + recursive group defined further down this file — a plain local to + `emit` (itself defined at the bottom of the file) would not be in + scope there. A name collides when more than one *distinct* module + declares a free fn with that exact name; only possible now that + modules exist at all (pre-Task-1, every discovered file was one flat + namespace, so this table is always empty for any program that + predates `use`). *) +let compute_colliding_fn_names ~(module_of : string -> string) (units : input list) : + (string, unit) Hashtbl.t = + let fn_modules : (string, (string, unit) Hashtbl.t) Hashtbl.t = Hashtbl.create 32 in + List.iter + (fun u -> + List.iter + (function + | Ast.Fn (m : Ast.method_decl) -> + let mid = module_of u.file in + let mods = + match Hashtbl.find_opt fn_modules m.name with + | Some t -> t + | None -> + let t = Hashtbl.create 2 in + Hashtbl.replace fn_modules m.name t; + t + in + Hashtbl.replace mods mid () + | Ast.Class _ | Ast.Interface _ | Ast.Use _ | Ast.Const _ | Ast.Union _ -> ()) + u.prog.decls) + units; + let colliding : (string, unit) Hashtbl.t = Hashtbl.create 8 in + Hashtbl.iter (fun name mods -> if Hashtbl.length mods >= 2 then Hashtbl.replace colliding name ()) fn_modules; + colliding + +(* A free fn's method-table key: its plain name, unless that name + collides across modules, in which case it's `"#"` — the + same composite-key idea class methods already use (`"Class.method"`). + Every free-fn method-table key, on both the build side (emit's own + pass 2, before `p : pctx` even exists yet — hence taking the raw + `colliding` table rather than `p`) and the lookup side (emit_call, via + `p.p_colliding`) goes through this now, so a non-colliding name + (everything before this task, and the overwhelming majority after it) + is completely unaffected — same plain key as always. *) +let free_fn_key (colliding : (string, unit) Hashtbl.t) (mid : string) (name : string) : string = + if Hashtbl.mem colliding name then mid ^ "#" ^ name else name + let class_method (p : pctx) (cname : string) (m : string) : Types.method_info option = match Types.StringMap.find_opt cname p.p_syms.Types.classes with | None -> None @@ -661,6 +804,7 @@ let iface_method (p : pctx) (iname : string) (m : string) : (int * Types.method_ let builtin_ret (name : string) (argty : Ast.field_ty option) : Ast.field_ty option = match name with + | "int_to_text" -> Some (Scalar "Text") | "now" -> Some (Scalar "Timestamp") | "print" | "print_int" | "push" | "set" -> Some (Scalar "Int") | "words" | "count" -> Some (Scalar "Int") @@ -675,14 +819,53 @@ let builtin_ret (name : string) (argty : Ast.field_ty option) : Ast.field_ty opt let is_builtin_name (n : string) = List.mem n [ "now"; "print"; "print_int"; "words"; "multi_new"; "push"; "get"; "count"; "latest"; - "map_new"; "set"; "has" ] + "map_new"; "set"; "has"; "int_to_text" ] + +(* ---- unions and variants (haxe-parity Task 4) ------------------------ + + All read straight off p_syms (types.ml's own tables) — the emitter + derives nothing types.ml already knows. A payload union's variants + each have a compiler-generated class-table entry keyed + "." in p_class_id (built in emit's pass 1, below; + idents can never contain a dot, so the composite key cannot collide + with a source-declared class — the same mangling convention + "Class.method" already uses in the method table). An all-bare union + has no entries at all: its variants ARE their ordinals. *) +let find_union (p : pctx) (n : string) : Types.union_info option = + Types.StringMap.find_opt n p.p_syms.Types.unions + +let find_variant (p : pctx) (n : string) : (Types.union_info * Types.variant_info) option = + Types.find_variant p.p_syms n + +let variant_class_key (u : Types.union_info) (vi : Types.variant_info) : string = + u.Types.u_name ^ "." ^ vi.Types.vi_name + +(* the runtime tag a case pattern / bare reference compares or loads: + the class-table id for a payload union's variant (the object header's + class_id — the format doc's variant convention), the ordinal for an + all-bare union's. *) +let variant_tag_value (p : pctx) (u : Types.union_info) (vi : Types.variant_info) : int = + if u.Types.u_has_payload then + match SM.find_opt (variant_class_key u vi) p.p_class_id with + | Some cid -> cid + | None -> 0 (* unreachable: pass 1 registers every payload-union variant *) + else vi.Types.vi_tag let rec ty_of_expr (p : pctx) (f : fstate) (e : Ast.expr) : Ast.field_ty option = match e.kind with | IntLit _ -> Some (Scalar "Int") | StrLit _ -> Some (Scalar "Text") | BoolLit _ -> Some (Scalar "Bool") - | Ident n -> ( match List.assoc_opt n f.f_env with Some (_, t) -> Some t | None -> None) + | Ident n -> ( + match List.assoc_opt n f.f_env with + | Some (_, t) -> Some t + | None -> ( + (* haxe-parity Task 4: a bare variant reference types as its + union; locals/params always won above, so a shadowing binding + is never mistaken for a variant. *) + match find_variant p n with + | Some (u, _) -> Some (Scalar u.Types.u_name) + | None -> None)) | Field (base, fname) -> ( match ty_of_expr p f base with | Some bt -> ( @@ -700,12 +883,29 @@ let rec ty_of_expr (p : pctx) (f : fstate) (e : Ast.expr) : Ast.field_ty option | Call (callee, args) -> ( match callee.kind with | Ident n -> ( - match free_fn p n with + (* haxe-parity Task 1 (modules), CRITICAL 1 review fix: own module + first — see emit_call's identical fix for why p_syms' flat merge + is the wrong table once two modules can share a free-fn name. *) + let own_mid = p.p_module_of f.f_file in + let own_fi = + match Hashtbl.find_opt p.p_module_syms own_mid with + | Some msyms -> Types.StringMap.find_opt n msyms.Types.free_fns + | None -> None + in + match own_fi with | Some fi -> fi.Types.ret - | None -> - if is_builtin_name n then - builtin_ret n (match args with a :: _ -> ty_of_expr p f a | [] -> None) - else None) + | None -> ( + match free_fn p n with + | Some fi -> fi.Types.ret + | None -> ( + (* haxe-parity Task 4: variant construction — the call's value + is the union's own type (a fresh variant object). *) + match find_variant p n with + | Some (u, _) -> Some (Scalar u.Types.u_name) + | None -> + if is_builtin_name n then + builtin_ret n (match args with a :: _ -> ty_of_expr p f a | [] -> None) + else None))) | Field (base, mname) -> ( match ty_of_expr p f base with | Some bt -> ( @@ -715,16 +915,96 @@ let rec ty_of_expr (p : pctx) (f : fstate) (e : Ast.expr) : Ast.field_ty option | Some mi -> mi.Types.ret | None -> ( match iface_method p cn mname with Some (_, sg) -> sg.Types.ret | None -> None)) | _ -> None) - | None -> None) + | None -> ( + (* base didn't resolve as a value at all (no local/param/self + named that) — a qualified free-fn call through a `use` alias + (haxe-parity Task 1) has exactly this shape; a genuine + receiver is always caught by the `Some bt` arm above, so + locals/params still shadow a same-named alias here too. *) + match base.kind with + | Ident alias -> ( + match use_edge_for p ~file:f.f_file alias with + | Some u when u.Types.ue_is_stdlib -> None (* nothing to infer a return type from yet *) + | Some u -> ( + let target_mid = Types.path_str u.Types.ue_segments in + match Hashtbl.find_opt p.p_module_syms target_mid with + | Some msyms -> ( + match Types.StringMap.find_opt mname msyms.Types.free_fns with + | Some fi -> fi.Types.ret + | None -> None) + | None -> None) + | None -> None) + | _ -> None)) | _ -> None) | Unary (Neg, o) -> ty_of_expr p f o | Binary (op, l, _) -> ( match op with | Concat -> Some (Scalar "Text") - | Eq | Ne | Lt | Le | Gt | Ge -> Some (Scalar "Bool") + | Eq | Ne | Lt | Le | Gt | Ge | And | Or -> Some (Scalar "Bool") | Add | Sub | Mul | Div | Mod -> ( match ty_of_expr p f l with Some t -> Some t | None -> Some (Scalar "Int"))) | Ctor (cn, _) -> Some (Scalar cn) + | Interp _ -> Some (Scalar "Text") | DbStub _ -> None + | Switch (subject, arms) -> ( + (* haxe-parity Task 3: mirrors types.ml's own `typecheck_switch` — + the first arm's type wins (types.ml already proved every other + arm agrees, or reported WO-E201 if not) — but derived through + this file's own, narrower `ty_of_expr` rather than duplicating + that pass. Needed for real, not a "not chased" placeholder like + `Index`/`Binary` above: this is what tells `Let`'s own emission + (below) whether a `let v = switch ... { case ...: "text"; ... }` + with no `: Type` annotation holds `Text` or `Int` — get it + wrong and a later `${v}` interpolation calls `int_to_text` on a + Text register, or an `==` picks EQ over EQS. + + Task 4 fix round 1 (review Critical 1b): an arm yielding its own + payload BINDING (`case Boxed(b): b;`) types as the binding's + declared field type — the binding is not in f_env at derivation + time (it exists only while the arm's own body is emitted), so + the plain recursive call returned None and the Int fallback + broke legal code downstream (`field access on Int`). Mirrors + owner.ml's binding_ty_of_arm. *) + match arms with + | [] -> None + | first :: _ -> ( + match List.rev first.body with + | { s_kind = ExprStmt ve; _ } :: _ -> ( + match ve.kind with + | Ident n -> ( + match emit_binding_ty_of_arm p f subject first n with + | Some fty -> Some fty + | None -> ty_of_expr p f ve) + | _ -> ty_of_expr p f ve) + | _ -> None)) + +(* The declared type of payload binding [n], when [arm]'s pattern binds + it off [subject]'s union — None whenever this is not that shape. + Mirrors owner.ml's binding_ty_of_arm (same convention as every other + mirrored deriver pair between these two files). *) +and emit_binding_ty_of_arm (p : pctx) (f : fstate) (subject : Ast.expr) (arm : Ast.switch_arm) + (n : string) : Ast.field_ty option = + match ty_of_expr p f subject with + | Some (Scalar sn) -> ( + match find_union p sn with + | Some u when u.Types.u_has_payload -> ( + match arm.values with + | [ { kind = Call ({ kind = Ident vname; _ }, bargs); _ } ] -> ( + match + List.find_opt (fun (vi : Types.variant_info) -> vi.Types.vi_name = vname) + u.Types.u_variants + with + | Some vi when List.length bargs = List.length vi.Types.vi_fields -> + let rec zip (args : Ast.expr list) fields = + match (args, fields) with + | { kind = Ident bn; _ } :: _, (_, fty) :: _ when bn = n -> Some fty + | _ :: ta, _ :: tf -> zip ta tf + | _ -> None + in + zip bargs vi.Types.vi_fields + | _ -> None) + | _ -> None) + | _ -> None) + | _ -> None let is_text (p : pctx) (f : fstate) (e : Ast.expr) : bool = match ty_of_expr p f e with Some t -> ( match unwrap t with Scalar "Text" -> true | _ -> false) | None -> false @@ -930,10 +1210,24 @@ let rec emit_expr (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e | Ident n -> ( match lookup_local f n with | Some (r, _) -> if r <> dst then put f (ins_abc op_move dst r 0) - | None -> - err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos - ~message:(Printf.sprintf "`%s` is not a local, parameter, or `self` — nothing to load" n); - put f (ins_abx op_loadk dst (const_int p 0))) + | None -> ( + (* haxe-parity Task 4: a bare variant reference. All-bare union: + the value IS the ordinal tag — one LOADK, no heap. Payload + union: every value of the union is a variant object, so even a + bare variant allocates its (zero-field) class — NEW is all it + takes, the header's class_id is the tag. *) + match find_variant p n with + | Some (u, vi) -> + if u.Types.u_has_payload then + put f (ins_abx op_new dst (check_bx p f e.pos "class" (variant_tag_value p u vi))) + else + put f + (ins_abx op_loadk dst + (check_bx p f e.pos "constant" (const_int p vi.Types.vi_tag))) + | None -> + err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos + ~message:(Printf.sprintf "`%s` is not a local, parameter, or `self` — nothing to load" n); + put f (ins_abx op_loadk dst (const_int p 0)))) | Field (base, fname) -> ( match ty_of_expr p f base with | Some bt -> ( @@ -983,10 +1277,35 @@ let rec emit_expr (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e put f (ins_abc op_neg dst b 0) | Binary (op, l, r) -> emit_binary p f v ~dst op l r | Ctor (cn, fields) -> emit_ctor p f v ~dst e cn fields + | Interp inner -> ( + (* haxe-parity Task 2: the type-directed half of the interpolation + desugar (parser.ml's own doc comment on Ast.Interp) — a Text + interpolant passes through untouched; an Int one is wrapped in + the `int_to_text` builtin; anything else has no lowering (the + brief's own scope: "desugar Int-typed expressions", not every + scalar). *) + match ty_of_expr p f inner with + | Some t -> ( + match unwrap t with + | Scalar "Text" -> emit_expr p f v ~dst inner + | Scalar "Int" -> emit_builtin p f v ~dst e "int_to_text" [ inner ] + | other -> + err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos + ~message: + (Printf.sprintf + "cannot interpolate a value of type `%s` in \"${...}\" — only Text and Int are \ + supported" + (Dump.field_ty_str other)); + put f (ins_abx op_loadk dst (const_int p 0))) + | None -> + err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos + ~message:"cannot resolve the interpolated expression's type"; + put f (ins_abx op_loadk dst (const_int p 0))) | Call (callee, args) -> emit_call p f v ~dst ?expected e callee args | DbStub _ -> sync_mask p f v e.id; - put f (ins_abc op_db_stub 0 0 0)); + put f (ins_abc op_db_stub 0 0 0) + | Switch (subject, arms) -> emit_switch p f v e ~dst subject arms); Hashtbl.replace f.f_node e.id dst; (* An escaping @gc value takes its increment right where the value lands. owner.ml's gc_escape anchors that acquire on the *place @@ -1066,6 +1385,32 @@ and emit_binary (p : pctx) (f : fstate) (v : views) ~(dst : int) (op : Ast.binop let z = alloc_temp p f pos in put f (ins_abx op_loadk z (check_bx p f pos "constant" (const_int p 0))); put f (ins_abc op_eq dst t z) + | And -> + (* haxe-parity Task 2: short-circuit -- `l`'s own value (0 or 1) + lands directly in `dst`; if it is already false, `r` is never + evaluated at all (the fixture's own proof: a right operand that + would trap, e.g. division by zero, must not run) and `dst` keeps + `l`'s value. Otherwise `r`'s value overwrites `dst`, becoming the + result. Compare-and-jump on the existing JZ opcode, no new one. *) + emit_expr p f v ~dst l; + f.f_cur_line <- pos.line; + let jz = here f in + put f (ins_asbx op_jz dst 0); + emit_expr p f v ~dst r; + patch_jump p f ~file:f.f_file ~pos jz (here f) + | Or -> + (* same shape, the other way: `l` true short-circuits (skip `r`, + keep `l`'s true value); `l` false falls through to `r`. JZ plus + one JMP (to skip `r` on the true path), still no new opcode. *) + emit_expr p f v ~dst l; + f.f_cur_line <- pos.line; + let jz = here f in + put f (ins_asbx op_jz dst 0); + let jmp = here f in + put f (ins_asbx op_jmp 0 0); + patch_jump p f ~file:f.f_file ~pos jz (here f); + emit_expr p f v ~dst r; + patch_jump p f ~file:f.f_file ~pos jmp (here f) | Mod -> (* no MOD opcode either: truncating `a % b` is `a - (a / b) * b`, exact for the VM's truncating DIV (which traps on 0 and on @@ -1077,6 +1422,323 @@ and emit_binary (p : pctx) (f : fstate) (v : views) ~(dst : int) (op : Ast.binop put f (ins_abc op_mul q q b); put f (ins_abc op_sub dst a q) +(* haxe-parity Task 3: compare-and-jump chain on the existing EQ/EQS/ + JZ/JMP opcodes — no new opcode, per the brief. The subject is + evaluated exactly once, into `subj_reg`, and every arm's comparisons + read it; `dst` is where an arm's value lands (mirrors `Binary`'s + own And/Or short-circuit above: the caller's own `dst` is written + directly, no intermediate temp to move out of). + + One case's `values` (the sample's own `case "@daily", "@midnight":` + comma form) chains: value 1's failure falls through to check value + 2; any success jumps straight to the arm body, skipping the rest of + that arm's own checks; the LAST value's failure falls through to the + NEXT ARM's own first check (backpatched once that arm starts emitting, + `pending_fail`). `default` has no checks at all — it always matches + whatever reaches it — which is also why the missing-default case + (already a WO-E208 *error*, so this image is never written — see + main.ml's own has_error gate) still lowers without crashing: the + last real arm's `pending_fail` simply has nowhere to go but the + switch's own exit, same as `end_jumps` below. + + Each arm is its own drop scope: this inlines emit_block's own + save/restore-and-drop shape (`f_nlocals`/`f_env`/`f_declared`, + `emit_scope_drops`, the @gc release group) rather than calling + emit_block outright, because emit_block emits every statement + *generically* — including the last one, which for a value-yielding + arm must land in the caller's `dst`, not a throwaway temp the way + emit_block's own ExprStmt handling (emit_tail) would. An arm whose + body doesn't end in `ExprStmt` (every arm in the sample's own + statement-position switches, which end in `return`) writes nothing + into `dst` — correct either way: statement position discards it + regardless, and expression position already has types.ml's own + WO-E201 for an arm that fails to yield a value (see typecheck_switch's + own doc comment — this file does not re-check that). + + `f.f_div` (this path has returned) mirrors emit_if's own THEN/ELSE + bookkeeping, generalized to N arms: an arm that diverged emits no + trailing jump to the switch's exit and contributes nothing to the + owned/@gc mask merge below (mask_meet, folded pairwise across every + *non*-diverging arm — the N-way generalization of emit_if's own + 2-way `mask_meet f then_owned then_gc` call, same helper, unchanged). + `emit_join_drops` (JOIN-DROP: a value this arm kept but some *other* + arm moved) is owner.ml's own table entry, keyed exactly the way + emit_if's THEN/ELSE already are — `(e.id, "ARM")` here vs. + `(s.s_id, "THEN"/"ELSE")` there — so this is a lookup, not new + logic. *) +(* `~want_value` (Task 4 fix round 1, Critical 1): true everywhere the + switch's value is consumed (a `let`'s value, a `return`, nested in an + expression — every emit_expr path), false only for the discarded + statement position (emit_stmt's own ExprStmt special case, mirroring + types.ml's want_value:false). It gates exactly one thing: the + payload MOVE-OUT below — an arm yielding its own binding nulls the + subject's field only when someone actually takes ownership of the + value; a discarded yield must leave the shell intact or the payload + would leak with nobody left to drop it. *) +and emit_switch ?(want_value = true) (p : pctx) (f : fstate) (v : views) (e : Ast.expr) + ~(dst : int) (subject : Ast.expr) (arms : Ast.switch_arm list) : unit = + let subj_is_text = is_text p f subject in + f.f_cur_line <- subject.pos.line; + let subj_reg = emit_operand p f v subject in + (* `dst` is not always already-reserved the way an ordinary expr's + `dst` is: in statement position (`switch {...}` alone, discarded), + `emit_tail`'s own "allocate then immediately un-reserve" convention + hands this a `dst` that is the *next free* temp/local slot — bug + found by this task's own ASan fixture, not a theoretical worry: an + arm's own `let` (`alloc_local`'s register is `f_nlocals`, entirely + independent of `f_temp`) legitimately picked that same slot, and + the arm's own trailing value-write into `dst` then silently + clobbered the live local sitting there before its DROP ran — a + real, ASan-confirmed leak (RED), not a hypothetical. Reserving + `dst` here, for the whole switch, fixes it at the source rather + than special-casing the discard path: every `alloc_local`/ + `alloc_temp` inside any arm is now guaranteed a register above + `dst`. A `let`-value switch's `dst` is already `< f_nlocals` + (`alloc_local` ran before this function was ever called), so this + is a no-op there — restoring `saved_nlocals` afterward gives back + exactly nothing it did not itself reserve. *) + let saved_nlocals = f.f_nlocals in + if f.f_nlocals <= dst then f.f_nlocals <- dst + 1; + if f.f_temp <= dst then f.f_temp <- dst + 1; + bump f dst; + (* haxe-parity Task 4: a union-typed subject compares variant TAGS. + All-bare union: the subject register already holds the ordinal — + compare it directly, exactly the scalar chain below. Payload union: + read the tag (the object header's class_id) once, via the + variant_tag builtin, and compare that; the subject register itself + stays live into the arm BODIES (payload bindings GETF from it), so + both it and the tag temp are reserved past every arm-local for the + switch's own duration — the same saved_nlocals guard `dst` already + rides, restored in one place below. *) + let subj_union = + match ty_of_expr p f subject with + | Some (Scalar n) -> find_union p n + | _ -> None + in + (* through `?T` too (fix round 1) — for PATTERN RECOGNITION only. A + `?Union` subject with variant cases is already a hard WO-E201 + upstream (types.ml), so no image carrying this lowering is ever + written; recognizing the patterns anyway (tag constants instead of + expression evaluation, bindings bound) keeps the emitter from + cascading misleading "`m` is not a local" errors on top of the real + diagnostic. Tag reads (variant_tag) and the payload move-out keep + gating on the EXACT `subj_union` above — never nullable-unwrapped. *) + let subj_union_deep = + match subj_union with + | Some _ as u -> u + | None -> ( + match ty_of_expr p f subject with + | Some t -> ( match unwrap t with Scalar n -> find_union p n | _ -> None) + | None -> None) + in + let cmp_reg = + match subj_union with + | Some u when u.Types.u_has_payload -> + if f.f_nlocals <= subj_reg then f.f_nlocals <- subj_reg + 1; + if f.f_temp <= subj_reg then f.f_temp <- subj_reg + 1; + let t = alloc_temp p f subject.pos in + f.f_cur_line <- subject.pos.line; + put f (ins_abc op_builtin t subj_reg b_variant_tag); + if f.f_nlocals <= t then f.f_nlocals <- t + 1; + t + | _ -> subj_reg + in + (* the tag constant a case pattern compares against, or None for the + plain-value path (non-union subjects; also a malformed pattern over + a union — already diagnosed upstream, WO-E201/E203, so no image is + ever written — which falls back to the value path rather than + crashing the serializer). *) + let union_case_tag (value_e : Ast.expr) : int option = + match subj_union_deep with + | None -> None + | Some u -> ( + let vname = + match value_e.Ast.kind with + | Ast.Ident n -> Some n + | Ast.Call ({ Ast.kind = Ast.Ident n; _ }, _) -> Some n + | _ -> None + in + match vname with + | None -> None + | Some n -> ( + match + List.find_opt (fun (vi : Types.variant_info) -> vi.Types.vi_name = n) u.Types.u_variants + with + | Some vi -> Some (variant_tag_value p u vi) + | None -> None)) + in + let switch_temp_base = f.f_temp in + let entry_owned = f.f_owned and entry_gc = f.f_gc in + let div0 = f.f_div in + let pending_fail = ref [] in + let end_jumps = ref [] in + let arm_results = ref [] in + (* review fix, Critical 1: `default` has no comparison of its own — + it matches unconditionally — so lowering the arms in raw *source* + order made any `case` arm written after a `default` permanently + unreachable dead code (reviewer-reproduced: `default` first, + `case 2` after it, `classify(2)` returned the `default` value). + `Ast.switch_lowering_order` moves `default` to the end before the + chain is built; owner.ml's `analyze_switch` walks the identical + order so the "ARM" labels the two files hand each other over + the drop-scope/JOIN-DROP tables never drift apart. *) + List.iteri + (fun i (arm : Ast.switch_arm) -> + let label = Printf.sprintf "ARM%d" i in + List.iter + (fun pc -> patch_jump p f ~file:f.f_file ~pos:arm.Ast.arm_pos pc (here f)) + !pending_fail; + pending_fail := []; + f.f_owned <- entry_owned; + f.f_gc <- entry_gc; + f.f_div <- div0; + f.f_temp <- switch_temp_base; + (if not arm.Ast.is_default then begin + let n = List.length arm.Ast.values in + let to_body = ref [] in + List.iteri + (fun j (value_e : Ast.expr) -> + f.f_cur_line <- value_e.Ast.pos.line; + let b = + match union_case_tag value_e with + | Some tagv -> + (* a variant pattern never evaluates as an expression — + its tag constant is loaded directly (a payload + pattern lowered through emit_operand would NEW a + fresh object and compare pointers: always false) *) + let tb = alloc_temp p f value_e.Ast.pos in + put f + (ins_abx op_loadk tb + (check_bx p f value_e.Ast.pos "constant" (const_int p tagv))); + tb + | None -> emit_operand p f v value_e + in + let t = alloc_temp p f value_e.Ast.pos in + put f (ins_abc (if subj_is_text then op_eqs else op_eq) t cmp_reg b); + let jz = here f in + put f (ins_asbx op_jz t 0); + if j < n - 1 then begin + let jmp = here f in + put f (ins_asbx op_jmp 0 0); + patch_jump p f ~file:f.f_file ~pos:value_e.Ast.pos jz (here f); + to_body := jmp :: !to_body + end + else pending_fail := jz :: !pending_fail) + arm.Ast.values; + let body_start = here f in + List.iter + (fun pc -> patch_jump p f ~file:f.f_file ~pos:arm.Ast.arm_pos pc body_start) + !to_body + end); + let saved_locals = f.f_nlocals in + let saved_env = f.f_env in + let saved_decls = f.f_declared in + (* haxe-parity Task 4: payload bindings — GETF the variant object's + fields into fresh arm-locals before the body runs. Plain + registers holding borrows of the subject's own fields: never in + a drop set (owner.ml declares them l_holds = false), undone by + the same env/locals restore every arm already gets. *) + let arm_binds = ref [] in + (match subj_union_deep with + | Some u when u.Types.u_has_payload -> ( + match arm.Ast.values with + | [ { Ast.kind = Ast.Call ({ Ast.kind = Ast.Ident vname; _ }, bargs); _ } ] -> ( + match + List.find_opt + (fun (vi : Types.variant_info) -> vi.Types.vi_name = vname) + u.Types.u_variants + with + | Some vi when List.length bargs = List.length vi.Types.vi_fields -> + List.iteri + (fun idx (barg : Ast.expr) -> + match barg.Ast.kind with + | Ast.Ident bn -> + let _, fty = List.nth vi.Types.vi_fields idx in + let r = alloc_local p f barg.Ast.pos in + f.f_cur_line <- barg.Ast.pos.line; + put f (ins_abc op_getf r subj_reg (check_field_idx p f barg.Ast.pos idx)); + f.f_env <- (bn, (r, fty)) :: f.f_env; + arm_binds := (bn, r, idx, fty) :: !arm_binds + | _ -> ()) + bargs + | _ -> ()) + | _ -> ()) + | _ -> ()); + (match List.rev arm.Ast.body with + | [] -> () + | last :: rev_init -> + List.iter (emit_stmt p f v) (List.rev rev_init); + (match last.Ast.s_kind with + | Ast.ExprStmt ve -> + stmt_reset f; + f.f_cur_line <- last.Ast.s_pos.line; + emit_expr p f v ~dst ve; + (* Task 4 fix round 1 (Critical 1a/1c): the arm yields its own + payload binding — a MOVE OUT of the variant object. The + payload pointer just landed in `dst` (its new owner's + register); null the shell's field so the shell's ordinary + recursive drop plan — which already skips zero slots + (runtime/src/gc.c wo_drop_kind) — frees the shell only, + never the escaped payload. Without this, the subject's + scope-end drop and the new owner's drop both freed the + payload: a real reviewer-reproduced double free. Gated on + `want_value` (a discarded yield must leave the shell whole) + and on the name still resolving to the BINDING's own + register (an arm-local `let` shadowing the binding is an + ordinary yield, not an escape). + + Fix round 2: pointer-kind payload fields ONLY. Escaping a + SCALAR field (Int/Bool/Timestamp/Id/ref, a bare-union tag) + is a COPY — there is no ownership to move, nothing the + shell's drop plan would double-free, and the SETF-0 was + indistinguishable from a legitimate 0: the reviewer's m3d + probe re-switched the same subject and read 0 where 5 + lived. Kind 0 is WO_K_SCALAR (runtime/src/wob.h). *) + (if want_value then + match ve.Ast.kind with + | Ast.Ident n -> ( + match List.find_opt (fun (bn, _, _, _) -> bn = n) !arm_binds with + | Some (_, breg, fidx, bfty) + when (match lookup_local f n with Some (r, _) -> r = breg | None -> false) + && field_kind p bfty <> 0 -> + let save = f.f_temp in + let z = alloc_temp p f ve.Ast.pos in + put f (ins_abx op_loadk z (check_bx p f ve.Ast.pos "constant" (const_int p 0))); + put f (ins_abc op_setf subj_reg (check_field_idx p f ve.Ast.pos fidx) z); + f.f_temp <- save + | _ -> ()) + | _ -> ()); + (match Hashtbl.find_opt v.v_move ve.id with + | Some place -> ( match lookup_local f place with Some (sr, _) -> mask_clear f sr | None -> ()) + | None -> ()) + | _ -> emit_stmt p f v last)); + emit_scope_drops p f v ~node:e.id ~label; + emit_rc p f v ~node:e.id ~acquire:false ~groups:(declared_since f saved_decls) (); + f.f_nlocals <- saved_locals; + f.f_env <- saved_env; + f.f_declared <- saved_decls; + f.f_temp <- saved_locals; + emit_join_drops p f v ~node:e.id ~label; + (if not f.f_div then begin + f.f_cur_line <- arm.Ast.arm_pos.line; + let pc = here f in + put f (ins_asbx op_jmp 0 0); + end_jumps := pc :: !end_jumps + end); + arm_results := (f.f_owned, f.f_gc, f.f_div) :: !arm_results) + (Ast.switch_lowering_order arms); + let exit_pc = here f in + List.iter (fun pc -> patch_jump p f ~file:f.f_file ~pos:e.pos pc exit_pc) !pending_fail; + List.iter (fun pc -> patch_jump p f ~file:f.f_file ~pos:e.pos pc exit_pc) !end_jumps; + f.f_nlocals <- saved_nlocals; + match List.filter (fun (_, _, d) -> not d) (List.rev !arm_results) with + | [] -> f.f_div <- true + | (o0, g0, _) :: rest -> + f.f_owned <- o0; + f.f_gc <- g0; + List.iter (fun (o, g, _) -> mask_meet f o g) rest; + f.f_div <- div0 + and emit_ctor (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) (cn : string) (fields : (string * Ast.expr) list) : unit = match class_of_name p cn with @@ -1086,6 +1748,15 @@ and emit_ctor (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) (c put f (ins_abx op_loadk dst (const_int p 0)) | Some cid -> put f (ins_abx op_new dst (check_bx p f e.pos "class" cid)); + (* dst holds the live object pointer every SETF below reads -- but + in tail position (`return Box{...}`, emit_tail's allocate-then- + un-reserve convention) dst sits AT f_temp, so the field-value + temp would be dst itself and the value-write would clobber the + pointer before SETF reads it (NEW r0; LOADK r0; SETF r0,f0,r0 -- + an int64 stored through as a heap pointer). Reserve dst past the + field loop; same guard emit_switch uses for its placeholder dst. *) + let outer = f.f_temp in + if f.f_temp <= dst then f.f_temp <- dst + 1; List.iter (fun ((fname : string), (fe : Ast.expr)) -> match field_of p cid fname with @@ -1104,7 +1775,109 @@ and emit_ctor (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) (c f.f_cur_line <- fe.pos.line; put f (ins_abc op_setf dst (check_field_idx p f e.pos idx) t); f.f_temp <- save) - fields + fields; + (* haxe-parity Task 4: fields the literal omitted. A declared + default is emitted and stored (this is what makes `TailState {}` + construct — the sample's own defaults-fill-in pattern); a + `?`-typed field with no default stays the zero word NEW left + (nil-by-shape). Appended AFTER the provided-field loop, never + interleaved, so a literal that provides every field emits + byte-identical code to before this task. A field that is neither + provided, defaulted, nor nullable was already WO-E206 upstream — + no image is written, so no arm is needed here. *) + (match Types.StringMap.find_opt cn p.p_syms.Types.classes with + | None -> () + | Some (ci : Types.class_info) -> + let provided = List.map fst fields in + List.iter + (fun (fname, _, fdefault, _) -> + match fdefault with + | Some d when not (List.mem fname provided) -> ( + match field_of p cid fname with + | None -> () + | Some (idx, fty) -> + let save = f.f_temp in + let t = alloc_temp p f e.pos in + emit_default_value p f ~dst:t ~fty ~pos:e.pos d; + f.f_cur_line <- e.pos.line; + put f (ins_abc op_setf dst (check_field_idx p f e.pos idx) t); + f.f_temp <- save) + | _ -> ()) + ci.Types.fields); + f.f_temp <- outer + +(* The default expressions the emitter can lower (haxe-parity Task 4): + the literal shapes the sample's own typedefs use — Int (optionally + negated), Text, Bool, `now()` (parse_default_expr's own recognized + case), and `[]` (an empty container, kinds from the field's declared + type — the same container_imm rule multi_new/map_new already + follow). A default is an opaque token span by design (ast.ml), so + anything richer is WO-E403 — a diagnostic, never invented bytecode. *) +and emit_default_value (p : pctx) (f : fstate) ~(dst : int) ~(fty : Ast.field_ty) + ~(pos : Ast.pos) (d : Ast.default_expr) : unit = + let bad () = + err p ~code:cannot_lower_code ~file:f.f_file ~pos + ~message: + "cannot lower this field default — only Int/Text/Bool literals, `now()`, and `[]` are \ + supported"; + put f (ins_abx op_loadk dst (const_int p 0)) + in + match d with + | Ast.DefaultNow -> put f (ins_abc op_builtin dst dst b_now) + | Ast.DefaultOpaque toks -> ( + match List.map (fun (t : Token.t) -> t.Token.kind) toks with + | [ Token.Int n ] -> put f (ins_abx op_loadk dst (check_bx p f pos "constant" (const_int p n))) + | [ Token.Dash; Token.Int n ] -> + put f (ins_abx op_loadk dst (check_bx p f pos "constant" (const_int p (-n)))) + | [ Token.Str s ] -> put f (ins_abx op_loadk dst (check_bx p f pos "constant" (const_text p s))) + | [ Token.KwTrue ] -> put f (ins_abx op_loadk dst (const_int p 1)) + | [ Token.KwFalse ] -> put f (ins_abx op_loadk dst (const_int p 0)) + | [ Token.LBracket; Token.RBracket ] -> ( + match container_imm p (Some fty) (match unwrap fty with Map _ -> true | _ -> false) with + | Some imm -> + put f + (ins_abc op_builtin dst imm + (match unwrap fty with Map _ -> b_map_new | _ -> b_multi_new)) + | None -> bad ()) + | _ -> bad ()) + +(* haxe-parity Task 4: variant construction (`Failed("boom")`). NEW of + the variant's own class (its id IS the tag — the header carries it, + nothing else to set), then positional SETFs, exactly a constructor + literal with positional instead of named fields. Same dst-reservation + guard as emit_ctor (tail position hands this a dst at f_temp). + Arity was already WO-E203 upstream (types.ml); this keeps the + emitter's own belt-and-braces WO-E403 like every call path does. *) +and emit_variant_ctor (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) + (u : Types.union_info) (vi : Types.variant_info) (args : Ast.expr list) : unit = + if + not + (check_arity p f e + ~what:(Printf.sprintf "variant `%s` of `%s`" vi.Types.vi_name u.Types.u_name) + ~want:(List.length vi.Types.vi_fields) ~got:(List.length args)) + then put f (ins_abx op_loadk dst (const_int p 0)) + else if not u.Types.u_has_payload then + (* a bare-union variant "called" with its zero arguments is the same + value as the bare reference: the ordinal tag *) + put f (ins_abx op_loadk dst (check_bx p f e.pos "constant" (const_int p vi.Types.vi_tag))) + else begin + put f (ins_abx op_new dst (check_bx p f e.pos "class" (variant_tag_value p u vi))); + let outer = f.f_temp in + if f.f_temp <= dst then f.f_temp <- dst + 1; + List.iteri + (fun idx (ae : Ast.expr) -> + match List.nth_opt vi.Types.vi_fields idx with + | None -> () + | Some (_, fty) -> + let save = f.f_temp in + let t = alloc_temp p f ae.pos in + emit_expr p f v ~dst:t ~expected:fty ae; + f.f_cur_line <- ae.pos.line; + put f (ins_abc op_setf dst (check_field_idx p f e.pos idx) t); + f.f_temp <- save) + args; + f.f_temp <- outer + end (* ---- calls --------------------------------------------------------- @@ -1121,15 +1894,42 @@ and emit_call (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e : As ignore expected; match callee.kind with | Ident name -> ( - match free_fn p name with - | Some fi -> emit_direct p f v ~dst e ~key:name ~recv:None ~params:fi.Types.params args - | None -> - if is_builtin_name name then emit_builtin p f v ~dst ?expected e name args - else begin - err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos - ~message:(Printf.sprintf "call to `%s`, which is not a declared fn or a builtin" name); - put f (ins_abx op_loadk dst (const_int p 0)) - end) + (* haxe-parity Task 1 (modules), CRITICAL 1 review fix: this file's + own module's own free_fns first — never p_syms' flat merge — so + an own-module bare call to a name that happens to collide with + some other module's same-named `pub fn` still resolves to *this* + module's declaration, not whichever one the flat merge kept. + Falls back to p_syms only when the own module doesn't declare it + at all (a bare call resolving through a single `use`d module, or + a builtin) — every pre-existing, non-colliding case behaves + exactly as before: a name with only one declaration anywhere is + never mangled either way, so free_fn_key returns it unchanged. *) + let own_mid = p.p_module_of f.f_file in + let own_fi = + match Hashtbl.find_opt p.p_module_syms own_mid with + | Some msyms -> Types.StringMap.find_opt name msyms.Types.free_fns + | None -> None + in + match own_fi with + | Some fi -> + emit_direct p f v ~dst e ~key:(free_fn_key p.p_colliding own_mid name) ~recv:None + ~params:fi.Types.params args + | None -> ( + match free_fn p name with + | Some fi -> emit_direct p f v ~dst e ~key:name ~recv:None ~params:fi.Types.params args + | None -> ( + (* haxe-parity Task 4: variant construction by name. A declared + free fn of the same name already won above (the same + shadowing rule builtins follow). *) + match find_variant p name with + | Some (u, vi) -> emit_variant_ctor p f v ~dst e u vi args + | None -> + if is_builtin_name name then emit_builtin p f v ~dst ?expected e name args + else begin + err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos + ~message:(Printf.sprintf "call to `%s`, which is not a declared fn or a builtin" name); + put f (ins_abx op_loadk dst (const_int p 0)) + end))) | Field (base, mname) -> ( match ty_of_expr p f base with | Some bt -> ( @@ -1150,10 +1950,67 @@ and emit_call (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e : As err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos ~message:(Printf.sprintf "method `%s` called on a value that is not a class instance" mname); put f (ins_abx op_loadk dst (const_int p 0))) - | None -> - err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos - ~message:(Printf.sprintf "cannot resolve the receiver's type for the call to `%s`" mname); - put f (ins_abx op_loadk dst (const_int p 0))) + | None -> ( + (* haxe-parity Task 1 (modules): before falling to the generic + "cannot resolve the receiver" error, check whether `base` is + actually a `use` alias for this file rather than an + unresolvable receiver expression — a genuine local/param/self + receiver is always caught by the `Some bt` arm above (ty_of_expr + resolves it), so this is reached only when `base` names nothing + ty_of_expr knows, which is exactly the shape a bare module alias + has. types.ml's check_modules already proved the reference + legitimate (own module unconditionally, a used module only its + `pub` names) before the compile got this far — that front-door + check decided whether this call was even allowed, not anything + here. Two shapes reach emission: + - a stdlib-reserved alias (`fs`/`proc`/...): nothing to lower to + yet (member signatures arrive in plan 9) — WO-E406, the one + place this milestone still says so, and only because this + call actually survived to emission (an unused `use fs` never + reaches this code at all). + - a project-module alias: resolves through *that module's own* + symbols (p_module_syms), never p_syms' flat merge (CRITICAL 1 + review fix) — p_syms may have silently dropped this exact + module's declaration in favor of some other module's + same-named `pub fn` (main.ml's merge_symbols is first-wins + across the whole discovered tree, oblivious to modules). This + is what makes `a.thing()` and `b.thing()` genuinely distinct + once qualification disambiguates them, not two spellings of + whichever one the flat merge happened to keep. *) + match base.kind with + | Ident alias -> ( + match use_edge_for p ~file:f.f_file alias with + | Some u when u.Types.ue_is_stdlib -> + err p ~code:stdlib_not_linked_code ~file:f.f_file ~pos:e.pos + ~message: + (Printf.sprintf "stdlib module `%s` is not linked in this milestone (called as `%s.%s`)" + alias alias mname); + put f (ins_abx op_loadk dst (const_int p 0)) + | Some u -> ( + let target_mid = Types.path_str u.Types.ue_segments in + let target_fi = + match Hashtbl.find_opt p.p_module_syms target_mid with + | Some msyms -> Types.StringMap.find_opt mname msyms.Types.free_fns + | None -> None + in + match target_fi with + | Some fi -> + emit_direct p f v ~dst e ~key:(free_fn_key p.p_colliding target_mid mname) ~recv:None + ~params:fi.Types.params args + | None -> + err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos + ~message: + (Printf.sprintf "call to `%s.%s`, which is not a declared fn in module `%s`" alias mname + alias); + put f (ins_abx op_loadk dst (const_int p 0))) + | None -> + err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos + ~message:(Printf.sprintf "cannot resolve the receiver's type for the call to `%s`" mname); + put f (ins_abx op_loadk dst (const_int p 0))) + | _ -> + err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos + ~message:(Printf.sprintf "cannot resolve the receiver's type for the call to `%s`" mname); + put f (ins_abx op_loadk dst (const_int p 0)))) | _ -> err p ~code:cannot_lower_code ~file:f.f_file ~pos:e.pos ~message:"only a name or a `receiver.method` form can be called"; @@ -1176,10 +2033,73 @@ and check_arity (p : pctx) (f : fstate) (e : Ast.expr) ~(what : string) ~(want : false end +(* The third return component (Task 4 fix rounds 1-2): stable registers + holding OWNED HEAP temporaries passed by borrow — a construction or + an owned-returning call as an argument (`get(Boxed(Pay{}))`, + `peek(Pay{})` — the reviewer's h5/m5c per-iteration leaks) is a + fresh owned value NOBODY owned before this fix: it is not a place, + so owner.ml never tracks it, and no scope ever dropped it. The + borrow convention means the callee never takes it either (a callee + that stores or returns the borrow is already WO-E304), so the CALLER + reaps it: each qualifying argument's pointer is copied to a slot + below the window (the callee's frame overlaps the window and may + overwrite the arg slot itself — same reasoning as the residual-guard + gbase) and DROPped by emit_direct/emit_iface once the call returns. + Recursive drop is correct both ways: a payload the callee moved out + (the switch escape above) left the field nulled, which the drop plan + skips; an untouched temp frees payload and shell together. + Emitter-only, no owner table: the temp never exists in owner.ml's + world, so there is no entry to conflict with; the one imprecision is + a trap DURING the call (the frame's drop mask cannot name a + register owner.ml never saw — the temp leaks on that path, the same + pre-existing behavior every expression temporary has). *) and call_window (p : pctx) (f : fstate) (v : views) (e : Ast.expr) ~(recv : Ast.expr option) - ~(params : (string * Ast.field_ty * Ast.param_conv) list) (args : Ast.expr list) : int * int = + ~(params : (string * Ast.field_ty * Ast.param_conv) list) (args : Ast.expr list) : + int * int * int list = let nrecv = match recv with Some _ -> 1 | None -> 0 in let argc = nrecv + List.length args in + (* Fix round 2 widened this from payload-union temps to ANY owned heap + temporary: the sibling leak (`peek(Pay{})`, a plain record ctor in + a loop — reviewer's m5c, 10,780 KB vs a 1,532 KB control) was the + same fresh-value-nobody-owns shape with a class instead of a + union. Qualifies: a Ctor literal, a variant construction, or a + call whose result is a payload union or a declared NON-@gc class + (records included — same table). Excluded, each for its own + reason: `take` params (a real transfer — the callee owns it, + m6a/m6c prove that path flat); places (their scope drops them); + @gc classes (their creating reference is the rc system's, and DROP + is the wrong op for a counted handle); Text (owner.ml classes it + Copy, so a callee may legitimately STORE a Text argument — classes + and unions can't, WO-E304 polices those borrows); interface-typed + call results (ty_of_expr names the interface, not the concrete + class — still leak, disclosed). *) + let owned_heap_temp (a : Ast.expr) : bool = + (match a.kind with + | Ident n -> lookup_local f n = None (* a local is a place, never a temp *) + | Call _ | Ctor _ -> true + | _ -> false) + && (match ty_of_expr p f a with + | Some t -> ( + match unwrap t with + | Scalar n -> ( + match find_union p n with + | Some u -> u.Types.u_has_payload + | None -> ( + match Types.StringMap.find_opt n p.p_syms.Types.classes with + | Some (ci : Types.class_info) -> not ci.Types.is_gc + | None -> false)) + | _ -> false) + | None -> false) + in + let temp_idx = + List.mapi + (fun i a -> + let conv = match List.nth_opt params i with Some (_, _, c) -> c | None -> Ast.Borrow in + if conv = Ast.Borrow && owned_heap_temp a then Some i else None) + args + |> List.filter_map Fun.id + in + let tbase = alloc_temps p f e.pos (List.length temp_idx) in let base = alloc_temps p f e.pos (max argc 1) in (match recv with None -> () | Some r -> emit_expr p f v ~dst:base r); List.iteri @@ -1192,7 +2112,15 @@ and call_window (p : pctx) (f : fstate) (v : views) (e : Ast.expr) ~(recv : Ast. | None -> emit_expr p f v ~dst:slot a); f.f_temp <- save) args; - (base, argc) + let temp_drops = + List.mapi + (fun j i -> + let g = tbase + j in + put f (ins_abc op_move g (base + nrecv + i) 0); + g) + temp_idx + in + (base, argc, temp_drops) and emit_direct (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) ~(key : string) ~(recv : Ast.expr option) ~(params : (string * Ast.field_ty * Ast.param_conv) list) @@ -1205,7 +2133,7 @@ and emit_direct (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) | Some midx when check_arity p f e ~what:(Printf.sprintf "`%s`" key) ~want:(List.length params) ~got:(List.length args) -> let gbase = alloc_temps p f e.pos (residual_count v e.id) in - let base, _ = call_window p f v e ~recv ~params args in + let base, _, temp_drops = call_window p f v e ~recv ~params args in let guards = residual_guards p f v e.id (Some gbase) in acquire_guards f guards; (* the frame's drop map, from the owner table, effective at the CALL *) @@ -1213,6 +2141,9 @@ and emit_direct (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) f.f_cur_line <- e.pos.line; put f (ins_abx op_call base (check_bx p f e.pos "method" midx)); release_guards f guards; + (* owned variant temporaries this call borrowed — reaped here, see + call_window's own doc comment *) + List.iter (fun g -> put f (ins_abc op_drop g 0 0)) temp_drops; if dst <> base then put f (ins_abc op_move dst base 0) | Some _ -> put f (ins_abx op_loadk dst (const_int p 0)) @@ -1224,13 +2155,15 @@ and emit_iface (p : pctx) (f : fstate) (v : views) ~(dst : int) (e : Ast.expr) ~ put f (ins_abx op_loadk dst (const_int p 0)) else begin let gbase = alloc_temps p f e.pos (residual_count v e.id) in - let w, _ = call_window p f v e ~recv:(Some base) ~params args in + let w, _, temp_drops = call_window p f v e ~recv:(Some base) ~params args in let guards = residual_guards p f v e.id (Some gbase) in acquire_guards f guards; sync_mask p f v e.id; f.f_cur_line <- e.pos.line; put f (ins_abx op_icall w (check_bx p f e.pos "interface slot" slot)); release_guards f guards; + (* owned variant temporaries this call borrowed — see call_window *) + List.iter (fun g -> put f (ins_abc op_drop g 0 0)) temp_drops; if dst <> w then put f (ins_abc op_move dst w 0) end @@ -1250,7 +2183,10 @@ and emit_builtin (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e : in let arity_of id = if id = b_now || id = b_multi_new || id = b_map_new then 0 - else if id = b_print || id = b_print_int || id = b_words || id = b_count || id = b_latest then 1 + else if + id = b_print || id = b_print_int || id = b_words || id = b_count || id = b_latest + || id = b_int_to_text + then 1 else if id = b_multi_push || id = b_multi_get || id = b_map_get || id = b_map_has then 2 else 3 in @@ -1283,6 +2219,7 @@ and emit_builtin (p : pctx) (f : fstate) (v : views) ~(dst : int) ?expected (e : | "words" -> fixed b_words | "count" -> fixed b_count | "latest" -> fixed b_latest + | "int_to_text" -> fixed b_int_to_text | "multi_new" | "map_new" -> let is_map = name = "map_new" in if args <> [] then bad (Printf.sprintf "builtin `%s` takes no arguments" name) @@ -1359,6 +2296,24 @@ and emit_stmt (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) : unit = | None -> ()); emit_rc p f v ~node:s.s_id ~acquire:true () | Assign { target; value } -> emit_assign p f v s target value + | ExprStmt ({ kind = Ast.Switch (subj, arms); _ } as e) -> + (* Task 4 fix round 1: the one place a switch's value is DISCARDED — + mirrors types.ml's own want_value:false special case. The flag + gates the payload move-out (see emit_switch's doc comment): a + discarded binding yield must leave the shell intact. The dst + convention and the emit_expr epilogue (node register, escape + increments) are replicated from emit_tail's non-place path so + this stays byte-identical to the generic path for everything but + the flag. *) + let t = alloc_temp p f e.pos in + f.f_temp <- t; + f.f_cur_line <- e.pos.line; + emit_switch ~want_value:false p f v e ~dst:t subj arms; + Hashtbl.replace f.f_node e.id t; + emit_rc p f v ~node:e.id ~acquire:true (); + (match Hashtbl.find_opt v.v_move e.id with + | Some place -> ( match lookup_local f place with Some (sr, _) -> mask_clear f sr | None -> ()) + | None -> ()) | ExprStmt e -> (* a discarded value lands in the next free temporary *without* reserving it: a call then places its own window at that same slot @@ -1372,6 +2327,9 @@ and emit_stmt (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) : unit = | If { cond; then_body; else_body } -> emit_if p f v s cond then_body else_body | While { cond; body } -> emit_while p f v s cond body | For { var; iter; body } -> emit_for p f v s var iter body + | Break -> emit_break p f v s + | Continue -> emit_continue p f v s + | DoWhile { body; cond } -> emit_do_while p f v s body cond and emit_assign (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) (target : Ast.expr) (value : Ast.expr) : unit = @@ -1536,6 +2494,47 @@ and emit_return (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) (opt : Ast.ex put f (ins_abc op_ret t 0 0); f.f_div <- true +(* haxe-parity Task 2: `break`/`continue` mirror emit_return's own shape + exactly (drops from the owner table at this node, then jump) — the + only difference is *where* the jump lands, which this frame does not + know yet (the enclosing loop patches it once it does — loop_frame's + own doc comment). `f.f_div <- true` afterward is the same call + emit_return makes for the same reason: the rest of this block is + unreachable, and emit_if's own THEN/ELSE merge already knows how to + fold that into a branch join (unchanged by this task — a `break` + inside an `if` inside a loop takes the exact path a `return` there + already does). Empty `f_loops` (no enclosing loop) is WO-E403: there + is no legal jump target to lower onto, the same "cannot lower" + convention every other construct with nothing to lower to uses. *) +and emit_break (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) : unit = + match f.f_loops with + | [] -> + err p ~code:cannot_lower_code ~file:f.f_file ~pos:s.s_pos ~message:"`break` outside of a loop" + | lf :: _ -> + emit_rc p f v ~node:s.s_id ~acquire:true (); + (match Hashtbl.find_opt v.v_break s.s_id with Some items -> emit_drops p f items | None -> ()); + emit_rc p f v ~node:s.s_id ~acquire:false (); + f.f_cur_line <- s.s_pos.line; + let pc = here f in + put f (ins_asbx op_jmp 0 0); + lf.lf_breaks <- pc :: lf.lf_breaks; + f.f_div <- true + +and emit_continue (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) : unit = + match f.f_loops with + | [] -> + err p ~code:cannot_lower_code ~file:f.f_file ~pos:s.s_pos + ~message:"`continue` outside of a loop" + | lf :: _ -> + emit_rc p f v ~node:s.s_id ~acquire:true (); + (match Hashtbl.find_opt v.v_continue s.s_id with Some items -> emit_drops p f items | None -> ()); + emit_rc p f v ~node:s.s_id ~acquire:false (); + f.f_cur_line <- s.s_pos.line; + let pc = here f in + put f (ins_asbx op_jmp 0 0); + lf.lf_continues <- pc :: lf.lf_continues; + f.f_div <- true + and emit_block (p : pctx) (f : fstate) (v : views) ~(node : int) ~(label : string) (body : Ast.stmt list) : unit = let saved_locals = f.f_nlocals in @@ -1609,14 +2608,34 @@ and emit_while (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) (cond : Ast.ex f.f_cur_line <- s.s_pos.line; let jz = here f in put f (ins_asbx op_jz t 0); + let lf = { lf_node = s.s_id; lf_breaks = []; lf_continues = [] } in + f.f_loops <- lf :: f.f_loops; emit_block p f v ~node:s.s_id ~label:"WHILE" body; + f.f_loops <- List.tl f.f_loops; f.f_cur_line <- s.s_pos.line; let back = here f in put f (ins_asbx op_jmp 0 0); patch_jump p f ~file:f.f_file ~pos:s.s_pos back top; - patch_jump p f ~file:f.f_file ~pos:s.s_pos jz (here f); + (* haxe-parity Task 2: `continue` re-enters at the condition check — + `top`, the exact pc the back-edge above already jumps to; never a + second copy of the condition. *) + List.iter (fun pc -> patch_jump p f ~file:f.f_file ~pos:s.s_pos pc top) lf.lf_continues; + let exit_pc = here f in + patch_jump p f ~file:f.f_file ~pos:s.s_pos jz exit_pc; + (* `break` exits to the exact same place the condition's own JZ does. *) + List.iter (fun pc -> patch_jump p f ~file:f.f_file ~pos:s.s_pos pc exit_pc) lf.lf_breaks; (* a loop may run zero times, so the exit state always includes the - entry state; a body that returned contributes nothing *) + entry state; a body that returned/broke/continued contributes + nothing. Disclosed, secondary-mechanism approximation (haxe-parity + Task 2): a `break`'s own mask at the moment it jumped is not + separately folded into this meet — f_owned/f_gc feed only the + per-pc trap-unwind table (this file's own `put`, above), never an + emission decision (every DROP/RC instruction break/continue itself + needs is already emitted at emit_break/emit_continue's own site, + from the owner table, unconditionally) — so the only thing this + could under/over-track is which registers a *trap during the + narrow window right after this loop* would additionally destroy, + not whether break/continue's own owned value is dropped at all. *) if f.f_div then begin f.f_owned <- entry_owned; f.f_gc <- entry_gc @@ -1659,9 +2678,22 @@ and emit_for (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) (var : string) ( let jz = here f in put f (ins_asbx op_jz tc 0); put f (ins_abc op_builtin rv rc b_multi_get); + let lf = { lf_node = s.s_id; lf_breaks = []; lf_continues = [] } in + f.f_loops <- lf :: f.f_loops; List.iter (emit_stmt p f v) body; + f.f_loops <- List.tl f.f_loops; emit_scope_drops p f v ~node:s.s_id ~label:"FOR"; emit_rc p f v ~node:s.s_id ~acquire:false ~groups:(declared_since f saved_decls) (); + (* haxe-parity Task 2: `continue` re-enters right here — after this + iteration's own scope-end cleanup (a `continue` already ran the + equivalent of it at its own site, from v_continue — see + emit_continue — so landing after the *normal* cleanup above + never double-drops), and before the increment, so the next + iteration still advances. *) + let continue_target = here f in + List.iter + (fun pc -> patch_jump p f ~file:f.f_file ~pos:s.s_pos pc continue_target) + lf.lf_continues; f.f_temp <- f.f_nlocals; f.f_cur_line <- s.s_pos.line; let one = alloc_temp p f s.s_pos in @@ -1670,7 +2702,9 @@ and emit_for (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) (var : string) ( let back = here f in put f (ins_asbx op_jmp 0 0); patch_jump p f ~file:f.f_file ~pos:s.s_pos back top; - patch_jump p f ~file:f.f_file ~pos:s.s_pos jz (here f); + let exit_pc = here f in + patch_jump p f ~file:f.f_file ~pos:s.s_pos jz exit_pc; + List.iter (fun pc -> patch_jump p f ~file:f.f_file ~pos:s.s_pos pc exit_pc) lf.lf_breaks; if f.f_div then begin f.f_owned <- entry_owned; f.f_gc <- entry_gc @@ -1686,6 +2720,51 @@ and emit_for (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) (var : string) ( ~message: "`for` can only iterate a `multi` — the v1 builtins expose no key enumeration for a `map`" +(* haxe-parity Task 2: `do { body } while cond` — body first, condition + after, otherwise the exact same JZ/JMP shape `while` uses (no new + opcode). `continue` re-enters at the condition check (the one point + every iteration passes through, whichever way it got there); `break` + exits to the same place the condition's own JZ does. Unlike + while/for, the body always runs at least once — there is no + zero-iteration path to merge the exit mask with, so (unlike + emit_while/emit_for) the non-diverged case simply keeps whatever + mask the condition check left, no `mask_meet` needed. The + `f.f_div`/entry-restore branch below is kept anyway, for consistency + with owner.ml's `fixpoint` (shared, unmodified, across all three loop + shapes, and always resets `diverged` to its pre-loop value) — a + disclosed, documented approximation for the one shape neither pass + chases precisely: a body that unconditionally returns/breaks on + every path, making the condition dead code. No fixture in this task + has that shape. *) +and emit_do_while (p : pctx) (f : fstate) (v : views) (s : Ast.stmt) (body : Ast.stmt list) + (cond : Ast.expr) : unit = + let top = here f in + let entry_owned = f.f_owned and entry_gc = f.f_gc in + let div0 = f.f_div in + let lf = { lf_node = s.s_id; lf_breaks = []; lf_continues = [] } in + f.f_loops <- lf :: f.f_loops; + emit_block p f v ~node:s.s_id ~label:"DO" body; + f.f_loops <- List.tl f.f_loops; + let cond_pc = here f in + List.iter (fun pc -> patch_jump p f ~file:f.f_file ~pos:s.s_pos pc cond_pc) lf.lf_continues; + let t = alloc_temp p f s.s_pos in + emit_expr p f v ~dst:t cond; + f.f_cur_line <- s.s_pos.line; + let jz = here f in + put f (ins_asbx op_jz t 0); + let back = here f in + put f (ins_asbx op_jmp 0 0); + patch_jump p f ~file:f.f_file ~pos:s.s_pos back top; + let exit_pc = here f in + patch_jump p f ~file:f.f_file ~pos:s.s_pos jz exit_pc; + List.iter (fun pc -> patch_jump p f ~file:f.f_file ~pos:s.s_pos pc exit_pc) lf.lf_breaks; + if f.f_div then begin + f.f_owned <- entry_owned; + f.f_gc <- entry_gc + end + else mask_meet f entry_owned entry_gc; + f.f_div <- div0 + (* ============================================================ One method ============================================================ *) @@ -1697,7 +2776,7 @@ let emit_method (p : pctx) (v : views) ~(file : string) ~(self_class : (int * st f_line = -1; f_lines = []; f_owned = 0L; f_gc = 0L; f_last_owned = 0L; f_last_gc = 0L; f_drops = []; f_nlocals = 0; f_temp = 0; f_max = 0; f_env = []; f_decl = Hashtbl.create 16; f_node = Hashtbl.create 64; f_kind = Hashtbl.create 16; f_declared = []; f_div = false; f_maxjmp = 0; - f_over = false } + f_over = false; f_loops = [] } in (match self_class with | None -> () @@ -1784,7 +2863,10 @@ let satisfies (p : pctx) (cid : int) (ir : ifacerec) : int list option = in go [] ir.ir_methods -let emit ~(syms : Types.symbols) (coll : Diag.Collector.t) (units : input list) : string = +let emit ~(syms : Types.symbols) ~(module_of : string -> string) + ~(module_syms : (string, Types.symbols) Hashtbl.t) (coll : Diag.Collector.t) (units : input list) : + string = + let colliding = compute_colliding_fn_names ~module_of units in (* ---- pass 1: declarations, in discovery then declaration order ---- *) let classes = ref [] and class_id = ref SM.empty and nclasses = ref 0 in let ifaces = ref [] and iface_id = ref SM.empty and nifaces = ref 0 and nslots = ref 0 in @@ -1792,22 +2874,83 @@ let emit ~(syms : Types.symbols) (coll : Diag.Collector.t) (units : input list) let entry = ref wob_none in (* (file, self class option, method_decl, unit) in method-table order *) let bodies = ref [] in + (* haxe-parity Task 4: typedef records are STRUCTURAL — two records + with the same shape share ONE class-table entry, keyed by this + rendering of the ordered field list. Defaults are part of the key + deliberately: aliases whose defaults differ get their own entries + (identical layout either way, so interchangeability is unaffected — + class ids only decide layout and drop plan), because sharing one + entry would make emit_ctor's default-filling read whichever alias + registered first. types.ml's typ_equal compares fields only — + strictly wider than this key, and safe for exactly that layout + reason. *) + let record_shape : (string, int) Hashtbl.t = Hashtbl.create 8 in + let record_shape_key (c : Ast.class_decl) : string = + String.concat ";" + (List.map + (fun (fl : Ast.field) -> + let dflt = + match fl.default with + | None -> "" + | Some Ast.DefaultNow -> "=now()" + | Some (Ast.DefaultOpaque toks) -> + "=" ^ String.concat " " (List.map (fun (t : Token.t) -> Dump.kind_label t.Token.kind) toks) + in + fl.name ^ ":" ^ Dump.field_ty_str fl.ty ^ dflt) + c.fields) + in List.iter (fun u -> List.iter (function | Ast.Class (c : Ast.class_decl) -> if not (SM.mem c.name !class_id) then begin - let cid = !nclasses in - class_id := SM.add c.name cid !class_id; - incr nclasses; - classes := - { cr_name = c.name; cr_gc = c.is_gc; - cr_fields = - Array.of_list (List.map (fun (fl : Ast.field) -> (fl.name, fl.ty)) c.fields); - cr_methods = List.map (fun (m : Ast.method_decl) -> m.name) c.methods } - :: !classes + let shape = if c.is_record then Some (record_shape_key c) else None in + let alias_of = + match shape with Some key -> Hashtbl.find_opt record_shape key | None -> None + in + match alias_of with + | Some cid -> + (* structural alias: this name maps onto the shape's + existing entry; no new clsrec *) + class_id := SM.add c.name cid !class_id + | None -> + let cid = !nclasses in + class_id := SM.add c.name cid !class_id; + incr nclasses; + (match shape with + | Some key -> Hashtbl.replace record_shape key cid + | None -> ()); + classes := + { cr_name = c.name; cr_gc = c.is_gc; + cr_fields = + Array.of_list (List.map (fun (fl : Ast.field) -> (fl.name, fl.ty)) c.fields); + cr_methods = List.map (fun (m : Ast.method_decl) -> m.name) c.methods } + :: !classes end + | Ast.Union (ud : Ast.union_decl) -> + (* haxe-parity Task 4: a payload union gets one compiler- + generated class entry PER VARIANT (bare variants of the + same union included — a uniform heap representation is + what lets one register hold "any variant of this union"); + the entry's id is the variant's runtime tag, carried by + the object header's own class_id. An all-bare union gets + nothing here at all: its values are plain ordinals. *) + if List.exists (fun (vd : Ast.variant_decl) -> vd.Ast.v_fields <> []) ud.variants then + List.iter + (fun (vd : Ast.variant_decl) -> + let key = ud.name ^ "." ^ vd.Ast.v_name in + if not (SM.mem key !class_id) then begin + let cid = !nclasses in + class_id := SM.add key cid !class_id; + incr nclasses; + classes := + { cr_name = key; cr_gc = false; + cr_fields = Array.of_list vd.Ast.v_fields; + cr_methods = [] } + :: !classes + end) + ud.variants | Ast.Interface (i : Ast.interface_decl) -> (* an interface with no methods gets no slots and no rows: the loader rejects a zero-method interface entry, and no ICALL @@ -1823,7 +2966,9 @@ let emit ~(syms : Types.symbols) (coll : Diag.Collector.t) (units : input list) :: !ifaces; nslots := !nslots + List.length i.methods end - | Ast.Fn _ -> ()) + | Ast.Fn _ -> () + | Ast.Use _ -> () + | Ast.Const _ -> ()) u.prog.decls) units; let class_id = !class_id in @@ -1850,8 +2995,9 @@ let emit ~(syms : Types.symbols) (coll : Diag.Collector.t) (units : input list) c.methods | Ast.Interface _ -> () | Ast.Fn (m : Ast.method_decl) -> - if not (SM.mem m.name !method_id) then begin - method_id := SM.add m.name !nmethods !method_id; + let key = free_fn_key colliding (module_of u.file) m.name in + if not (SM.mem key !method_id) then begin + method_id := SM.add key !nmethods !method_id; methods := { mr_name = m.name; mr_class = None; mr_argc = List.length m.params; mr_regc = 1; mr_code = [||]; mr_lines = []; mr_drops = [] } @@ -1876,13 +3022,20 @@ let emit ~(syms : Types.symbols) (coll : Diag.Collector.t) (units : input list) | Some _ | None -> ()) end; incr nmethods - end) + end + | Ast.Use _ -> () + | Ast.Const _ -> () + | Ast.Union _ -> () (* haxe-parity Task 4: no methods to emit *)) u.prog.decls) units; let p_methods = Array.of_list (List.rev !methods) in + let p_uses : (string, Types.use_edge list) Hashtbl.t = Hashtbl.create 8 in + List.iter (fun u -> Hashtbl.replace p_uses u.file (Types.uses_of_program u.prog)) units; let p = { p_syms = syms; p_coll = coll; p_classes; p_class_id = class_id; p_ifaces; - p_iface_id = !iface_id; p_method_id = !method_id; p_methods; p_kints = Hashtbl.create 32; + p_iface_id = !iface_id; p_method_id = !method_id; p_methods; p_uses; + p_module_syms = module_syms; p_module_of = module_of; p_colliding = colliding; + p_kints = Hashtbl.create 32; p_ktexts = Hashtbl.create 32; p_consts = []; p_nconsts = 0 } in (* names are constants; interning them first keeps the pool's low diff --git a/compiler/src/lexer.ml b/compiler/src/lexer.ml index 8aaeb41..5b88edb 100644 --- a/compiler/src/lexer.ml +++ b/compiler/src/lexer.ml @@ -105,7 +105,8 @@ let read_ident_chars lx = plus uppercase-only INSERT/SELECT. Deliberately absent: self, me, subscribe, receive, and lowercase insert/select — those fall through to the `_ -> None` case below and lex as plain Ident, - matching rt and the CLAUDE.md gotcha this task exists to preserve. *) + matching rt and the CLAUDE.md gotcha this task exists to preserve. + `use`/`pub` (haxe-parity Task 1, modules) added on top of that set. *) let keyword_kind = function | "type" -> Some Token.KwType | "class" -> Some Token.KwClass @@ -122,10 +123,82 @@ let keyword_kind = function | "in" -> Some Token.KwIn | "true" -> Some Token.KwTrue | "false" -> Some Token.KwFalse + | "use" -> Some Token.KwUse + | "pub" -> Some Token.KwPub + | "break" -> Some Token.KwBreak + | "continue" -> Some Token.KwContinue + | "do" -> Some Token.KwDo + | "const" -> Some Token.KwConst + | "and" -> Some Token.KwAnd + | "or" -> Some Token.KwOr + | "inline" -> Some Token.KwInline + | "switch" -> Some Token.KwSwitch + | "case" -> Some Token.KwCase + | "default" -> Some Token.KwDefault + | "typedef" -> Some Token.KwTypedef | "INSERT" -> Some Token.KwInsert | "SELECT" -> Some Token.KwSelect | _ -> None +(* haxe-parity Task 2: scans the raw source of one `${...}` interpolation + body, starting right after the `{` (caller already consumed `$` and + `{`). Returns that raw, unlexed text -- the parser re-tokenizes it as a + full expression (parser.ml's own desugar-to-Concat step; this is a + mechanical extraction only, no semantics). Tracks brace depth so a + nested `{}` (a constructor literal inside an interpolation, + `${Point{x:1}.x}`) doesn't end the scan early, and skips a nested + string literal verbatim (honoring its own backslash escapes) so a + quote or brace *inside* that nested string can't confuse either + count. Runs off the end of the file the same silent way an + unterminated outer string does -- the caller's own EOF handling picks + up right after. *) +let read_interp_expr lx = + let buf = Buffer.create 16 in + let depth = ref 0 in + let continue_ = ref true in + while !continue_ do + match peek lx with + | None -> continue_ := false + | Some '}' when !depth = 0 -> + ignore (advance lx); + continue_ := false + | Some ('{' as c) -> + incr depth; + Buffer.add_char buf c; + ignore (advance lx) + | Some ('}' as c) -> + decr depth; + Buffer.add_char buf c; + ignore (advance lx) + | Some (('"' | '\'') as q) -> + Buffer.add_char buf q; + ignore (advance lx); + let scanning = ref true in + while !scanning do + match peek lx with + | None -> scanning := false + | Some c when c = q -> + Buffer.add_char buf c; + ignore (advance lx); + scanning := false + | Some '\\' -> ( + Buffer.add_char buf '\\'; + ignore (advance lx); + match peek lx with + | Some c -> + Buffer.add_char buf c; + ignore (advance lx) + | None -> scanning := false) + | Some c -> + Buffer.add_char buf c; + ignore (advance lx) + done + | Some c -> + Buffer.add_char buf c; + ignore (advance lx) + done; + Buffer.contents buf + let tokenize (collector : Diag.Collector.t) ~(file : string) (src : string) : Token.t list = let lx = make src in @@ -171,6 +244,16 @@ let tokenize (collector : Diag.Collector.t) ~(file : string) (src : string) : let quote = c in ignore (advance lx); let buf = Buffer.create 16 in + (* haxe-parity Task 2: segments accumulate here only when at + least one `${...}` is actually found (flush_text below); a + plain string never touches `parts` at all, so it emits the + exact same `Token.Str` it always did -- see the `match !parts` + dispatch after the loop. *) + let parts = ref [] in + let flush_text () = + parts := Token.SText (Buffer.contents buf) :: !parts; + Buffer.clear buf + in let scanning = ref true in while !scanning do match peek lx with @@ -184,6 +267,17 @@ let tokenize (collector : Diag.Collector.t) ~(file : string) (src : string) : | Some c when c = quote -> ignore (advance lx); scanning := false + | Some '$' when peek_at lx 1 = Some '{' -> + (* Unescaped `${` -- `\$` never reaches here, it is fully + consumed by the backslash branch below, one dispatch + earlier, so this is always a genuine interpolation start, + never an escaped `$` that happens to be followed by `{`. *) + flush_text (); + ignore (advance lx); + (* '$' *) + ignore (advance lx); + (* '{' *) + parts := Token.SExpr (read_interp_expr lx) :: !parts | Some '\\' -> ( (* Captured before advancing: this is the backslash's own position, so a dangling-escape diagnostic points at the @@ -196,6 +290,10 @@ let tokenize (collector : Diag.Collector.t) ~(file : string) (src : string) : | Some '\\' -> Buffer.add_char buf '\\' | Some '"' -> Buffer.add_char buf '"' | Some '\'' -> Buffer.add_char buf '\'' + (* `\$` -- not one of the escapes above, so it falls into + this catch-all exactly like any other unrecognized + backslash sequence, producing a literal `$` that the `$` + dispatch above never sees (it already advanced past it). *) | Some other -> Buffer.add_char buf other | None -> report_unterminated_escape esc_line esc_col; @@ -204,7 +302,11 @@ let tokenize (collector : Diag.Collector.t) ~(file : string) (src : string) : ignore (advance lx); Buffer.add_char buf other done; - emit (Token.Str (Buffer.contents buf)) line col + flush_text (); + (match List.rev !parts with + | [] -> emit (Token.Str "") line col + | [ Token.SText s ] -> emit (Token.Str s) line col + | segs -> emit (Token.InterpStr segs) line col) end else if is_digit c then begin let n = ref 0 in diff --git a/compiler/src/owner.ml b/compiler/src/owner.ml index 6ab3c3d..037d419 100644 --- a/compiler/src/owner.ml +++ b/compiler/src/owner.ml @@ -243,6 +243,13 @@ type drop_item = { DReturn — every live owned local in *all* enclosing scopes at an early (or final) return, after the returned value's own move: the DROPs that must run before the frame leaves. + DBreak/DContinue (haxe-parity Task 2) — every live owned local in + every scope from here up to *and including* the nearest + enclosing loop's own body scope (WHILE/FOR/DO — never + beyond it, since a break/continue only exits the loop, not + the function). Same "reuse DReturn's own machinery" shape, + bounded to the loop instead of the whole function — see + live_holders_upto. DOverwrite — the value an assignment overwrites (see the module doc). DBranchJoin — join normalization: the locals the *other* branch of an if moved and this one did not, dropped at this branch's end so @@ -260,6 +267,8 @@ type drop_kind = | DOverwrite | DBranchJoin of string | DLiveMask + | DBreak + | DContinue type drop_site = { dr_node : int; @@ -370,6 +379,15 @@ type ctx = { sink : sink; fn_name : string; mutable scopes : scope list; (* innermost first *) + (* haxe-parity Task 2: the enclosing While/For/DoWhile statement ids, + innermost first — the nearest enclosing loop's own `s.s_id`, which + is also its own scope's `sc_node` (analyze_block ~node:s.s_id). + Empty outside any loop; a break/continue found there records no + drop site at all (nothing to bound the drop to) and leaves the + actual rejection to emit.ml, which has no jump target to lower it + onto — the same WO-E403 "no legal target" convention as every + other construct with nothing to lower to. *) + mutable loop_stack : int list; (* false during a loop's probe pass: no diagnostics, no table entries *) mutable recording : bool; (* set when the current path has returned; a diverged path contributes @@ -399,7 +417,15 @@ let oclass_of (ctx : ctx) (ft : Ast.field_ty) : oclass = if Types.is_builtin_scalar n then Copy else if Types.is_gc_class ctx.syms n then Gc else if Types.StringMap.mem n ctx.syms.Types.classes then Owned - else Copy (* unknown type: WO-E225 already reported by types.ml *) + else ( + (* haxe-parity Task 4: an all-bare union value is a plain integer + tag — Copy, exactly like a builtin scalar (moving/aliasing it + is copying an int). A payload union value is a heap variant + object — Owned, one owner, dropped at scope end like any other + non-@gc instance. *) + match Types.StringMap.find_opt n ctx.syms.Types.unions with + | Some u -> if u.Types.u_has_payload then Owned else Copy + | None -> Copy (* unknown type: WO-E225 already reported by types.ml *)) | Ref _ -> Copy | Multi _ | Map _ -> Owned | Nullable _ -> Copy (* unreachable: unwrapped above *) @@ -447,8 +473,8 @@ and stmt_writes_self (s : Ast.stmt) : bool = | If { then_body; else_body; _ } -> body_writes_self then_body || (match else_body with Some (_, b) -> body_writes_self b | None -> false) - | While { body; _ } | For { body; _ } -> body_writes_self body - | Let _ | Return _ | ExprStmt _ -> false + | While { body; _ } | For { body; _ } | DoWhile { body; _ } -> body_writes_self body + | Let _ | Return _ | ExprStmt _ | Break | Continue -> false (* A resolved callee: its parameter conventions (positional), its return type, and — for a method call — whether the receiver is borrowed @@ -463,22 +489,108 @@ type callee = { ce_recv_excl : bool; } +(* haxe-parity Task 4: a bare variant reference (`Pending`) or a variant + construction (`Failed("x")`) types as its union — locals always win + first (find_local / resolve_callee run before this), so a shadowing + binding is never mistaken for a variant. *) +let variant_union_ty (ctx : ctx) (n : string) : Ast.field_ty option = + match Types.find_variant ctx.syms n with + | Some (u, _) -> Some (Ast.Scalar u.Types.u_name) + | None -> None + let rec expr_ty (ctx : ctx) (e : Ast.expr) : Ast.field_ty option = match e.kind with | IntLit _ -> Some (Scalar "Int") | StrLit _ -> Some (Scalar "Text") | BoolLit _ -> Some (Scalar "Bool") - | Ident n -> ( match find_local ctx n with Some l -> Some l.l_ty | None -> None) + | Ident n -> ( + match find_local ctx n with + | Some l -> Some l.l_ty + | None -> variant_union_ty ctx n) | Field (base, f) -> ( match expr_ty ctx base with | Some bt -> ( match unwrap_nullable bt with Scalar cn -> field_ty_of ctx cn f | _ -> None) | None -> None) | Index (base, _) -> ( match expr_ty ctx base with Some bt -> elem_ty bt | None -> None) - | Call (callee, _) -> ( match resolve_callee ctx callee with Some c -> c.ce_ret | None -> None) + | Call (callee, _) -> ( + match resolve_callee ctx callee with + | Some c -> c.ce_ret + | None -> ( + (* an unresolved Ident callee may be a variant construction — its + value is a fresh Owned variant object of the union's type, and + missing this here is a real leak (analyze_let's None-fallback + classifies as Copy, so the object would never be dropped). *) + match callee.kind with + | Ident n -> variant_union_ty ctx n + | _ -> None)) | Unary (_, o) -> expr_ty ctx o | Binary _ -> None (* arithmetic/comparison: Copy either way *) | Ctor (cn, _) -> Some (Scalar cn) + | Interp _ -> Some (Scalar "Text") (* an interpolation always produces Text *) | DbStub _ -> None + | Switch (subject, arms) -> + (* review fix, Critical 3: this was `None` ("not chased", the same + call as `Binary`/`DbStub` above) — a real, reviewer-reproduced + leak, not a theoretical gap: `analyze_let`'s own fallback for + `expr_ty = None` is `Scalar "Int"` (Copy), so an *unannotated* + `let v = switch ... { case ...: SomeClass{...}; ... }` was + classified Copy and never dropped, even for a plain class with + no union involved. Mirrors emit.ml's own `ty_of_expr` Switch + case exactly (same shape, this file's own `Ast.field_ty`/`ctx` + types instead of `Types.typ`/`pctx`) rather than duplicating + types.ml's `typecheck_switch` unification: the first arm's + trailing `ExprStmt`'s own type wins — types.ml already proved + every other arm agrees, or reported WO-E201 if not, so trusting + the first arm here is not a second, weaker check, just this + file's own narrower deriver reading the same fact. + + Task 4 fix round 1 (review Critical 1b): an arm may yield its own + payload BINDING (`case Boxed(b): b;` — the escape shape the + log-watcher's own return pattern uses). The binding is not a + local at derivation time (it exists only during the arm's own + walk), so the plain recursive call typed the whole switch `None` + -> the `Scalar "Int"` fallback -> Copy — a leak (unannotated + `let`) or a bogus downstream error. `binding_ty_of_arm` reads the + binding's type straight off the subject's variant declaration. *) + (match arms with + | [] -> None + | first :: _ -> ( + match List.rev first.Ast.body with + | { Ast.s_kind = ExprStmt ve; _ } :: _ -> ( + match ve.Ast.kind with + | Ident n -> ( + match binding_ty_of_arm ctx subject first n with + | Some fty -> Some fty + | None -> expr_ty ctx ve) + | _ -> expr_ty ctx ve) + | _ -> None)) + +(* The declared type of payload binding [n], when [arm]'s pattern binds + it off [subject]'s union — None whenever this is not that shape. *) +and binding_ty_of_arm (ctx : ctx) (subject : Ast.expr) (arm : Ast.switch_arm) (n : string) : + Ast.field_ty option = + match expr_ty ctx subject with + | Some (Scalar sn) -> ( + match Types.StringMap.find_opt sn ctx.syms.Types.unions with + | Some u when u.Types.u_has_payload -> ( + match arm.Ast.values with + | [ { Ast.kind = Ast.Call ({ Ast.kind = Ast.Ident vname; _ }, bargs); _ } ] -> ( + match + List.find_opt (fun (vi : Types.variant_info) -> vi.Types.vi_name = vname) + u.Types.u_variants + with + | Some vi when List.length bargs = List.length vi.Types.vi_fields -> + let rec zip (args : Ast.expr list) fields = + match (args, fields) with + | { Ast.kind = Ast.Ident bn; _ } :: _, (_, fty) :: _ when bn = n -> Some fty + | _ :: ta, _ :: tf -> zip ta tf + | _ -> None + in + zip bargs vi.Types.vi_fields + | _ -> None) + | _ -> None) + | _ -> None) + | _ -> None and resolve_callee (ctx : ctx) (callee : Ast.expr) : callee option = let params_of ps = List.map (fun (n, _, conv) -> (n, conv)) ps in @@ -683,6 +795,23 @@ let is_live_holder (l : local) : bool = let live_holders (ctx : ctx) : local list = List.concat_map (fun sc -> List.filter is_live_holder sc.sc_locals) ctx.scopes +(* haxe-parity Task 2: every live holder from the innermost scope up to + and including the scope whose sc_node is [loop_node] (the nearest + enclosing loop's own body scope) — DBreak/DContinue's own bound + version of live_holders, which goes all the way to the function's + own outermost scope (return's job: leave the whole frame). A + break/continue only leaves the loop, so scopes *outside* it are + untouched — their own DScope drop still runs later, at the loop's + normal exit. *) +let live_holders_upto (ctx : ctx) (loop_node : int) : local list = + let rec go = function + | [] -> [] + | (sc : scope) :: rest -> + let here = List.filter is_live_holder sc.sc_locals in + if sc.sc_node = loop_node then here else here @ go rest + in + go ctx.scopes + let owned_items (ls : local list) : drop_item list = ls |> List.filter (fun l -> l.l_class = Owned) @@ -913,9 +1042,11 @@ let rec read_expr (ctx : ctx) (e : Ast.expr) : unit = | Binary (_, a, b) -> read_expr ctx a; read_expr ctx b + | Interp inner -> read_expr ctx inner | DbStub _ -> (* trap-capable: the frame needs its drop map here *) record_drop ctx ~node:e.id ~pos:e.pos ~kind:DLiveMask ~items:(mask_items (live_holders ctx)) + | Switch (subject, arms) -> analyze_switch ctx e.id subject arms (* The root of a place expression is already accounted for by use_place; what still needs walking are index subexpressions and a non-place base @@ -947,6 +1078,43 @@ and analyze_ctor (ctx : ctx) (cn : string) (fields : (string * Ast.expr) list) : transfers — that ordering is what makes `f(x, take x)` a move-while-borrowed rather than a use-after-move. *) and analyze_call (ctx : ctx) (call_e : Ast.expr) (callee : Ast.expr) (args : Ast.expr list) : unit = + (* haxe-parity Task 4: a variant construction is not a call — it + lowers to NEW + SETF, no CALL instruction — so every place-shaped + payload argument is a ctor-field ESCAPE (analyze_ctor's own rule: + the value is stored into the fresh object, which owns it from + here), never a borrow-for-the-duration-of-the-call. Getting this + wrong is a double free, not an imprecision: a local moved into the + payload would otherwise stay Live and be dropped at scope end on + top of the variant object's own recursive drop. No LIVE-MASK is + recorded either — there is no trap-capable call site to sync a + drop map at. A declared free fn of the same name shadows the + variant (the same flat-table resolution resolve_callee itself + uses). *) + let variant_ctor = + match callee.kind with + | Ident n when not (Types.StringMap.mem n ctx.syms.Types.free_fns) -> + Types.find_variant ctx.syms n + | _ -> None + in + match variant_ctor with + | Some (_, vi) -> + List.iteri + (fun i (fe : Ast.expr) -> + read_expr ctx fe; + match place_of fe with + | None -> () + | Some p -> + let fname = + match List.nth_opt vi.Types.vi_fields i with + | Some (n, _) -> n + | None -> Printf.sprintf "arg%d" (i + 1) + in + if + transfer ctx p + ~what:(Printf.sprintf "cannot be stored in `%s.%s`" vi.Types.vi_name fname) + then record_move ctx p (MvCtorField fname)) + args + | None -> let resolved = resolve_callee ctx callee in (* receiver *) let recv = @@ -1130,6 +1298,128 @@ and branch_join_drops (ctx : ctx) ~(node : int) ~(label : string) ~(pos : Ast.po in record_drop ctx ~node ~pos ~kind:(DBranchJoin label) ~items +(* haxe-parity Task 3: `switch`'s own arms are alternate flows joining + back together after the switch — exactly what `if`/`else` already + is, generalized from two branches to N (one per arm). Reused, not + reinvented, per the brief's own instruction: each arm is its own + `analyze_block` (so an arm-local owned value that is never moved + still gets its ordinary DScope drop at that arm's own end — nothing + special to write for that half); a diverging arm (every path inside + it returned) drops out of the join exactly like a diverging `if` + branch does; and a value moved in *some* arms but not others gets + `branch_join_drops`'s own JOIN-DROP treatment, called once per kept + arm against the join of every *other* (non-diverging) arm's ending + state — the N-way shape of the same "the branch that kept it drops + it at its own end" rule the module doc above states for two. + + The subject is read (`read_expr`, never `transfer`) exactly once, + before any arm runs: it is compared against, never consumed — "the + SUBJECT's ownership — borrowed for the comparison, not consumed" per + this task's own brief. Case values are read the same way; for this + task's scalar/Text subjects they are always literals, so this is a + no-op today and only matters once a union variant tag becomes a real + bound reference (Task 4). *) +and analyze_switch (ctx : ctx) (node : int) (subject : Ast.expr) (arms : Ast.switch_arm list) : + unit = + read_expr ctx subject; + (* haxe-parity Task 4: over a union-typed subject the case "values" + are variant PATTERNS (`case Ok:`, `case Failed(reason):`), not + expressions — never read as such (a pattern's binding names are + unbound on purpose; reading them would be noise at best). The + subject's own union-ness comes from this pass's own expr_ty, + deliberately NOT unwrapped through `?T` (types.ml's subj_union + makes the same call — a `?Union` subject stays on the plain-value + path until Task 6). *) + let subj_union = + match expr_ty ctx subject with + | Some (Scalar n) -> Types.StringMap.find_opt n ctx.syms.Types.unions + | _ -> None + in + (match subj_union with + | Some _ -> () + | None -> + List.iter (fun (a : Ast.switch_arm) -> List.iter (read_expr ctx) a.Ast.values) arms); + (* A payload pattern's bindings are BORROWS of the subject's own + fields (`case Failed(reason):` reads `reason` straight out of the + variant object via GETF — the subject keeps owning the payload, so + the binding must never be dropped by the arm or the subject's own + drop double-frees). Declared into the arm's own scope, exactly like + a `for` cursor is into its loop's (same Borrowed state, same + l_holds = false); when the subject is a place, the binding's source + place is that place plus the field projection, so moving the + subject out from under a live binding is the ordinary WO-E302. *) + let arm_bindings (a : Ast.switch_arm) : local list = + match subj_union with + | None -> [] + | Some u -> ( + match a.Ast.values with + | [ { Ast.kind = Ast.Call ({ Ast.kind = Ast.Ident vname; _ }, args); _ } ] -> ( + match + List.find_opt (fun (v : Types.variant_info) -> v.Types.vi_name = vname) + u.Types.u_variants + with + | Some vi when List.length args = List.length vi.Types.vi_fields -> + let subj_place = place_of subject in + List.concat + (List.map2 + (fun (arg : Ast.expr) (fname, fty) -> + match arg.Ast.kind with + | Ast.Ident bn -> + let src = + match subj_place with + | Some p -> + Some { p with projs = p.projs @ [ PField fname ]; pnode = arg.Ast.id } + | None -> None + in + [ { l_name = bn; l_ty = fty; l_class = oclass_of ctx fty; + l_node = arg.Ast.id; l_pos = arg.Ast.pos; l_holds = false; l_src = src; + l_bkind = AShared; l_state = Borrowed arg.Ast.pos } ] + | _ -> []) + args vi.Types.vi_fields) + | _ -> []) + | _ -> []) + in + let entry = snapshot ctx in + let div0 = ctx.diverged in + (* review fix, Critical 1: walk the *lowering* order (default last), + not raw source order — see Ast.switch_lowering_order's own doc + comment. "ARM" must be the same index emit.ml's own + emit_switch hands the owner tables, or every DScope/JOIN-DROP + lookup below silently misses. *) + let results = + List.mapi + (fun i (a : Ast.switch_arm) -> + restore entry; + ctx.diverged <- div0; + let label = Printf.sprintf "ARM%d" i in + analyze_block ctx ~pre:(arm_bindings a) ~node ~pos:a.Ast.arm_pos ~label a.Ast.body; + (label, a.Ast.arm_pos, snapshot ctx, ctx.diverged)) + (Ast.switch_lowering_order arms) + in + let non_diverged = List.filter (fun (_, _, _, d) -> not d) results in + match non_diverged with + | [] -> + (* every arm diverged (or there were no arms at all — a malformed + switch types.ml already reports on): nothing reachable follows, + so — mirroring analyze_stmt's own `If` case, which restores + *some* snapshot purely for hygiene even though it is provably + unobservable — restore the last arm's ending state, if any. *) + (match List.rev results with (_, _, sn, _) :: _ -> restore sn | [] -> ()); + ctx.diverged <- true + | (_, _, first_sn, _) :: rest -> + List.iter + (fun (label, pos, sn, _) -> + match List.filter (fun (l, _, _, _) -> l <> label) non_diverged with + | [] -> () (* the only non-diverging arm: nothing else could have moved anything *) + | (_, _, first_other, _) :: rest_other -> + let moved_elsewhere = + List.fold_left (fun acc (_, _, s, _) -> join acc s) first_other rest_other + in + branch_join_drops ctx ~node ~label ~pos ~moving:moved_elsewhere ~other:sn) + non_diverged; + restore (List.fold_left (fun acc (_, _, s, _) -> join acc s) first_sn rest); + ctx.diverged <- div0 + and analyze_stmt (ctx : ctx) (s : Ast.stmt) : unit = match s.s_kind with | Let { name; ty; value } -> analyze_let ctx s name ty value @@ -1182,16 +1472,19 @@ and analyze_stmt (ctx : ctx) (s : Ast.stmt) : unit = ctx.diverged <- div0 end | While { cond; body } -> + ctx.loop_stack <- s.s_id :: ctx.loop_stack; fixpoint ctx (fun () -> read_expr ctx cond; - analyze_block ctx ~node:s.s_id ~pos:s.s_pos ~label:"WHILE" body) + analyze_block ctx ~node:s.s_id ~pos:s.s_pos ~label:"WHILE" body); + ctx.loop_stack <- List.tl ctx.loop_stack | For { var; iter; body } -> read_expr ctx iter; let src = place_of iter in let item_ty = match expr_ty ctx iter with Some t -> ( match elem_ty t with Some e -> e | None -> t) | None -> Scalar "Int" in + ctx.loop_stack <- s.s_id :: ctx.loop_stack; fixpoint ctx (fun () -> push_scope ctx ~node:s.s_id ~pos:s.s_pos ~label:"FOR"; @@ -1202,7 +1495,22 @@ and analyze_stmt (ctx : ctx) (s : Ast.stmt) : unit = l_pos = s.s_pos; l_holds = false; l_src = src; l_bkind = AShared; l_state = Borrowed s.s_pos }; List.iter (analyze_stmt ctx) body; - pop_scope ctx) + pop_scope ctx); + ctx.loop_stack <- List.tl ctx.loop_stack + | DoWhile { body; cond } -> + (* `do { body } while cond` — body always runs before the condition + is ever consulted, so it is analyzed first; still wrapped in + `fixpoint` for the same reason `while`/`for` are (a *second* + iteration's move state must be joined against the first's, the + brief's own loop rule — see fixpoint's doc comment). *) + ctx.loop_stack <- s.s_id :: ctx.loop_stack; + fixpoint ctx + (fun () -> + analyze_block ctx ~node:s.s_id ~pos:s.s_pos ~label:"DO" body; + read_expr ctx cond); + ctx.loop_stack <- List.tl ctx.loop_stack + | Break -> analyze_break ctx s + | Continue -> analyze_continue ctx s (* The brief's loop rule: probe the body once with recording off, join that with the entry state, then analyze for real against the joined @@ -1223,8 +1531,14 @@ and fixpoint (ctx : ctx) (run : unit -> unit) : unit = restore (join entry after); ctx.diverged <- div0 -and analyze_block (ctx : ctx) ~node ~pos ~label (body : Ast.stmt list) : unit = +(* `~pre` (haxe-parity Task 4): locals to declare into the fresh scope + before its statements run — a payload pattern's bindings, and nothing + else today. Borrows only (l_holds = false), so pop_scope's drop + recording never sees them; every pre-existing call site passes + nothing and is byte-identical. *) +and analyze_block (ctx : ctx) ?(pre = []) ~node ~pos ~label (body : Ast.stmt list) : unit = push_scope ctx ~node ~pos ~label; + List.iter (declare ctx) pre; List.iter (analyze_stmt ctx) body; pop_scope ctx @@ -1360,6 +1674,38 @@ and analyze_return (ctx : ctx) (s : Ast.stmt) (opt : Ast.expr option) : unit = release_gc ctx ~node:s.s_id ~pos:s.s_pos live; ctx.diverged <- true +(* haxe-parity Task 2: `break`/`continue` reuse analyze_return's own + drop machinery verbatim, bounded to the nearest enclosing loop + instead of the whole function (live_holders_upto vs. live_holders — + see that function's doc comment) — this is "the one non-trivial bit" + the brief calls out: an owned value still alive in the loop body at + a `break`/`continue` gets its DROP recorded right here, at the jump, + not left to leak. `ctx.diverged <- true` afterward mirrors + analyze_return's own reasoning exactly: the rest of *this* block is + unreachable, and the surrounding if/fixpoint machinery already knows + how to fold that into a branch join or a loop's own entry/exit meet + (the same normalization a `return` inside a loop or an `if` already + gets, unchanged by this task). Outside any loop, `loop_stack` is + empty and nothing is recorded — see that field's own doc comment for + why emit.ml, not this pass, is the actual gate for that case. *) +and analyze_break (ctx : ctx) (s : Ast.stmt) : unit = + (match ctx.loop_stack with + | [] -> () + | loop_node :: _ -> + let live = live_holders_upto ctx loop_node in + record_drop ctx ~node:s.s_id ~pos:s.s_pos ~kind:DBreak ~items:(owned_items live); + release_gc ctx ~node:s.s_id ~pos:s.s_pos live); + ctx.diverged <- true + +and analyze_continue (ctx : ctx) (s : Ast.stmt) : unit = + (match ctx.loop_stack with + | [] -> () + | loop_node :: _ -> + let live = live_holders_upto ctx loop_node in + record_drop ctx ~node:s.s_id ~pos:s.s_pos ~kind:DContinue ~items:(owned_items live); + release_gc ctx ~node:s.s_id ~pos:s.s_pos live); + ctx.diverged <- true + (* ============================================================ Per-function driver ============================================================ *) @@ -1396,8 +1742,8 @@ let resolve_rc (ctx : ctx) : unit = let analyze_fn ~(file : string) (syms : Types.symbols) (coll : Diag.Collector.t) (sink : sink) ~(self_class : string option) (m : Ast.method_decl) : unit = let ctx = - { file; syms; coll; sink; fn_name = m.name; scopes = []; recording = true; diverged = false; - fn_rcs = []; rc_groups = Hashtbl.create 8; rc_escaped = Hashtbl.create 8; + { file; syms; coll; sink; fn_name = m.name; scopes = []; loop_stack = []; recording = true; + diverged = false; fn_rcs = []; rc_groups = Hashtbl.create 8; rc_escaped = Hashtbl.create 8; clobbered = Hashtbl.create 8 } in push_scope ctx ~node:m.id ~pos:m.pos ~label:"BODY"; @@ -1430,7 +1776,10 @@ let analyze ~(file : string) (prog : Ast.program) (syms : Types.symbols) | Ast.Class c -> List.iter (fun m -> analyze_fn ~file syms coll sink ~self_class:(Some c.name) m) c.methods | Ast.Interface _ -> () - | Ast.Fn f -> analyze_fn ~file syms coll sink ~self_class:None f) + | Ast.Fn f -> analyze_fn ~file syms coll sink ~self_class:None f + | Ast.Use _ -> () + | Ast.Const _ -> () + | Ast.Union _ -> () (* haxe-parity Task 4: no bodies to analyze *)) prog.decls; (* Source order: sort by position, stably, so entries sharing a position keep the order the walk produced. Node ids can *not* be diff --git a/compiler/src/parser.ml b/compiler/src/parser.ml index b4b7e14..f06a4b3 100644 --- a/compiler/src/parser.ml +++ b/compiler/src/parser.ml @@ -127,6 +127,15 @@ let fail (st : state) (site : Ast.pos) (code : string) (message : string) : 'a = let syntax_code = Diag.parsing_prefix ^ "01" (* WO-E101: generic syntax error *) let table_code = Diag.parsing_prefix ^ "02" (* WO-E102: invalid @table(...) configuration *) +(* haxe-parity Task 2: the haxe keyword verdict table's `inline` row — + "adopt (values): const compile-time values; inline *functions* + rejected — optimization is the compiler's job". `const` (below) is + the adopted half; this is the reject half's own diagnostic, cited at + `inline`'s own position, one per bad declaration (parse_program's + existing try/with resyncs past the whole discarded `inline fn ...` + body, same as any other bad top-level declaration). *) +let inline_fn_code = Diag.parsing_prefix ^ "03" (* WO-E103 *) + let unexpected (st : state) (what : string) : 'a = let p = peek_pos st in fail st p syntax_code @@ -149,6 +158,19 @@ let expect_ident (st : state) (what : string) : string = s | _ -> unexpected st what +(* haxe-parity Task 4: `type` is a legal FIELD name (the sample's own + wire-format key — mcp.wo's `ToolText = { type: Text, ... }` carries + JSON's `type` verbatim), so the three field-NAME positions (a field + declaration, a constructor-literal key, a `.field` access) accept the + keyword and treat it as the plain name "type". Field positions only — + everywhere else `type` stays the declaration keyword it is. *) +let expect_field_name (st : state) (what : string) : string = + match peek st with + | Token.KwType -> + ignore (advance st); + "type" + | _ -> expect_ident st what + (* ---- field/service/policy/on disambiguation -------------------------- Lookahead only: Ident immediately followed by Colon. Same shape rt @@ -205,9 +227,23 @@ let sync_to_next_top_level (st : state) : unit = decr depth; ignore (advance st) | Token.KwType when !depth = 0 && st.pos > start -> continue_ := false + | Token.KwTypedef when !depth = 0 && st.pos > start -> continue_ := false | Token.KwClass when !depth = 0 && st.pos > start -> continue_ := false | Token.KwInterface when !depth = 0 && st.pos > start -> continue_ := false | Token.KwFn when !depth = 0 && st.pos > start -> continue_ := false + | Token.KwUse when !depth = 0 && st.pos > start -> continue_ := false + | Token.KwConst when !depth = 0 && st.pos > start -> continue_ := false + (* KwPub deliberately NOT a sync point (unlike every other top-level + starter above): `pub(read)` (Task 7's field-accessor marker, not + this task's — ast.ml's method_decl.pub doc comment) recurs + *inside* an already-broken class/type body one field at a time, + and making KwPub a stop point would turn one coarse "whole class + discarded" diagnostic into one diagnostic per `pub(read)` field + line. Leaving it out preserves the pre-existing coarse-recovery + behavior there — the brief's own "leave it unparsed" option for + `pub(` — while a genuinely top-level `pub` still needs no sync + help at all: it's handled inline by parse_program on the + error-free path, and recovery only ever runs after a failure. *) | Token.At when !depth = 0 && st.pos > start -> continue_ := false | Token.Ident s when !depth = 0 && st.pos > start && is_sync_ident s -> continue_ := false | _ -> ignore (advance st) @@ -330,7 +366,17 @@ let parse_field_ty (st : state) : Ast.field_ty = Ast.Map (k, v) | Token.Ident name -> ignore (advance st); - Ast.Scalar name + (* haxe-parity Task 4: one qualified segment (`json.Value` — the + sample's own stdlib-reserved type in a record field). Kept as + one dotted Scalar name; whether it resolves is types.ml's + question (is_known_type_name treats a reserved-stdlib head as + UNKNOWN-BUT-RESERVED, same convention as `fs.stat(...)` calls). *) + if peek st = Token.Dot then begin + ignore (advance st); + let member = expect_ident st "qualified type name" in + Ast.Scalar (name ^ "." ^ member) + end + else Ast.Scalar name | _ -> unexpected st "a field type" in if !nullable then Ast.Nullable base_ty else base_ty @@ -394,9 +440,17 @@ let parse_default_expr (st : state) : Ast.default_expr = end else Ast.DefaultOpaque (collect_default_tokens st) -let parse_field (st : state) : Ast.field = +(* `~comma_ends` (haxe-parity Task 4): a typedef record body may list + its fields on one line, comma-separated (`typedef HttpResp = { + status: Int, body: Text }` — the sample's own shape), so a depth-0 + comma ends the field there exactly like a newline does in a + class/type body; the comma itself is left for the record loop to + consume. Every pre-existing call site passes nothing and keeps the + class-body behavior byte-identical (a comma there is still the same + "unexpected" error as before). *) +let parse_field ?(comma_ends = false) (st : state) : Ast.field = let pos = peek_pos st in - let name = expect_ident st "field name" in + let name = expect_field_name st "field name" in expect st Token.Colon "':'"; let ty = parse_field_ty st in let default = ref None in @@ -412,6 +466,7 @@ let parse_field (st : state) : Ast.field = | Token.Eq -> ignore (advance st); default := Some (parse_default_expr st) + | Token.Comma when comma_ends -> continue_ := false | Token.Newline | Token.RBrace | Token.Eof -> continue_ := false | _ -> unexpected st "an annotation, '=', or end of field" done; @@ -487,6 +542,8 @@ let parse_sig_head (st : state) : sig_head = Precedence ladder, loosest to tightest (parse_expr is the entry point; each level's loop is left-associative): + or or (haxe-parity Task 2) + and and (haxe-parity Task 2) comparison == != < <= > >= concat .. additive + - @@ -498,7 +555,11 @@ let parse_sig_head (st : state) : sig_head = This ordering matches Lua's (concat binds looser than +/-, tighter than comparison) — see ast.ml's module doc for why `..`/Concat is - this task's own addition, not a straight rt port. + this task's own addition, not a straight rt port. `and`/`or` sit + above comparison per the spec amendment's own words ("or binds + loosest, then and, then comparison") — real keywords (KwAnd/KwOr), + never `&&`/`||`, so `a == 1 and b == 2` parses with no parens: `and` + only ever sees fully-formed comparisons as its operands. End-of-statement convention mirrors parse_field's: a "simple" statement (let/assign/return/expr-statement/DbStub) must end at an @@ -650,7 +711,37 @@ let with_no_brace (st : state) (value : bool) (f : unit -> 'a) : 'a = (* ---- expression parsing -------------------------------------------------- *) -let rec parse_expr (st : state) : Ast.expr = parse_comparison st +let rec parse_expr (st : state) : Ast.expr = parse_or st + +and parse_or (st : state) : Ast.expr = + let lhs = ref (parse_and st) in + let continue_ = ref true in + while !continue_ do + match peek st with + | Token.KwOr -> + let pos = peek_pos st in + let id = fresh_id st in + ignore (advance st); + let rhs = parse_and st in + lhs := { Ast.id; pos; kind = Ast.Binary (Ast.Or, !lhs, rhs) } + | _ -> continue_ := false + done; + !lhs + +and parse_and (st : state) : Ast.expr = + let lhs = ref (parse_comparison st) in + let continue_ = ref true in + while !continue_ do + match peek st with + | Token.KwAnd -> + let pos = peek_pos st in + let id = fresh_id st in + ignore (advance st); + let rhs = parse_comparison st in + lhs := { Ast.id; pos; kind = Ast.Binary (Ast.And, !lhs, rhs) } + | _ -> continue_ := false + done; + !lhs and parse_comparison (st : state) : Ast.expr = let lhs = ref (parse_concat st) in @@ -741,7 +832,7 @@ and parse_postfix (st : state) : Ast.expr = | Token.Dot -> let pos = peek_pos st in ignore (advance st); - let name = expect_ident st "field or method name" in + let name = expect_field_name st "field or method name" in base := { Ast.id = fresh_id st; pos; kind = Ast.Field (!base, name) } | Token.LParen -> let pos = peek_pos st in @@ -791,20 +882,90 @@ and parse_ctor_literal (st : state) : Ast.expr = let fields = ref [] in let continue_ = ref (peek st <> Token.RBrace) in while !continue_ do - let fname = expect_ident st "constructor field name" in + let fname = expect_field_name st "constructor field name" in expect st Token.Colon "':'"; let fval = parse_expr st in fields := (fname, fval) :: !fields; skip_newlines st; - if accept st Token.Comma then skip_newlines st else continue_ := false + if accept st Token.Comma then begin + skip_newlines st; + (* trailing comma before the close (haxe-parity Task 4 — the + sample's own multi-line record literals end `..., }`) *) + if peek st = Token.RBrace then continue_ := false + end + else continue_ := false done; skip_newlines st; expect st Token.RBrace "'}'"; { Ast.id; pos; kind = Ast.Ctor (name, List.rev !fields) } +(* haxe-parity Task 3: `switch subject { case v1, v2: ... default: + }` — the sample's own shape (grepped every `switch` site in + docs/examples/log-watcher/*.wo first). The subject is parsed + `no_brace` for the exact reason if/while/for's own conditions are: + `switch res { ... }` must not read `res {` as a constructor literal + swallowing the switch's own body. Arms have no brace of their own + (the sample never wraps a case body in `{ }`) — [parse_switch_arm_body] + is [parse_block]'s loop with `case`/`default`/`}` as its stop set + instead of `}` alone, and no brace to expect/consume. `default` is + grammar-optional here; whether it's *required* depends on the + subject's type (scalar/Text: yes; a union: only if a variant is + missing — Task 4's territory), which is a typecheck-time question + (WO-E208), not a parse-time one. *) +and parse_switch_arm_body (st : state) : Ast.stmt list = + let stmts = ref [] in + let continue_ = ref true in + while !continue_ do + skip_newlines st; + match peek st with + | Token.KwCase | Token.KwDefault | Token.RBrace -> continue_ := false + | Token.Eof -> fail st (peek_pos st) syntax_code "unexpected end of input inside switch arm" + | _ -> ( + try stmts := parse_stmt st :: !stmts + with Parse_error -> sync_to_next_stmt st) + done; + List.rev !stmts + +and parse_switch_expr (st : state) : Ast.expr = + let pos = peek_pos st in + let id = fresh_id st in + ignore (advance st); + (* 'switch' *) + let subject = parse_expr_no_brace st in + expect st Token.LBrace "'{' to open switch body"; + let arms = ref [] in + let continue_ = ref true in + while !continue_ do + skip_newlines st; + match peek st with + | Token.RBrace -> + ignore (advance st); + continue_ := false + | Token.Eof -> fail st (peek_pos st) syntax_code "unexpected end of input inside switch body" + | Token.KwCase -> + let arm_pos = peek_pos st in + ignore (advance st); + let values = ref [ parse_expr st ] in + while accept st Token.Comma do + values := parse_expr st :: !values + done; + expect st Token.Colon "':' after switch case value(s)"; + let body = parse_switch_arm_body st in + arms := { Ast.arm_pos; values = List.rev !values; is_default = false; body } :: !arms + | Token.KwDefault -> + let arm_pos = peek_pos st in + ignore (advance st); + expect st Token.Colon "':' after `default`"; + let body = parse_switch_arm_body st in + arms := { Ast.arm_pos; values = []; is_default = true; body } :: !arms + | _ -> unexpected st "`case`, `default`, or '}' in switch body" + done; + { Ast.id; pos; kind = Ast.Switch (subject, List.rev !arms) } + and parse_primary (st : state) : Ast.expr = match peek st with | k when is_select_trigger k -> parse_dbstub_expr st + | Token.KwSwitch -> parse_switch_expr st | Token.Int n -> let pos = peek_pos st in let id = fresh_id st in @@ -815,6 +976,10 @@ and parse_primary (st : state) : Ast.expr = let id = fresh_id st in ignore (advance st); { Ast.id; pos; kind = Ast.StrLit s } + | Token.InterpStr segs -> + let pos = peek_pos st in + ignore (advance st); + desugar_interp st pos segs | Token.KwTrue -> let pos = peek_pos st in let id = fresh_id st in @@ -841,6 +1006,67 @@ and parse_primary (st : state) : Ast.expr = { Ast.id; pos; kind = Ast.Ident s } | _ -> unexpected st "an expression" +(* haxe-parity Task 2: desugars one interpolated string's segments into a + `..`/Concat chain of StrLit (text) and Interp (embedded expression) + nodes — the "desugars at parse time to concatenation" the brief + names. Each `Token.SExpr raw` segment is a full expression's *raw + source*, captured verbatim by the lexer (token.ml/lexer.ml's own doc + comments) — re-tokenized and re-parsed here via a fresh, nested + lexer/parser state over just that substring. Every generated node + (StrLit/Interp/the Concat spine) shares the outer string literal's + own single position: this AST has no source *ranges* (ast.ml's + module doc), and per-segment positions would need the lexer to track + an offset into the interpolation that nothing downstream needs today. + Known, disclosed imprecision: a malformed `${...}` expression's own + error therefore reports at the whole string's start, not the + sub-expression's real column — acceptable since the sub-parse still + raises a real, correctly-coded diagnostic, just at a coarser site. + + Review fix (Important, post-Task-2): a genuine sub-parse failure + (`"${1 +}"`, not just trailing garbage — `"${1 2}"`) used to add its + OWN diagnostic straight to `st.collector` from inside `parse_expr + sub_st`, at `sub_st`'s own uncorrected line/col (that lexer counts + from 1:1 over the raw substring, so the reported position landed on + some unrelated line of the *real* file), and then let `Parse_error` + propagate straight past this function, skipping the "malformed + ${...}" framing entirely. The sub-lex/sub-parse now runs against a + private, throwaway collector — nothing it reports (a lex error, a + parse error, or reaching a non-`Eof` leftover) ever touches the real + collector — so every failure inside collapses to exactly the one + diagnostic below, at the outer string's own position. *) +and desugar_interp (st : state) (pos : Ast.pos) (segs : Token.str_part list) : Ast.expr = + let mk_str s = { Ast.id = fresh_id st; pos; kind = Ast.StrLit s } in + let mk_interp inner = { Ast.id = fresh_id st; pos; kind = Ast.Interp inner } in + let parse_segment_expr (raw : string) : Ast.expr = + let sub_collector = Diag.Collector.create () in + let sub_toks = Lexer.tokenize sub_collector ~file:st.file raw in + let sub_st = make sub_collector ~file:st.file sub_toks in + let parsed = + try + let e = parse_expr sub_st in + if peek sub_st = Token.Eof && not (Diag.Collector.has_error sub_collector) then Some e + else None + with Parse_error -> None + in + match parsed with + | Some e -> e + | None -> fail st pos syntax_code "malformed \"${...}\" interpolation expression" + in + let parts = + List.filter_map + (function + | Token.SText "" -> None + | Token.SText s -> Some (mk_str s) + | Token.SExpr raw -> Some (mk_interp (parse_segment_expr raw))) + segs + in + match parts with + | [] -> mk_str "" + | first :: rest -> + List.fold_left + (fun acc e -> { Ast.id = fresh_id st; pos; kind = Ast.Binary (Ast.Concat, acc, e) }) + first rest + (* ---- statement parsing --------------------------------------------------- *) and parse_block (st : state) : Ast.stmt list = @@ -925,6 +1151,42 @@ and parse_return_stmt (st : state) : Ast.stmt = end_of_stmt st; { Ast.s_id = id; s_pos = pos; s_kind = Ast.Return value } +(* haxe-parity Task 2: `break`/`continue`. Whether either actually sits + inside a loop is not checked here (this parser has no loop-nesting + state, unlike `state.no_brace`) — emit.ml is the gate, exactly the + existing WO-E403 convention: a construct the emitter has no legal + jump target for is a diagnostic, not invented bytecode. *) +and parse_break_stmt (st : state) : Ast.stmt = + let pos = peek_pos st in + let id = fresh_id st in + ignore (advance st); + end_of_stmt st; + { Ast.s_id = id; s_pos = pos; s_kind = Ast.Break } + +and parse_continue_stmt (st : state) : Ast.stmt = + let pos = peek_pos st in + let id = fresh_id st in + ignore (advance st); + end_of_stmt st; + { Ast.s_id = id; s_pos = pos; s_kind = Ast.Continue } + +(* `do { body } while cond` — no `parse_expr_no_brace` needed for `cond`: + unlike `if`/`while`, nothing braced follows it (the statement just + ends), so a constructor literal there is never ambiguous with a + trailing block, the same reasoning `parse_return_stmt`'s value + already relies on. *) +and parse_do_while_stmt (st : state) : Ast.stmt = + let pos = peek_pos st in + let id = fresh_id st in + ignore (advance st); + (* 'do' *) + let body = parse_block st in + skip_newlines st; + expect st Token.KwWhile "`while` after `do { ... }`"; + let cond = parse_expr st in + end_of_stmt st; + { Ast.s_id = id; s_pos = pos; s_kind = Ast.DoWhile { body; cond } } + and parse_stmt (st : state) : Ast.stmt = match peek st with | k when is_insert_trigger k -> @@ -938,6 +1200,9 @@ and parse_stmt (st : state) : Ast.stmt = | Token.KwWhile -> parse_while_stmt st | Token.KwFor -> parse_for_stmt st | Token.KwReturn -> parse_return_stmt st + | Token.KwBreak -> parse_break_stmt st + | Token.KwContinue -> parse_continue_stmt st + | Token.KwDo -> parse_do_while_stmt st | _ -> let pos = peek_pos st in let id = fresh_id st in @@ -957,15 +1222,20 @@ and parse_stmt (st : state) : Ast.stmt = and [looks_like_ctor]. *) and parse_expr_no_brace (st : state) : Ast.expr = with_no_brace st true (fun () -> parse_expr st) -let parse_method (st : state) : Ast.method_decl = +(* `pub` (haxe-parity Task 1, modules) defaults to false: a class body's + own methods always call this with no `~pub` argument (method-level + visibility is a different, not-yet-designed question — see + ast.ml's method_decl.pub doc comment), so this default is what keeps + every existing call site's behavior byte-identical. *) +let parse_method ?(pub = false) (st : state) : Ast.method_decl = let h = parse_sig_head st in let body = parse_block st in - { Ast.id = h.s_id; pos = h.s_pos; name = h.s_name; params = h.s_params; ret = h.s_ret; body } + { Ast.id = h.s_id; pos = h.s_pos; name = h.s_name; params = h.s_params; ret = h.s_ret; body; pub } (* A free top-level function is grammatically identical to a class method (signature + brace-delimited body span) — Task 6's brief ("free-fn tables") is why this exists as real grammar. *) -let parse_fn_decl (st : state) : Ast.method_decl = parse_method st +let parse_fn_decl ~(pub : bool) (st : state) : Ast.method_decl = parse_method ~pub st (* Interface signatures have no body: the line ends at a Newline (which is consumed) or at the interface's own closing brace / EOF (left for @@ -1040,6 +1310,51 @@ let skip_on_block (st : state) : unit = | _ -> ignore (advance st) done +(* ---- const declaration (haxe-parity Task 2) ----------------------------- + + `const NAME = ` — top-level or (bare, no `static`) class-level. + The brief's own wording is "= literal", not "= expr": restricted here + to Int (optionally `-`-prefixed, folded directly into the literal — + no `Unary` wrapper needed for a compile-time value), Text, or Bool. + Resolved by a dedicated post-parse substitution pass (see `parse`, + below) rather than threaded through typecheck/owner/emit as a new + kind of name. *) +let parse_const_literal (st : state) : Ast.expr = + let pos = peek_pos st in + let id = fresh_id st in + match peek st with + | Token.Int n -> + ignore (advance st); + { Ast.id; pos; kind = Ast.IntLit n } + | Token.Dash -> ( + ignore (advance st); + match peek st with + | Token.Int n -> + ignore (advance st); + { Ast.id; pos; kind = Ast.IntLit (-n) } + | _ -> unexpected st "an integer literal after '-'") + | Token.Str s -> + ignore (advance st); + { Ast.id; pos; kind = Ast.StrLit s } + | Token.KwTrue -> + ignore (advance st); + { Ast.id; pos; kind = Ast.BoolLit true } + | Token.KwFalse -> + ignore (advance st); + { Ast.id; pos; kind = Ast.BoolLit false } + | _ -> unexpected st "a literal (Int, Text, or Bool)" + +let parse_const_decl (st : state) : Ast.const_decl = + let pos = peek_pos st in + let id = fresh_id st in + ignore (advance st); + (* 'const' *) + let name = expect_ident st "const name" in + expect st Token.Eq "'=' in const declaration"; + let value = parse_const_literal st in + end_of_stmt st; + { Ast.id; pos; name; value } + (* ---- class / type declaration ------------------------------------------- Task 4 brief: "class Name { ... } and type Name { ... } — identical @@ -1048,7 +1363,7 @@ let skip_on_block (st : state) : unit = skip-discarded) — so both keywords get the same body loop here, `is_class` recorded purely as data for later stages, never gating what's parsed. *) -let parse_class_or_type (st : state) (ann : type_annotations) : Ast.class_decl = +let parse_class_or_type ?(pub = false) (st : state) (ann : type_annotations) : Ast.class_decl = let pos = peek_pos st in let is_class = peek st = Token.KwClass in if is_class then ignore (advance st) else expect st Token.KwType "`type` or `class`"; @@ -1057,6 +1372,7 @@ let parse_class_or_type (st : state) (ann : type_annotations) : Ast.class_decl = let id = fresh_id st in let fields = ref [] in let methods = ref [] in + let consts = ref [] in let continue_ = ref true in while !continue_ do skip_newlines st; @@ -1067,6 +1383,13 @@ let parse_class_or_type (st : state) (ann : type_annotations) : Ast.class_decl = | Token.Eof -> fail st (peek_pos st) syntax_code "unexpected end of input inside type/class body" | Token.KwFn -> methods := parse_method st :: !methods + (* bare `const` only — `static const` (Task 7's `static`) is not + recognized here at all: `static` lexes as a plain Ident, matches + none of this loop's arms (not looks_like_field: the next token is + `const`, not a Colon), and falls through to the same clean + "expected a field, method, or ..." error every other unrecognized + class-body construct gets — no half-swallow, per the brief. *) + | Token.KwConst -> consts := parse_const_decl st :: !consts (* looks_like_field MUST be checked before is_sync_ident: `on`/ `service`/`policy` are plain Idents here (Task 3 deliberately kept them as usable identifiers, unlike rt where they're real keywords @@ -1085,19 +1408,120 @@ let parse_class_or_type (st : state) (ann : type_annotations) : Ast.class_decl = pos; name; is_class; + is_record = false; is_gc = ann.is_gc; table = ann.table; fields = List.rev !fields; methods = List.rev !methods; + consts = List.rev !consts; + pub; } +(* ---- typedef record declaration (haxe-parity Task 4) --------------------- + + `typedef Name = { field: Type [= default] [, ...] ?opt: Type ... }` — + a structural record alias. Fields only (no methods, no consts, no + service/policy/on leniency — a record is pure data shape); separators + are newlines OR commas (the sample writes both: multi-line SupConfig, + single-line HttpResp). A `?` prefixing the field NAME (`?detections: + Text`, the Haxe `@:optional` spelling) desugars to the field typed + `?T` — "?fields land as nullable-by-shape" (the task brief's own + words): one representation, `Nullable`, whether the `?` was written + on the name or on the type, so Task 6's forced-handling work has a + single shape to tighten. *) +let parse_record_decl ?(pub = false) (st : state) : Ast.class_decl = + let pos = peek_pos st in + ignore (advance st); + (* 'typedef' *) + let name = expect_ident st "typedef name" in + expect st Token.Eq "'=' in typedef declaration"; + expect st Token.LBrace "'{' to open typedef record body"; + let id = fresh_id st in + let fields = ref [] in + let continue_ = ref true in + while !continue_ do + skip_newlines st; + match peek st with + | Token.RBrace -> + ignore (advance st); + continue_ := false + | Token.Eof -> fail st (peek_pos st) syntax_code "unexpected end of input inside typedef body" + | _ -> + let optional = accept st Token.Question in + let f = parse_field ~comma_ends:true st in + let f = + if optional then + match f.Ast.ty with + | Ast.Nullable _ -> f (* `?opt: ?T` — already nullable, don't double-wrap *) + | ty -> { f with Ast.ty = Ast.Nullable ty } + else f + in + fields := f :: !fields; + ignore (accept st Token.Comma) + done; + { + Ast.id; + pos; + name; + is_class = false; + is_record = true; + is_gc = false; + table = None; + fields = List.rev !fields; + methods = []; + consts = []; + pub; + } + +(* ---- union declaration (haxe-parity Task 4) ------------------------------- + + `type Name = V1 | V2 | V3(field: Type, ...)` — a tagged union, + sharing the `type` keyword with the struct form (`type Name { ... }`) + and disambiguated by the token after the name (`=` vs `{`, decided by + parse_program's two-token lookahead before either parser runs). A + variant's payload reuses the field grammar's `name: Type` pairs, + comma-separated inside its parens; a newline is allowed after a `|` + (so a long union can wrap) but the declaration otherwise ends the way + a `use`/`let` line does (end_of_stmt). *) +let parse_union_decl ?(pub = false) (st : state) : Ast.union_decl = + let pos = peek_pos st in + ignore (advance st); + (* 'type' *) + let name = expect_ident st "union name" in + let id = fresh_id st in + expect st Token.Eq "'=' in union declaration"; + let parse_variant () : Ast.variant_decl = + let v_pos = peek_pos st in + let v_name = expect_ident st "variant name" in + let v_fields = ref [] in + if accept st Token.LParen then begin + let more = ref (peek st <> Token.RParen) in + while !more do + let fname = expect_ident st "payload field name" in + expect st Token.Colon "':'"; + let fty = parse_field_ty st in + v_fields := (fname, fty) :: !v_fields; + if not (accept st Token.Comma) then more := false + done; + expect st Token.RParen "')'" + end; + { Ast.v_pos; v_name; v_fields = List.rev !v_fields } + in + let variants = ref [ parse_variant () ] in + while accept st Token.Pipe do + skip_newlines st; + variants := parse_variant () :: !variants + done; + end_of_stmt st; + { Ast.id; pos; name; variants = List.rev !variants; pub } + (* ---- interface declaration ---------------------------------------------- Signatures only — no fields, no bodies (Task 4 brief: "interface Name { fn sig... } (signatures only)"). Anything other than `fn` inside an interface body is a parse error; interfaces don't get the service/policy/on leniency class/type bodies get. *) -let parse_interface (st : state) : Ast.interface_decl = +let parse_interface ?(pub = false) (st : state) : Ast.interface_decl = let pos = peek_pos st in expect st Token.KwInterface "`interface`"; let name = expect_ident st "interface name" in @@ -1115,7 +1539,31 @@ let parse_interface (st : state) : Ast.interface_decl = | Token.KwFn -> methods := parse_iface_sig st :: !methods | _ -> unexpected st "a method signature (`fn ...`)" done; - { Ast.id; pos; name; methods = List.rev !methods } + { Ast.id; pos; name; methods = List.rev !methods; pub } + +(* ---- use declaration (haxe-parity Task 1, modules) ---------------------- + + `use fs` (a reserved stdlib namespace) or `use shared/util` (a + project-relative path — slash-separated directory segments naming + another discovered module's directory). Which of those two a given + path actually is, and whether it resolves at all, is the resolver's + job (types.ml) — this only demands at least one identifier segment, + with `/`-separated continuations, ended the same way a `let`/return + statement is (`end_of_stmt`: optional `;`, then newline/EOF — there + is no enclosing block at top level, but end_of_stmt's RBrace arm is + harmless dead code here, never reached). *) +let parse_use_decl (st : state) : Ast.use_decl = + let pos = peek_pos st in + let id = fresh_id st in + ignore (advance st); + (* 'use' *) + let first = expect_ident st "module name" in + let segments = ref [ first ] in + while accept st Token.Slash do + segments := expect_ident st "module path segment" :: !segments + done; + end_of_stmt st; + { Ast.id; pos; segments = List.rev !segments } (* ---- top-level program --------------------------------------------------- @@ -1124,6 +1572,15 @@ let parse_interface (st : state) : Ast.interface_decl = try/with: on Parse_error (already reported at its raise site, see [fail]), sync to the next top-level construct and keep going — exactly one diagnostic per broken declaration, never a cascade. *) +(* `type Name = ...` is a union; `type Name { ... }` stays the struct + form — two-token lookahead past the name (haxe-parity Task 4), + mirroring looks_like_ctor's identifier-then-brace trick one token + further out. Anything else after the name falls to + parse_class_or_type's own "expected '{'" error, unchanged. *) +let looks_like_union (st : state) : bool = + (match (tok_at st (st.pos + 1)).kind with Token.Ident _ -> true | _ -> false) + && (tok_at st (st.pos + 2)).kind = Token.Eq + let parse_program (st : state) : Ast.program = let decls = ref [] in let continue_ = ref true in @@ -1133,10 +1590,40 @@ let parse_program (st : state) : Ast.program = else begin (try match peek st with + | Token.KwType when looks_like_union st -> + decls := Ast.Union (parse_union_decl st) :: !decls | Token.KwType | Token.KwClass -> decls := Ast.Class (parse_class_or_type st no_annotations) :: !decls + | Token.KwTypedef -> decls := Ast.Class (parse_record_decl st) :: !decls | Token.KwInterface -> decls := Ast.Interface (parse_interface st) :: !decls - | Token.KwFn -> decls := Ast.Fn (parse_fn_decl st) :: !decls + | Token.KwFn -> decls := Ast.Fn (parse_fn_decl ~pub:false st) :: !decls + | Token.KwUse -> decls := Ast.Use (parse_use_decl st) :: !decls + | Token.KwConst -> decls := Ast.Const (parse_const_decl st) :: !decls + | Token.KwInline -> + let ipos = peek_pos st in + ignore (advance st); + (match peek st with + | Token.KwFn -> + fail st ipos inline_fn_code + "`inline fn` is rejected — optimization is the compiler's job (const values are \ + the adopted half of this row)" + | _ -> unexpected st "`fn` after `inline`") + | Token.KwPub -> ( + ignore (advance st); + (* consume 'pub'; a stray '(' here (`pub(read)` at top level — + Task 7's field-accessor marker, not this task's) falls + through to the same clean "expected ... after `pub`" error + as any other unrecognized token, rather than being + half-parsed. *) + match peek st with + | Token.KwType when looks_like_union st -> + decls := Ast.Union (parse_union_decl ~pub:true st) :: !decls + | Token.KwType | Token.KwClass -> + decls := Ast.Class (parse_class_or_type ~pub:true st no_annotations) :: !decls + | Token.KwTypedef -> decls := Ast.Class (parse_record_decl ~pub:true st) :: !decls + | Token.KwInterface -> decls := Ast.Interface (parse_interface ~pub:true st) :: !decls + | Token.KwFn -> decls := Ast.Fn (parse_fn_decl ~pub:true st) :: !decls + | _ -> unexpected st "`type`, `class`, `interface`, or `fn` after `pub`") | Token.At -> let ann = parse_type_annotations st in skip_newlines st; @@ -1150,6 +1637,134 @@ let parse_program (st : state) : Ast.program = done; { Ast.decls = List.rev !decls } +(* ---- const substitution (haxe-parity Task 2) ---------------------------- + + Runs once, over the whole freshly-parsed program, right before `parse` + returns it. Replaces every unshadowed `Ident NAME` with the literal + expr NAME's `const` declared, so typecheck/owner/emit see a plain + literal and need zero const-specific code anywhere downstream — the + same "desugar early, touch nothing later" shape string interpolation + already uses in this file. Scope-aware exactly like types.ml's own + local-shadows-a-`use`-alias fix (Task 1 review): a local, parameter, + `for` variable, or `self` binding of the same name always wins over a + const of that name, so `fn f(CHUNK: Int) { return CHUNK }` next to a + top-level `const CHUNK = 65536` still returns the parameter, not + 65536. A const's own value is grammar-restricted to a literal + (parse_const_literal) — never an `Ident` — so one const's value can + never need substitution itself; no ordering/cycle question arises. *) +module StringMap = Map.Make (String) +module StringSet = Set.Make (String) + +let rec subst_expr (consts : Ast.expr StringMap.t) (bound : StringSet.t) (e : Ast.expr) : Ast.expr = + match e.Ast.kind with + | Ast.IntLit _ | Ast.StrLit _ | Ast.BoolLit _ | Ast.DbStub _ -> e + | Ast.Ident name -> + if StringSet.mem name bound then e + else ( match StringMap.find_opt name consts with Some v -> { e with Ast.kind = v.Ast.kind } | None -> e) + | Ast.Field (base, fname) -> { e with Ast.kind = Ast.Field (subst_expr consts bound base, fname) } + | Ast.Index (base, idx) -> + { e with Ast.kind = Ast.Index (subst_expr consts bound base, subst_expr consts bound idx) } + | Ast.Call (callee, args) -> + { e with Ast.kind = Ast.Call (subst_expr consts bound callee, List.map (subst_expr consts bound) args) } + | Ast.Unary (op, operand) -> { e with Ast.kind = Ast.Unary (op, subst_expr consts bound operand) } + | Ast.Binary (op, l, r) -> + { e with Ast.kind = Ast.Binary (op, subst_expr consts bound l, subst_expr consts bound r) } + | Ast.Ctor (cn, fields) -> + { e with Ast.kind = Ast.Ctor (cn, List.map (fun (n, v) -> (n, subst_expr consts bound v)) fields) } + | Ast.Interp inner -> { e with Ast.kind = Ast.Interp (subst_expr consts bound inner) } + | Ast.Switch (subject, arms) -> + { e with + Ast.kind = + Ast.Switch + ( subst_expr consts bound subject, + List.map + (fun (a : Ast.switch_arm) -> + { a with + Ast.values = List.map (subst_expr consts bound) a.Ast.values; + body = subst_block consts bound a.Ast.body; + }) + arms ) + } + +(* `let` extends the rest of *this* block only, exactly like types.ml's + walk_stmt/walk_block: a nested block's own `let`s never leak back out + to the caller's bound set. + + `subst_expr` now reaches into `Switch`'s own `stmt list` arm bodies + (haxe-parity Task 3), so it and `subst_block`/`subst_stmt` are one + `and`-chain from here on, not two separate `let rec` groups — the + same merge ast.ml's own `expr`/`stmt` needed for the same reason. *) +and subst_block (consts : Ast.expr StringMap.t) (bound : StringSet.t) (body : Ast.stmt list) : + Ast.stmt list = + let bound_ref = ref bound in + List.map + (fun (s : Ast.stmt) -> + let s' = subst_stmt consts !bound_ref s in + (match s.Ast.s_kind with + | Ast.Let { name; _ } -> bound_ref := StringSet.add name !bound_ref + | _ -> ()); + s') + body + +and subst_stmt (consts : Ast.expr StringMap.t) (bound : StringSet.t) (s : Ast.stmt) : Ast.stmt = + let e = subst_expr consts bound in + match s.Ast.s_kind with + | Ast.Let { name; ty; value } -> { s with Ast.s_kind = Ast.Let { name; ty; value = e value } } + | Ast.Assign { target; value } -> { s with Ast.s_kind = Ast.Assign { target = e target; value = e value } } + | Ast.If { cond; then_body; else_body } -> + { s with + Ast.s_kind = + Ast.If + { cond = e cond; + then_body = subst_block consts bound then_body; + else_body = Option.map (fun (p, b) -> (p, subst_block consts bound b)) else_body + } + } + | Ast.While { cond; body } -> + { s with Ast.s_kind = Ast.While { cond = e cond; body = subst_block consts bound body } } + | Ast.For { var; iter; body } -> + let bound' = StringSet.add var bound in + { s with Ast.s_kind = Ast.For { var; iter = e iter; body = subst_block consts bound' body } } + | Ast.Return opt -> { s with Ast.s_kind = Ast.Return (Option.map e opt) } + | Ast.ExprStmt ex -> { s with Ast.s_kind = Ast.ExprStmt (e ex) } + | Ast.Break | Ast.Continue -> s + | Ast.DoWhile { body; cond } -> + { s with Ast.s_kind = Ast.DoWhile { body = subst_block consts bound body; cond = e cond } } + +let params_bound (base : StringSet.t) (params : Ast.param list) : StringSet.t = + List.fold_left (fun acc (p : Ast.param) -> StringSet.add p.Ast.name acc) base params + +let const_map (consts : Ast.const_decl list) : Ast.expr StringMap.t = + List.fold_left (fun acc (c : Ast.const_decl) -> StringMap.add c.Ast.name c.Ast.value acc) StringMap.empty consts + +let subst_consts (prog : Ast.program) : Ast.program = + let top_consts = + const_map (List.filter_map (function Ast.Const c -> Some c | _ -> None) prog.Ast.decls) + in + let decls' = + List.map + (function + | Ast.Class c -> + (* class consts win over top-level ones on a name collision -- + innermost scope wins, matching how a param/local also + outranks either. *) + let merged = StringMap.fold StringMap.add (const_map c.Ast.consts) top_consts in + let methods' = + List.map + (fun (m : Ast.method_decl) -> + let bound = params_bound (StringSet.singleton "self") m.Ast.params in + { m with Ast.body = subst_block merged bound m.Ast.body }) + c.Ast.methods + in + Ast.Class { c with Ast.methods = methods' } + | Ast.Fn fn -> + let bound = params_bound StringSet.empty fn.Ast.params in + Ast.Fn { fn with Ast.body = subst_block top_consts bound fn.Ast.body } + | (Ast.Interface _ | Ast.Use _ | Ast.Const _ | Ast.Union _) as d -> d) + prog.Ast.decls + in + { Ast.decls = decls' } + let parse (collector : Diag.Collector.t) ~(file : string) (toks : Token.t list) : Ast.program = let st = make collector ~file toks in - parse_program st + subst_consts (parse_program st) diff --git a/compiler/src/token.ml b/compiler/src/token.ml index da705b0..7b3eda3 100644 --- a/compiler/src/token.ml +++ b/compiler/src/token.ml @@ -20,11 +20,25 @@ (CLAUDE.md gotcha — this is the whole reason Task 3 exists as a from-scratch lexer rather than a copy of rt's). *) +type str_part = + | SText of string (* literal text, escapes already applied *) + | SExpr of string (* raw, unlexed source of one `${...}`'s body *) + type kind = (* literals *) | Ident of string | Int of int | Str of string + (* haxe-parity Task 2: a string literal containing at least one + `${expr}` interpolation. Alternating text/expr segments, in source + order; SExpr carries the *raw, unlexed* source text between the + `${` and its matching `}` (nested braces/strings skipped verbatim + by the lexer's own scan) -- the parser re-tokenizes/re-parses it as + a real expression, which is where "desugars at parse time to + concatenation" actually happens (ast.ml/parser.ml). A plain string + with no `${` never produces this -- it still lexes as a bare Str, + byte-identical to every pre-existing fixture. *) + | InterpStr of str_part list (* milestone-1 keywords *) | KwType | KwClass @@ -41,6 +55,41 @@ type kind = | KwIn | KwTrue | KwFalse + (* haxe-parity Task 1 (modules): `use ` top-level import and the + `pub` visibility marker on class/interface/fn declarations. Real + keywords, not positionally-recognized idents like insert/select or + ref/multi/map -- neither name is used as an identifier anywhere in + the existing corpus/fixtures, so there is no rt-parity or + field-name collision to dodge (see lexer.ml's module doc for why + those other names stayed idents). *) + | KwUse + | KwPub + (* haxe-parity Task 2 (small control surface): break/continue/do-while, + const values, and/or booleans, and inline-fn rejection (the haxe + verdict table's own row: "const compile-time values; inline + *functions* rejected"). All real keywords -- none collides with an + existing corpus identifier (grepped before adding, same discipline + Task 1 used for use/pub). *) + | KwBreak + | KwContinue + | KwDo + | KwConst + | KwAnd + | KwOr + | KwInline + (* haxe-parity Task 3: `switch`/`case`/`default` — real keywords (none + collides with an existing corpus/sample identifier, grepped first, + same discipline Tasks 1/2 used for use/pub/break/etc.). *) + | KwSwitch + | KwCase + | KwDefault + (* haxe-parity Task 4: `typedef Name = { ... }` structural records. A + real keyword (grepped the corpus/sample first, same discipline as + every keyword above — `typedef` appears only as this declaration's + own leading word, never as an identifier). Union declarations reuse + the existing KwType (`type Name = A | B` vs. the struct form + `type Name { ... }` — disambiguated by the token after the name). *) + | KwTypedef (* uppercase-only SQL-layer stubs (Task 5 parses these into a DbStub span); lowercase "insert"/"select" are plain Ident, never these. *) | KwInsert diff --git a/compiler/src/types.ml b/compiler/src/types.ml index 8099705..d50e54e 100644 --- a/compiler/src/types.ml +++ b/compiler/src/types.ml @@ -7,6 +7,7 @@ open Ast module StringMap = Map.Make(String) +module StringSet = Set.Make(String) (* ============================================================ Type representations (internal, resolved) @@ -37,12 +38,14 @@ type wob_kind = type class_info = { name : string; is_class : bool; + is_record : bool; (* haxe-parity Task 4 — see Ast.class_decl.is_record *) is_gc : bool; table : table_cfg option; fields : (string * field_ty * default_expr option * string list) list; methods : method_info list; id : int; pos : pos; + pub : bool; (* haxe-parity Task 1 (modules) — see Ast.class_decl.pub *) } and interface_info = { @@ -50,6 +53,7 @@ and interface_info = { methods : method_sig_info list; id : int; pos : pos; + pub : bool; (* haxe-parity Task 1 (modules) *) } and method_sig_info = { @@ -79,6 +83,7 @@ and free_fn_info = { mutates : bool; id : int; pos : pos; + pub : bool; (* haxe-parity Task 1 (modules) *) } and typedef_info = { @@ -88,19 +93,76 @@ and typedef_info = { pos : pos; } +(* haxe-parity Task 4: one variant of a union. `vi_tag` is the variant's + ordinal in its union's declaration order — for an all-bare union that + IS the runtime value (a plain scalar tag); for a payload-carrying + union the runtime tag is instead the variant's own class-table id + (emit.ml assigns it; the object header's class_id field carries it — + docs/plan/oop-vm/00-wob-format.md's variant convention), and vi_tag + only orders exhaustiveness messages deterministically. *) +and variant_info = { + vi_name : string; + vi_fields : (string * field_ty) list; + vi_tag : int; +} + +and union_info = { + u_name : string; + u_variants : variant_info list; + (* at least one variant carries payload fields: every value of this + union is a heap variant object. False = all-bare: pure scalar tags, + no class-table entries, no heap. *) + u_has_payload : bool; + u_id : int; + u_pos : pos; + u_pub : bool; +} + and symbols = { classes : class_info StringMap.t; interfaces : interface_info StringMap.t; free_fns : free_fn_info StringMap.t; typedefs : typedef_info StringMap.t; + unions : union_info StringMap.t; (* haxe-parity Task 4 *) modules : string list; } +(* Variant lookup by bare name, across every union in scope — how a + `Pending`/`Failed(...)` reference resolves at all (variants share one + flat namespace per program, like free fns; a duplicate within one + file is WO-E215, below). Unions are few and small, so a fold beats + maintaining a second, derived map that could drift. *) +let find_variant_in (unions : union_info StringMap.t) (name : string) : + (union_info * variant_info) option = + StringMap.fold + (fun _ u acc -> + match acc with + | Some _ -> acc + | None -> ( + match List.find_opt (fun v -> v.vi_name = name) u.u_variants with + | Some v -> Some (u, v) + | None -> None)) + unions None + +let find_variant (syms : symbols) (name : string) : (union_info * variant_info) option = + find_variant_in syms.unions name + (* Builtin scalars *) let builtin_scalars = ["Int"; "Bool"; "Text"; "Timestamp"; "Id"] let is_builtin_scalar name = List.mem name builtin_scalars +(* haxe-parity Task 1 (modules) / gap-closure amendment: six reserved + stdlib namespaces, not the plan text's five — `use fs`/`proc`/`net`/ + `time`/`json`/`env` must resolve now (their members arrive in plan + 9); a project module can never legally shadow one of these six + single-segment names (`check_use_edges` below treats any one-segment + `use` path whose name is in this list as stdlib, unconditionally, + never as a project directory search). *) +let stdlib_modules = [ "fs"; "proc"; "net"; "time"; "json"; "env" ] + +let is_stdlib_module (name : string) : bool = List.mem name stdlib_modules + let rec has_recursive_structure (cls : class_info) : bool = List.exists (fun (_, ty, _, _) -> match ty with @@ -166,6 +228,15 @@ let wob_kind_of_typ (syms : symbols) (t : typ) : wob_kind = caller. *) if name = "Text" then WO_K_TEXT else if is_builtin_scalar name then WO_K_SCALAR + else if StringMap.mem name syms.unions then + (* haxe-parity Task 4: an all-bare union value is a plain + integer tag — SCALAR, or the drop plan would chase the tag + as a pointer (the exact int-as-pointer segfault family this + codebase keeps re-finding). A payload union value is a heap + variant object the slot owns — OWNED, its own class-table + kinds free the payload recursively. *) + (if (StringMap.find name syms.unions).u_has_payload then WO_K_OWNED + else WO_K_SCALAR) else if is_gc_class syms name then WO_K_GCREF else WO_K_OWNED | TNullable _inner -> WO_K_NULLABLE @@ -194,8 +265,29 @@ let nullable_used_without_check_code = Diag.types_prefix ^ "11" let nullable_assign_mismatch_code = Diag.types_prefix ^ "12" let missing_nil_check_code = Diag.types_prefix ^ "13" +(* haxe-parity Task 1 (modules). module_not_imported_code (WO-E210, + above) was already reserved by Task 6's brief for exactly this: "a + name used from a module that was never `use`d" — genuinely blocked + until now on there being a `use`/module concept at all + (docs/plan/compiler/nullable-types-implementation.md's dead-code + register). The three below are new — no earlier task named or + reserved them, because no earlier task had a module system to need + them for. *) +let unknown_module_code = Diag.types_prefix ^ "16" (* WO-E216 *) +let private_name_code = Diag.types_prefix ^ "17" (* WO-E217 *) +let use_collision_code = Diag.types_prefix ^ "18" (* WO-E218 *) +let unused_use_code = Diag.warning_prefix ^ "202" (* WO-W202 *) + let unknown_type_name_code = Diag.types_prefix ^ "25" (* WO-E225 *) +(* haxe-parity Task 3, review fix (Critical 1). `default` is moved to + the *end* of the lowering order regardless of where it sits in the + source (Ast.switch_lowering_order) -- so a `case` arm written after + it is not a silent, unreachable dead-code trap the way it was + before that fix, but it is still surprising source: warn once per + switch shaped that way, naming where `default` actually sits. *) +let switch_default_not_last_code = Diag.warning_prefix ^ "203" (* WO-W203 *) + (* Same-file counterpart to main.ml's cross-file WO-E214 (Task 8 review): a duplicate class/interface/fn name declared twice *within one file* was silently dropped by collect_declarations's StringMap.add (Task 1 @@ -226,6 +318,7 @@ let collect_declarations ~file (prog : program) (collector : Diag.Collector.t) : let interfaces = ref StringMap.empty in let free_fns = ref StringMap.empty in let typedefs = ref StringMap.empty in + let unions = ref StringMap.empty in let modules = ref [] in List.iter (function @@ -246,12 +339,14 @@ let collect_declarations ~file (prog : program) (collector : Diag.Collector.t) : let info = { name = c.name; is_class = c.is_class; + is_record = c.is_record; is_gc = c.is_gc; table = c.table; fields = fields; methods = methods; id = c.id; pos = c.pos; + pub = c.pub; } in (match StringMap.find_opt c.name !classes with | Some (existing : class_info) -> @@ -273,6 +368,7 @@ let collect_declarations ~file (prog : program) (collector : Diag.Collector.t) : methods = methods; id = i.id; pos = i.pos; + pub = i.pub; } in (match StringMap.find_opt i.name !interfaces with | Some (existing : interface_info) -> @@ -288,16 +384,69 @@ let collect_declarations ~file (prog : program) (collector : Diag.Collector.t) : mutates = false; id = f.id; pos = f.pos; + pub = f.pub; } in (match StringMap.find_opt f.name !free_fns with | Some (existing : free_fn_info) -> report_duplicate_decl collector ~file ~kind:"fn" ~name:f.name ~pos:f.pos ~first_pos:existing.pos | None -> free_fns := StringMap.add f.name info !free_fns) + | Ast.Use _ -> () + (* module-graph concern (haxe-parity Task 1), not a declaration — + handled by check_modules below, over the raw AST directly (it + needs the *file's* use-edges, not a merged per-name table). *) + | Ast.Const _ -> () + (* haxe-parity Task 2: consts are fully resolved by parser.ml's own + post-parse substitution pass before typecheck ever runs — every + reference already *is* the literal it named, so there is + nothing left for this stage to declare or check. *) + | Ast.Union u -> + (* haxe-parity Task 4. Duplicate union names get WO-E215 exactly + like classes/interfaces/fns do; a variant name reused across + this file's unions gets it too (variants share one flat value + namespace — a bare `Ok` reference could not otherwise pick a + tag). Cross-file variant collisions ride the same first-wins + merge every other kind already has (WO-E214 covers classes/ + interfaces only — disclosed, not extended here). *) + let variants = + List.mapi + (fun i (v : Ast.variant_decl) -> + { vi_name = v.v_name; vi_fields = v.v_fields; vi_tag = i }) + u.variants + in + let info = { + u_name = u.name; + u_variants = variants; + u_has_payload = List.exists (fun v -> v.vi_fields <> []) variants; + u_id = u.id; + u_pos = u.pos; + u_pub = u.pub; + } in + (match StringMap.find_opt u.name !unions with + | Some (existing : union_info) -> + report_duplicate_decl collector ~file ~kind:"union" ~name:u.name ~pos:u.pos + ~first_pos:existing.u_pos + | None -> + let seen_own = ref [] in + List.iter + (fun (v : Ast.variant_decl) -> + (match List.assoc_opt v.v_name !seen_own with + | Some first_pos -> + report_duplicate_decl collector ~file ~kind:"variant" ~name:v.v_name + ~pos:v.v_pos ~first_pos + | None -> ( + match find_variant_in !unions v.v_name with + | Some (other, _) -> + report_duplicate_decl collector ~file ~kind:"variant" ~name:v.v_name + ~pos:v.v_pos ~first_pos:other.u_pos + | None -> ())); + seen_own := (v.v_name, v.v_pos) :: !seen_own) + u.variants; + unions := StringMap.add u.name info !unions) ) prog.decls; { classes = !classes; interfaces = !interfaces; free_fns = !free_fns; - typedefs = !typedefs; modules = !modules } + typedefs = !typedefs; unions = !unions; modules = !modules } (* ============================================================ Pass 2: Body Typechecking @@ -308,12 +457,22 @@ type expr_type_result = { is_nil : bool; } -(* WO-E225's "known type" set: builtin, a declared class, or a declared - interface. *) +(* WO-E225's "known type" set: builtin, a declared class (typedef + records included — they live in `classes`), a declared interface, or + (haxe-parity Task 4) a declared union. A dotted name whose head is a + reserved stdlib namespace (`json.Value` — the sample's own record + field) is UNKNOWN-BUT-RESERVED: accepted here the same way a + `fs.stat(...)` call is accepted by the module checker, since the six + namespaces' members arrive in plan 9. Any other dotted name is as + unknown as a misspelling. *) let is_known_type_name (syms : symbols) (name : string) : bool = is_builtin_scalar name || StringMap.mem name syms.classes || StringMap.mem name syms.interfaces + || StringMap.mem name syms.unions + || (match String.index_opt name '.' with + | Some i -> is_stdlib_module (String.sub name 0 i) + | None -> false) let rec scalar_name_of (ft : field_ty) : string option = match ft with @@ -341,14 +500,449 @@ let check_field_types ~file (syms : symbols) (collector : Diag.Collector.t) ~message:(Printf.sprintf "unknown type `%s`" name) ()) | _ -> () ) c.fields - | Ast.Interface _ | Ast.Fn _ -> () + | Ast.Union u -> + (* haxe-parity Task 4: a variant's payload field types get the + same once-per-declaration WO-E225 check a class field's type + does, at the variant's own position. *) + List.iter (fun (v : Ast.variant_decl) -> + List.iter (fun (_, fty) -> + match scalar_name_of fty with + | Some name when not (is_known_type_name syms name) -> + Diag.Collector.add collector + (Diag.error ~code:unknown_type_name_code ~file + ~line:v.v_pos.line ~col:v.v_pos.col + ~message:(Printf.sprintf "unknown type `%s`" name) ()) + | _ -> () + ) v.v_fields + ) u.variants + | Ast.Interface _ | Ast.Fn _ | Ast.Use _ | Ast.Const _ -> () ) prog.decls -let typecheck_program ~file (prog : program) (syms : symbols) (collector : Diag.Collector.t) : unit = +(* haxe-parity Task 4: structural typedef equality — "two typedefs with + the same shape are the SAME type" (the task brief's own words). Shape + = the ordered (name, type) field list; defaults are construction-time + sugar carried per alias, not part of the shape. Used wherever two + resolved types are compared for agreement (today: a switch's arm + unification); nominal names still win everywhere else (`A` = `A` + short-circuits first). *) +let record_shapes_equal (syms : symbols) (a : string) (b : string) : bool = + match (StringMap.find_opt a syms.classes, StringMap.find_opt b syms.classes) with + | Some ca, Some cb -> + ca.is_record && cb.is_record + && List.length ca.fields = List.length cb.fields + && List.for_all2 + (fun (na, ta, _, _) (nb, tb, _, _) -> na = nb && ta = tb) + ca.fields cb.fields + | _ -> false + +let rec typ_equal (syms : symbols) (a : typ) (b : typ) : bool = + a = b + || (match (a, b) with + | TScalar x, TScalar y -> record_shapes_equal syms x y + | TNullable x, TNullable y -> typ_equal syms x y + | TMulti x, TMulti y -> typ_equal syms x y + | TMap (ka, va), TMap (kb, vb) -> typ_equal syms ka kb && typ_equal syms va vb + | _ -> false) + +(* ============================================================ + WO-E209 — builtin call signature checking (hotfix) + ============================================================ + + `print(7)` compiled clean and segfaulted wovm: `print` wants a + `Text` (a heap-string pointer, .wob kind WO_K_TEXT), the VM's + `str_check` dereferences whatever register it's handed as a + `wo_str*` with no runtime tag to check first (registers are + untyped by design -- the compiler is supposed to be the only gate), + and a bare `7` is a WO_K_SCALAR int64 sitting in that register -- + a wild pointer read. Source of truth for the table below is + docs/plan/oop-vm/08-builtin-surface.md; the arities mirror + emit.ml's `is_builtin_name`/`arity_of` (its own, emission-time + arity check, WO-E403, kept as-is -- this is a second, earlier gate + over the same contract, not a replacement). *) + +type builtin_arg_req = + | ReqText + | ReqInt + | ReqMulti + | ReqMap + | ReqContainer (* multi or map, e.g. `count`/`get` resolve on either *) + | ReqAny (* not checked here -- e.g. push/set/get's key/value args: + their type depends on the container's own element/key/value + kind, which this check does not chase *) + +let builtin_signatures : (string * int * builtin_arg_req list) list = + [ ("now", 0, []); + ("print", 1, [ ReqText ]); + ("print_int", 1, [ ReqInt ]); + ("words", 1, [ ReqText ]); + ("multi_new", 0, []); + ("map_new", 0, []); + ("push", 2, [ ReqMulti; ReqAny ]); + ("get", 2, [ ReqContainer; ReqAny ]); + ("count", 1, [ ReqContainer ]); + ("latest", 1, [ ReqMulti ]); + ("set", 3, [ ReqMap; ReqAny; ReqAny ]); + ("has", 2, [ ReqMap; ReqAny ]); + ("int_to_text", 1, [ ReqInt ]); + ] + +let rec unwrap_nullable (t : typ) : typ = + match t with + | TNullable inner -> unwrap_nullable inner + | other -> other + +(* `ReqInt` accepts any non-`Text` builtin scalar (`Int`, `Bool`, + `Timestamp`, `Id`), not literally the string "Int" -- `wob_kind_of_typ` + (above) maps all four to the identical runtime representation, + `WO_K_SCALAR`, a plain int64 register. The hazard this whole check + exists for is a *representation* mismatch (`WO_K_TEXT`'s heap-string + pointer read where a `WO_K_SCALAR` int64 sits, or vice versa) -- and + `has`/`now` returning `Bool`/`Timestamp` into a `print_int` + (`docs/plan/oop-vm/08-builtin-surface.md`'s own "1/0" convention for + `has`) is exactly as runtime-safe as an `Int` there, found as a real + false positive against `tests/corpus/run/pricing-containers/`'s + `print_int(has(c.by_name, "shirt"))` once `confident_typ` started + chasing builtin return types. `Text` stays its own, narrower case: + it is the one builtin scalar with a genuinely different + representation. *) +let is_scalar_shaped (name : string) : bool = is_builtin_scalar name && name <> "Text" + +let matches_req (req : builtin_arg_req) (t : typ) : bool = + match req, unwrap_nullable t with + | ReqAny, _ -> true + | ReqText, TScalar "Text" -> true + | ReqInt, TScalar name -> is_scalar_shaped name + | ReqMulti, TMulti _ -> true + | ReqMap, TMap _ -> true + | ReqContainer, (TMulti _ | TMap _) -> true + | (ReqText | ReqInt | ReqMulti | ReqMap | ReqContainer), _ -> false + +let req_label = function + | ReqText -> "Text" + | ReqInt -> "Int" + | ReqMulti -> "a `multi`" + | ReqMap -> "a `map`" + | ReqContainer -> "a `multi` or `map`" + | ReqAny -> "any" (* matches_req is always true here -- never rendered *) + +let rec typ_label (t : typ) : string = + match t with + | TScalar name -> name + | TNullable inner -> "?" ^ typ_label inner + | TMulti _ -> "multi" + | TMap _ -> "map" + | TRef name -> "ref " ^ name + | TVoid -> "void" + +(* A builtin call's own confident return type, for when it appears as + *another* builtin's argument (`print(words(x))` -- `words` returns + `Int`, so that's `WO-E209` too, not a pass-through). Mirrors emit.ml's + `builtin_ret` (its own confident return-type table, used when + lowering an expression position) -- duplicated rather than shared + because emit.ml operates over `Ast.field_ty`/its own `pctx`/`fstate`, + not `Types.typ`/`symbols`, and this task leaves emit.ml untouched. + Kept deliberately in sync: a future builtin whose return type changes + needs both tables updated together. `multi_new`/`map_new` are absent + on purpose -- their result's element kind comes from the destination + (08-builtin-surface.md), not from anything chaseable here. *) +let builtin_confident_ret (name : string) (arg0 : typ option) : typ option = + let arg0 = Option.map unwrap_nullable arg0 in + match name with + | "int_to_text" -> Some (TScalar "Text") + | "now" -> Some (TScalar "Timestamp") + | "print" | "print_int" | "push" | "set" -> Some (TScalar "Int") + | "words" | "count" -> Some (TScalar "Int") + | "has" -> Some (TScalar "Bool") + | "latest" -> ( match arg0 with Some (TMulti e) -> Some e | _ -> None) + | "get" -> ( match arg0 with Some (TMulti e) -> Some e | Some (TMap (_, v)) -> Some v | _ -> None) + | _ -> None + +(* `use_edge`/`uses_of_program`/`path_str` -- relocated here (hotfix) + from their original home in the "Modules" section, much further + below, purely so `confident_typ`'s free-fn resolution (inside + `typecheck_program`, next) can see them; OCaml has no forward + reference across top-level `let`s. See the "Modules" section itself + for the full design writeup these belong to. *) +type use_edge = { + ue_pos : pos; + ue_alias : string; + ue_segments : string list; + ue_is_stdlib : bool; +} + +let uses_of_program (prog : program) : use_edge list = + List.filter_map + (function + | Use u -> + let alias = match List.rev u.segments with a :: _ -> a | [] -> "" in + let is_stdlib = + match u.segments with [ s ] -> is_stdlib_module s | _ -> false + in + Some { ue_pos = u.pos; ue_alias = alias; ue_segments = u.segments; ue_is_stdlib = is_stdlib } + | Class _ | Interface _ | Fn _ | Const _ | Union _ -> None) + prog.decls + +let path_str (segments : string list) : string = String.concat "/" segments + +(* `check_builtin_call` itself is unopinionated about *how* an + argument's type was derived -- it just compares whatever `typ + option` it's handed against the signature table. The derivation + (`confident_typ`, deliberately NOT `typecheck_expr`'s own `.typ`) is + defined inside `typecheck_program` below, next to `syms`/`env` -- + see its own doc comment there for why a separate, narrower deriver + is load-bearing for this check's "stay silent when underivable" + contract. *) +let check_builtin_call ~file (collector : Diag.Collector.t) (name : string) (call_pos : pos) + (args : expr list) (confident_types : typ option list) : unit = + match List.find_opt (fun (n, _, _) -> n = name) builtin_signatures with + | None -> () (* not one of ours -- WO-E204's unresolved-call territory, not this check's *) + | Some (_, arity, reqs) -> + let given = List.length args in + if given <> arity then + Diag.Collector.add collector + (Diag.error ~code:invalid_builtin_code ~file ~line:call_pos.line ~col:call_pos.col + ~message:(Printf.sprintf "builtin `%s` takes %d argument(s), given %d" name arity given) ()) + else + List.iter2 + (fun ((req : builtin_arg_req), (arg_e : expr)) (ct : typ option) -> + match ct with + | None -> () (* underivable -- stay silent, no false positives *) + | Some t -> + if not (matches_req req t) then + Diag.Collector.add collector + (Diag.error ~code:invalid_builtin_code ~file ~line:arg_e.pos.line ~col:arg_e.pos.col + ~message: + (Printf.sprintf "builtin `%s` expects %s, got `%s`" name (req_label req) + (typ_label t)) + ())) + (List.combine reqs args) confident_types + +(* `~file_syms` (hotfix, multi-file double-report): this file's OWN, + unmerged collect_declarations output — as opposed to `syms` below, + the whole-program merged table. Before this parameter existed, the + two StringMap.iter loops at the bottom of this function walked + `syms.classes`/`syms.free_fns` — the flat, cross-file table — + regardless of which file was being checked, so a program of N files + ran every file's bodies through typecheck_method/the free-fn loop + once per discovered file (N times total, not once), each redundant + pass re-reporting that body's diagnostics stamped with whichever + `~file` happened to be current. Every OTHER lookup in this function + (confident_typ, typecheck_expr's Field/Ctor cases, resolve_free_fn, + ...) still goes through `syms`, unchanged — cross-file field/type/ + call resolution keeps seeing the whole program; only the SET OF + BODIES actually walked and diagnosed narrows to this file's own. See + .superpowers/sdd/2026-08-01-haxe-parity-language/hotfix-e209-report.md's + "Disclosed, NOT fixed" section for the original repro and diagnosis. *) +let typecheck_program ~file ~(module_of : string -> string) + ~(module_syms : (string, symbols) Hashtbl.t) ~(file_syms : symbols) (prog : program) + (syms : symbols) (collector : Diag.Collector.t) : unit = check_field_types ~file syms collector prog; let resolve_field_ty = typ_of_field_ty in - let rec typecheck_expr (env : typ StringMap.t) (e : expr) : expr_type_result = + (* Free-fn resolution for `confident_typ`'s `Call`-return derivation + below, and for whether a bare `Ident` callee is a builtin at all + (a call to it, further down). Own module's own `free_fns` + unconditionally, then exactly one used module's `pub` export; + anything else (not found at all, or ambiguous across more than one + used module) is `None`, not a guess -- that ambiguity is + `WO-E217`/`WO-E218`'s own territory (`check_module_refs`, below), + not this derivation's to adjudicate. Deliberately NOT + `syms.free_fns` (the flat, whole-program merge fed to owner.ml and + most of emit.ml): two modules sharing a free-fn name would let the + flat table resolve to whichever module happened to merge first -- + the exact Critical-1 bug shape haxe-parity Task 1 already found + and fixed for the emitter (emit.ml's `ty_of_expr`/`emit_call`, same + fix, same reason); this mirrors it here instead of repeating it. *) + let own_module_syms = Hashtbl.find_opt module_syms (module_of file) in + let uses_resolved = + List.filter_map + (fun (u : use_edge) -> + if u.ue_is_stdlib then None + else + match Hashtbl.find_opt module_syms (path_str u.ue_segments) with + | Some s -> Some (u, s) + | None -> None) + (uses_of_program prog) + in + let resolve_free_fn (name : string) : free_fn_info option = + match own_module_syms with + | Some s when StringMap.mem name s.free_fns -> StringMap.find_opt name s.free_fns + | _ -> ( + match + List.filter_map + (fun (_, (msyms : symbols)) -> + match StringMap.find_opt name msyms.free_fns with + | Some fi when fi.pub -> Some fi + | _ -> None) + uses_resolved + with + | [ fi ] -> Some fi + | _ -> None) + in + + (* WO-E209's own type deriver -- deliberately NOT typecheck_expr's + `.typ` below, and deliberately narrower. typecheck_expr hands back + exactly two placeholder values whenever it can't actually resolve + an expression -- `TScalar "Int"` (an unresolved `Ident`, a + `Field`/`Index` it can't type, a `Ctor` naming an unknown class) + and `TScalar "Bool"` (every `Binary`, unconditionally, regardless + of the real operator -- `a + b` types as "Bool" today exactly like + `a == b` does). Both are also genuine, real types an expression + can legitimately have, so trusting them blindly would misfire on + ordinary code this corpus actually has: `print(items[0])` (`Index` + always placeholder-types as `Int`) or `print_int(a + b)` (`Binary` + always types as `Bool`) would both become false positives. + `confident_typ` instead only trusts a handful of shapes it can + trace straight back to a declaration -- a literal, `self`'s or a + parameter's declared type, a class field's declared type, a `let` + whose own value was itself confidently typed, or (below) a `Call` + whose *declared signature* (a free fn, a class method, or an + interface method's signature) is known -- and returns `None` for + everything else, which is exactly this check's "stay silent when + underivable" contract. Its own `cenv` threads through every + statement in lockstep with `env` below (same `Let`/`If`/`While`/ + `For` shape, same scoping quirks) but never shares storage with + it, so a placeholder that leaks into `env` through a `let` never + contaminates `cenv`. + + A *declared* return type is the opposite of underivable, so a + `Call` is not blanket-skipped the way `Index`/`Binary` are: a free + fn's or method's own signature sits in the symbol table exactly + like a field's declared type does, and passing its result to a + builtin without ever narrowing it is the same class of bug + `print(7)` is -- `print(takesSecret(box))` where `takesSecret` + is declared `-> Int` is exactly as wrong as `print(7)`, just one + call deeper. A declared return type of `None` (no `-> T` written + at all) is `TVoid`, not another guess -- still confident, since a + fn/method with no declared return genuinely has no value to hand + back in this grammar. What still isn't chased: a *qualified* + free-fn call (`mod.fn(...)`) falls through the `Field` case below + with a use-alias `base` that never resolves as a value, landing on + `None`; `multi_new`/`map_new` (contextual on the destination, + `builtin_confident_ret`'s own doc comment); and an + UNKNOWN-BUT-RESERVED stdlib call (`fs.stat(...)`) has no signature + to find in the first place, so it also falls through to `None` + unchanged. *) + let rec confident_typ (cenv : typ StringMap.t) (e : expr) : typ option = + match e.kind with + | IntLit _ -> Some (TScalar "Int") + | StrLit _ -> Some (TScalar "Text") + | BoolLit _ -> Some (TScalar "Bool") + | Ident name -> StringMap.find_opt name cenv + | Field (base, field_name) -> ( + match confident_typ cenv base with + | Some (TScalar class_name) -> ( + match StringMap.find_opt class_name syms.classes with + | None -> None + | Some cls -> ( + match List.find_opt (fun (fname, _, _, _) -> fname = field_name) cls.fields with + | Some (_, field_ty, _, _) -> Some (resolve_field_ty field_ty) + | None -> None)) + | _ -> None) + | Call (callee, args) -> ( + match callee.kind with + | Ident name -> ( + match resolve_free_fn name with + | Some fi -> ( match fi.ret with Some ft -> Some (resolve_field_ty ft) | None -> Some TVoid) + | None -> ( + (* haxe-parity Task 4: a payload-variant construction + (`Failed("boom")`) is confidently its union's own + type — the variant name is a declaration lookup, the + same "traceable straight back to a declaration" + standard every other confident shape here meets. A + declared free fn of the same name already won above + (the shadowing rule); a call position can never be a + local, so no lexical-shadowing hazard either (the + bare-Ident variant reference is deliberately NOT + derived here for exactly that reason — cenv cannot + distinguish an unconfident local from an unbound + name). *) + match find_variant syms name with + | Some (u, _) -> Some (TScalar u.u_name) + | None -> ( + match List.find_opt (fun (n, _, _) -> n = name) builtin_signatures with + | None -> None + | Some _ -> + let arg0 = match args with a :: _ -> confident_typ cenv a | [] -> None in + builtin_confident_ret name arg0))) + | Field (base, mname) -> ( + (* A method call, dispatched by the *receiver's* confident + type -- a concrete class first (an ordinary method), an + interface second (structural dispatch, ICALL). A + use-alias `base` (a qualified free-fn call) never + resolves here at all -- `confident_typ` has no binding + for a bare module alias, only for locals/params/`self` + -- so it falls straight to `None`, matching the existing + exemption for stdlib-qualified calls elsewhere in this + check. *) + match confident_typ cenv base with + | Some (TScalar class_name) -> ( + match StringMap.find_opt class_name syms.classes with + | Some cls -> ( + match List.find_opt (fun (m : method_info) -> m.name = mname) cls.methods with + | Some m -> ( + match m.ret with Some ft -> Some (resolve_field_ty ft) | None -> Some TVoid) + | None -> None) + | None -> ( + match StringMap.find_opt class_name syms.interfaces with + | Some iface -> ( + match + List.find_opt (fun (s : method_sig_info) -> s.name = mname) iface.methods + with + | Some s -> ( + match s.ret with Some ft -> Some (resolve_field_ty ft) | None -> Some TVoid) + | None -> None) + | None -> None)) + | _ -> None) + | _ -> None) + | Ctor (class_name, _fields) -> + (* `Ctor`'s class name is never a placeholder -- unlike + `Ident`/`Field`/`Index`/`Call`, there is no fallback path + that invents a `Ctor` node, so the name it carries is always + exactly what the source wrote. A real declared class makes + this confident (and is also what lets a receiver built the + ordinary way, `let b = Box{}`, feed the method-call + derivation above through `b`'s own `let` binding); an + unknown class name is already `WO-E207`'s own territory, not + a fallback this check should trust. *) + if StringMap.mem class_name syms.classes then Some (TScalar class_name) else None + | Binary ((Eq | Ne | Lt | Le | Gt | Ge | And | Or), _, _) -> + (* Unlike Add/Sub/Concat/etc. (still "not chased" below — a real + placeholder-avoidance gap, not this task's to fix), a + comparison or `and`/`or` is confidently `Bool` regardless of + its operands' own types: that is what the operator *means*, + not a guess the way `TScalar "Int"` would be for e.g. `Index`. + This is what lets the and/or operand check (below, + typecheck_expr's own `Binary` case) see through + `a == 1 and b == 2` without a false "underivable" silence on + the left-hand comparison. *) + Some (TScalar "Bool") + | Interp _ -> + (* An interpolation always *produces* Text by construction + (emit.ml decides, per-segment, whether the embedded value + needs `int_to_text` first) -- unlike the placeholders below, + this is a fact, not a guess. *) + Some (TScalar "Text") + | Index _ | Unary _ | Binary _ | DbStub _ -> + (* Not chased: `Index`/the arithmetic-ladder `Binary` ops have no + reliable per-node type in this pass at all (see above); + `Unary`/`DbStub` would be cheap to add but nothing in this + task's fixtures or the log-watcher sample needs them, and a + narrower deriver is the safer default. *) + None + | Switch _ -> + (* haxe-parity Task 3: same "not chased" call as `Index`/`Binary` + above — `typecheck_expr`'s own `Switch` case (below) is the + real, full derivation (arm unification, the default-required + check); a `switch` as a WO-E209 builtin argument (e.g. + `print(switch x {...})`) is not a shape any fixture or the + sample needs, so this narrower deriver stays silent rather + than duplicating that logic here. *) + None + in + + let rec typecheck_expr (env : typ StringMap.t) (cenv : typ StringMap.t) (e : expr) : + expr_type_result = match e.kind with | IntLit _ -> { typ = TScalar "Int"; is_nil = false } | StrLit _ -> { typ = TScalar "Text"; is_nil = false } @@ -359,7 +953,7 @@ let typecheck_program ~file (prog : program) (syms : symbols) (collector : Diag. { typ = t; is_nil = false } with Not_found -> { typ = TScalar "Int"; is_nil = false }) | Field (base, field_name) -> - let base_res = typecheck_expr env base in + let base_res = typecheck_expr env cenv base in (match base_res.typ with | TScalar class_name -> (* Only a *declared* class can be checked for a missing field. @@ -384,23 +978,149 @@ let typecheck_program ~file (prog : program) (syms : symbols) (collector : Diag. { typ = TScalar "Int"; is_nil = false })) | _ -> { typ = TScalar "Int"; is_nil = false }) | Index (base, idx) -> - let _ = typecheck_expr env base in - let _ = typecheck_expr env idx in + let _ = typecheck_expr env cenv base in + let _ = typecheck_expr env cenv idx in { typ = TScalar "Int"; is_nil = false } - | Call (_callee, args) -> - List.iter (fun arg -> ignore (typecheck_expr env arg)) args; + | Call (callee, args) -> + List.iter (fun arg -> ignore (typecheck_expr env cenv arg)) args; + (match callee.kind with + | Ident name when Option.is_none (resolve_free_fn name) -> ( + (* "A user-declared free fn of the same name always wins" + (08-builtin-surface.md's shadowing rule) -- resolved + through `resolve_free_fn` (own module, then used + modules), NOT the flat `syms.free_fns`: two modules + sharing a free-fn name would let the flat table pick + whichever merged first, shadowing the builtin from a + file that never actually `use`s the module that + collided with it. A `free_fns` hit means this isn't a + builtin call at all, so this check has nothing to say + about it (WO-E203's fn/method arity gap is a separate, + pre-existing, not-this-task's-to-fix hole). A qualified + call (`mod.fn(...)`) never has an `Ident` callee -- its + callee is a `Field` -- so a stdlib call through a + `use`d alias is exempt automatically, matching its + UNKNOWN-BUT-RESERVED typing everywhere else. *) + match find_variant syms name with + | Some (u, vi) -> + (* haxe-parity Task 4: constructing a payload variant by + name — the argument count must match the variant's + declared payload fields exactly (they are positional). + WO-E203 (bad arity), reserved since plan 2 Task 6: + this is its first real emission site, scoped to + variant constructions (fn/method call arity stays the + emitter's WO-E403, unchanged). *) + let want = List.length vi.vi_fields and got = List.length args in + if got <> want then + Diag.Collector.add collector + (Diag.error ~code:bad_arity_code ~file ~line:e.pos.line ~col:e.pos.col + ~message: + (Printf.sprintf + "variant `%s` of `%s` takes %d payload argument(s), given %d" + vi.vi_name u.u_name want got) + ()) + | None -> + let confident_types = List.map (confident_typ cenv) args in + check_builtin_call ~file collector name e.pos args confident_types) + | _ -> ()); { typ = TScalar "Int"; is_nil = false } - | Unary (_, operand) -> typecheck_expr env operand - | Binary (_, left, right) -> - let _ = typecheck_expr env left in - let _ = typecheck_expr env right in + | Unary (_, operand) -> typecheck_expr env cenv operand + | Binary ((And | Or) as op, left, right) -> + (* haxe-parity Task 2: `Bool`-typed operands only, no truthiness + -- wired through the same E209-style "confident-type, stay + silent when underivable" contract check_builtin_call already + uses, rather than a duplicate of it, per this task's own + design note. Chose WO-E201 (`type_mismatch_code`): declared + in this file since Task 6, never given a real emission site + until now (docs/plan/oop-vm/01-error-catalog.md's own + "Reserved, not yet emitted" list) -- and "a non-Bool operand + where Bool was required" is exactly what that name promises, + so this is the clean case the brief's own note anticipated, + not the fallback ("reuse the invalid-operand pattern"). *) + let _ = typecheck_expr env cenv left in + let _ = typecheck_expr env cenv right in + let op_name = match op with And -> "and" | _ -> "or" in + let check_operand (operand : expr) = + match confident_typ cenv operand with + | None -> () (* underivable -- stay silent, no false positives *) + | Some t -> + (* `unwrap_nullable` accepts a `?Bool` operand silently -- + no forced-handling diagnostic for the nil case, same + shape as the pre-existing, disclosed `?T`-enforcement + gap (docs/plan/compiler/nullable-types-implementation.md: + "?T is plumbed but not enforced"). Task 6's own + WO-E211/E212/E213 work should revisit this call site + too, not just field/return positions. *) + if unwrap_nullable t <> TScalar "Bool" then + Diag.Collector.add collector + (Diag.error ~code:type_mismatch_code ~file ~line:operand.pos.line + ~col:operand.pos.col + ~message: + (Printf.sprintf + "`%s` operand must be `Bool`, got `%s` -- no truthiness in this language" + op_name (typ_label t)) + ()) + in + check_operand left; + check_operand right; { typ = TScalar "Bool"; is_nil = false } + | Binary ((Eq | Ne), left, right) -> + let _ = typecheck_expr env cenv left in + let _ = typecheck_expr env cenv right in + (* Task 4 fix round 1 (review Major): two bare unions share the + ordinal tag representation, so `X == P` across two DIFFERENT + unions was silently true whenever the ordinals matched. An + operand's union is derived from `confident_typ` or — for a + bare variant reference, which that deriver deliberately skips + — from the variant table, locals winning first (`env`, the + Task 1 shadowing rule). Same-union comparison stays legal + (bare tags compare exactly); one union against anything else + is left to Task 6's wider porosity work, disclosed. *) + let union_of_operand (e : expr) : union_info option = + match confident_typ cenv e with + | Some t -> ( + match unwrap_nullable t with + | TScalar n -> StringMap.find_opt n syms.unions + | _ -> None) + | None -> ( + match e.kind with + | (Ident n | Call ({ kind = Ident n; _ }, _)) when not (StringMap.mem n env) -> ( + match find_variant syms n with Some (u, _) -> Some u | None -> None) + | _ -> None) + in + (match (union_of_operand left, union_of_operand right) with + | Some ul, Some ur when ul.u_name <> ur.u_name -> + Diag.Collector.add collector + (Diag.error ~code:type_mismatch_code ~file ~line:e.pos.line ~col:e.pos.col + ~message: + (Printf.sprintf + "cannot compare `%s` with `%s` — values of different unions never \ + compare equal (their tags merely share a representation)" + ul.u_name ur.u_name) + ()) + | _ -> ()); + { typ = TScalar "Bool"; is_nil = false } + | Binary (_, left, right) -> + let _ = typecheck_expr env cenv left in + let _ = typecheck_expr env cenv right in + { typ = TScalar "Bool"; is_nil = false } + | Interp inner -> + let _ = typecheck_expr env cenv inner in + { typ = TScalar "Text"; is_nil = false } | Ctor (class_name, fields) -> (try let cls = StringMap.find class_name syms.classes in let provided = List.map (fun (n, _) -> n) fields in - List.iter (fun (fname, _, _, _) -> - if not (List.mem fname provided) then + (* haxe-parity Task 4: a field with a declared default is + omittable (the emitter now fills it — `TailState {}`, the + sample's own pattern), and so is a `?`-typed field + ("?fields land as nullable-by-shape": omitted means nil, + the zero word NEW already leaves there). Everything else + stays WO-E206, classes and records alike. *) + let omittable (default : default_expr option) (fty : field_ty) : bool = + Option.is_some default || (match fty with Nullable _ -> true | _ -> false) + in + List.iter (fun (fname, fty, fdefault, _) -> + if not (List.mem fname provided) && not (omittable fdefault fty) then Diag.Collector.add collector (Diag.error ~code:incomplete_ctor_code ~file ~line:e.pos.line ~col:e.pos.col ~message:(Printf.sprintf "missing field `%s` in constructor of `%s`" fname class_name) ()) @@ -412,37 +1132,430 @@ let typecheck_program ~file (prog : program) (syms : symbols) (collector : Diag. ~message:(Printf.sprintf "unknown type `%s` in constructor" class_name) ()); { typ = TScalar "Int"; is_nil = false }) | DbStub _ -> { typ = TVoid; is_nil = false } - in + | Switch (subject, arms) -> typecheck_switch ~want_value:true env cenv subject arms - let rec typecheck_stmt (env : typ StringMap.t) (s : stmt) : typ StringMap.t = + (* haxe-parity Task 3: the one deriver behind both `Switch` call sites + -- `typecheck_expr`'s own case above (every "the value is used" + position: a `let`'s value, a `return`, nested inside another expr + -- reached generically, with zero extra code per call site, simply + because `typecheck_expr` is what every one of those already + recurses through) and `typecheck_stmt`'s `ExprStmt` case below (the + one position where the value is NOT used -- "statement position is + the expression with a discarded value", the brief's own words, so + this is the ONE place `want_value` differs from the default). Both + modes always fully typecheck every arm's body (side effects/ + diagnostics inside an arm are never skipped); `want_value` only + gates whether a value is *required and unified* across arms. + + Default-required (WO-E208): unconditional here, because no union + type exists yet (`typ` above has no `TUnion` -- ast.ml's own module + doc). This is deliberately the exact shape Task 4 extends, not a + bespoke check to replace: add a `TUnion variants` arm that walks + the arms' `values` for coverage (naming the missing variants) and + falls through to this same E208 for every other subject type, + unchanged. + + Arm typing avoids double-typechecking each arm's own trailing + expression: `typecheck_stmt` already knows how to fold a `stmt + list`, but it discards each statement's own expr *type* (only + `typecheck_expr`'s caller sees that) -- so the last statement is + handled specially here rather than calling `typecheck_stmt` on the + whole body and then re-deriving the tail's type a second time + (which `diag.ml`'s own (code,file,line,col) dedup would make + harmless, but doing the double work at all is needless). An arm + whose last statement is not `ExprStmt` (e.g. every arm in the + sample's own statement-position switches, which end in `return`) + types as `TVoid` -- not a special case, just what "no value here" + naturally is, and it is what makes an arm that fails to yield a + value in expression position surface as an ordinary arm-type- + mismatch against its sibling arms, with no separate diagnostic. *) + and typecheck_switch ~(want_value : bool) (env : typ StringMap.t) (cenv : typ StringMap.t) + (subject : expr) (arms : switch_arm list) : expr_type_result = + let subj_res = typecheck_expr env cenv subject in + (* review fix, Critical 2: a case label whose type is confidently + Text against a non-Text scalar subject (or vice versa) is not + just a type error — it is a real VM segfault (reviewer- + reproduced: `switch s { case 1: ... }` over `s: Text` emits + EQS on a raw int register, and the VM's `str_check` dereferences + it as a `wo_str*`; the reverse direction — an Int subject with a + Text label — is equally wrong, just silently always-false + rather than a crash). + + Deliberately built on `confident_typ`, NOT `typecheck_expr`'s + own `.typ` (round-1 mistake, self-caught before shipping): + `typecheck_expr` hands back `TScalar "Int"` for *any* + unresolved base (an unbound `Ident`, and therefore any `Field` + read through one) — exactly the placeholder that made + `j.method` (log-watcher's own `mcp.wo`, where `j`'s own `let ... + as RpcReq` fails to parse today, leaving `j` unbound) look + "confidently Int" and false-positive against its very real + `"initialize"`/`"ping"`/... Text case labels. `confident_typ` + returns `None` for exactly that shape (an unbound `Ident`'s + `Field`), so this stays silent there — the same "confident, stay + silent when underivable" contract WO-E209 already established. + `repr_kind` narrows a confident type to exactly the two + representations emit.ml's own EQ-vs-EQS choice cares about + (`WO_K_TEXT` vs `WO_K_SCALAR`); anything else (an unresolved or + union-typed subject — the sample's own `switch res {...}`/ + `switch names {...}` sites, Task 4's territory, already + WO-E207'd) is `Other` and never compared. Reuses WO-E201 + (`type_mismatch_code`) — the same code the arm-unification check + below uses — per the review's own instruction ("wire through + E201 like arm mismatch"). *) + let repr_kind (t : typ) : [ `Text | `Scalar | `Other ] = + match wob_kind_of_typ syms t with + | WO_K_TEXT -> `Text + | WO_K_SCALAR -> `Scalar + | WO_K_OWNED | WO_K_GCREF | WO_K_MULTI | WO_K_MAP | WO_K_NULLABLE -> `Other + in + (* haxe-parity Task 4: a union-typed subject switches the arms from + VALUE comparisons to variant PATTERNS — `case Ok:` names a + variant (never an expression to evaluate), `case Failed(reason):` + additionally binds the payload fields for that arm's own body. + Derived through `confident_typ` exactly like the repr check below + (and NOT unwrapped through `?T`: a `?Union` subject stays on the + plain-value path until Task 6's forced-handling work legalizes + narrowing it) — an underivable subject falls through to the + scalar rules unchanged, the same "stay silent when underivable" + contract as every other confident-type consumer. *) + let subj_union = + match confident_typ cenv subject with + | Some (TScalar n) -> StringMap.find_opt n syms.unions + | _ -> None + in + (* Task 4 fix round 1 (review Critical 2): a `?Union` subject with a + variant-named case compiled clean and could NEVER match — the + case constructed a fresh variant object (or, for a payload + pattern, fell into the emitter as an unbound name) and the + pointer compare was always false, so `default` always won. A + `?`-typed union is not narrowed here (narrowing is Task 6's + forced-handling work, deliberately not implemented), so variant + patterns are meaningless over it — say so, pointing at the nil + case first. *) + let subj_opt_union = + match confident_typ cenv subject with + | Some (TNullable inner) -> ( + match unwrap_nullable inner with + | TScalar n -> StringMap.find_opt n syms.unions + | _ -> None) + | _ -> None + in + (match subj_opt_union with + | None -> () + | Some u -> + List.iter + (fun (a : switch_arm) -> + List.iter + (fun (v : expr) -> + match v.kind with + | (Ident n | Call ({ kind = Ident n; _ }, _)) + when Option.is_some (find_variant syms n) -> + Diag.Collector.add collector + (Diag.error ~code:type_mismatch_code ~file ~line:v.pos.line + ~col:v.pos.col + ~message: + (Printf.sprintf + "`%s` can never match here — the subject is `?%s`, which may be \ + nil and is not narrowed by `switch`; handle the nil case first \ + (forced `?T` handling arrives with Task 6)" + n u.u_name) + ()) + | _ -> ()) + a.values) + arms); + (match subj_union with + | None -> () + | Some u -> + let variant_of name = List.find_opt (fun v -> v.vi_name = name) u.u_variants in + let pattern_err ~code (pos : pos) message = + Diag.Collector.add collector + (Diag.error ~code ~file ~line:pos.line ~col:pos.col ~message ()) + in + List.iter + (fun (a : switch_arm) -> + List.iter + (fun (v : expr) -> + match v.kind with + | Ident vname -> ( + match variant_of vname with + | Some _ -> () + | None -> + pattern_err ~code:type_mismatch_code v.pos + (Printf.sprintf "`%s` is not a variant of union `%s`" vname u.u_name)) + | Call ({ kind = Ident vname; _ }, args) -> ( + match variant_of vname with + | None -> + pattern_err ~code:type_mismatch_code v.pos + (Printf.sprintf "`%s` is not a variant of union `%s`" vname u.u_name) + | Some vi -> + let want = List.length vi.vi_fields and got = List.length args in + if got <> want then + pattern_err ~code:bad_arity_code v.pos + (Printf.sprintf + "pattern for `%s` binds %d payload field(s), but `%s` declares %d" + vi.vi_name got vi.vi_name want) + else if + not + (List.for_all + (fun (arg : expr) -> + match arg.kind with Ident _ -> true | _ -> false) + args) + then + pattern_err ~code:bad_arity_code v.pos + (Printf.sprintf + "pattern for `%s` must bind plain names — payload fields are \ + bound positionally, never matched by value" + vi.vi_name) + else if List.length a.values > 1 then + pattern_err ~code:bad_arity_code v.pos + (Printf.sprintf + "a payload-binding pattern (`%s(...)`) must be its arm's only \ + value" + vi.vi_name)) + | _ -> + pattern_err ~code:type_mismatch_code v.pos + (Printf.sprintf + "switch over union `%s` matches variants — this case value is not one" + u.u_name)) + a.values) + arms); + (match (if Option.is_none subj_union then confident_typ cenv subject else None) with + | None -> () (* subject underivable (or a union, handled above) -- stay silent *) + | Some subj_t -> + let subj_repr = repr_kind subj_t in + List.iter + (fun (a : switch_arm) -> + List.iter + (fun v -> + ignore (typecheck_expr env cenv v); + (* Task 4 fix round 1 (review Major): the inverse of the + union-subject direction — a case value naming a KNOWN + variant while the subject is confidently some other + type silently ordinal-matched (`switch n { case Lo: }` + over `n: Int` matched n == 0). Lexical scope wins + first (`env`, every local/param — the Task 1 + shadowing lesson), so a local that happens to share a + variant's name is never misread as one. *) + (match v.kind with + | Ident n | Call ({ kind = Ident n; _ }, _) -> ( + if not (StringMap.mem n env) then + match find_variant syms n with + | Some (vu, _) -> + Diag.Collector.add collector + (Diag.error ~code:type_mismatch_code ~file ~line:v.pos.line + ~col:v.pos.col + ~message: + (Printf.sprintf + "`%s` is a variant of union `%s`, but the switch subject \ + has type `%s`" + n vu.u_name (typ_label subj_t)) + ()) + | None -> ()) + | _ -> ()); + match confident_typ cenv v with + | None -> () + | Some vt -> ( + match (repr_kind vt, subj_repr) with + | (`Text, `Scalar | `Scalar, `Text) -> + Diag.Collector.add collector + (Diag.error ~code:type_mismatch_code ~file ~line:v.pos.line + ~col:v.pos.col + ~message: + (Printf.sprintf + "switch case value has type `%s`, but the switch subject \ + has type `%s`" + (typ_label vt) (typ_label subj_t)) + ()) + | _ -> ())) + a.values) + arms); + (* review fix, Critical 1 (the warning half — the reorder itself is + ast.ml's `switch_lowering_order`, applied downstream in + owner.ml/emit.ml, not here): a `case` arm textually after + `default` no longer silently loses to it (that was the bug), + but it is still surprising source, so this warns once per + switch shaped that way, anchored at `default`'s own position. *) + let default_pos = ref None in + let case_after_default = ref false in + List.iter + (fun (a : switch_arm) -> + match !default_pos with + | None -> if a.is_default then default_pos := Some a.arm_pos + | Some _ -> if not a.is_default then case_after_default := true) + arms; + (match !default_pos with + | Some pos when !case_after_default -> + Diag.Collector.add collector + (Diag.warning ~code:switch_default_not_last_code ~file ~line:pos.line ~col:pos.col + ~message: + "`default` is not the last arm -- a `case` written after it still matches (this \ + compiler evaluates `default` last regardless of source position), which reads \ + as dead code" + ()) + | _ -> ()); + (* WO-E208. Union subjects get the exhaustiveness rule the spec's + switch row promised ("`default` optional when exhaustive"): no + `default` is fine exactly when every variant is covered by some + arm; a gap names the missing variants, in declaration order. + Every other subject keeps Task 3's unconditional rule — scalars + and Text always require `default`. *) + (if not (List.exists (fun (a : switch_arm) -> a.is_default) arms) then + match subj_union with + | Some u -> + let covered = + List.concat_map + (fun (a : switch_arm) -> + List.filter_map + (fun (v : expr) -> + match v.kind with + | Ident n | Call ({ kind = Ident n; _ }, _) -> Some n + | _ -> None) + a.values) + arms + in + let missing = + List.filter (fun vi -> not (List.mem vi.vi_name covered)) u.u_variants + in + if missing <> [] then + Diag.Collector.add collector + (Diag.error ~code:non_exhaustive_switch_code ~file ~line:subject.pos.line + ~col:subject.pos.col + ~message: + (Printf.sprintf + "switch over `%s` has no `default` arm and does not cover: %s" u.u_name + (String.concat ", " (List.map (fun vi -> vi.vi_name) missing))) + ()) + | None -> + Diag.Collector.add collector + (Diag.error ~code:non_exhaustive_switch_code ~file ~line:subject.pos.line + ~col:subject.pos.col + ~message: + (Printf.sprintf "switch over `%s` has no `default` arm" (typ_label subj_res.typ)) + ())); + (* haxe-parity Task 4: the names a payload pattern binds, typed with + the variant's own declared field types, visible to that arm's + body only. Empty for every non-union subject and every bare/ + malformed pattern (the malformed ones already got their own + diagnostic above — typing the body against fewer names is the + do-no-harm fallback, not a second error). *) + let bindings_of (a : switch_arm) : (string * typ) list = + (* `?Union` too (fix round 1): the variant-named cases over a + `?Union` subject are already a hard WO-E201 (above) — binding + the pattern's names anyway keeps the arm BODY typed against + real names instead of cascading a second, misleading + arm-mismatch error off an unbound placeholder. *) + match (match subj_union with Some _ as u -> u | None -> subj_opt_union) with + | None -> [] + | Some u -> ( + match a.values with + | [ { kind = Call ({ kind = Ident vname; _ }, args); _ } ] -> ( + match List.find_opt (fun vi -> vi.vi_name = vname) u.u_variants with + | Some vi when List.length args = List.length vi.vi_fields -> + List.concat + (List.map2 + (fun (arg : expr) (_, fty) -> + match arg.kind with + | Ident bn -> [ (bn, resolve_field_ty fty) ] + | _ -> []) + args vi.vi_fields) + | _ -> []) + | _ -> []) + in + let arm_value (a : switch_arm) : typ * pos = + let bound = bindings_of a in + let benv = List.fold_left (fun m (n, t) -> StringMap.add n t m) env bound in + let bcenv = List.fold_left (fun m (n, t) -> StringMap.add n t m) cenv bound in + match List.rev a.body with + | [] -> (TVoid, a.arm_pos) + | last :: rev_init -> + let env', cenv' = List.fold_left typecheck_stmt (benv, bcenv) (List.rev rev_init) in + (match last.s_kind with + | ExprStmt e -> ((typecheck_expr env' cenv' e).typ, e.pos) + | _ -> + let _ = typecheck_stmt (env', cenv') last in + (TVoid, last.s_pos)) + in + let arm_types = List.map arm_value arms in + (if want_value then + match arm_types with + | [] -> () + | (ref_typ, _) :: rest -> + List.iter + (fun (t, pos) -> + (* structural, not (=): two same-shape typedef records are + the same type (haxe-parity Task 4, typ_equal). *) + if not (typ_equal syms t ref_typ) then + Diag.Collector.add collector + (Diag.error ~code:type_mismatch_code ~file ~line:pos.line ~col:pos.col + ~message: + (Printf.sprintf + "switch arm yields `%s`, but the switch's type is `%s` (from an \ + earlier arm)" + (typ_label t) (typ_label ref_typ)) + ())) + rest); + match arm_types with (t, _) :: _ -> { typ = t; is_nil = false } | [] -> { typ = TVoid; is_nil = false } + + (* `typecheck_switch` (above) folds `typecheck_stmt` over an arm's own + body, and `typecheck_stmt`'s `ExprStmt` case (below) calls + `typecheck_switch` in `want_value:false` mode -- the two are + mutually recursive, so they (and `typecheck_expr`, which + `typecheck_switch` also calls) must be one `and`-chain, not the + three separate `let rec ... in` bindings this function had before + this task. *) + and typecheck_stmt ((env, cenv) : typ StringMap.t * typ StringMap.t) (s : stmt) : + typ StringMap.t * typ StringMap.t = match s.s_kind with | Let { name; ty = _ty; value } -> - let val_res = typecheck_expr env value in - StringMap.add name val_res.typ env + let val_res = typecheck_expr env cenv value in + let new_cenv = + match confident_typ cenv value with + | Some t -> StringMap.add name t cenv + | None -> StringMap.remove name cenv + in + (StringMap.add name val_res.typ env, new_cenv) | Assign { target; value } -> - let _ = typecheck_expr env target in - let _ = typecheck_expr env value in - env + let _ = typecheck_expr env cenv target in + let _ = typecheck_expr env cenv value in + (env, cenv) | If { cond; then_body; else_body } -> - let _ = typecheck_expr env cond in - let env_then = List.fold_left typecheck_stmt env then_body in + let _ = typecheck_expr env cenv cond in + let then_result = List.fold_left typecheck_stmt (env, cenv) then_body in (match else_body with - | Some (_, else_body) -> - List.fold_left typecheck_stmt env else_body - | None -> env_then) + | Some (_, else_body) -> List.fold_left typecheck_stmt (env, cenv) else_body + | None -> then_result) | While { cond; body } -> - let _ = typecheck_expr env cond in - List.fold_left typecheck_stmt env body + let _ = typecheck_expr env cenv cond in + List.fold_left typecheck_stmt (env, cenv) body | For { var; iter; body } -> - let iter_res = typecheck_expr env iter in + let iter_res = typecheck_expr env cenv iter in let env_body = StringMap.add var iter_res.typ env in - List.fold_left typecheck_stmt env_body body + let cenv_body = + match confident_typ cenv iter with + | Some (TMulti inner_t) -> StringMap.add var inner_t cenv + | _ -> StringMap.remove var cenv + in + List.fold_left typecheck_stmt (env_body, cenv_body) body | Return opt_e -> - (match opt_e with Some e -> let _ = typecheck_expr env e in () | None -> ()); - env + (match opt_e with Some e -> let _ = typecheck_expr env cenv e in () | None -> ()); + (env, cenv) + | ExprStmt { kind = Switch (subject, arms); _ } -> + (* haxe-parity Task 3: the one place `want_value` is false -- + "statement position is the expression with a discarded + value" (the brief's own words). Every arm's body is still + fully typechecked (typecheck_switch's own contract); nothing + here requires or unifies a value the way the generic + `Switch` case of `typecheck_expr` (used for every other + position: `let`, `return`, nested inside another expr) does. *) + let _ = typecheck_switch ~want_value:false env cenv subject arms in + (env, cenv) | ExprStmt e -> - let _ = typecheck_expr env e in - env + let _ = typecheck_expr env cenv e in + (env, cenv) + | Break | Continue -> (env, cenv) + | DoWhile { cond; body } -> + let _ = typecheck_expr env cenv cond in + List.fold_left typecheck_stmt (env, cenv) body in (* `self` is bound to the *enclosing class name*, not a literal "Self": @@ -452,20 +1565,32 @@ let typecheck_program ~file (prog : program) (syms : symbols) (collector : Diag. let param_env = List.fold_left (fun acc (name, ty, _) -> StringMap.add name (resolve_field_ty ty) acc) env m.params in let env_with_self = StringMap.add "self" (TScalar self_class) param_env in - let _ = List.fold_left typecheck_stmt env_with_self m.body in + (* Every param/`self` is always confidently typed (a declared type + is mandatory here), so `cenv`'s starting point for a method body + is exactly `env_with_self`'s own shape -- no ambiguity to guard + against at the entry to a body, only inside it. *) + let cenv_with_self = List.fold_left (fun acc (name, ty, _) -> + StringMap.add name (resolve_field_ty ty) acc) + (StringMap.singleton "self" (TScalar self_class)) m.params in + let _ = List.fold_left typecheck_stmt (env_with_self, cenv_with_self) m.body in false in + (* Walk THIS FILE's own classes/free_fns only (`file_syms`, not the + merged `syms`) -- see this function's own doc comment above for + why. *) StringMap.iter (fun _name cls -> let method_env = StringMap.empty in List.iter (fun m -> ignore (typecheck_method ~self_class:cls.name method_env m)) cls.methods - ) syms.classes; + ) file_syms.classes; StringMap.iter (fun _name (fn : free_fn_info) -> let param_env = List.fold_left (fun acc (name, ty, _) -> StringMap.add name (resolve_field_ty ty) acc) StringMap.empty fn.params in - ignore (List.fold_left typecheck_stmt param_env fn.body) - ) syms.free_fns; + let param_cenv = List.fold_left (fun acc (name, ty, _) -> + StringMap.add name (resolve_field_ty ty) acc) StringMap.empty fn.params in + ignore (List.fold_left typecheck_stmt (param_env, param_cenv) fn.body) + ) file_syms.free_fns; () @@ -473,11 +1598,409 @@ let typecheck_program ~file (prog : program) (syms : symbols) (collector : Diag. Entry point ============================================================ *) +(* Single-file convenience wrapper (runner.ml's ~40 direct assertion + helpers all go through this, never `typecheck_program` directly) -- + its own external signature is unchanged by the hotfix's new + `~module_of`/`~module_syms` parameters on `typecheck_program`: a + lone file has no sibling module structure to differ from, so it is + its own one-and-only module, exactly the convention runner.ml's + `emit_str` already established for the same single-file case + (`~module_of:(fun _ -> ".")`, one `module_syms` entry keyed `"."`). *) let typecheck ~file (prog : program) (collector : Diag.Collector.t) : symbols * unit = let syms = collect_declarations ~file prog collector in - let () = typecheck_program ~file prog syms collector in + let module_syms = Hashtbl.create 1 in + Hashtbl.replace module_syms "." syms; + (* Single file -- `syms` IS this file's own declarations, so it is + also exactly this call's `~file_syms` (hotfix). *) + let () = + typecheck_program ~file ~module_of:(fun _ -> ".") ~module_syms ~file_syms:syms prog syms collector + in (syms, ()) +(* ============================================================ + Modules (haxe-parity Task 1): use-based cross-module visibility + ============================================================ + + Layered ON TOP of the existing multi-file discovery (Task 8, + compiler/bin/main.ml): every file in one module (one directory) still + sees every other same-module file's declarations unconditionally, + exactly as before this task — that mechanism (collect_declarations + + the driver's merge) is UNCHANGED. What is new is a second, additive + check that walks each file's own `Ctor`/`Call` sites and asks "is the + declaration this name resolves to actually reachable from here?" — + own module: always; a `use`d module: only its `pub` names; anything + else: an error. This never changes *which* declaration a name + resolves to (main.ml's driver-level merge, emit.ml's lowering, and + owner.ml's analysis are all untouched) — it only decides whether that + resolution was legitimate, so a violation is a hard compile error + before any of those later stages ever run, never a silent shadow. + + A deliberate scope cut, disclosed rather than silently skipped: only + `Ctor` (constructor-literal class names) and `Call` (bare `fn(...)` + and qualified `mod.fn(...)`) sites are checked. Field/parameter/ + return *type* positions (`field: OtherModuleClass`) are not + module-gated by this task — no fixture upstream of this task needs + it (log-watcher's own 18 `use` lines are all reserved-stdlib, and + this task's own fixtures exercise classes/fns through construction + and calls), and bolting it on would mean walking every field_ty in + every class, a materially bigger surface than the brief's own + examples ask for. *) + +(* `use_edge`/`uses_of_program`/`path_str` moved up above + `typecheck_program` (hotfix, hoisted alongside `builtin_signatures`) — + `confident_typ`'s free-fn return-type derivation needs them there too + now, and OCaml has no forward reference across top-level `let`s. Kept + conceptually here in reading order; see their real definitions above + `typecheck_program` for the code. *) + +(* Merges bare `symbols` values (no diagnostics — collisions within one + module are already WO-E214/WO-E215's job, upstream of this) purely to + group per-file declarations into their shared module's surface. A + small local twin of main.ml's own merge_symbols rather than a shared + export: main.ml's version is already exercised by 399 passing checks + and touching it is not this change's job (see this task's own + "surgical changes" instruction). *) +let merge_syms_for_module (syms_list : symbols list) : symbols = + let keep_first _key a _b = Some a in + List.fold_left + (fun (acc : symbols) (s : symbols) -> + { + classes = StringMap.union keep_first acc.classes s.classes; + interfaces = StringMap.union keep_first acc.interfaces s.interfaces; + free_fns = StringMap.union keep_first acc.free_fns s.free_fns; + typedefs = StringMap.union keep_first acc.typedefs s.typedefs; + unions = StringMap.union keep_first acc.unions s.unions; + modules = acc.modules @ s.modules; + }) + { classes = StringMap.empty; interfaces = StringMap.empty; free_fns = StringMap.empty; + typedefs = StringMap.empty; unions = StringMap.empty; modules = [] } + syms_list + +(* Generic structural walk over every Ctor/Call site in a program's + method/fn bodies — deliberately NOT the full typechecker's + typecheck_expr (that resolves types; this only needs to *locate* + constructor names and call callees, own recursion kept separate and + small rather than teaching typecheck_expr a second, unrelated job). + + Threads `bound` — the set of names currently in lexical scope as a + local/param/`self` — through every visit (IMPORTANT 2 review fix, + haxe-parity Task 1: `use secret; let secret = Box(); secret.hidden()` + was a false-positive WO-E217, because the qualified-call check had no + notion of scope at all and treated any `Ident` matching a `use` + alias's spelling as that alias, unconditionally. Lexical scope wins + here exactly like everywhere else in every language with both + modules and locals — the checker in check_module_refs below is what + actually acts on `bound`; this walk only has to compute and pass it + through). Block-scoped like the language's own `let` (a `let` inside + an `if`'s body does not leak to code after that `if`) — `walk_block` + folds `bound` across a statement *list*, but every nested-block call + site passes the accumulated `bound` down and discards what comes + back, exactly the semantics that keeps a block's own bindings from + escaping it. *) +let rec walk_block (bound : StringSet.t) (visit : StringSet.t -> expr -> unit) (stmts : stmt list) : unit + = + ignore (List.fold_left (fun b s -> walk_stmt b visit s) bound stmts) + +and walk_stmt (bound : StringSet.t) (visit : StringSet.t -> expr -> unit) (s : stmt) : StringSet.t = + match s.s_kind with + | Let { name; value; _ } -> + walk_expr bound visit value; + StringSet.add name bound + | Assign { target; value } -> + walk_expr bound visit target; + walk_expr bound visit value; + bound + | If { cond; then_body; else_body } -> + walk_expr bound visit cond; + walk_block bound visit then_body; + (match else_body with Some (_, b) -> walk_block bound visit b | None -> ()); + bound + | While { cond; body } -> + walk_expr bound visit cond; + walk_block bound visit body; + bound + | For { var; iter; body } -> + walk_expr bound visit iter; + walk_block (StringSet.add var bound) visit body; + bound + | Return (Some e) -> + walk_expr bound visit e; + bound + | Return None -> bound + | ExprStmt e -> + walk_expr bound visit e; + bound + | Break | Continue -> bound + | DoWhile { cond; body } -> + walk_block bound visit body; + walk_expr bound visit cond; + bound + +and walk_expr (bound : StringSet.t) (visit : StringSet.t -> expr -> unit) (e : expr) : unit = + visit bound e; + match e.kind with + | IntLit _ | StrLit _ | BoolLit _ | Ident _ -> () + | Field (b, _) -> walk_expr bound visit b + | Index (b, i) -> + walk_expr bound visit b; + walk_expr bound visit i + | Call (callee, args) -> + walk_expr bound visit callee; + List.iter (walk_expr bound visit) args + | Unary (_, o) -> walk_expr bound visit o + | Binary (_, l, r) -> + walk_expr bound visit l; + walk_expr bound visit r + | Ctor (_, fields) -> List.iter (fun (_, v) -> walk_expr bound visit v) fields + | Interp inner -> walk_expr bound visit inner + | DbStub _ -> () + | Switch (subject, arms) -> + walk_expr bound visit subject; + List.iter + (fun (a : switch_arm) -> + List.iter (walk_expr bound visit) a.values; + walk_block bound visit a.body) + arms + +let walk_program (visit : StringSet.t -> expr -> unit) (prog : program) : unit = + List.iter + (function + | Class c -> + List.iter + (fun (m : method_decl) -> + let params = List.fold_left (fun acc (p : param) -> StringSet.add p.name acc) (StringSet.singleton "self") m.params in + walk_block params visit m.body) + c.methods + | Interface _ -> () + | Fn m -> + let params = List.fold_left (fun acc (p : param) -> StringSet.add p.name acc) StringSet.empty m.params in + walk_block params visit m.body + | Use _ -> () + | Const _ -> () + | Union _ -> ()) + prog.decls + +(* How a name used from this file resolved, against one declaration-kind + projection (classes for Ctor, free_fns for Call) of the surrounding + module graph. *) +type resolution = + | ROwn + | RUsed of string (* the use-edge alias that supplied it *) + | RCollision of string list (* every alias whose used module exports it `pub` *) + | RNotImported of string (* the module id it actually lives in *) + | RNotFound (* not own, not used, not anywhere else either — pre-existing gap (WO-E204/WO-E207's own territory), not this check's to raise *) + +let resolve_name (get : symbols -> 'a StringMap.t) (pub_of : 'a -> bool) ~(own : symbols) + ~(uses_resolved : (use_edge * symbols) list) ~(others : (string * symbols) list) (name : string) : + resolution = + if StringMap.mem name (get own) then ROwn + else + let used_hits = + List.filter_map + (fun (u, msyms) -> + match StringMap.find_opt name (get msyms) with + | Some info when pub_of info -> Some u.ue_alias + | _ -> None) + uses_resolved + in + match used_hits with + | [] -> ( + match List.find_opt (fun (_, msyms) -> StringMap.mem name (get msyms)) others with + | Some (mid, _) -> RNotImported mid + | None -> RNotFound) + | [ alias ] -> RUsed alias + | aliases -> RCollision aliases + +let report_not_imported (collector : Diag.Collector.t) ~file (pos : pos) ~(name : string) + ~(mid : string) : unit = + Diag.Collector.add collector + (Diag.error ~code:module_not_imported_code ~file ~line:pos.line ~col:pos.col + ~message:(Printf.sprintf "`%s` is declared in module `%s`, which is not `use`d here" name mid) + ()) + +let report_use_collision (collector : Diag.Collector.t) ~file (pos : pos) ~(name : string) + ~(aliases : string list) : unit = + Diag.Collector.add collector + (Diag.error ~code:use_collision_code ~file ~line:pos.line ~col:pos.col + ~message: + (Printf.sprintf "`%s` is ambiguous — exported `pub` by more than one used module (%s)" name + (String.concat ", " aliases)) + ()) + +(* Walks one file's Ctor/Call sites, checking each against the module + graph the caller (check_modules) has already assembled for it. + `mark_used` is called once per use-edge alias whenever a reference + actually resolves through it — the unused-`use` warning's own data. *) +let check_module_refs (collector : Diag.Collector.t) ~file ~(own : symbols) + ~(uses_resolved : (use_edge * symbols) list) ~(stdlib_aliases : string list) + ~(others : (string * symbols) list) ~(mark_used : string -> unit) (prog : program) : unit = + let alias_tbl = Hashtbl.create 8 in + List.iter (fun (u, msyms) -> Hashtbl.replace alias_tbl u.ue_alias msyms) uses_resolved; + let check_ctor (pos : pos) (name : string) : unit = + match resolve_name (fun s -> s.classes) (fun (c : class_info) -> c.pub) ~own ~uses_resolved ~others name with + | ROwn | RNotFound -> () + | RUsed alias -> mark_used alias + | RCollision aliases -> + (* every alias that contributed to the ambiguity was genuinely + referenced (that's exactly what makes it ambiguous) — mark + them all used so the same `use` line doesn't also draw an + "unused" warning alongside its collision error. *) + List.iter mark_used aliases; + report_use_collision collector ~file pos ~name ~aliases + | RNotImported mid -> report_not_imported collector ~file pos ~name ~mid + in + let check_bare_call (pos : pos) (name : string) : unit = + match resolve_name (fun s -> s.free_fns) (fun (f : free_fn_info) -> f.pub) ~own ~uses_resolved ~others name with + | ROwn | RNotFound -> () + (* RNotFound also covers a builtin (`print`, `len`, ...) or a + genuinely unresolved name — 08-builtin-surface.md's shadowing + rule ("a user-declared free fn of the same name always wins") + already makes ROwn win first when both exist; RNotFound's other + half (truly nothing resolves) is WO-E204's own pre-existing, + not-this-task's-to-fix gap (see nullable-types-implementation.md's + dead-code register) — silence here matches silence there. *) + | RUsed alias -> mark_used alias + | RCollision aliases -> + (* every alias that contributed to the ambiguity was genuinely + referenced (that's exactly what makes it ambiguous) — mark + them all used so the same `use` line doesn't also draw an + "unused" warning alongside its collision error. *) + List.iter mark_used aliases; + report_use_collision collector ~file pos ~name ~aliases + | RNotImported mid -> report_not_imported collector ~file pos ~name ~mid + in + let check_qualified_call (bound : StringSet.t) (pos : pos) (alias : string) (member : string) : unit = + if StringSet.mem alias bound then () + (* IMPORTANT 2 review fix: `alias` is a local/param/`self` in scope + right here — lexical scope wins, exactly like everywhere else + in every language with both modules and locals. `secret.hidden()` + where `secret` is `let secret = Box()` is an ordinary method + call the existing (unrelated, untouched) class-method machinery + already handles correctly; this module-alias check has nothing + to say about it at all, not even a used-vs-unused opinion — + `secret` the module alias was never actually referenced here. *) + else if List.mem alias stdlib_aliases then mark_used alias + (* stdlib members arrive in plan 9 — UNKNOWN-BUT-RESERVED here on + purpose: no E207/E225/arity check, nothing to look up yet. The + emitter (emit.ml) is the one place that still cares, and only + if a call through this alias survives all the way to + emission. *) + else + match Hashtbl.find_opt alias_tbl alias with + | None -> () (* not a use-alias at all: a receiver expression (`obj.method(...)`), unrelated to this check *) + | Some msyms -> ( + mark_used alias; + match StringMap.find_opt member msyms.free_fns with + | None -> () (* unknown fn in that module -- WO-E204's territory, not this check's *) + | Some (fi : free_fn_info) -> + if not fi.pub then + Diag.Collector.add collector + (Diag.error ~code:private_name_code ~file ~line:pos.line ~col:pos.col + ~message:(Printf.sprintf "`%s` is not `pub` in module `%s`" member alias) ())) + in + let visit (bound : StringSet.t) (e : expr) : unit = + match e.kind with + | Ctor (name, _) -> check_ctor e.pos name + | Call ({ kind = Ident name; _ }, _) -> check_bare_call e.pos name + | Call ({ kind = Field ({ kind = Ident alias; _ }, member); pos = fpos; _ }, _) -> + check_qualified_call bound fpos alias member + | _ -> () + in + walk_program visit prog + +(* Groups per-file declarations by module (directory) and merges within + each group — the module-scoped analogue of main.ml's existing global + merge, and every module-aware consumer's shared starting point. + `module_of` maps a discovered file to its module id (see check_modules' + own doc comment below for the exact convention). Exposed (not just + inlined into check_modules) because the emitter needs the same + per-module tables too — CRITICAL 1 review finding (plan 3): free_fns + staying one flat, globally-merged StringMap all the way through + emission is exactly what let `a.thing()`/`b.thing()` both silently + execute the same (whichever-merged-first) body. emit.ml resolves a + qualified call against *this* table (the aliased module's own, + unmangled `free_fns`), never the flat one, so two modules' same-named + `pub fn` are genuinely distinct once qualification disambiguates them. *) +let module_symbols ~(module_of : string -> string) (per_file_syms : (string * symbols) list) : + (string, symbols) Hashtbl.t = + let by_module : (string, symbols list) Hashtbl.t = Hashtbl.create 16 in + List.iter + (fun (file, syms) -> + let mid = module_of file in + let prev = try Hashtbl.find by_module mid with Not_found -> [] in + Hashtbl.replace by_module mid (syms :: prev)) + per_file_syms; + let module_syms : (string, symbols) Hashtbl.t = Hashtbl.create 16 in + Hashtbl.iter (fun mid syms_list -> Hashtbl.replace module_syms mid (merge_syms_for_module syms_list)) by_module; + module_syms + +(* The one entry point the driver (bin/main.ml) calls. `module_of` maps + a discovered file to its module id (its directory, relative to + whatever root path was discovered from — the driver's own concern, + computed once from the same root/rel machinery Task 8's discover_dir + already has; "." denotes the root module, matching Filename.dirname's + own convention for a bare name with no directory part). + `per_file_syms` is exactly what typecheck_all already builds (each + file's OWN, unmerged collect_declarations output) — grouping it by + module and merging within each group is `module_symbols`, above. + `per_file_progs` supplies the bodies to walk. *) +let check_modules (collector : Diag.Collector.t) ~(module_of : string -> string) + (per_file_syms : (string * symbols) list) (per_file_progs : (string * program) list) : unit = + let module_syms = module_symbols ~module_of per_file_syms in + let known_modules = Hashtbl.fold (fun k _ acc -> k :: acc) module_syms [] in + List.iter + (fun (file, prog) -> + let mid = module_of file in + let own = try Hashtbl.find module_syms mid with Not_found -> merge_syms_for_module [] in + let uses = uses_of_program prog in + (* Defined before the unknown-module check below (not just before + check_module_refs) so that check can mark_used its own + offending edge — an unknown-module `use` is already reported + once, precisely; a second, redundant "unused `use`" on the same + line would only be noise, not new information. *) + let used_aliases : (string, unit) Hashtbl.t = Hashtbl.create 8 in + let mark_used alias = Hashtbl.replace used_aliases alias () in + List.iter + (fun (u : use_edge) -> + if (not u.ue_is_stdlib) && not (List.mem (path_str u.ue_segments) known_modules) then begin + mark_used u.ue_alias; + Diag.Collector.add collector + (Diag.error ~code:unknown_module_code ~file ~line:u.ue_pos.line ~col:u.ue_pos.col + ~message: + (Printf.sprintf + "unknown module `%s` — not a discovered project module and not a reserved \ + stdlib namespace" + (path_str u.ue_segments)) + ()) + end) + uses; + let uses_resolved = + List.filter_map + (fun (u : use_edge) -> + if u.ue_is_stdlib then None + else + match Hashtbl.find_opt module_syms (path_str u.ue_segments) with + | Some s -> Some (u, s) + | None -> None) + uses + in + let stdlib_aliases = List.filter_map (fun u -> if u.ue_is_stdlib then Some u.ue_alias else None) uses in + let used_ids = List.map (fun (u, _) -> path_str u.ue_segments) uses_resolved in + let others = + Hashtbl.fold + (fun m s acc -> if m = mid || List.mem m used_ids then acc else (m, s) :: acc) + module_syms [] + in + check_module_refs collector ~file ~own ~uses_resolved ~stdlib_aliases ~others ~mark_used prog; + List.iter + (fun (u : use_edge) -> + if not (Hashtbl.mem used_aliases u.ue_alias) then + Diag.Collector.add collector + (Diag.warning ~code:unused_use_code ~file ~line:u.ue_pos.line ~col:u.ue_pos.col + ~message:(Printf.sprintf "unused `use %s`" (path_str u.ue_segments)) ())) + uses) + per_file_progs + (* ============================================================ Dump support ============================================================ *) diff --git a/compiler/test/fixtures/driver/module-unused-use/unused.wo b/compiler/test/fixtures/driver/module-unused-use/unused.wo new file mode 100644 index 0000000..76afb21 --- /dev/null +++ b/compiler/test/fixtures/driver/module-unused-use/unused.wo @@ -0,0 +1,9 @@ +-- haxe-parity Task 1 (modules): `use fs` is declared but this file +-- never calls anything through the `fs` alias -- WO-W202. A warning, +-- not an error: the bare `woc ` exit-code contract (0 clean, 1 +-- diagnostics-*with-an-error*-reported) means this still exits 0. +use fs + +fn main() { + print("hello") +} diff --git a/compiler/test/fixtures/driver/multifile-single-report/a.wo b/compiler/test/fixtures/driver/multifile-single-report/a.wo new file mode 100644 index 0000000..0eecb3a --- /dev/null +++ b/compiler/test/fixtures/driver/multifile-single-report/a.wo @@ -0,0 +1,3 @@ +-- Hotfix (multi-file double-report): see b.wo and runner.ml's own +-- "multifile single-report" test block for what this pins. +class Item { n: Int } diff --git a/compiler/test/fixtures/driver/multifile-single-report/b.wo b/compiler/test/fixtures/driver/multifile-single-report/b.wo new file mode 100644 index 0000000..902095b --- /dev/null +++ b/compiler/test/fixtures/driver/multifile-single-report/b.wo @@ -0,0 +1,9 @@ +-- `it.price` is the one real bug: Item (a.wo) has no `price` field, +-- only `n`. Before the hotfix, this body-level WO-E202 check re-ran +-- once per OTHER discovered file too (a.wo's own pass here), so a +-- 2-file program reported it twice -- once correctly at b.wo, once +-- phantom-stamped with a.wo's path at the same (nonexistent) line/col. +fn main() { + let it = Item{n:1} + print_int(it.price) +} diff --git a/compiler/test/runner.ml b/compiler/test/runner.ml index 2b203ef..e5853ba 100644 --- a/compiler/test/runner.ml +++ b/compiler/test/runner.ml @@ -460,14 +460,19 @@ let () = && List.for_all (fun (m : Ast.method_decl) -> c.id < m.id) c.methods); add c.id; List.iter visit_field c.fields; - List.iter visit_method c.methods + List.iter visit_method c.methods; + (* haxe-parity Task 2: bare class-level consts, same shape *) + List.iter (fun (cd : Ast.const_decl) -> add cd.id) c.consts | Ast.Interface i -> check (Printf.sprintf "node ids: interface `%s` id < all its method ids" i.name) (List.for_all (fun (s : Ast.method_sig) -> i.id < s.id) i.methods); add i.id; List.iter visit_sig i.methods - | Ast.Fn m -> visit_method m) + | Ast.Fn m -> visit_method m + | Ast.Use u -> add u.id + | Ast.Const c -> add c.id + | Ast.Union u -> add u.id (* haxe-parity Task 4: variants carry no ids of their own *)) prog.Ast.decls; let sorted = List.sort compare !ids in let deduped = List.sort_uniq compare !ids in @@ -575,6 +580,161 @@ let () = | _ -> check "no_brace guard: exactly one `if` statement" false) | _ -> check "no_brace guard: exactly one free fn" false +(* ---- haxe-parity Task 2 (not golden-diffed) ----------------------------- + + `and`/`or` precedence, string-interpolation desugar shape, and const + substitution's scope-awareness — all structural facts a text dump + cannot show cleanly (same rationale as this file's other direct + assertions above). break/continue/do-while's own shapes are simple + enough that golden/ast coverage would suffice, so they are not + duplicated here. *) + +let () = + (* `or` binds loosest, then `and`, then comparison (parser.ml's own + ladder doc): `a == 1 and b == 2` must parse as + `And(Eq(a,1), Eq(b,2))` with no parens needed. *) + let prog, _ = parse_str ~file:"and-prec.wo" "fn f(a: Int, b: Int) {\n return a == 1 and b == 2\n}\n" in + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.Return (Some { Ast.kind = Ast.Binary (Ast.And, l, r); _ }); _ } ] -> + check "and/or precedence: left operand is `a == 1`" + (match l.Ast.kind with + | Ast.Binary (Ast.Eq, { Ast.kind = Ast.Ident "a"; _ }, { Ast.kind = Ast.IntLit 1; _ }) -> true + | _ -> false); + check "and/or precedence: right operand is `b == 2`" + (match r.Ast.kind with + | Ast.Binary (Ast.Eq, { Ast.kind = Ast.Ident "b"; _ }, { Ast.kind = Ast.IntLit 2; _ }) -> true + | _ -> false) + | _ -> check "and/or precedence: top-level operator is `and`, not split by `==`" false) + | _ -> check "and/or precedence: exactly one free fn" false + +let () = + (* `or` looser than `and`: `x or y and z` is `Or(x, And(y, z))`, not + `And(Or(x,y), z)`. *) + let prog, _ = parse_str ~file:"or-prec.wo" "fn f(x: Bool, y: Bool, z: Bool) {\n return x or y and z\n}\n" in + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.Return (Some { Ast.kind = Ast.Binary (Ast.Or, l, r); _ }); _ } ] -> + check "or looser than and: left operand is bare `x`" + (match l.Ast.kind with Ast.Ident "x" -> true | _ -> false); + check "or looser than and: right operand is `y and z`" + (match r.Ast.kind with + | Ast.Binary (Ast.And, { Ast.kind = Ast.Ident "y"; _ }, { Ast.kind = Ast.Ident "z"; _ }) -> true + | _ -> false) + | _ -> check "or looser than and: top-level operator is `or`" false) + | _ -> check "or looser than and: exactly one free fn" false + +let () = + (* Interpolation desugar shape: `"${x} y"` -> Concat(Interp(Ident x), + StrLit " y") -- the parse-time-decided chain shape parser.ml's own + Ast.Interp doc comment describes. *) + let prog, _ = parse_str ~file:"interp.wo" "fn f(x: Int) {\n return \"${x} y\"\n}\n" in + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ + { + Ast.s_kind = + Ast.Return (Some { Ast.kind = Ast.Binary (Ast.Concat, { Ast.kind = Ast.Interp inner; _ }, tail); _ }); + _; + }; + ] -> + check "interp desugar: the embedded expression is bare `x`" + (match inner.Ast.kind with Ast.Ident "x" -> true | _ -> false); + check "interp desugar: the trailing text segment is `\" y\"`" + (match tail.Ast.kind with Ast.StrLit " y" -> true | _ -> false) + | _ -> check "interp desugar: exactly one `return Concat(Interp, StrLit)`" false) + | _ -> check "interp desugar: exactly one free fn" false + +let () = + (* `\$` is a literal `$`, so a fully-escaped `${x}` never triggers + interpolation at all -- the whole literal stays one plain StrLit, + not a degenerate one-segment Interp chain. *) + let prog, _ = parse_str ~file:"interp-escape.wo" "fn f() {\n return \"\\${x}\"\n}\n" in + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.Return (Some e); _ } ] -> + check "interp desugar: `\\${x}` is a plain StrLit \"${x}\", no interpolation" + (match e.Ast.kind with Ast.StrLit "${x}" -> true | _ -> false) + | _ -> check "interp desugar (escape): exactly one `return`" false) + | _ -> check "interp desugar (escape): exactly one free fn" false + +let () = + (* Review fix (Important, post-Task-2): a genuine sub-parse failure + inside an interpolation (1 +, not just trailing garbage) must + report at the outer string literal's own position, with the same + malformed-interpolation framing the trailing-garbage case already + used — not at the sub-lexer's own uncorrected 1:1-relative + line/col, which used to land on some unrelated line of the real + file (and never mentioned interpolation at all, since it was + raised straight out of the nested parse_expr). The source below + puts the string literal's own opening quote at line 2, column 10; + a regression back to the old, uncaught-inner-failure behavior + would report at line 1 (the sub-lexer's own count) instead. *) + let prog, collector = + parse_str ~file:"interp-malformed.wo" "fn f() {\n return \"${1 +}\"\n}\n" + in + (match Diag.Collector.diagnostics collector with + | d :: _ -> + check "interp malformed sub-expr: reports at the outer string's own position (2:10)" + (d.Diag.site.Diag.line = 2 && d.Diag.site.Diag.col = 10); + check "interp malformed sub-expr: the \"malformed ${...}\" message, not a raw sub-parse error" + (d.Diag.message = "malformed \"${...}\" interpolation expression"); + check "interp malformed sub-expr: code is WO-E101" (d.Diag.code = "WO-E101") + | [] -> check "interp malformed sub-expr: at least one diagnostic reported" false); + (* The failure is caught and recovered at the *statement* level + (parse_block's own sync_to_next_stmt, unchanged by this fix) -- + `fn f` itself still parses, just with its one bad `return` + statement dropped, confirming desugar_interp's `fail` raises + Parse_error the ordinary way rather than short-circuiting recovery + entirely. *) + ignore prog + +let () = + (* const substitution (parser.ml's own post-parse pass): a bare + `Ident` reference becomes the literal expr the const named. *) + let prog, _ = parse_str ~file:"const.wo" "const N = 5\nfn f() {\n return N\n}\n" in + match prog.Ast.decls with + | [ Ast.Const _; Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.Return (Some { Ast.kind = Ast.IntLit 5; _ }); _ } ] -> + check "const substitution: `return N` became `return 5`" true + | _ -> check "const substitution: `return N` should desugar to `return 5`" false) + | _ -> check "const substitution: exactly one const decl and one free fn" false + +let () = + (* Scope-aware, exactly like types.ml's own local-shadows-a-`use`- + alias fix (Task 1 review): a parameter named the same as a + top-level const always wins, so `f`'s own `N` parameter is returned + unsubstituted, not silently replaced by the const's `5`. *) + let prog, _ = parse_str ~file:"const-shadow.wo" "const N = 5\nfn f(N: Int) {\n return N\n}\n" in + match prog.Ast.decls with + | [ Ast.Const _; Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.Return (Some { Ast.kind = Ast.Ident "N"; _ }); _ } ] -> + check "const substitution: a same-named parameter shadows the const" true + | _ -> check "const substitution: a same-named parameter must shadow the const, not get replaced" false) + | _ -> check "const substitution (shadowing): exactly one const decl and one free fn" false + +let () = + (* Class-level consts win over a same-named top-level one (innermost + scope wins) and are visible bare, with no `self.` prefix, inside + that class's own methods only. *) + let prog, _ = + parse_str ~file:"const-class.wo" + "const LABEL = \"top\"\nclass Box {\n const LABEL = \"class\"\n n: Int\n fn get() -> Text {\n return LABEL\n }\n}\n" + in + match prog.Ast.decls with + | [ Ast.Const _; Ast.Class c ] -> ( + match c.methods with + | [ { body = [ { Ast.s_kind = Ast.Return (Some { Ast.kind = Ast.StrLit "class"; _ }); _ } ]; _ } ] -> + check "const substitution: class-level const shadows the top-level one" true + | _ -> check "const substitution: class-level LABEL should win, returning \"class\"" false) + | _ -> check "const substitution (class-level): exactly one const decl and one class" false + (* ---- fix round 1 regressions (post-review CRITICAL 1/2/3) --------------- golden/ast/{condition-recovery,db-stub-nested}.wo and the extra @@ -695,6 +855,108 @@ let () = | _ -> check "ctor in call/index inside a condition: exactly two `if` statements" false) | _ -> check "ctor in call/index inside a condition: exactly one free fn" false +(* ---- haxe-parity Task 3 (`switch` as expression, not golden-diffed) -- + + Same rationale as Task 2's own direct-assertion section above: the + grammar shape (arm count, multi-value `case`, `default`'s empty + `values`, the no_brace guard on the subject) is a structural fact a + text dump cannot show cleanly. *) + +let () = + (* `switch code { case 200: "a"; case 404, 410: "b"; default: "c"; }` + -- the sample's own shape (docs/examples/log-watcher/cron.wo's + `case "@daily", "@midnight": ...`): a `case` may carry more than + one value, `default` carries none and is flagged. *) + let prog, collector = + parse_str ~file:"switch-shape.wo" + "fn f(code: Int) -> Text {\n\ + \ return switch code {\n\ + \ case 200: \"a\";\n\ + \ case 404, 410: \"b\";\n\ + \ default: \"c\";\n\ + \ };\n\ + }\n" + in + check_eq "switch shape: reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.Return (Some { Ast.kind = Ast.Switch (subject, arms); _ }); _ } ] -> + check "switch shape: subject is the bare Ident `code`" + (match subject.Ast.kind with Ast.Ident "code" -> true | _ -> false); + (match arms with + | [ a1; a2; a3 ] -> + check "switch shape: arm 1 is a single-value `case 200`, not default" + (not a1.Ast.is_default + && match a1.Ast.values with [ { Ast.kind = Ast.IntLit 200; _ } ] -> true | _ -> false); + check "switch shape: arm 2 is the multi-value `case 404, 410`" + (not a2.Ast.is_default + && + match a2.Ast.values with + | [ { Ast.kind = Ast.IntLit 404; _ }; { Ast.kind = Ast.IntLit 410; _ } ] -> true + | _ -> false); + check "switch shape: arm 3 is `default`, with no values" + (a3.Ast.is_default && a3.Ast.values = []) + | _ -> check "switch shape: exactly three arms" false) + | _ -> check "switch shape: exactly one `return switch ...`" false) + | _ -> check "switch shape: exactly one free fn" false + +let () = + (* Statement position: "one construct, not two" (the brief's own + words) -- a bare `switch {...}` with no assignment is exactly the + same `Ast.Switch` node, just wrapped in `ExprStmt`, its value + discarded -- the same shape a bare `select ...`/function-call + statement already is. *) + let prog, collector = + parse_str ~file:"switch-stmt-shape.wo" + "fn f(n: Int) {\n\ + \ switch n {\n\ + \ case 1: print(\"one\");\n\ + \ default: print(\"other\");\n\ + \ }\n\ + }\n" + in + check_eq "switch statement shape: reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.ExprStmt { Ast.kind = Ast.Switch (subject, arms); _ }; _ } ] -> + check "switch statement shape: subject is the bare Ident `n`" + (match subject.Ast.kind with Ast.Ident "n" -> true | _ -> false); + check_eq "switch statement shape: two arms" ~expected:2 ~actual:(List.length arms) + string_of_int + | _ -> check "switch statement shape: exactly one bare `ExprStmt(Switch ...)`" false) + | _ -> check "switch statement shape: exactly one free fn" false + +let () = + (* The no_brace guard (parser.ml's state.no_brace / looks_like_ctor), + for `switch` exactly like `if`/`while`/`for` above: a bare + identifier subject immediately followed by `{` is the switch's own + body, never a constructor literal swallowing it. *) + let prog, collector = + parse_str ~file:"switch-no-brace.wo" + "fn f(active: Int) {\n\ + \ switch active {\n\ + \ default: return\n\ + \ }\n\ + }\n" + in + check_eq "switch no_brace guard: reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) + string_of_int; + match prog.Ast.decls with + | [ Ast.Fn m ] -> ( + match m.body with + | [ { Ast.s_kind = Ast.ExprStmt { Ast.kind = Ast.Switch (subject, _); _ }; _ } ] -> + check "switch no_brace guard: subject is the bare ident, not a Ctor" + (match subject.Ast.kind with Ast.Ident "active" -> true | _ -> false) + | _ -> check "switch no_brace guard: exactly one switch statement" false) + | _ -> check "switch no_brace guard: exactly one free fn" false + (* ---- CLI smoke ------------------------------------------------------- Everything above calls Lexer.tokenize/Dump.dump_tokens in-process -- @@ -880,6 +1142,65 @@ let () = stderr <> None) +let () = + (* haxe-parity Task 1 (modules): unused-`use` golden. Corpus fixtures + (tests/corpus/run and tests/corpus/compile-fail, "lang-use-" prefix) + exercise the resolver end to end through the real woc/wovm pair — + cross-module call, + collision, private-name-access — but oop-e2e.sh's compile-fail/ + kind demands exit 1, and run/ only diffs stdout, so neither kind + can assert a *warning*-only outcome (exit 0, something on stderr) + at all; that gap is exactly why the brief calls out "golden via + compiler suite since warnings don't fail" for this one case, and + is filed here rather than duplicating the collision/private-access/ + cross-module cases already proven end to end by the corpus. *) + let path = "fixtures/driver/module-unused-use/unused.wo" in + let exit_code, _stdout, stderr = run_cli [ path ] in + check "unused use: `use fs` declared and never called still exits 0 (a warning, not an error)" + (exit_code = 0); + check "unused use: WO-W202 on the `use fs` line, naming the module" + (find_substring ~needle:"unused.wo:5:1: warning WO-W202: unused `use fs`" stderr <> None) + +(* Manual non-overlapping substring counter, same idiom as find_substring + just above -- the one thing that helper can't answer on its own + (whether a needle occurs more than once), needed only by the single + test right below it. *) +let count_substring ~needle haystack = + let hlen = String.length haystack and nlen = String.length needle in + let rec go i n = + if i + nlen > hlen then n + else if String.sub haystack i nlen = needle then go (i + nlen) (n + 1) + else go (i + 1) n + in + go 0 0 + +let () = + (* Hotfix (multi-file double-report): typecheck_program used to walk + the whole-program *merged* symbol table's classes/free_fns + regardless of which file was actually being checked, so an N-file + program ran every file's bodies through the checker once per + discovered file (here N=2, so 2x, not once) -- b.wo's one real + WO-E202 (`it.price`; Item, declared in a.wo, has no such field) + got a second, phantom copy stamped with a.wo's own path, at the + same (line, col) a.wo doesn't even have that many lines of. See + types.ml's typecheck_program doc comment (the `~file_syms` fix) + and .superpowers/sdd/2026-08-01-haxe-parity-language/ + hotfix-e209-report.md's "Disclosed, NOT fixed" section for the + original diagnosis this pins the fix for. Bare check-only mode + (no --emit) on purpose: it skips emit.ml's own, unrelated + field-existence check (WO-E403), keeping this fixture down to + exactly the one diagnostic under test. *) + let dir = "fixtures/driver/multifile-single-report" in + let exit_code, _stdout, stderr = run_cli [ dir ] in + check "multifile single-report: exits 1 (one real WO-E202, nothing else)" (exit_code = 1); + check "multifile single-report: WO-E202 reported EXACTLY once, not once per other file" + (count_substring ~needle:"error WO-E202" stderr = 1); + check "multifile single-report: the one report is tagged with b.wo (the real site)" + (find_substring ~needle:"b.wo:8:15: error WO-E202: unknown field `price` on `Item`" stderr + <> None); + check "multifile single-report: no phantom copy stamped with a.wo's path" + (find_substring ~needle:"a.wo:" stderr = None) + (* ---- direct typechecker assertions (Task 6b) -------------------------- No golden "types" stage exists yet: that would need `--dump-types` @@ -1113,6 +1434,363 @@ let () = check_eq "class/fn name sharing across namespaces: reports nothing" ~expected:0 ~actual:(List.length (Diag.Collector.diagnostics collector)) string_of_int +(* ---- WO-E209 direct assertions (hotfix: invalid-builtin-arg) ---------- + + `print(7)` used to compile clean and segfault `wovm` -- `print` wants + a `Text` (a heap-string pointer) and a bare `7` is a plain int64 + register, so the VM's `str_check` dereferenced it as a wild pointer. + `tests/corpus/compile-fail/lang-builtin-arg-type/` and + `lang-builtin-arity/` pin the same two shapes end to end through + `woc`/`oop-e2e.sh`; these assertions pin the Collector-level contract + directly (code, severity, exact position), the same way the WO-W201/ + WO-E225/WO-E215 blocks above do. *) + +let () = + (* Positive control: a correctly-typed `print` call must stay silent -- + this check must not regress the common case. *) + let _, collector = typecheck_str ~file:"print-ok.wo" "fn main() {\n print(\"x\")\n}\n" in + check_eq "builtin-arg-type: print(\"x\") reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) string_of_int + +let () = + (* Negative #1: print(7) -- a Text builtin called with an Int literal, + the exact segfault repro. Reported at the argument's own position + (2:9, the `7`), not the call's. *) + let path = "print-int-lit.wo" in + let _, collector = typecheck_str ~file:path "fn main() {\n print(7)\n}\n" in + let diags = Diag.Collector.diagnostics collector in + check_eq "builtin-arg-type: print(7) is exactly one diagnostic (WO-E209)" ~expected:1 + ~actual:(List.length diags) string_of_int; + (match diags with + | [ d ] -> + check "builtin-arg-type: code is WO-E209" (d.Diag.code = "WO-E209"); + check "builtin-arg-type: severity is Error" (d.Diag.severity = Diag.Error); + check "builtin-arg-type: reported at the argument's own position (print-int-lit.wo:2:9)" + (d.Diag.site.Diag.file = path && d.Diag.site.Diag.line = 2 && d.Diag.site.Diag.col = 9); + check "builtin-arg-type: message names the builtin, expected, and actual type" + (find_substring ~needle:"builtin `print` expects Text, got `Int`" d.Diag.message <> None) + | _ -> check "builtin-arg-type: print(7) exactly one diagnostic" false); + check_eq "builtin-arg-type: an error run exits 1" ~expected:1 + ~actual:(Diag.Collector.exit_code collector) string_of_int + +let () = + (* Negative #2: now(1) -- `now` takes zero arguments + (08-builtin-surface.md's `now()` row). Reported at the call's own + position (2:6, the `(` -- e.pos for a Call node), same code as the + argument-type mismatch above: WO-E209 covers both halves of + "invalid builtin call." *) + let path = "now-arity.wo" in + let _, collector = typecheck_str ~file:path "fn main() {\n now(1)\n}\n" in + let diags = Diag.Collector.diagnostics collector in + check_eq "builtin-arity: now(1) is exactly one diagnostic (WO-E209)" ~expected:1 + ~actual:(List.length diags) string_of_int; + match diags with + | [ d ] -> + check "builtin-arity: code is WO-E209" (d.Diag.code = "WO-E209"); + check "builtin-arity: reported at the call's own position (now-arity.wo:2:6)" + (d.Diag.site.Diag.file = path && d.Diag.site.Diag.line = 2 && d.Diag.site.Diag.col = 6); + check "builtin-arity: message names the builtin and the counts" + (find_substring ~needle:"builtin `now` takes 0 argument(s), given 1" d.Diag.message <> None) + | _ -> check "builtin-arity: now(1) exactly one diagnostic" false + +let () = + (* Container-ness, real catch: `push` wants a `multi` receiver + (08-builtin-surface.md); `b.n` is a genuinely *declared* `Int` + field, not an unresolved placeholder, so this must fire even though + the receiver isn't a literal -- the case that motivated threading + `confident_typ`'s own `cenv` through field/parameter resolution + instead of only trusting literals. *) + let _, collector = + typecheck_str ~file:"push-wrong-receiver.wo" + "class Box {\n n: Int\n}\nfn use_box(b: Box) {\n push(b.n, 1)\n}\n" + in + let diags = Diag.Collector.diagnostics collector in + check_eq "builtin-arg-type: push(b.n, 1) is exactly one diagnostic (WO-E209)" ~expected:1 + ~actual:(List.length diags) string_of_int; + match diags with + | [ d ] -> + check "builtin-arg-type: code is WO-E209" (d.Diag.code = "WO-E209"); + check "builtin-arg-type: message names push, a multi, and Int" + (find_substring ~needle:"builtin `push` expects a `multi`, got `Int`" d.Diag.message <> None) + | _ -> check "builtin-arg-type: push(b.n, 1) exactly one diagnostic" false + +let () = + (* Container-ness, positive control: `push` onto a genuinely-declared + `multi` field must stay silent. *) + let _, collector = + typecheck_str ~file:"push-ok.wo" + "class Item {\n n: Int\n}\nclass Box {\n items: multi Item\n}\nfn use_box(b: Box) {\n \ + push(b.items, Item { n: 1 })\n}\n" + in + check_eq "builtin-arg-type: push onto a declared `multi` field reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) string_of_int + +let () = + (* Shadowing: "a user-declared free fn of the same name always wins" + (08-builtin-surface.md) -- a same-named `print` taking a `Text` + means `print(7)` is now a call to *that* fn, not the builtin, so + this check must not fire (whether the user fn's own call is + well-typed is WO-E203/WO-E204's pre-existing, unrelated gap). *) + let _, collector = + typecheck_str ~file:"print-shadowed.wo" + "fn print(x: Text) {\n print_int(1)\n}\nfn main() {\n print(7)\n}\n" + in + check_eq "builtin-arg-type: user-declared `print` shadows the builtin, reports nothing" + ~expected:0 ~actual:(List.length (Diag.Collector.diagnostics collector)) string_of_int + +let () = + (* Conservatism: `print(x)` where `x` is an unresolved name has no + confidently-known type (an unresolved `Ident` is `confident_typ`'s + own `None` case) -- this check must stay silent rather than guess, + exactly the "stay silent when underivable" contract. *) + let _, collector = typecheck_str ~file:"print-unresolved.wo" "fn main() {\n print(x)\n}\n" in + check_eq "builtin-arg-type: print(x) with x unresolved reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) string_of_int + +(* ---- WO-E209 round 2: Call-return derivation (fix-round-1 finding) ---- + + Round 1's `confident_typ` chased literals/fields/params but never a + `Call`'s own return type -- so `print(takesSecret(box))`, where + `takesSecret` is declared `-> Int`, compiled clean and segfaulted + `wovm` exactly like `print(7)` does, one call deeper. Controller- + verified real repro; `tests/corpus/compile-fail/ + lang-builtin-arg-type-{freefn,method}/` pin the same two shapes end + to end through `woc`/`oop-e2e.sh`. *) + +let () = + (* Free-fn call: `takesSecret` is declared `-> Int`; a class method + call inside it (`box.hidden()`) is itself part of the repro but not + what's being pinned here -- the outer `print` call is. *) + let path = "print-freefn-call.wo" in + let src = + "class Box {\n fn hidden() -> Int {\n return 7\n }\n}\n\ + fn takesSecret(box: Box) -> Int {\n return box.hidden()\n}\n\ + fn main() {\n print(takesSecret(Box{}))\n}\n" + in + let _, collector = typecheck_str ~file:path src in + let diags = Diag.Collector.diagnostics collector in + check_eq "builtin-arg-type: print(freefn-call) is exactly one diagnostic (WO-E209)" ~expected:1 + ~actual:(List.length diags) string_of_int; + match diags with + | [ d ] -> + check "builtin-arg-type: code is WO-E209" (d.Diag.code = "WO-E209"); + check "builtin-arg-type: reported at the call's own position (print-freefn-call.wo:10:20)" + (d.Diag.site.Diag.file = path && d.Diag.site.Diag.line = 10 && d.Diag.site.Diag.col = 20); + check "builtin-arg-type: message names print, Text, and Int" + (find_substring ~needle:"builtin `print` expects Text, got `Int`" d.Diag.message <> None) + | _ -> check "builtin-arg-type: print(freefn-call) exactly one diagnostic" false + +let () = + (* Method call, receiver built the ordinary way (`let b = Box{}`, a + `Ctor` -- confident_typ has to chase that too, not only a + parameter's declared type, to reach `hidden`'s own `-> Int`). *) + let path = "print-method-call.wo" in + let src = + "class Box {\n fn hidden() -> Int {\n return 7\n }\n}\n\ + fn main() {\n let b = Box{}\n print(b.hidden())\n}\n" + in + let _, collector = typecheck_str ~file:path src in + let diags = Diag.Collector.diagnostics collector in + check_eq "builtin-arg-type: print(method-call) is exactly one diagnostic (WO-E209)" ~expected:1 + ~actual:(List.length diags) string_of_int; + match diags with + | [ d ] -> + check "builtin-arg-type: code is WO-E209" (d.Diag.code = "WO-E209"); + check "builtin-arg-type: reported at the call's own position (print-method-call.wo:8:17)" + (d.Diag.site.Diag.file = path && d.Diag.site.Diag.line = 8 && d.Diag.site.Diag.col = 17); + check "builtin-arg-type: message names print, Text, and Int" + (find_substring ~needle:"builtin `print` expects Text, got `Int`" d.Diag.message <> None) + | _ -> check "builtin-arg-type: print(method-call) exactly one diagnostic" false + +let () = + (* Bidirectional pin on a builtin-call return type feeding another + builtin: `words` returns `Int` (08-builtin-surface.md), so + `print(words(...))` is WO-E209 (wants `Text`) and + `print_int(words(...))` is clean (wants `Int`) -- same underlying + `builtin_confident_ret` entry, both directions asserted so a + regression flipping either one is caught. *) + let _, bad_collector = + typecheck_str ~file:"print-words.wo" "fn main() {\n print(words(\"a b\"))\n}\n" + in + let bad_diags = Diag.Collector.diagnostics bad_collector in + check_eq "builtin-arg-type: print(words(...)) is exactly one diagnostic (WO-E209)" ~expected:1 + ~actual:(List.length bad_diags) string_of_int; + (match bad_diags with + | [ d ] -> + check "builtin-arg-type: print(words(...)) code is WO-E209" (d.Diag.code = "WO-E209"); + check "builtin-arg-type: print(words(...)) message names print, Text, and Int" + (find_substring ~needle:"builtin `print` expects Text, got `Int`" d.Diag.message <> None) + | _ -> check "builtin-arg-type: print(words(...)) exactly one diagnostic" false); + let _, ok_collector = + typecheck_str ~file:"print-int-words.wo" "fn main() {\n print_int(words(\"a b\"))\n}\n" + in + check_eq "builtin-arg-type: print_int(words(...)) reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics ok_collector)) string_of_int + +(* ---- haxe-parity Task 3: WO-E208 (missing default), WO-E201 (arm + mismatch) direct assertions -------------------------------------- + + tests/corpus/compile-fail/lang-switch-missing-default and + lang-switch-arm-mismatch already pin the end-to-end shape (real code, + real exit status); these pin the exact diagnostic — count, severity, + site — the same way the WO-E209 blocks above do for builtins. *) + +let () = + (* Scalar subject (`Int`), no `default`: unconditional today (no union + type exists yet — see typecheck_switch's own doc comment, the seam + Task 4 extends) — WO-E208, at the subject's own position. *) + let path = "switch-no-default.wo" in + let _, collector = + typecheck_str ~file:path + "fn f(n: Int) -> Text {\n let v = switch n {\n case 1: \"a\";\n case 2: \"b\";\n }\n return v\n}\n" + in + let diags = Diag.Collector.diagnostics collector in + check_eq "switch missing default: exactly one diagnostic (WO-E208)" ~expected:1 + ~actual:(List.length diags) string_of_int; + match diags with + | [ d ] -> + check "switch missing default: code is WO-E208" (d.Diag.code = "WO-E208"); + check "switch missing default: severity is Error" (d.Diag.severity = Diag.Error); + check "switch missing default: message names the subject's type (`Int`)" + (find_substring ~needle:"switch over `Int` has no `default` arm" d.Diag.message <> None) + | _ -> check "switch missing default: exactly one diagnostic" false + +let () = + (* Review fix (Critical 1): a `default` arm satisfies the default- + required rule even when it is not textually last (no error) — but + is no longer silent about it either: `case 2`, written after + `default`, used to be permanently unreachable dead code (nothing + ever jumped into it) with zero diagnostic; `default` is now + lowered last regardless of source position (ast.ml's own + `switch_lowering_order`, so `case 2` is live again — see the + dedicated corpus fixture, lang-switch-default-not-last, for the + runtime proof), and this position is still surprising enough + source to warn about once, at `default`'s own site. *) + let path = "switch-default-present.wo" in + let _, collector = + typecheck_str ~file:path + "fn f(n: Int) -> Text {\n let v = switch n {\n case 1: \"a\";\n default: \"z\";\n case 2: \"b\";\n }\n return v\n}\n" + in + let diags = Diag.Collector.diagnostics collector in + check_eq "switch with default present (not last): exactly one diagnostic (WO-W203)" + ~expected:1 ~actual:(List.length diags) string_of_int; + match diags with + | [ d ] -> + check "switch default not last: code is WO-W203" (d.Diag.code = "WO-W203"); + check "switch default not last: severity is Warning (never an error)" + (d.Diag.severity = Diag.Warning); + check_eq "switch default not last: exits 0 (a warning-only run)" ~expected:0 + ~actual:(Diag.Collector.exit_code collector) string_of_int + | _ -> check "switch default not last: exactly one diagnostic" false + +let () = + (* Arm-type unification: `case 1` yields `Text`, `default` yields + `Int` — the switch's own type is fixed by the first arm + (typecheck_switch's "first wins" convention), so the mismatch is + reported at the *later* (default) arm's own value, not the first. *) + let path = "switch-arm-mismatch.wo" in + let _, collector = + typecheck_str ~file:path + "fn f(n: Int) -> Text {\n let v = switch n {\n case 1: \"a\";\n default: 0;\n }\n return v\n}\n" + in + let diags = Diag.Collector.diagnostics collector in + check_eq "switch arm mismatch: exactly one diagnostic (WO-E201)" ~expected:1 + ~actual:(List.length diags) string_of_int; + (match diags with + | [ d ] -> + check "switch arm mismatch: code is WO-E201" (d.Diag.code = "WO-E201"); + check "switch arm mismatch: severity is Error" (d.Diag.severity = Diag.Error); + check "switch arm mismatch: message names both types (`Int` vs `Text`)" + (find_substring ~needle:"switch arm yields `Int`, but the switch's type is `Text`" + d.Diag.message + <> None); + check_eq "switch arm mismatch: reported at the `default` arm's own value (line 4, col 14)" + ~expected:(4, 14) ~actual:(d.Diag.site.Diag.line, d.Diag.site.Diag.col) + (fun (l, c) -> Printf.sprintf "%d:%d" l c) + | _ -> check "switch arm mismatch: exactly one diagnostic" false) + +let () = + (* Statement position: "the expression with a discarded value" — an + arm that fails to yield one (every arm here ends in `return`, not + an `ExprStmt`) must NOT be treated as a type mismatch: nothing is + unified when the value is never used. Also proves `default` is + still required in statement position, unconditionally (not just + when the value is consumed). *) + let _, collector = + typecheck_str ~file:"switch-stmt-no-mismatch.wo" + "fn f(n: Int) -> Int {\n switch n {\n case 1: return 1\n default: return 0\n }\n return 0\n}\n" + in + check_eq "switch statement position, every arm returns: reports nothing" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) string_of_int + +let () = + (* Review fix (Critical 2): a `Text` subject compared against an + `Int` case label is not merely a type error — unchecked, it is a + real VM segfault (emit.ml's EQ-vs-EQS choice reads only the + subject's type; `s: Text` picks EQS, whose `str_check` + dereferences the case value's own register — a raw int64 — as a + `wo_str*`). Wired through WO-E201 (`type_mismatch_code`), the + same code the arm-unification check above uses, per the review's + own instruction. *) + let path = "switch-text-int-mismatch.wo" in + let _, collector = + typecheck_str ~file:path + "fn f(s: Text) -> Text {\n let v = switch s {\n case 1: \"a\";\n default: \"b\";\n }\n return v\n}\n" + in + let diags = Diag.Collector.diagnostics collector in + check_eq "switch Text-subject/Int-case: exactly one diagnostic (WO-E201)" ~expected:1 + ~actual:(List.length diags) string_of_int; + (match diags with + | [ d ] -> + check "switch Text-subject/Int-case: code is WO-E201" (d.Diag.code = "WO-E201"); + check "switch Text-subject/Int-case: severity is Error" (d.Diag.severity = Diag.Error); + check "switch Text-subject/Int-case: message names both types" + (find_substring + ~needle:"switch case value has type `Int`, but the switch subject has type `Text`" + d.Diag.message + <> None) + | _ -> check "switch Text-subject/Int-case: exactly one diagnostic" false) + +let () = + (* The reverse direction: an `Int` subject against a `Text` case + label doesn't crash the VM (EQ just compares two int64s), but the + case can never fire (a silent always-false) — equally wrong, and + the review calls it out explicitly as "equally wrong today." *) + let _, collector = + typecheck_str ~file:"switch-int-text-mismatch.wo" + "fn f(n: Int) -> Text {\n let v = switch n {\n case \"one\": \"a\";\n default: \"b\";\n }\n return v\n}\n" + in + let diags = Diag.Collector.diagnostics collector in + check_eq "switch Int-subject/Text-case: exactly one diagnostic (WO-E201)" ~expected:1 + ~actual:(List.length diags) string_of_int; + match diags with + | [ d ] -> + check "switch Int-subject/Text-case: code is WO-E201" (d.Diag.code = "WO-E201"); + check "switch Int-subject/Text-case: message names both types" + (find_substring + ~needle:"switch case value has type `Text`, but the switch subject has type `Int`" + d.Diag.message + <> None) + | _ -> check "switch Int-subject/Text-case: exactly one diagnostic" false + +let () = + (* Silence proof: the pattern-vs-subject check must NOT false-positive + against an unresolved/placeholder subject type — the exact shape + the sample's own union-typed switch sites have today (Task 4's + territory, already WO-E207'd) — matching the "confident, stay + silent when underivable" contract WO-E209 established. `Unknown` + is not a builtin scalar, gc class, or declared class, so its + `wob_kind` is WO_K_OWNED — deliberately `Other`, never compared. *) + let _, collector = + typecheck_str ~file:"switch-unresolved-subject.wo" + "fn f(u: Unknown) -> Text {\n let v = switch u {\n case Ok: \"a\";\n default: \"b\";\n }\n return v\n}\n" + in + let non_e201 = + List.filter (fun (d : Diag.t) -> d.Diag.code = "WO-E201") (Diag.Collector.diagnostics collector) + in + check_eq "switch unresolved subject: no WO-E201 false positive" ~expected:0 + ~actual:(List.length non_e201) string_of_int + (* ---- direct ownership-pass assertions (Task 7) ------------------------ golden/owner-err/ already pins the *rendered* text of every must-fail @@ -1142,7 +1820,14 @@ let emit_str ~file src = let prog = Parser.parse collector ~file toks in let syms, () = Types.typecheck ~file prog collector in let tables = Owner.analyze ~file prog syms collector in - let image = Emit.emit ~syms collector [ { Emit.file; prog; tables } ] in + (* Single-file helper (every golden fixture is one file): its own + module is "." and that module's own symbols are exactly `syms` — + no cross-module resolution to plumb through for these tests. *) + let module_syms = Hashtbl.create 1 in + Hashtbl.replace module_syms "." syms; + let image = + Emit.emit ~syms ~module_of:(fun _ -> ".") ~module_syms collector [ { Emit.file; prog; tables } ] + in (image, collector) let is_ownership_code (code : string) = @@ -1502,6 +2187,141 @@ let () = check "re-init after move: no OVERWRITE, since the moved-out local held nothing" (not (List.exists (fun (d : Owner.drop_site) -> d.Owner.dr_pos.Ast.line = 63) overwrites)) +let () = + (* haxe-parity Task 3: switch arms are alternate flows joining back + together — the N-way generalization of if/else's own JOIN-DROP + (branch_join_drops, reused verbatim per the brief's own + instruction: "reuse it, do not invent a second join"). `pick` + moves `b` in ARM0 (`case 1`, via a `take` call) and merely reads + it in ARM1 (`default`); after the merge `b` is Moved either way + (join takes Moved over Live), so ARM1 — the arm that *kept* it — + must get its own synthetic drop at its own end, or the value + leaks on that path; ARM0 must NOT get a second one (a double + free). Controller-verified end to end under `runtime/build/ + wovm_asan` (both call paths, task-3-report.md has the transcript); + this pins the table entry the ASan proof depends on. *) + let src = + "class Box {\n n: Int\n}\n\n\ + fn consume(take b: Box) -> Int {\n return b.n\n}\n\n\ + fn pick(k: Int, take b: Box) -> Int {\n\ + \ switch k {\n\ + \ case 1:\n\ + \ print_int(consume(b))\n\ + \ default:\n\ + \ print(\"kept\")\n\ + \ }\n\ + \ return 0\n\ + }\n" + in + let tables, coll = owner_str ~file:"switch-join.wo" src in + check_eq "switch join: reports nothing (a legal move on one arm only)" ~expected:0 + ~actual:(List.length (ownership_diags coll)) string_of_int; + let joins = drop_sites_of tables (function Owner.DBranchJoin _ -> true | _ -> false) in + single_site "switch join: exactly one JOIN-DROP" joins (fun d -> + check "switch join: on the arm that kept `b` (the `default` arm, ARM1)" + (d.Owner.dr_kind = Owner.DBranchJoin "ARM1"); + check "switch join: drops the value the other arm (ARM0) moved" (names_of d = [ "b" ])); + check "switch join: the moving arm (ARM0) gets no synthetic drop of its own" + (not + (List.exists + (fun (d : Owner.drop_site) -> d.Owner.dr_kind = Owner.DBranchJoin "ARM0") + tables.Owner.drops)) + +let () = + (* Arm-local drop: an owned value created inside one arm and never + moved dies at that arm's own scope end (DScope "ARM") — the + ordinary scope-drop machinery every block already gets via + analyze_block, reused verbatim ("each arm is its own drop scope", + the brief's own words). tests/corpus/run/lang-switch-arm-drop + proves this under ASan with a real leak-sized object; this pins + the table entry that fixture's own DROP instruction depends on. *) + let src = + "class Item {\n n: Int\n}\n\n\ + fn f(k: Int) -> Int {\n\ + \ switch k {\n\ + \ case 1:\n\ + \ let it = Item { n: 1 }\n\ + \ print_int(it.n)\n\ + \ default:\n\ + \ print(\"other\")\n\ + \ }\n\ + \ return 0\n\ + }\n" + in + let tables, coll = owner_str ~file:"switch-arm-scope.wo" src in + check_eq "switch arm scope: reports nothing" ~expected:0 + ~actual:(List.length (ownership_diags coll)) string_of_int; + let scopes = + drop_sites_of tables (function + | Owner.DScope l -> String.length l >= 3 && String.sub l 0 3 = "ARM" + | _ -> false) + in + single_site "switch arm scope: exactly one arm-local DScope drop" scopes (fun d -> + check "switch arm scope: on ARM0 (`case 1`)" (d.Owner.dr_kind = Owner.DScope "ARM0"); + check "switch arm scope: drops the arm-local `it`" (names_of d = [ "it" ])) + +let () = + (* Review fix (Critical 1), the two-file half: `default` is lowered + *last* regardless of source position (Ast.switch_lowering_order), + and owner.ml's `analyze_switch` must walk the identical order or + its "ARM" labels drift from emit.ml's own — this is exactly + the failure mode that would silently break DScope/JOIN-DROP + lookups without ever showing up as a wrong *count*. `default` is + written FIRST here, `case 1` SECOND; if the two files agreed on + source order (the bug) the JOIN-DROP would land on "ARM0" + (`default`, keeping `b`) — this asserts it lands on "ARM1" + instead, proving `default` was actually lowered (and labeled) + last, matching lang-switch-default-not-last's own runtime proof. *) + let src = + "class Box {\n n: Int\n}\n\n\ + fn consume(take b: Box) -> Int {\n return b.n\n}\n\n\ + fn pick(k: Int, take b: Box) -> Int {\n\ + \ switch k {\n\ + \ default:\n\ + \ print(\"kept\")\n\ + \ case 1:\n\ + \ print_int(consume(b))\n\ + \ }\n\ + \ return 0\n\ + }\n" + in + let tables, coll = owner_str ~file:"switch-reorder.wo" src in + check_eq "switch reorder: reports nothing (WO-W203 aside — this is typecheck-only)" + ~expected:0 ~actual:(List.length (ownership_diags coll)) string_of_int; + let joins = drop_sites_of tables (function Owner.DBranchJoin _ -> true | _ -> false) in + single_site "switch reorder: exactly one JOIN-DROP" joins (fun d -> + check + "switch reorder: on ARM1 (`default`, lowered last despite being written first)" + (d.Owner.dr_kind = Owner.DBranchJoin "ARM1"); + check "switch reorder: drops the value ARM0 (`case 1`) moved" (names_of d = [ "b" ])) + +let () = + (* Review fix (Critical 3): owner.ml's `expr_ty` used to return + `None` for a `Switch` — `analyze_let`'s own fallback for that is + `Scalar "Int"` (Copy), so an *unannotated* `let` binding a + class-yielding switch was silently never dropped (reviewer- + reproduced real leak; tests/corpus/run/lang-switch-class-arm-leak + has the ASan RED→GREEN transcript). This pins the table entry + that fixture's own DROP instruction depends on: `w` must be + classified Owned (a real DReturn drop naming it), not silently + absent the way a Copy-classified local would leave it. *) + let src = + "class Widget {\n a: Int\n}\n\n\ + fn f(k: Int) -> Int {\n\ + \ let w = switch k {\n\ + \ case 1: Widget { a: 1 }\n\ + \ default: Widget { a: 2 }\n\ + \ }\n\ + \ return w.a\n\ + }\n" + in + let tables, coll = owner_str ~file:"switch-let-class.wo" src in + check_eq "switch let-class: reports nothing" ~expected:0 + ~actual:(List.length (ownership_diags coll)) string_of_int; + let returns = drop_sites_of tables (fun k -> k = Owner.DReturn) in + check "switch let-class: `w` is dropped at the return (classified Owned, not silently Copy)" + (List.exists (fun d -> names_of d = [ "w" ]) returns) + let () = (* IMPORTANT: a `mut` argument means the callee may replace what the place holds. For a @gc place that invalidates rc elision — the elided @@ -1858,6 +2678,35 @@ let () = check "elision: the escaping acquire in `main` is still emitted (fixture is not vacuous)" (find_substring ~needle:"RC_INC" main_block <> None) +let () = + (* haxe-parity Task 3: the compare-and-jump chain lowers onto the + existing EQ/EQS/JZ/JMP opcodes — no new one, per the brief. An + `Int` subject compares via EQ, never EQS (that switch, over + `Text`, is tests/corpus/run/lang-switch-value's own second half — + both are proven end to end there; this pins the instruction + *shape* a --dump-bc reader would actually see, task-3-report.md's + own excerpt). *) + let src = + "fn classify(code: Int) -> Text {\n\ + \ let v = switch code {\n\ + \ case 200: \"a\"\n\ + \ default: \"b\"\n\ + \ }\n\ + \ return v\n\ + }\n\n\ + fn main() -> Int {\n return 0\n}\n" + in + let image, collector = emit_str ~file:"switch-bc.wo" src in + check_eq "switch bc: compiles clean" ~expected:0 + ~actual:(List.length (Diag.Collector.diagnostics collector)) string_of_int; + let block = method_block (Disasm.dump image) "classify" in + check "switch bc: an Int subject compares via EQ" (find_substring ~needle:"EQ " block <> None); + check "switch bc: never EQS for an Int subject" (find_substring ~needle:"EQS" block = None); + check "switch bc: at least one JZ (the case-value test)" + (find_substring ~needle:"JZ" block <> None); + check "switch bc: at least one JMP (the matched arm's own jump to the switch's exit)" + (find_substring ~needle:"JMP" block <> None) + let () = (* Residual guards: one coalesced pair per operand, and — the regression this pins — never on a register inside the call window. @@ -2002,7 +2851,8 @@ let () = (fun n (d : Owner.drop_site) -> match d.Owner.dr_kind with | Owner.DLiveMask -> n - | Owner.DScope _ | Owner.DReturn | Owner.DOverwrite | Owner.DBranchJoin _ -> + | Owner.DScope _ | Owner.DReturn | Owner.DOverwrite | Owner.DBranchJoin _ + | Owner.DBreak | Owner.DContinue -> n + List.length (List.filter @@ -2212,6 +3062,499 @@ let () = check "cli smoke: --emit without -o is a usage error (exit 2)" (exit_code = 2); check "cli smoke: usage goes to stderr" (stderr <> "") +(* ---- typedef records + enum payload variants (haxe-parity Task 4) ---- + + Direct assertions, no golden diffs (the same convention Tasks 2/3's + sections follow): parser shapes for the two new declarations, the + structural-equivalence contract at both levels it lives on (types.ml + unification and the emitted class table), the E203/E208/E201/E206 + diagnostic surface, the union field-kind rule (a bare union field is + a SCALAR slot — the int-as-pointer segfault family), the ownership + rows (a payload argument MOVES into the construction; a payload + binding is a borrow, never dropped), and the lowering shapes + (variant_tag for payload unions only, defaults filled for omitted + fields). The corpus fixtures (the lang-typedef-/lang-variant- + directories) pin the end-to-end round trips; these pin the internals + a round trip cannot state as a contract. *) + +let () = + (* parser: typedef record — comma and newline field forms, `?name` + desugars to Nullable, `type` legal as a field name, is_record set *) + let src = + "typedef R = { a: Int = 7, ?b: Text, type: Text }\n\ + typedef S = {\n n: Int\n ?m: ?Int\n}\n" + in + let prog, collector = parse_str ~file:"t4-record.wo" src in + check "t4 record: parses clean" (not (Diag.Collector.has_error collector)); + (match prog.Ast.decls with + | [ Ast.Class r; Ast.Class s ] -> + check "t4 record: is_record set, is_class clear" (r.Ast.is_record && not r.Ast.is_class); + check "t4 record: comma form keeps all three fields" + (List.map (fun (f : Ast.field) -> f.Ast.name) r.Ast.fields = [ "a"; "b"; "type" ]); + check "t4 record: `?b: Text` desugars to Nullable Text" + (match r.Ast.fields with + | [ _; b; _ ] -> b.Ast.ty = Ast.Nullable (Ast.Scalar "Text") + | _ -> false); + check "t4 record: `a` keeps its default" + (match r.Ast.fields with a :: _ -> a.Ast.default <> None | [] -> false); + check "t4 record: `?m: ?Int` does not double-wrap" + (match s.Ast.fields with + | [ _; m ] -> m.Ast.ty = Ast.Nullable (Ast.Scalar "Int") + | _ -> false); + check "t4 record: dump header says TYPEDEF" + (count_substring ~needle:"TYPEDEF R" (Dump.dump_ast prog) = 1) + | _ -> check "t4 record: two typedef declarations survive" false) + +let () = + (* parser: union declarations — bare, payload, and the struct form + `type Note { ... }` staying a struct (the `=` lookahead) *) + let src = + "type Status = Pending | Failed(reason: Text, code: Int)\n\ + type Note { n: Int }\n" + in + let prog, collector = parse_str ~file:"t4-union.wo" src in + check "t4 union: parses clean" (not (Diag.Collector.has_error collector)); + (match prog.Ast.decls with + | [ Ast.Union u; Ast.Class note ] -> + check "t4 union: two variants, payload fields in order" + (match u.Ast.variants with + | [ p; fl ] -> + p.Ast.v_name = "Pending" && p.Ast.v_fields = [] + && fl.Ast.v_name = "Failed" + && fl.Ast.v_fields = [ ("reason", Ast.Scalar "Text"); ("code", Ast.Scalar "Int") ] + | _ -> false); + check "t4 union: `type Note { ... }` is still the struct form" + ((not note.Ast.is_class) && not note.Ast.is_record); + check "t4 union: dump renders the variant line" + (count_substring ~needle:"UNION Status = Pending | Failed(reason: Text, code: Int)" + (Dump.dump_ast prog) + = 1) + | _ -> check "t4 union: union + struct decls survive" false) + +let () = + (* parser: one dotted segment in a type position (the sample's own + `?id: json.Value`) — one Scalar name, dot included *) + let src = "typedef Q = { ?id: json.Value }\n" in + let prog, collector = parse_str ~file:"t4-dotted.wo" src in + check "t4 dotted: parses clean" (not (Diag.Collector.has_error collector)); + (match prog.Ast.decls with + | [ Ast.Class q ] -> + check "t4 dotted: field type is Scalar \"json.Value\" under Nullable" + (match q.Ast.fields with + | [ f ] -> f.Ast.ty = Ast.Nullable (Ast.Scalar "json.Value") + | _ -> false) + | _ -> check "t4 dotted: typedef survives" false) + +(* the whole check-only pipeline (no emitter), returning every diagnostic *) +let t4_diags ~file src = + let collector = Diag.Collector.create () in + let toks = Lexer.tokenize collector ~file src in + let prog = Parser.parse collector ~file toks in + let _syms, () = Types.typecheck ~file prog collector in + Diag.Collector.diagnostics collector + +let t4_codes ~file src = List.map (fun (d : Diag.t) -> d.Diag.code) (t4_diags ~file src) + +let () = + (* WO-E206's new omittability rule: defaults and `?` fields fill in / + nil in; a plain field still fires *) + let base = "typedef R = { a: Int = 7, ?b: Text, c: Text }\n" in + check "t4 E206: omitting defaulted+optional fields is clean" + (t4_codes ~file:"t4-e206a.wo" (base ^ "fn main() { let r = R { c: \"x\" }\n print(r.c) }\n") + = []); + check "t4 E206: omitting a plain field still fires" + (t4_codes ~file:"t4-e206b.wo" (base ^ "fn main() { let r = R {}\n print(r.c) }\n") + = [ "WO-E206" ]) + +let () = + (* WO-E203, both sites: construction arity and pattern arity/shape *) + let u = "type Status = Pending | Failed(reason: Text)\n" in + check "t4 E203: construction with too many payload args" + (t4_codes ~file:"t4-e203a.wo" (u ^ "fn main() { let s = Failed(\"a\", \"b\") }\n") + = [ "WO-E203" ]); + check "t4 E203: construction with too few payload args" + (t4_codes ~file:"t4-e203b.wo" (u ^ "fn main() { let s = Failed() }\n") = [ "WO-E203" ]); + check "t4 E203: pattern binding the wrong number of fields" + (t4_codes ~file:"t4-e203c.wo" + (u + ^ "fn f(s: Status) -> Int { return switch s {\n\ + \ case Pending: 0;\n case Failed(a, b): 1;\n} }\nfn main() { }\n") + = [ "WO-E203" ]); + check "t4 E203: pattern arguments must be plain names" + (t4_codes ~file:"t4-e203d.wo" + (u + ^ "fn f(s: Status) -> Int { return switch s {\n\ + \ case Pending: 0;\n case Failed(\"x\"): 1;\n} }\nfn main() { }\n") + = [ "WO-E203" ]) + +let () = + (* WO-E208's union exhaustiveness rule + WO-E201 for a non-variant + pattern *) + let u = "type Kind = Lo | Mid | Hi\n" in + check "t4 E208: all variants covered needs no default" + (t4_codes ~file:"t4-e208a.wo" + (u + ^ "fn f(k: Kind) -> Int { return switch k {\n\ + \ case Lo: 1;\n case Mid: 2;\n case Hi: 3;\n} }\nfn main() { }\n") + = []); + (match + t4_diags ~file:"t4-e208b.wo" + (u ^ "fn f(k: Kind) -> Int { return switch k {\n case Lo: 1;\n} }\nfn main() { }\n") + with + | [ d ] -> + check "t4 E208: uncovered variants fire E208" (d.Diag.code = "WO-E208"); + check "t4 E208: the message names the missing variants, in order" + (count_substring ~needle:"does not cover: Mid, Hi" d.Diag.message = 1) + | ds -> + check_eq "t4 E208: exactly one diagnostic" ~expected:1 ~actual:(List.length ds) string_of_int); + check "t4 E208: a default covers the gap" + (t4_codes ~file:"t4-e208c.wo" + (u + ^ "fn f(k: Kind) -> Int { return switch k {\n\ + \ case Lo: 1;\n default: 0;\n} }\nfn main() { }\n") + = []); + check "t4 E201: a non-variant case name over a union subject" + (t4_codes ~file:"t4-e201a.wo" + (u + ^ "fn f(k: Kind) -> Int { return switch k {\n\ + \ case Lo: 1;\n case Wat: 2;\n default: 0;\n} }\nfn main() { }\n") + = [ "WO-E201" ]); + check "t4 E201: a literal case value over a union subject" + (t4_codes ~file:"t4-e201b.wo" + (u + ^ "fn f(k: Kind) -> Int { return switch k {\n\ + \ case 1: 1;\n default: 0;\n} }\nfn main() { }\n") + = [ "WO-E201" ]) + +let () = + (* structural equivalence, types.ml half: same-shape typedefs unify + across switch arms; different shapes still WO-E201 *) + let two_same = "typedef A = { n: Int }\ntypedef B = { n: Int }\n" in + let two_diff = "typedef A = { n: Int }\ntypedef B = { n: Text }\n" in + let body = + "fn f(c: Int) -> Int {\n\ + \ let v = switch c {\n\ + \ case 1: A { n: 1 };\n\ + \ default: B { n: 2 };\n\ + \ }\n\ + \ return 0\n\ + }\nfn main() { }\n" + in + let body_diff = + "fn f(c: Int) -> Int {\n\ + \ let v = switch c {\n\ + \ case 1: A { n: 1 };\n\ + \ default: B { n: \"x\" };\n\ + \ }\n\ + \ return 0\n\ + }\nfn main() { }\n" + in + check "t4 structural: same shape, arms unify with no E201" + (t4_codes ~file:"t4-str1.wo" (two_same ^ body) = []); + check "t4 structural: different shape still mismatches" + (t4_codes ~file:"t4-str2.wo" (two_diff ^ body_diff) = [ "WO-E201" ]) + +let () = + (* WO-E215 for duplicate unions and variant names *) + check "t4 E215: duplicate union name" + (t4_codes ~file:"t4-e215a.wo" "type K = A | B\ntype K = C | D\nfn main() { }\n" + = [ "WO-E215" ]); + check "t4 E215: variant name reused across unions" + (t4_codes ~file:"t4-e215b.wo" "type K = A | B\ntype L = B | C\nfn main() { }\n" + = [ "WO-E215" ]); + check "t4 E215: variant name reused inside one union" + (t4_codes ~file:"t4-e215c.wo" "type K = A | A\nfn main() { }\n" = [ "WO-E215" ]) + +let () = + (* the emitted class table: structural dedup (one entry for two + same-shape typedefs), per-variant entries for a payload union + (composite `Union.Variant` names), NO entries for a bare union, and + the union field-kind rule (SCALAR for bare — the stubbed-kind RED + was a real wo_drop_obj SEGV chasing tag 2 as a pointer; OWNED for + payload) *) + let src = + "typedef A = { n: Int, tag: Text }\n\ + typedef B = { n: Int, tag: Text }\n\ + type Kind = Lo | Mid | Hi\n\ + type Status = Pending | Failed(reason: Text)\n\ + typedef Holder = { k: Kind, st: ?Status }\n\ + fn main() -> Int {\n\ + \ let a = A { n: 1, tag: \"t\" }\n\ + \ let h = Holder { k: Lo, st: Pending }\n\ + \ print_int(a.n)\n\ + \ return 0\n\ + }\n" + in + let image, collector = emit_str ~file:"t4-table.wo" src in + check "t4 table: compiles clean" (not (Diag.Collector.has_error collector)); + let dump = Disasm.dump image in + check "t4 table: A and B share ONE class entry (structural dedup)" + (count_substring ~needle:"A flags" dump = 1 && count_substring ~needle:"B flags" dump = 0); + check "t4 table: payload union gets one entry per variant" + (count_substring ~needle:"Status.Pending flags" dump = 1 + && count_substring ~needle:"Status.Failed flags" dump = 1); + check "t4 table: Status.Failed's payload Text is a TEXT slot" + (count_substring ~needle:"Status.Failed flags=- fields=[TEXT]" dump = 1); + check "t4 table: bare union gets no class entries" + (count_substring ~needle:"Kind" dump + - count_substring ~needle:"Kind" (String.concat "" [ "" ]) + >= 0 + && count_substring ~needle:"Kind flags" dump = 0 + && count_substring ~needle:"Kind.Lo" dump = 0); + check "t4 table: a bare-union record field is a SCALAR slot, a payload one OWNED" + (count_substring ~needle:"Holder flags=- fields=[SCALAR, OWNED]" dump = 1) + +let () = + (* lowering shapes: variant_tag for a payload union's switch only; a + bare union switch is a plain EQ chain (no variant_tag, no NEW); + omitted defaults are filled (SETF count) *) + let src = + "type Status = Pending | Failed(reason: Text)\n\ + type Kind = Lo | Mid\n\ + fn f(s: Status) -> Int {\n\ + \ return switch s {\n\ + \ case Pending: 0;\n\ + \ case Failed(reason): 1;\n\ + \ }\n\ + }\n\ + fn g(k: Kind) -> Int {\n\ + \ return switch k {\n\ + \ case Lo: 0;\n\ + \ case Mid: 1;\n\ + \ }\n\ + }\n\ + fn main() { }\n" + in + let image, collector = emit_str ~file:"t4-lower.wo" src in + check "t4 lower: compiles clean" (not (Diag.Collector.has_error collector)); + let dump = Disasm.dump image in + check "t4 lower: exactly one variant_tag read (f's switch, not g's)" + (count_substring ~needle:"variant_tag" dump = 1); + let rec_default = + "typedef R = { a: Int = 7, b: Text = \"seven\", ?c: Text }\n\ + fn main() -> Int {\n\ + \ let r = R {}\n\ + \ print(r.b)\n\ + \ return 0\n\ + }\n" + in + let image2, collector2 = emit_str ~file:"t4-defaults.wo" rec_default in + check "t4 defaults: compiles clean" (not (Diag.Collector.has_error collector2)); + let dump2 = Disasm.dump image2 in + check "t4 defaults: two omitted defaults stored, the ?field left nil (2 SETFs)" + (count_substring ~needle:"SETF" dump2 = 2); + let bad_default = + "typedef R = { a: Int = 1 + 2 }\nfn main() { let r = R {}\n print_int(r.a) }\n" + in + let _, collector3 = emit_str ~file:"t4-baddefault.wo" bad_default in + check "t4 defaults: a non-literal default is WO-E403, never invented bytecode" + (List.exists + (fun (d : Diag.t) -> d.Diag.code = "WO-E403") + (Diag.Collector.diagnostics collector3)) + +let () = + (* ownership rows: a place-shaped payload argument MOVES into the + construction (the un-stubbed half of the double-free RED); a + payload binding is a borrow — never in any drop set *) + let src = + "class Box { n: Int }\n\ + type W = Just(b: Box)\n\ + fn main() -> Int {\n\ + \ let bx = Box { n: 1 }\n\ + \ let w = Just(bx)\n\ + \ switch w {\n\ + \ case Just(inner): print_int(inner.n);\n\ + \ }\n\ + \ return 0\n\ + }\n" + in + let tables, collector = owner_str ~file:"t4-owner.wo" src in + check "t4 owner: analyzes clean" (not (Diag.Collector.has_error collector)); + let dump = Dump.dump_owner tables in + check "t4 owner: `bx` moves into the payload field (CTOR row)" + (count_substring ~needle:"MOVE bx CTOR(b)" dump = 1); + check "t4 owner: `w` still drops before the frame leaves; moved-out `bx` does not" + (* main ends in `return 0`, so the drop set is the RETURN row (the + BODY scope-end is unreachable after a return and suppressed) *) + (count_substring ~needle:"RETURN [w]" dump = 1 + && count_substring ~needle:"[bx" dump = 0); + check "t4 owner: the binding `inner` is a borrow — in no drop set" + (count_substring ~needle:"[inner" dump = 0 && count_substring ~needle:", inner" dump = 0) + +(* ---- Task 4 fix round 1 (review: 2 Critical + 1 Major) --------------- + + Critical 1: a payload binding escaping its arm as the switch's value + is a MOVE OUT of the variant object — the escape arm nulls the + shell's field (its recursive drop plan already skips zero slots), the + derivers type the escaped value by the binding's declared field, and + the caller reaps owned variant temporaries passed by borrow. + Critical 2 / Major: three new WO-E201 sites (variant case over + `?Union`, cross-union `==`, variant case over a non-union subject). *) + +let () = + let u = "class P { a: Int }\ntype Ev = Tick | Boxed(p: P)\n" in + (* value position: the escape arm nulls the shell's field — one SETF + more than the identical switch in statement position, where the + discarded yield must leave the shell whole (want_value gate). *) + let value_pos = + u + ^ "fn main() -> Int {\n\ + \ let v = Boxed(P { a: 7 })\n\ + \ let out = switch v {\n\ + \ case Boxed(p): p;\n\ + \ case Tick: P { a: 0 };\n\ + \ }\n\ + \ print_int(out.a)\n\ + \ return 0\n\ + }\n" + in + let stmt_pos = + u + ^ "fn main() -> Int {\n\ + \ let v = Boxed(P { a: 7 })\n\ + \ switch v {\n\ + \ case Boxed(p): p;\n\ + \ case Tick: print(\"t\");\n\ + \ }\n\ + \ return 0\n\ + }\n" + in + let image, collector = emit_str ~file:"t4f-escape.wo" value_pos in + check "t4fix escape: binding-yield switch compiles clean (was `field access on Int`)" + (not (Diag.Collector.has_error collector)); + let dump = Disasm.dump image in + check_eq "t4fix escape: ctor(1) + payload store(1) + escape NULL(1) + arm ctor(1) = 4 SETFs" + ~expected:4 ~actual:(count_substring ~needle:"SETF" dump) string_of_int; + let image2, collector2 = emit_str ~file:"t4f-escape-stmt.wo" stmt_pos in + check "t4fix escape: statement position compiles clean" (not (Diag.Collector.has_error collector2)); + check_eq "t4fix escape: discarded yield does NOT null the shell (2 SETFs only)" + ~expected:2 ~actual:(count_substring ~needle:"SETF" (Disasm.dump image2)) string_of_int; + (* owner half of the drop plan: both the escaped payload's new owner + (`out`) and the shell (`v`) drop before the frame leaves — one drop + each, shell-only semantics coming from the nulled field, never from + a second table entry. *) + let tables, ocoll = owner_str ~file:"t4f-escape-owner.wo" value_pos in + check "t4fix escape: owner analyzes clean" (not (Diag.Collector.has_error ocoll)); + check "t4fix escape: RETURN drops [out, v] — payload owner AND shell, once each" + (count_substring ~needle:"RETURN [out, v]" (Dump.dump_owner tables) = 1) + +let () = + (* the caller reaps an owned variant temporary passed by borrow: the + reviewer's h5 shell leak (~30 B/iteration, arena-backed and + LSan-invisible — pinned here at the bytecode level instead). *) + let src = + "class P { a: Int }\n\ + type Ev = Tick | Boxed(p: P)\n\ + fn use_ev(e: Ev) -> Int { return 1 }\n\ + fn main() -> Int {\n\ + \ print_int(use_ev(Boxed(P { a: 1 })))\n\ + \ return 0\n\ + }\n" + in + let image, collector = emit_str ~file:"t4f-reap.wo" src in + check "t4fix reap: compiles clean" (not (Diag.Collector.has_error collector)); + check_eq "t4fix reap: exactly one DROP — the borrowed variant temp, after the call" + ~expected:1 ~actual:(count_substring ~needle:"DROP" (Disasm.dump image)) string_of_int + +let () = + (* WO-E201, three new sites *) + let st = "type St = Pending | Failed(m: Text)\ntypedef R = { ?st: St }\n" in + (match + t4_diags ~file:"t4f-optunion.wo" + (st + ^ "fn f(r: R) -> Text { return switch r.st {\n\ + \ case Pending: \"p\";\n default: \"n\";\n} }\nfn main() { }\n") + with + | [ d ] -> + check "t4fix ?union: variant case over `?Union` is WO-E201" (d.Diag.code = "WO-E201"); + check "t4fix ?union: the message points at nil handling first" + (count_substring ~needle:"may be nil" d.Diag.message = 1) + | ds -> + check_eq "t4fix ?union: exactly one diagnostic" ~expected:1 ~actual:(List.length ds) + string_of_int); + check "t4fix ?union: a default-only switch over `?Union` stays legal" + (t4_codes ~file:"t4f-optunion-ok.wo" + (st ^ "fn f(r: R) -> Text { return switch r.st {\n default: \"n\";\n} }\nfn main() { }\n") + = []); + let two = "type A = X | Yv\ntype B = P | Qv\n" in + check "t4fix cross-union ==: WO-E201" + (t4_codes ~file:"t4f-crosseq.wo" (two ^ "fn main() { if X == P { print(\"x\") } }\n") + = [ "WO-E201" ]); + check "t4fix cross-union ==: same union stays legal, and a local shadowing a variant is a local" + (t4_codes ~file:"t4f-crosseq-ok.wo" + (two ^ "fn main() { let X = 1\n if X == 1 { print(\"a\") }\n if P == Qv { print(\"b\") } }\n") + = []); + check "t4fix int-subject: a variant case over an Int subject is WO-E201" + (t4_codes ~file:"t4f-intsubj.wo" + ("type K = Lo | Mid | Hi\n" + ^ "fn f(n: Int) -> Int { return switch n {\n case Lo: 99;\n default: 0;\n} }\n\ + fn main() { }\n") + = [ "WO-E201" ]) + +(* ---- Task 4 fix round 2 (review: scalar move-out corruption + the + record/class sibling of the temp-argument leak) --------------------- *) + +let () = + (* NEW 1: escaping a SCALAR payload field is a COPY — no null. The + pointer-payload escape pins 4 SETFs above (one of them the null); + this scalar twin has exactly the payload store, nothing else. *) + let src = + "type Ev = Tick | Wrap(n: Int)\n\ + fn main() -> Int {\n\ + \ let v = Wrap(5)\n\ + \ let x = switch v {\n\ + \ case Tick: 0;\n\ + \ case Wrap(n): n;\n\ + \ }\n\ + \ print_int(x)\n\ + \ return 0\n\ + }\n" + in + let image, collector = emit_str ~file:"t4f2-scalar.wo" src in + check "t4fix2 scalar escape: compiles clean" (not (Diag.Collector.has_error collector)); + check_eq "t4fix2 scalar escape: payload store only — NO null SETF (subject stays intact)" + ~expected:1 ~actual:(count_substring ~needle:"SETF" (Disasm.dump image)) string_of_int + +let () = + (* NEW 2: the reap covers every owned heap temp by borrow — record + ctor, class-returning call — while `take` stays the callee's drop + (exactly one DROP total, in the callee; two would be the double + free) and a place is never reaped. *) + let rec_decl = "typedef P = { a: Int = 1 }\n" in + let borrow_ctor = + rec_decl ^ "fn peek(p: P) -> Int { return p.a }\nfn main() -> Int {\n print_int(peek(P {}))\n return 0\n}\n" + in + let borrow_call = + rec_decl + ^ "fn mk() -> P { return P {} }\nfn peek(p: P) -> Int { return p.a }\n\ + fn main() -> Int {\n print_int(peek(mk()))\n return 0\n}\n" + in + let take_ctor = + rec_decl + ^ "fn eat(take p: P) -> Int { return p.a }\nfn main() -> Int {\n print_int(eat(P {}))\n return 0\n}\n" + in + let place_borrow = + rec_decl + ^ "fn peek(p: P) -> Int { return p.a }\nfn main() -> Int {\n\ + \ let q = P {}\n print_int(peek(q))\n return 0\n}\n" + in + let drops label src expected = + let image, collector = emit_str ~file:(label ^ ".wo") src in + check (label ^ ": compiles clean") (not (Diag.Collector.has_error collector)); + check_eq (label ^ ": DROP count") ~expected + ~actual:(count_substring ~needle:"DROP" (Disasm.dump image)) string_of_int + in + (* one DROP each and each a DIFFERENT one: the caller's reap for the + two borrow shapes (mk returns its fresh value undropped, peek + borrows), the CALLEE's take-param drop for the take shape (a + second one there would be the double free), and the local's own + scope drop for the place shape (a reap on top would be too). *) + drops "t4fix2 reap record-ctor temp by borrow (caller reaps)" borrow_ctor 1; + drops "t4fix2 reap class-returning-call temp by borrow (caller reaps)" borrow_call 1; + drops "t4fix2 take temp: exactly ONE drop — the callee's, never a second (double free)" + take_ctor 1; + drops "t4fix2 place by borrow: the local's own scope drop only, never a reap" place_borrow 1 + (* ---- golden-directory walk ------------------------------------------ *) (* Each stage directory under golden/ names one `woc --dump-*` flag. diff --git a/docs/plan/compiler/nullable-types-implementation.md b/docs/plan/compiler/nullable-types-implementation.md index 99ca294..c82efd4 100644 --- a/docs/plan/compiler/nullable-types-implementation.md +++ b/docs/plan/compiler/nullable-types-implementation.md @@ -47,13 +47,64 @@ claiming ownership of that work. ## Dead-code register -Ten `WO-E2xx` codes are declared as named constants in `types.ml` with no -call site anywhere in the front end — `grep '~code:'` finds exactly five +**Update (haxe-parity Task 1, modules):** `WO-E210` below has since been +wired — the module concept it was blocked on now exists +(`compiler/src/types.ml`'s `check_modules`) — so it is no longer one of the +ten; it has moved up into `docs/plan/oop-vm/01-error-catalog.md`'s main +table. The table below is left as this doc's own historical record of the +state Task 6b found, not edited to match current reality (same convention +this doc already uses elsewhere for its "historical record" blocks). + +**Update (hotfix, 2026-08-11):** `WO-E209` below has also since been +wired — a real bug forced it: `print(7)` compiled clean and segfaulted +`wovm` (`print` wants a `Text`, a heap-string pointer; a bare `Int` is a +plain int64 register, which the VM's `str_check` dereferenced as a wild +pointer with no runtime tag to catch it first). It too is no longer one +of the ten; it has moved up into `docs/plan/oop-vm/01-error-catalog.md`'s +main table. The check (`compiler/src/types.ml`'s `check_builtin_call` and +`confident_typ`) covers exactly the arity-and-signature gap the row below +describes, but conservatively: an argument is only checked against a +builtin's expected type when it is *confidently* known — a literal, +`self`, a parameter's or class field's declared type, or a `let` whose +value traces back to one of those — never a guess, so an unresolved name +or an UNKNOWN-BUT-RESERVED stdlib call result stays unchecked rather than +risk a false positive. Same convention as the `WO-E210` note above: the +table below is left unedited. + +**Update (haxe-parity Task 2, 2026-08-11):** `WO-E201` below has also +since been wired — the row's own gap ("`Binary`/`Unary` in `types.ml` +don't check operand types at all") is exactly what stayed true for +every operator *except* the two Task 2 added: `and`/`or` are `Bool`-only +by the language's own design (no truthiness), and their operands *are* +now checked, via the same "confident-type, stay silent when underivable" +contract `WO-E209` uses. Every other `Binary`/`Unary` operator (the +arithmetic ladder, comparisons' own operand types) remains exactly as +unchecked as this row describes — this is a new, narrow call site, not +a general fix of the row's own gap. It too has moved up into +`docs/plan/oop-vm/01-error-catalog.md`'s main table. Same convention as +the notes above: the table below is left unedited. + +**Update (haxe-parity Task 3, 2026-08-12):** `WO-E208` below has also +since been wired — the row's own blocker ("no `switch` keyword exists +in `token.ml`/`lexer.ml`/`parser.ml` yet") is exactly what haxe-parity +Task 3 closed. The check (`compiler/src/types.ml`'s `typecheck_switch`) +is unconditional today, for every subject: no union type exists in +`typ` yet, so "exhaustiveness over a union, missing `default` only +when a variant is uncovered" — the row's own description — is not yet +a distinct code path, just the same E208 Task 4 will branch ahead of +(a `TUnion` arm, not a second check) once tagged unions land. `WO-E201` +picked up a second, unrelated call site in the same task: a `switch` +expression's arms disagree on their yielded type. Both have moved up +into `docs/plan/oop-vm/01-error-catalog.md`'s main table. Same +convention as the notes above: the table below is left unedited. + +Ten `WO-E2xx` codes were declared as named constants in `types.ml` with no +call site anywhere in the front end — `grep '~code:'` found exactly five sites (`WO-W201`, `WO-E202`, `WO-E206`, `WO-E207`, `WO-E225`); the other ten -declared constants are never referenced by a `Diag.error`/`Diag.warning` +declared constants were never referenced by a `Diag.error`/`Diag.warning` call. `docs/plan/oop-vm/01-error-catalog.md`'s "Reserved, not yet emitted" -section already lists all ten; this table adds *why* each is dead and who, -if anyone, is expected to wire it: +section listed all ten at the time; this table adds *why* each was dead and +who, if anyone, was expected to wire it: | Code | Meaning | Why it's dead | |------|---------|----------------| diff --git a/docs/plan/oop-vm/00-wob-format.md b/docs/plan/oop-vm/00-wob-format.md index 0dada6b..2914643 100644 --- a/docs/plan/oop-vm/00-wob-format.md +++ b/docs/plan/oop-vm/00-wob-format.md @@ -44,10 +44,74 @@ All integers little-endian; offsets are absolute file offsets. | 30 | DB_STUB | trap T_DB "engine not linked" (spec: SQL-layer statements in milestone 1) | | 31 | TRAP Bx | explicit trap with code Bx | -**Builtins:** now (ms), print (text), print_int, words (whitespace token count), multi_new/multi_push/multi_get/count/latest, map_new/map_set/map_get/map_has. +**Builtins:** now (ms), print (text), print_int, words (whitespace token count), multi_new/multi_push/multi_get/count/latest, map_new/map_set/map_get/map_has, int_to_text (haxe-parity Task 2), variant_tag (haxe-parity Task 4 — see "Enum payload variants" below). **Trap codes:** DIV0, BORROW, STACK, OOM, DB, BOUNDS, KEY, EXPLICIT. +## Enum payload variants (haxe-parity compiler Task 4) + +`.wob` v1 is unchanged — no new section, no new header field, no version +bump. A union with at least one payload variant (`type Status = Pending | +Failed(reason: Text)`) compiles to **one ordinary class-table entry per +variant**, named `"."` in the constant pool (source +identifiers can never contain a dot, so the composite name cannot collide +with a declared class — the same convention the method table already uses +for `"Class.method"`). A variant's payload fields are the entry's fields, +declaration order, ordinary kind bytes — so a variant object is dropped, +masked, and cycle-scanned exactly like any other instance, including +recursive payload frees, with zero collector changes. + +**The variant tag IS the class-table index**, carried by the object +header's existing `class_id` field — nothing new is stored and `NEW` +needs no change. The one VM addition is builtin **14 `variant_tag`**: +register A = the header `class_id` of the object in register B, so a +`switch` over a payload union reads the tag once and compares it against +`LOADK`-ed class-id constants — no per-arm allocation. It traps +`T_BOUNDS` on a null receiver or a native (`WO_CLS_*`) class id, the same +defense `ICALL` keeps; a non-pointer register stays the compiler's to +prevent (untyped registers, the residual-check doctrine). `variant_tag` +is compiler-internal: it is not a source-callable name and does not +appear in [`08-builtin-surface.md`](08-builtin-surface.md). + +An **all-bare union** (`type CronResult = Ok | ErrorFinal | Miss`) never +reaches this file's format at all: its values are plain integer ordinals +(0, 1, 2 … in declaration order) in `WO_K_SCALAR` positions, compared +with `EQ` — no class entries, no heap objects, no `variant_tag`. + +**Payload move-out** (Task 4 fix rounds 1–2): a `switch` arm that yields +its own payload binding as the switch's value (`case Boxed(b): b;`) MOVES +the payload out of the variant object — **pointer-kind fields only** +(OWNED/GCREF/TEXT/MULTI/MAP). The convention needs no format or collector +change: the compiler emits a `SETF` writing zero into the moved field +right after the value lands in its new owner's register, and the shell's +ordinary recursive drop plan — which already skips zero slots for every +kind (`runtime/src/gc.c wo_drop_kind`) — thereby frees the shell only. +Escaping a **SCALAR** field (Int/Bool/Timestamp/Id/`ref`, a bare-union +tag) is a plain COPY: no ownership moves and the field is left intact — +nulling it would corrupt the subject with a value indistinguishable from +a legitimate 0. A DISCARDED yield (statement-position switch) does not +null either: the shell keeps the payload and frees it as usual. +**Re-reading a moved-out payload is nil**: the field holds the zero word, +so a later `switch` over the same subject GETFs 0 into the binding and +any use of it traps `T_BOUNDS` ("null receiver") — memory-safe and +defined, the residual-check doctrine's direction; a later task may +promote this to a compile-time partial-move diagnostic (WO-E301 family). +One companion rule on the caller side: an **owned heap temporary** passed +as a borrow argument — a record/class constructor literal, a variant +construction, or an owned-returning call (`peek(Pay{})`, +`get(Boxed(Pay{}))`) — is copied to a stable register below the call +window and `DROP`ped by the caller once the call returns (`take` +arguments are the callee's to drop; places are their scope's; `@gc` and +`Text` temporaries are excluded — the rc system's and the Copy-aliasing +story's, respectively). Recursive drop is correct both ways, because a +payload the callee moved out left the field nulled. + +**Typedef records** (`typedef Name = { ... }`) are ordinary class-table +entries too, with one compiler-side convention the loader never sees: two +records with the same shape (same ordered fields, same types, same +defaults) share a single entry — structural aliasing decided entirely at +emit time. + ## Single-binary trailer (`woc build`, plan 3 Task 6) This section is **not part of the `.wob` format above** — `.wob` v1 is unchanged. diff --git a/docs/plan/oop-vm/01-error-catalog.md b/docs/plan/oop-vm/01-error-catalog.md index d9a623f..e0274fa 100644 --- a/docs/plan/oop-vm/01-error-catalog.md +++ b/docs/plan/oop-vm/01-error-catalog.md @@ -27,40 +27,68 @@ half of the story ("moved here" / "borrowed here" / etc.). | WO-E001 | an input byte the lexer doesn't recognize as the start of any token. Reported once per bad byte, which is then skipped — one bad byte never stops the whole file. | `unknown character '$'` | | WO-E002 | a string literal's backslash escape is the last byte of the file, with no character left to escape (a plain unterminated string with no dangling backslash is *not* an error — rt parity). | `unterminated string escape` | -## WO-E1xx — parsing (Tasks 4–5, `compiler/src/parser.ml`) +## WO-E1xx — parsing (Tasks 4–5, `compiler/src/parser.ml`; WO-E103 haxe-parity Task 2) | code | meaning | example message | | --- | --- | --- | | WO-E101 | generic syntax error: an unexpected token where the grammar expected something else, including running off the end of the file inside an unclosed block/type/interface body. Declaration-level recovery syncs to the next top-level keyword so one bad declaration yields one diagnostic, not a cascade. | `expected ')' or ',', got NEWLINE` | | WO-E102 | an invalid `@table(...)` configuration: `name` given twice, an `index` with no columns, or an argument key other than `name`/`index`. | `@table(name: ...) given twice` | +| WO-E103 | haxe-parity Task 2. `inline fn ...` — the haxe keyword verdict table's own reject half of the `inline` row (`const` values are the adopted half). The whole declaration is discarded by the usual top-level recovery, same as any other bad declaration. | `` `inline fn` is rejected — optimization is the compiler's job `` | -## WO-E2xx / WO-W2xx — types (Task 6, `compiler/src/types.ml`; WO-E214 Task 8, `compiler/bin/main.ml`; WO-E215 plan 3 Task 2, `compiler/src/types.ml`) +## WO-E2xx / WO-W2xx — types (Task 6, `compiler/src/types.ml`; WO-E214 Task 8, `compiler/bin/main.ml`; WO-E215 plan 3 Task 2, `compiler/src/types.ml`; WO-E210/E216–E218/W202 haxe-parity Task 1, `compiler/src/types.ml`; WO-E201 haxe-parity Task 2, `compiler/src/types.ml`; WO-E208 haxe-parity Task 3, `compiler/src/types.ml`; WO-E203 haxe-parity Task 4, `compiler/src/types.ml`) | code | meaning | example message | | --- | --- | --- | +| WO-E201 | haxe-parity Task 2. An `and`/`or` operand whose type is confidently known (the same narrow, "stay silent when underivable" deriver WO-E209 uses — `confident_typ`) and is not `Bool` — this language has no truthiness. Reserved since Task 6, its first real emission site. Haxe-parity Task 3 gave it two more sites: a `switch` expression's arms disagree on their yielded type (the switch's own type is fixed by the first arm — types.ml's "first wins" convention — every later arm is checked against it, via the regular `.typ` inference, not `confident_typ`; since haxe-parity Task 4 the comparison is *structural* — two typedef records with the same shape are the same type, `typ_equal`); and (review fix, Critical 2) a `case` value whose representation (`WO_K_TEXT` vs. `WO_K_SCALAR`) doesn't match the switch subject's — a real VM segfault if unchecked (a `Text` subject picks EQS, and EQS's `str_check` dereferences whatever sits in a mismatched `Int` case value's register), checked via `confident_typ`, silent when either side is unresolved. Haxe-parity Task 4 added the union-subject site: a `case` value over a confidently union-typed subject that does not name one of that union's variants (a misspelled variant, a variant of some other union, or a plain literal — union arms match variants, never values). Task 4's fix round 1 added three inverse/porosity sites, each a reviewer-reproduced silent-wrong-behavior hole: a variant-named `case` over a confidently **`?Union`** subject (it can never match — `switch` does not narrow `?T`; the message points at handling nil first, since forced handling is Task 6's), a variant-named `case` over a confidently **non-union** subject (`switch n { case Lo: }` over `n: Int` silently ordinal-matched), and a **cross-union `==`/`!=`** (`X == P` from two different bare unions was silently true whenever the ordinals matched; same-union comparison stays legal). Lexical scope wins at every one of these sites — a local sharing a variant's name is never misread as one. | `` `Wat` is not a variant of union `Kind` `` | +| WO-E203 | haxe-parity Task 4 (`typedef` records + enum payload variants). A payload variant's argument count doesn't match its declaration, at either of the two places payload fields are positional: a construction (`Failed("a", "b")` against `Failed(reason: Text)`) or a `switch` pattern (`case Failed(a, b):`). The pattern site also rejects a non-name argument (`case Failed("x"):` — payload fields are bound positionally, never matched by value) and a payload-binding pattern sharing its arm with other values (`case Failed(r), Pending:` — the binding would be meaningless on the other match). Reserved since plan 2 Task 6; these are its first real emission sites, scoped to variant payloads only — user `fn`/method call arity is still the emitter's WO-E403, unchanged (see "Reserved, not yet emitted" below for the history of that gap). | `` variant `Failed` of `Status` takes 1 payload argument(s), given 2 `` | | WO-W201 *(warning)* | a class has recursive/shared structure (a field, directly or through `ref`/`multi`/`map`/`?`, refers back to its own class) that the ownership pass cannot prove disjoint, has no `@table`, and has no `@unique` field — suggests `@gc`. | `Node has recursive/shared structure that borrow checker cannot prove. Consider adding @gc if this is an ephemeral in-memory cache. If this maps to a database table, keep owned (default).` | | WO-E202 | a `.field` access names a field that the base's class (a *declared* class — an unresolved/placeholder expression type never triggers this) doesn't have. | `unknown field \`price\` on \`Product\`` | -| WO-E206 | a constructor literal (`ClassName { ... }`) omits a field the class declares (no default). | `missing field \`sku\` in constructor of \`Product\`` | -| WO-E207 | a constructor literal names a class that isn't declared anywhere in the (possibly multi-file) program. | `unknown type \`Widget\` in constructor` | +| WO-E206 | a constructor literal (`ClassName { ... }`) omits a field the class declares that is neither defaulted nor nullable. Haxe-parity Task 4 narrowed it from "omits any field with no default was already the rule, but defaults were unenforceable" to the real omittability rule: a field with a declared default is filled by the emitter (`TailState {}` — the sample's defaults-fill-in pattern), and a `?`-typed field omitted is nil (the zero word `NEW` already leaves), for classes and typedef records alike. | `missing field \`sku\` in constructor of \`Product\`` | +| WO-E207 | a constructor literal names a class that isn't declared anywhere in the (possibly multi-file) program. `typedef` records (haxe-parity Task 4) are classes to this check — a record name resolves here like any declared class. | `unknown type \`Widget\` in constructor` | +| WO-E208 | haxe-parity Task 3 (`switch` as expression); the union exhaustiveness rule is haxe-parity Task 4's. Two subject regimes: (1) a **union-typed** subject (derived via `confident_typ`, the "stay silent when underivable" deriver — an underivable subject falls to regime 2) needs no `default` exactly when every variant is covered by some arm; a gap fires this code and names the missing variants, in declaration order. A `default` always satisfies it. (2) every **other** subject (scalars, Text, and anything underivable) keeps Task 3's unconditional rule: no `default` arm is always this error. A `?Union` subject is deliberately regime 2 until Task 6's forced-handling work legalizes narrowing it. | `` switch over `Kind` has no `default` arm and does not cover: Mid, Hi `` | +| WO-E209 | hotfix (2026-08-11, round 2). A builtin call (`print`, `print_int`, `words`, `now`, `push`, `get`, `count`, `latest`, `set`, `has`, `multi_new`, `map_new`) given the wrong number of arguments, or an argument whose type is confidently known and does not match the builtin's signature (source of truth: [`08-builtin-surface.md`](08-builtin-surface.md)). Motivated by a real segfault: `print(7)` compiled clean and crashed `wovm` — `print` wants a `Text` (a heap-string pointer), and the VM's `str_check` dereferences whatever register it is handed as a `wo_str*` with no runtime tag to check first, so a bare `Int` was a wild pointer read. `types.ml`'s own `confident_typ` (deliberately narrower than the typechecker's regular `.typ` inference — see its doc comment) derives an argument's type from a literal, `self`, a parameter's declared type, a class field's declared type, a `Ctor` naming a real declared class, a `let` whose value was itself confidently typed, or (round 2 — round 1 missed this, a real second segfault repro: `print(takesSecret(box))` where `takesSecret` is declared `-> Int`) a `Call` whose declared signature is known: a free fn (resolved own-module-first-then-used-modules, never the flat whole-program symbol merge — the same Critical-1 bug shape haxe-parity Task 1 already fixed for the emitter), a class method off a confidently-typed receiver, an interface method's signature, or another builtin's own confident return type (`words`/`count` → `Int`, `now` → `Timestamp`, `has` → `Bool`, …). `ReqInt` accepts any non-`Text` builtin scalar (`Int`/`Bool`/`Timestamp`/`Id` all share the identical `WO_K_SCALAR` runtime representation — found as a real false positive against `print_int(has(...))` once builtin return-chasing went live). Anything still not chased (an unresolved name, an `Index`/`Binary` result, a qualified free-fn call through a `use` alias, an UNKNOWN-BUT-RESERVED stdlib call) is left unchecked rather than guessed at — see "Remaining unchecked surface" below. A user-declared free `fn` of the same name always wins over the builtin table (08-builtin-surface.md's shadowing rule; also resolved module-aware, not via the flat merge), so a shadowed name is never checked here either. Arity mismatches are also still caught later, at emission (`WO-E403`, unchanged) — this is an earlier, additional gate over the same contract, not a replacement. | `` builtin `print` expects Text, got `Int` `` | +| WO-E210 | haxe-parity Task 1 (modules). A `Ctor`/bare-call name resolves — it's declared, somewhere — but not in this file's own module and not through any `use` edge either; the module it actually lives in is named as a hint. Reserved by Task 6's own brief, genuinely blocked until a module concept existed at all (see the nullable-types-implementation.md handoff) — this is its first real emission site. | `` `helper` is declared in module `shared/util`, which is not `use`d here `` | | WO-E214 | a class or interface name is declared more than once across the files a directory discovers (one program, multiple files — Task 8). Reported at the *later*-discovered declaration (sorted by path), with the first declaration as the related site; the merged symbol table keeps the first one, so this is what stops that silent keep from also hiding a real shape conflict. Driver-level, not `types.ml` — reuses the `types_prefix` range because it's a symbol-table concern, not a lexing/parsing/ownership one. | `class \`Dup\` already declared in \`a_first.wo\`` | -| WO-E215 | a class, interface, or free `fn` name is declared more than once in the *same file* (`collect_declarations`'s own `StringMap.add` silently dropped the earlier one — Task 1 review, found while building the plan-3 emitter, fixed in Task 2). Reported at the later declaration, with the first as the related site — the same shape as WO-E214, one file instead of two; the symbol table keeps the first declaration. Class/interface names and free-fn names are separate namespaces, so a class and a fn sharing a name never collide here. | `class \`Dup\` already declared` | -| WO-E225 | a field's declared type name isn't a builtin scalar, a declared class, or a declared interface. Checked once per field declaration, at the field's own position. | `unknown type \`Wdiget\`` | +| WO-E215 | a class, interface, free `fn`, or (haxe-parity Task 4) union name is declared more than once in the *same file* (`collect_declarations`'s own `StringMap.add` silently dropped the earlier one — Task 1 review, found while building the plan-3 emitter, fixed in Task 2). Task 4 also fires it for a *variant* name reused within a file's unions (inside one union or across two — variants share one flat value namespace, so a bare `Ok` reference could not otherwise pick a tag), reported at the reusing variant with the owning union as the related site. Reported at the later declaration, with the first as the related site — the same shape as WO-E214, one file instead of two; the symbol table keeps the first declaration. Class/interface names and free-fn names are separate namespaces, so a class and a fn sharing a name never collide here. | `class \`Dup\` already declared` | +| WO-E216 | haxe-parity Task 1 (modules). A `use ` names something that is neither one of the six reserved stdlib namespaces (`fs`, `proc`, `net`, `time`, `json`, `env`) nor a directory this program actually discovers. | `` unknown module `nosuchmodule` — not a discovered project module and not a reserved stdlib namespace `` | +| WO-E217 | haxe-parity Task 1 (modules). A qualified reference (`alias.name(...)`) names a real declaration in a real, `use`d module, but that declaration has no `pub` marker — private to its own module. | `` `hidden` is not `pub` in module `secret` `` | +| WO-E218 | haxe-parity Task 1 (modules). A bare (unqualified) name resolves as `pub` in *more than one* used module — "collisions diagnose rather than shadow silently" (the plan's own words): resolution never silently picks a winner among used modules, it fails loudly and names every alias that matched. | `` `thing` is ambiguous — exported `pub` by more than one used module (a, b) `` | +| WO-E225 | a field's declared type name isn't a builtin scalar, a declared class (typedef records included), a declared interface, or (haxe-parity Task 4) a declared union. Also checked, same shape, on a payload variant's field types. A dotted name whose head is a reserved stdlib namespace (`json.Value`) is accepted as UNKNOWN-BUT-RESERVED — the same plan-9 convention `fs.stat(...)` calls get; any other dotted name is as unknown as a misspelling. Checked once per field declaration, at the field's own position. | `unknown type \`Wdiget\`` | +| WO-W202 *(warning)* | haxe-parity Task 1 (modules). A file's own `use` clause is never actually referenced — neither a bare name resolving through it nor a qualified `alias.name(...)` call — anywhere in that file's surviving parse tree. | `` unused `use fs` `` | +| WO-W203 *(warning)* | haxe-parity Task 3 review fix (Critical 1). A `switch`'s `default` arm is not textually last — no longer a silent dead-code trap (`default` is lowered last regardless of source position, `Ast.switch_lowering_order`), but still surprising source; fired once per switch, at `default`'s own position. | `` `default` is not the last arm -- a `case` written after it still matches (this compiler evaluates `default` last regardless of source position), which reads as dead code `` | ### Reserved, not yet emitted -`type_mismatch_code` (WO-E201), `bad_arity_code` (WO-E203), -`unknown_fn_code` (WO-E204), `non_exhaustive_switch_code` (WO-E208), -`invalid_builtin_code` (WO-E209), `module_not_imported_code` (WO-E210), +`unknown_fn_code` (WO-E204), `nullable_used_without_check_code` (WO-E211), `nullable_assign_mismatch_code` (WO-E212), and `missing_nil_check_code` (WO-E213) are declared in `types.ml` -— the range is reserved — but as of Task 7 nothing in the front end ever +— the range is reserved — but as of this task nothing in the front end ever raises them; there is no call site and therefore no real example message to catalog. They read like placeholders for checks Task 6's own plan brief named (type mismatch, bad arity, unsatisfied interface, …) -that the shipped typechecker doesn't yet implement. Listed here so a -conformance fixture (plan 3) or a future reader doesn't assume one of -these codes is reachable today; move a code up into the table above in -the same commit that wires its first real emission site. +that the shipped typechecker doesn't yet implement. `module_not_imported_code` +(WO-E210) — the one member of this list Task 6's brief named that a *later* +task, not a gap in Task 6's own shipped work, was blocking — has moved up +into the table above: haxe-parity Task 1 gave it its first real emission +site. `invalid_builtin_code` (WO-E209) has also since moved up into the +table above — a 2026-08-11 hotfix wired it (a real `print(7)` segfault +forced the issue; see its row above) — and `type_mismatch_code` (WO-E201) +has too: haxe-parity Task 2 wired it for `and`/`or`'s non-`Bool`-operand +check (see its row above). `non_exhaustive_switch_code` (WO-E208) has also +moved up: haxe-parity Task 3 (`switch` as expression) wired it — the exact +"genuinely blocked: no `switch` keyword exists yet" gap the nullable-types +dead-code register named is closed (see its row above). `bad_arity_code` +(WO-E203) has now moved up too: haxe-parity Task 4 wired it for variant +payload arity (construction and pattern sites — see its row above). That +wiring is deliberately narrower than the code's own name promises: a +user-declared `fn`/method call's arity is still ungated here and caught +only at emission (WO-E403), the same pre-existing gap the WO-E209 hotfix +note already disclosed for builtins. Four of the original ten remain dead +(WO-E204, WO-E211, WO-E212, WO-E213 — the last three are Task 6's own +forced-handling work). Listed here so a conformance fixture (plan 3) or a +future reader doesn't assume one of the remaining codes is reachable +today; move a code up into the table above in the same commit that wires +its first real emission site. ### Reachable but unenforced @@ -125,9 +153,10 @@ written when any of these fire (`woc --emit` writes nothing on exit 1). | --- | --- | --- | | WO-E401 | the method needs more than 64 registers — the VM's register window (`runtime/src/wob.h` `WO_MAX_REGS`, enforced by the loader). Reported once per method, at the method's own position. | `` `wide` needs more than 64 registers — the VM's register window is 64 slots; split the method or reduce the number of live locals `` | | WO-E402 | a value that does not fit an instruction field: a constant/class/method/interface-slot index above 65535 (`LOADK`/`NEW`/`CALL`/`ICALL` carry a 16-bit operand), a field index above 255 (`GETF`/`SETF` carry a byte), or a jump farther than the signed 16-bit displacement. | `field index 300 exceeds the 8-bit GETF/SETF field` | -| WO-E403 | a construct the v1 instruction set cannot express, or a call the emitter cannot lower correctly. The full source-surface contract is [`08-builtin-surface.md`](08-builtin-surface.md); the cases raised here are: an unresolved name; a call to something that is neither a declared `fn` nor a builtin; a wrong argument count (nothing upstream checks arity — WO-E203 is declared and never raised — and a mismatched call reserves a window the callee does not read, which the loader rejects); a field/method on a type that is not a declared class; `multi_new()`/`map_new()` with no destination of declared type (the element kinds are the container's runtime drop plan and cannot be guessed); an element write into a `multi` (v1 has `multi_push`/`multi_get`, no element store); a `for` over a `map` (v1 exposes no key enumeration). Several of these are cases the typechecker's placeholder types let through — the emitter is the first stage that must be exact. | `` `for` can only iterate a `multi` — the v1 builtins expose no key enumeration for a `map` `` | +| WO-E403 | a construct the v1 instruction set cannot express, or a call the emitter cannot lower correctly. The full source-surface contract is [`08-builtin-surface.md`](08-builtin-surface.md); the cases raised here are: an unresolved name; a call to something that is neither a declared `fn` nor a builtin; a wrong argument count (nothing upstream checks arity — WO-E203 is declared and never raised — and a mismatched call reserves a window the callee does not read, which the loader rejects); a field/method on a type that is not a declared class; `multi_new()`/`map_new()` with no destination of declared type (the element kinds are the container's runtime drop plan and cannot be guessed); an element write into a `multi` (v1 has `multi_push`/`multi_get`, no element store); a `for` over a `map` (v1 exposes no key enumeration); (haxe-parity Task 2) `break`/`continue` with no enclosing loop — nothing upstream tracks loop nesting to reject it earlier; (haxe-parity Task 2) a `"${expr}"` interpolant whose type is neither `Text` nor `Int`, or is unresolvable; (haxe-parity Task 4) a field default the emitter cannot lower when a constructor literal omits that field — defaults are opaque token spans by design (ast.ml), and the lowerable set is exactly the sample's own shapes: Int (optionally negated), Text, and Bool literals, `now()`, and `[]` (an empty container, kinds from the field's declared type). Several of these are cases the typechecker's placeholder types let through — the emitter is the first stage that must be exact. | `` `for` can only iterate a `multi` — the v1 builtins expose no key enumeration for a `map` `` | | WO-E404 | an ownership-table entry the emitter could not honor: a residual borrow site whose operand has no register at the guarded region, a residual region no lowering wrapped at all (checked at the end of every compilation unit — owner.ml anchors regions on several different node kinds, and one nobody consumed would ship the aliasing check silently disabled), or a drop/rc site naming a local that has no register. Emitting such a region unguarded would drop the single enforcement a residual site exists for, so it fails instead. | `` residual borrow site in `shuffle` names an operand with no live register — the runtime guard cannot be placed `` | | WO-E405 | the program entry (the zero-arg free fn `main`, selected by name) declares a return type other than `Int`. The systems-track spec (`docs/superpowers/specs/2026-08-01-systems-track-design.md:70`) makes the entry's return value the process exit code, so any other declared return type was never legal — this is the check that finally says so. `main` with no return annotation at all is unaffected (nothing declared to contradict `Int`); every other milestone-1 fixture uses that form. Reported once, at `main`'s own position. | `` entry `main` declares return type `Node` — the entry's return value is the process exit code, so it must return `Int` `` | +| WO-E406 | haxe-parity Task 1 (modules). A call through a reserved stdlib alias (`use fs`/`proc`/`net`/`time`/`json`/`env`) survived typechecking — `types.ml` accepts it as UNKNOWN-BUT-RESERVED, since the six namespaces' members arrive in plan 9 — and reached emission. There is nothing to lower it to yet; an unused `use fs` never reaches this code at all, only a call that actually goes through it. | `` stdlib module `fs` is not linked in this milestone (called as `fs.stat`) `` | ## Completeness method diff --git a/docs/plan/oop-vm/02-corpus.md b/docs/plan/oop-vm/02-corpus.md index f025319..cf1212b 100644 --- a/docs/plan/oop-vm/02-corpus.md +++ b/docs/plan/oop-vm/02-corpus.md @@ -38,6 +38,35 @@ placed directly inside a kind directory (not in its own subdirectory) is never picked up — no error, no run, it just silently does not exist as a fixture. If a fixture stops appearing in the tally, check that first. +**`run/` and `compile-fail/` compile the fixture's own *directory*, not +just `fixture.wo`** (haxe-parity Task 1, modules) — `woc --emit + -o .wob`, letting `woc`'s own multi-file discovery +find every `.wo` file under it. For a fixture with no other `.wo` file +beside `fixture.wo` (every fixture that predates modules, and the large +majority since) this is behavior-identical to compiling `fixture.wo` +alone. What it's *for*: a module fixture puts its extra module(s) in a +**subdirectory** (`greet/greet.wo`, `secret/secret.wo`, `a/a.wo`, ...) — +each subdirectory is its own module (a `.wo` file's module is its +directory), so this is how a `run`/`compile-fail` fixture exercises a +real `use` across module boundaries at all. + +**Guarded, not open season**: exactly one top-level `.wo` file +(`fixture.wo` itself) is required directly inside the fixture's own +directory — `scripts/oop-e2e.sh`'s `assert_one_top_level_wo` counts +`/*.wo` (never recursing into subdirectories) and fails the +fixture by name, before compiling anything, if that count isn't exactly +1. Without this, a second `.wo` file dropped loose beside `fixture.wo` +(not a module fixture's intentional subdirectory — a mistake, or worse) +silently joins the compile as a second file in the *same* module (Task +8's own discovery contract: every same-directory file is unconditionally +visible to every other) — confirmed exploitable: an alphabetically- +earlier stray `fn main` hijacks the fixture's own entry point with zero +diagnostics, since free fns are excluded from the cross-file collision +check (`01-error-catalog.md`'s WO-E214 row is classes/interfaces only). +A subdirectory full of `.wo` files is unaffected by this guard — that's +a different module by construction, exactly the shape a module fixture +is supposed to have. + ## `run/` — compiles, runs, exact stdout **Files:** `fixture.wo`, `fixture.out`. diff --git a/docs/plan/oop-vm/08-builtin-surface.md b/docs/plan/oop-vm/08-builtin-surface.md index e7de7dc..88f5e7d 100644 --- a/docs/plan/oop-vm/08-builtin-surface.md +++ b/docs/plan/oop-vm/08-builtin-surface.md @@ -29,6 +29,7 @@ maps to one `BUILTIN` id of the format doc. | `get(c, k)` | `multi_get` / `map_get` | 2 | element by index, or value by key (a missing key traps `KEY`) | | `set(m, k, v)` | `map_set` | 3 | insert or replace in a `map` | | `has(m, k)` | `map_has` | 2 | `1`/`0` | +| `int_to_text(n)` | `int_to_text` | 1 | decimal rendering of an `Int`, as a fresh owned `Text` — haxe-parity Task 2's one fenced VM addition, the type-directed half of string interpolation (below); also directly callable | `get`, `set`, `push`, `count` and `has` resolve on the container they are given, so one source name covers the `multi` and `map` ids the runtime @@ -96,6 +97,43 @@ type, which is also a typed destination. - `self` occupies the callee's `r0`, so a method's argument count is `1 + parameters`. +## Modules (haxe-parity Task 1) + +A `.wo` file's **module is its directory** — no manifest, no declared +module name. Every file sharing a directory sees every other same- +directory file's declarations unconditionally (Task 8's existing +multi-file discovery, unchanged); a name declared in a *different* +directory needs `use` to become visible at all, and even then only if +it is marked `pub`. + +- **`pub`** on a top-level `class`/`type`/`interface`/`fn` exports it + outside its own module. Default is private-to-module — visible to + every file in the same directory, invisible to every other module + regardless of `use` (`WO-E217` if referenced anyway). `pub` on a + class/interface method, or the `pub(read)` field-accessor marker + (Haxe's `(default, null)`), is a different, later feature — not this + one. +- **`use fs`** (a bare, single-segment name) is a **reserved stdlib + namespace**: exactly `fs`, `proc`, `net`, `time`, `json`, `env`, no + others, and always stdlib even if a same-named project directory + exists. A call through one (`fs.stat(...)`) typechecks as + UNKNOWN-BUT-RESERVED — no E207/E225/arity check, since the six + namespaces' members arrive in plan 9 — and is `WO-E406` only if such + a call survives all the way to emission; an unused `use fs` compiles + clean (modulo `WO-W202`, below). +- **`use shared/util`** (slash-separated segments) is **project- + relative**: it must name a directory this program's own discovery + actually finds, or `WO-E216`. The alias a call site uses is always + the path's *last* segment (`util.fn(...)`, not `shared.fn(...)`). +- **Resolution order** for a bare (unqualified) name: this file's own + module, unconditionally; then every `use`d module's `pub` surface. If + more than one used module exports the same `pub` name, that is + `WO-E218` — collisions diagnose rather than silently pick a winner. + A qualified reference (`alias.name(...)`) skips straight to its + named module; `WO-E217` if `name` exists there but isn't `pub`. +- A `use` clause never referenced (bare or qualified) anywhere in its + own file is `WO-W202` — a warning, so it does not fail the build. + ## Program entry The entry point is the **zero-argument free `fn main`**. A `main` that @@ -113,6 +151,8 @@ Lowered by the emitter, not added to the format: | `a > b`, `a >= b` | `LT` / `LE` with the operands swapped | | `a == b` on `Text` | `EQS` (content equality); `EQ` otherwise | | `a .. b` | `CONCAT` — `+` is arithmetic only, never string addition | +| `a and b` | evaluate `a`; `JZ` past evaluating `b` (result stays `a`'s value); else evaluate `b` into the same register (haxe-parity Task 2) | +| `a or b` | evaluate `a`; `JZ` + `JMP` past evaluating `b` when `a` is already true; else evaluate `b` (haxe-parity Task 2) | ## Not lowerable in milestone 1 @@ -125,6 +165,50 @@ Each is `WO-E403` at the offending site, never invented bytecode: - a field or method on a type that is not a declared class — including a class named only inside `multi T` / `ref T`, which `types.ml`'s unknown-type check (`WO-E225`) does not look inside. +- `break`/`continue` outside any loop (haxe-parity Task 2) — nothing + upstream tracks loop nesting to reject it earlier, so the emitter's + own "no legal jump target" gate is the only one. +- interpolating (`"${expr}"`) a value that is neither `Text` nor `Int` + (haxe-parity Task 2) — the brief's own scope; a class, `multi`, `map`, + or other scalar has no defined textification here. + +## Small control surface (haxe-parity Task 2) + +`break`/`continue`/`do...while`, `const`, `and`/`or`, and string +interpolation — the haxe keyword verdict table's low-risk batch, added +2026-08-11. + +- **`break`/`continue`** reuse the owner pass's own `return`-drop + machinery, bounded to the nearest enclosing loop instead of the whole + function: an owned value still alive in the loop body is dropped at + the `break`/`continue` site itself, not left to leak (proven under + ASan, `tests/corpus/run/lang-break-owned-drop/`). `continue`'s actual + jump target depends on loop shape — `while`'s own condition check, + `for`'s increment step, or `do...while`'s condition check — but the + drop-set computation is identical either way. +- **`do { body } while cond`** — the body always runs at least once; + lowered onto the same `JZ`/`JMP` pair `while`/`for` already use, just + reordered. +- **`const NAME = `** (top-level, or bare — no `static` — + class-level) is resolved entirely by `parser.ml`, before typecheck + ever runs: every unshadowed reference is replaced by the literal it + names, so nothing downstream (types/owner/emit) has any const-specific + code at all. A local/parameter/`self` of the same name always shadows + it. `static const` is Task 7's own syntax (`static`), not recognized + here. +- **`and`/`or`** are real keywords (never `&&`/`||`), one precedence + level below comparison (`or` loosest, then `and`, then comparison — + so `a == 1 and b == 2` needs no parens). `Bool`-typed operands only, + no truthiness: a confidently-non-`Bool` operand is `WO-E201`. Short- + circuit, lowered to compare-and-jump above — no new opcode. +- **String interpolation** (`"${expr}"`) desugars at parse time to a + `..` (`Concat`) chain of text segments and embedded expressions; each + embedded expression's *textification* is decided at emit time, once + its type is known: `Text` passes through untouched, `Int` is wrapped + in `int_to_text` (above), anything else is `WO-E403` (see "Not + lowerable in milestone 1"). `\$` is a literal `$` (so `\${x}` stays + literal, never interpolates); a lone `$` not followed by `{` is also + literal, unconditionally. ## `?T` diff --git a/runtime/src/builtin.c b/runtime/src/builtin.c index e5c909a..06a4cff 100644 --- a/runtime/src/builtin.c +++ b/runtime/src/builtin.c @@ -150,6 +150,34 @@ int wo_builtin(wo_vm *vm, uint64_t *R, uint32_t ins, const char **msg) { R[A] = wo_map_has(m, R[B + 1]) ? 1 : 0; return 0; } + case WO_B_INT_TO_TEXT: { /* haxe-parity compiler Task 2: string interpolation */ + char buf[32]; + int len = snprintf(buf, sizeof buf, "%lld", (long long)(int64_t)R[B]); + wo_str *s = wo_str_new(rt, buf, (uint32_t)len); + if (!s) { + *msg = "out of memory"; + return WO_T_OOM; + } + R[A] = (uint64_t)(uintptr_t)s; + return 0; + } + case WO_B_VARIANT_TAG: { /* haxe-parity compiler Task 4: enum payload variants */ + /* the tag IS the header's class_id (wob.h's convention). Null and + * native-class receivers trap BOUNDS — same defense ICALL keeps; + * a non-pointer register is the compiler's to prevent (untyped + * registers, the residual-check doctrine). */ + if (!R[B]) { + *msg = "null receiver"; + return WO_T_BOUNDS; + } + wo_hdr *o = (wo_hdr *)(uintptr_t)R[B]; + if (o->class_id >= vm->mod->class_cnt) { + *msg = "variant tag of a native value"; + return WO_T_BOUNDS; + } + R[A] = o->class_id; + return 0; + } default: /* unreachable: loader validated the id */ *msg = "unknown builtin"; return WO_T_EXPLICIT; diff --git a/runtime/src/loader.c b/runtime/src/loader.c index 70dc19b..2559ab0 100644 --- a/runtime/src/loader.c +++ b/runtime/src/loader.c @@ -40,7 +40,8 @@ static const uint8_t b_arity[WO_B_MAX + 1] = { [WO_B_WORDS] = 1, [WO_B_MULTI_NEW] = 0, [WO_B_MULTI_PUSH] = 2, [WO_B_MULTI_GET] = 2, [WO_B_COUNT] = 1, [WO_B_LATEST] = 1, [WO_B_MAP_NEW] = 0, [WO_B_MAP_SET] = 3, [WO_B_MAP_GET] = 2, - [WO_B_MAP_HAS] = 2, + [WO_B_MAP_HAS] = 2, [WO_B_INT_TO_TEXT] = 1, + [WO_B_VARIANT_TAG] = 1, }; static int vtab_cmp(const void *a, const void *b) { diff --git a/runtime/src/wob.h b/runtime/src/wob.h index c629884..d99c918 100644 --- a/runtime/src/wob.h +++ b/runtime/src/wob.h @@ -138,8 +138,22 @@ enum { WO_B_MAP_SET = 10, WO_B_MAP_GET = 11, /* missing key traps WO_T_KEY */ WO_B_MAP_HAS = 12, + /* haxe-parity compiler Task 2: string interpolation's Int -> Text + * conversion (`"${count} lines"`). (i64) -> a fresh owned Text of + * its decimal rendering. */ + WO_B_INT_TO_TEXT = 13, + /* haxe-parity compiler Task 4: enum payload variants. A payload + * union's variants are compiler-generated class-table entries; the + * variant TAG is the object header's existing class_id (no new + * header field, no new flag — docs/plan/oop-vm/00-wob-format.md, + * "enum payload variants"). (variant object) -> i64 tag: reads + * r[B]'s header class_id into r[A] so a switch over a payload + * union compares tags without a per-arm allocation. Traps + * WO_T_BOUNDS on a null receiver or a native class id — the same + * defense ICALL keeps for a miscompiled receiver. */ + WO_B_VARIANT_TAG = 14, }; -#define WO_B_MAX 12u +#define WO_B_MAX 14u /* ---- instruction encode/decode: op:8 A:8 then B:8 C:8 or Bx:16 ---- */ static inline uint32_t wo_ins_abc(uint8_t op, uint8_t a, uint8_t b, uint8_t c) { diff --git a/scripts/oop-e2e.sh b/scripts/oop-e2e.sh index 8813270..940f5f0 100755 --- a/scripts/oop-e2e.sh +++ b/scripts/oop-e2e.sh @@ -81,17 +81,51 @@ extract_error_codes() { grep -oE 'error (WO-E[0-9]+):' "$1" | sed -E 's/error (WO-E[0-9]+):/\1/' } +# haxe-parity Task 1 review, IMPORTANT 3: compiling the fixture's own +# directory (not just fixture.wo) means woc's own multi-file discovery +# picks up *any* .wo file dropped there, not only fixture.wo -- a stray +# second .wo directly beside fixture.wo silently joins the compile as a +# second file in the SAME module (Task 8's own discovery contract: every +# file sharing a directory is unconditionally visible to every other), +# and its own free fns/classes are exactly as reachable as fixture.wo's +# own. Confirmed exploitable: an alphabetically-earlier stray `fn main` +# hijacks the fixture's entry point with zero diagnostics (free fns are +# excluded from the cross-file collision check, docs/plan/oop-vm/ +# 01-error-catalog.md's WO-E214 row). A *subdirectory* full of .wo files +# is a different module on purpose -- that's the whole point of a +# module fixture (greet/, secret/, a/, b/, ...) -- so this only counts +# files directly inside $1, never recursing into subdirectories. +assert_one_top_level_wo() { + local dir="$1" name="$2" + local top_level=("$dir"/*.wo) + if [[ ${#top_level[@]} -ne 1 ]]; then + bad "$name" "expected exactly one top-level .wo file in $dir, found ${#top_level[@]} -- module fixtures belong in a subdirectory, not loose beside fixture.wo" + return 1 + fi + return 0 +} + run_fixture() { local dir="$1" name="run/$(basename "$1")" local prefix wob out err rc if [[ ! -f "$dir/fixture.wo" ]]; then bad "$name" "missing fixture.wo"; return; fi if [[ ! -f "$dir/fixture.out" ]]; then bad "$name" "missing fixture.out"; return; fi + assert_one_top_level_wo "$dir" "$name" || return prefix="$(tmp_prefix "$name")" wob="$prefix.wob" out="$prefix.out" err="$prefix.err" - timeout "$TIMEOUT" "$WOC" --emit "$dir/fixture.wo" -o "$wob" >/dev/null 2>"$err" + # Compile the fixture's own directory, not just fixture.wo directly: + # for a fixture with no other .wo file beside fixture.wo (every + # pre-haxe-parity fixture), woc's directory discovery finds exactly + # that one file, so this is behavior-identical to compiling + # "$dir/fixture.wo" on its own. It's what lets a fixture exercise a + # real cross-module `use` (haxe-parity Task 1) by adding a nested + # module directory (e.g. `greet/greet.wo`) beside fixture.wo — woc's + # own multi-file discovery (Task 8) then compiles both as one + # program, exactly like a real project layout would. + timeout "$TIMEOUT" "$WOC" --emit "$dir" -o "$wob" >/dev/null 2>"$err" rc=$? if [[ $rc -eq 124 ]]; then bad "$name" "woc timed out after ${TIMEOUT}s" @@ -211,6 +245,7 @@ compile_fail_fixture() { if [[ ! -f "$dir/fixture.wo" ]]; then bad "$name" "missing fixture.wo"; return; fi if [[ ! -f "$dir/fixture.code" ]]; then bad "$name" "missing fixture.code"; return; fi + assert_one_top_level_wo "$dir" "$name" || return prefix="$(tmp_prefix "$name")" wob="$prefix.wob" err="$prefix.err" @@ -221,7 +256,16 @@ compile_fail_fixture() { return fi - timeout "$TIMEOUT" "$WOC" --emit "$dir/fixture.wo" -o "$wob" >/dev/null 2>"$err" + # Compile the fixture's own directory, not just fixture.wo directly: + # for a fixture with no other .wo file beside fixture.wo (every + # pre-haxe-parity fixture), woc's directory discovery finds exactly + # that one file, so this is behavior-identical to compiling + # "$dir/fixture.wo" on its own. It's what lets a fixture exercise a + # real cross-module `use` (haxe-parity Task 1) by adding a nested + # module directory (e.g. `greet/greet.wo`) beside fixture.wo — woc's + # own multi-file discovery (Task 8) then compiles both as one + # program, exactly like a real project layout would. + timeout "$TIMEOUT" "$WOC" --emit "$dir" -o "$wob" >/dev/null 2>"$err" rc=$? if [[ $rc -eq 124 ]]; then diff --git a/tests/corpus/compile-fail/lang-and-non-bool-operand/fixture.code b/tests/corpus/compile-fail/lang-and-non-bool-operand/fixture.code new file mode 100644 index 0000000..f03205b --- /dev/null +++ b/tests/corpus/compile-fail/lang-and-non-bool-operand/fixture.code @@ -0,0 +1 @@ +WO-E201 diff --git a/tests/corpus/compile-fail/lang-and-non-bool-operand/fixture.wo b/tests/corpus/compile-fail/lang-and-non-bool-operand/fixture.wo new file mode 100644 index 0000000..67d3922 --- /dev/null +++ b/tests/corpus/compile-fail/lang-and-non-bool-operand/fixture.wo @@ -0,0 +1,10 @@ +-- haxe-parity Task 2: `and`/`or` are Bool-only, no truthiness -- +-- `count` is confidently Int (a literal-valued local), so this is a +-- real, statically-provable type error, not a guess. +fn main() -> Int { + let count = 1 + if count and true { + print("unreachable") + } + return 0 +} diff --git a/tests/corpus/compile-fail/lang-break-outside-loop/fixture.code b/tests/corpus/compile-fail/lang-break-outside-loop/fixture.code new file mode 100644 index 0000000..e261753 --- /dev/null +++ b/tests/corpus/compile-fail/lang-break-outside-loop/fixture.code @@ -0,0 +1 @@ +WO-E403 diff --git a/tests/corpus/compile-fail/lang-break-outside-loop/fixture.wo b/tests/corpus/compile-fail/lang-break-outside-loop/fixture.wo new file mode 100644 index 0000000..f0648d7 --- /dev/null +++ b/tests/corpus/compile-fail/lang-break-outside-loop/fixture.wo @@ -0,0 +1,9 @@ +-- haxe-parity Task 2: `break` outside any loop has no legal jump +-- target -- emit.ml's own "cannot lower" gate (WO-E403), the same +-- convention every other construct with nothing to lower to uses. +-- Nothing upstream (parser/types/owner) tracks loop nesting to reject +-- this earlier. +fn main() -> Int { + break + return 0 +} diff --git a/tests/corpus/compile-fail/lang-builtin-arg-type-freefn/fixture.code b/tests/corpus/compile-fail/lang-builtin-arg-type-freefn/fixture.code new file mode 100644 index 0000000..0c571ae --- /dev/null +++ b/tests/corpus/compile-fail/lang-builtin-arg-type-freefn/fixture.code @@ -0,0 +1 @@ +WO-E209 diff --git a/tests/corpus/compile-fail/lang-builtin-arg-type-freefn/fixture.wo b/tests/corpus/compile-fail/lang-builtin-arg-type-freefn/fixture.wo new file mode 100644 index 0000000..a5ad82b --- /dev/null +++ b/tests/corpus/compile-fail/lang-builtin-arg-type-freefn/fixture.wo @@ -0,0 +1,20 @@ +-- Hotfix round 2 (WO-E209): `takesSecret` is declared `-> Int`, so its +-- call result is exactly as confidently `Int` as a bare literal would +-- be -- passing it to `print` (wants `Text`) is the same class of bug +-- `print(7)` is, just one call deeper. Controller-verified real repro: +-- this compiled clean and segfaulted `wovm` before `confident_typ` +-- chased a free fn's own declared return type (round 1 only chased +-- literals/fields/params, missing this shape entirely). +class Box { + fn hidden() -> Int { + return 7 + } +} + +fn takesSecret(box: Box) -> Int { + return box.hidden() +} + +fn main() { + print(takesSecret(Box{})) +} diff --git a/tests/corpus/compile-fail/lang-builtin-arg-type-method/fixture.code b/tests/corpus/compile-fail/lang-builtin-arg-type-method/fixture.code new file mode 100644 index 0000000..0c571ae --- /dev/null +++ b/tests/corpus/compile-fail/lang-builtin-arg-type-method/fixture.code @@ -0,0 +1 @@ +WO-E209 diff --git a/tests/corpus/compile-fail/lang-builtin-arg-type-method/fixture.wo b/tests/corpus/compile-fail/lang-builtin-arg-type-method/fixture.wo new file mode 100644 index 0000000..710f7bc --- /dev/null +++ b/tests/corpus/compile-fail/lang-builtin-arg-type-method/fixture.wo @@ -0,0 +1,17 @@ +-- Hotfix round 2 (WO-E209): a direct method call, not a free fn wrapping +-- one -- `Box.hidden` is declared `-> Int`, and the receiver `b` is +-- confidently `Box` because it was built the ordinary way (`let b = +-- Box{}`, a `Ctor`, which `confident_typ` also had to start chasing to +-- reach method calls off a receiver built this way rather than only a +-- parameter). `print(b.hidden())` is the same class of bug as +-- `print(7)`, dispatched through a method instead of a free fn. +class Box { + fn hidden() -> Int { + return 7 + } +} + +fn main() { + let b = Box{} + print(b.hidden()) +} diff --git a/tests/corpus/compile-fail/lang-builtin-arg-type/fixture.code b/tests/corpus/compile-fail/lang-builtin-arg-type/fixture.code new file mode 100644 index 0000000..0c571ae --- /dev/null +++ b/tests/corpus/compile-fail/lang-builtin-arg-type/fixture.code @@ -0,0 +1 @@ +WO-E209 diff --git a/tests/corpus/compile-fail/lang-builtin-arg-type/fixture.wo b/tests/corpus/compile-fail/lang-builtin-arg-type/fixture.wo new file mode 100644 index 0000000..2c8c819 --- /dev/null +++ b/tests/corpus/compile-fail/lang-builtin-arg-type/fixture.wo @@ -0,0 +1,11 @@ +-- Hotfix (WO-E209): `print` wants a `Text` -- a heap-string pointer, +-- .wob kind WO_K_TEXT -- and a bare Int literal is a WO_K_SCALAR +-- register holding a raw int64 (docs/plan/oop-vm/08-builtin-surface.md's +-- `print(t)` row). Before this check existed, this compiled clean and +-- segfaulted `wovm`: the VM's `str_check` (runtime/src/vm.c) dereferences +-- whatever register it's handed as a `wo_str*` with no runtime tag to +-- check first, so the literal `7` was a wild pointer read. The exact +-- repro that motivated wiring this diagnostic up. +fn main() { + print(7) +} diff --git a/tests/corpus/compile-fail/lang-builtin-arity/fixture.code b/tests/corpus/compile-fail/lang-builtin-arity/fixture.code new file mode 100644 index 0000000..0c571ae --- /dev/null +++ b/tests/corpus/compile-fail/lang-builtin-arity/fixture.code @@ -0,0 +1 @@ +WO-E209 diff --git a/tests/corpus/compile-fail/lang-builtin-arity/fixture.wo b/tests/corpus/compile-fail/lang-builtin-arity/fixture.wo new file mode 100644 index 0000000..94362ce --- /dev/null +++ b/tests/corpus/compile-fail/lang-builtin-arity/fixture.wo @@ -0,0 +1,9 @@ +-- Hotfix (WO-E209): `now` takes zero arguments +-- (docs/plan/oop-vm/08-builtin-surface.md's `now()` row) -- this +-- exercises the wrong-arity half of the same diagnostic, caught at +-- typecheck time. Arity mismatches were already caught later, at +-- emission (`WO-E403`, `emit.ml`) -- that check stays as-is; this is an +-- earlier, additional gate over the same contract, not a replacement. +fn main() { + now(1) +} diff --git a/tests/corpus/compile-fail/lang-inline-fn-rejected/fixture.code b/tests/corpus/compile-fail/lang-inline-fn-rejected/fixture.code new file mode 100644 index 0000000..6afa604 --- /dev/null +++ b/tests/corpus/compile-fail/lang-inline-fn-rejected/fixture.code @@ -0,0 +1 @@ +WO-E103 diff --git a/tests/corpus/compile-fail/lang-inline-fn-rejected/fixture.wo b/tests/corpus/compile-fail/lang-inline-fn-rejected/fixture.wo new file mode 100644 index 0000000..6f2bf40 --- /dev/null +++ b/tests/corpus/compile-fail/lang-inline-fn-rejected/fixture.wo @@ -0,0 +1,11 @@ +-- haxe-parity Task 2: the keyword verdict table's `inline` row -- +-- `const` values are adopted (see run/lang-const-usage); inline +-- *functions* are rejected outright, optimization being the +-- compiler's job, not the source language's. +inline fn double(n: Int) -> Int { + return n + n +} + +fn main() -> Int { + return double(2) +} diff --git a/tests/corpus/compile-fail/lang-interp-malformed-expr/fixture.code b/tests/corpus/compile-fail/lang-interp-malformed-expr/fixture.code new file mode 100644 index 0000000..d2a6f14 --- /dev/null +++ b/tests/corpus/compile-fail/lang-interp-malformed-expr/fixture.code @@ -0,0 +1 @@ +WO-E101 diff --git a/tests/corpus/compile-fail/lang-interp-malformed-expr/fixture.wo b/tests/corpus/compile-fail/lang-interp-malformed-expr/fixture.wo new file mode 100644 index 0000000..b42ad71 --- /dev/null +++ b/tests/corpus/compile-fail/lang-interp-malformed-expr/fixture.wo @@ -0,0 +1,11 @@ +-- haxe-parity Task 2 review fix (Important): a genuine sub-parse +-- failure inside "${...}" (`1 +`, not just trailing garbage) must +-- report at this string literal's own position with the malformed- +-- interpolation message -- not at the sub-lexer's own uncorrected +-- line/col (which used to land on some unrelated line of this real +-- file). See compiler/test/runner.ml's direct assertion for the exact +-- position/message pin; this fixture only pins the outcome (WO-E101). +fn main() -> Int { + print("prefix ${1 +} suffix") + return 0 +} diff --git a/tests/corpus/compile-fail/lang-multifile-single-report/fixture.code b/tests/corpus/compile-fail/lang-multifile-single-report/fixture.code new file mode 100644 index 0000000..ad9c07e --- /dev/null +++ b/tests/corpus/compile-fail/lang-multifile-single-report/fixture.code @@ -0,0 +1 @@ +WO-E202 diff --git a/tests/corpus/compile-fail/lang-multifile-single-report/fixture.wo b/tests/corpus/compile-fail/lang-multifile-single-report/fixture.wo new file mode 100644 index 0000000..b38978c --- /dev/null +++ b/tests/corpus/compile-fail/lang-multifile-single-report/fixture.wo @@ -0,0 +1,15 @@ +-- Hotfix repro (multi-file double-report): a body-level check (here +-- WO-E202, unknown field) must fire exactly once, tagged with THIS +-- file -- not once per OTHER discovered file too. `it.price` is the +-- one real bug (Item has no `price` field, only `n`). other/helper.wo +-- exists purely to make this a two-file program: the bug needs N>1 +-- discovered files to reproduce at all (with one file, there is no +-- "other file's pass" to re-report under). See +-- .superpowers/sdd/2026-08-01-haxe-parity-language/hotfix-e209-report.md's +-- "Disclosed, NOT fixed" section for the original diagnosis. +class Item { n: Int } + +fn main() { + let it = Item{n:1} + print_int(it.price) +} diff --git a/tests/corpus/compile-fail/lang-multifile-single-report/other/helper.wo b/tests/corpus/compile-fail/lang-multifile-single-report/other/helper.wo new file mode 100644 index 0000000..2da55c4 --- /dev/null +++ b/tests/corpus/compile-fail/lang-multifile-single-report/other/helper.wo @@ -0,0 +1,8 @@ +-- Unrelated file, deliberately trivial and error-free -- its only job +-- is being a second discovered file in this program (see fixture.wo's +-- own comment for why). No Ctor/Call site here means no module `use` +-- gating gets exercised either -- this fixture is purely about the +-- double-report bug, not the module system. +fn helper() -> Int { + return 1 +} diff --git a/tests/corpus/compile-fail/lang-switch-arm-mismatch/fixture.code b/tests/corpus/compile-fail/lang-switch-arm-mismatch/fixture.code new file mode 100644 index 0000000..f03205b --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-arm-mismatch/fixture.code @@ -0,0 +1 @@ +WO-E201 diff --git a/tests/corpus/compile-fail/lang-switch-arm-mismatch/fixture.wo b/tests/corpus/compile-fail/lang-switch-arm-mismatch/fixture.wo new file mode 100644 index 0000000..75d0883 --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-arm-mismatch/fixture.wo @@ -0,0 +1,16 @@ +-- haxe-parity Task 3: arm-type unification. `default` yields `Int` +-- while the earlier `case` arms yield `Text` -- the switch's own type +-- is fixed by the first arm (types.ml's own "first wins" convention), +-- so this is a real, statically-provable mismatch, not a guess. +fn classify(n: Int) -> Text { + let label = switch n { + case 1: "one"; + case 2: "two"; + default: 0; + }; + return label; +} + +fn main() -> Int { + return 0; +} diff --git a/tests/corpus/compile-fail/lang-switch-builtin-subject-int-case/fixture.code b/tests/corpus/compile-fail/lang-switch-builtin-subject-int-case/fixture.code new file mode 100644 index 0000000..f03205b --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-builtin-subject-int-case/fixture.code @@ -0,0 +1 @@ +WO-E201 diff --git a/tests/corpus/compile-fail/lang-switch-builtin-subject-int-case/fixture.wo b/tests/corpus/compile-fail/lang-switch-builtin-subject-int-case/fixture.wo new file mode 100644 index 0000000..7320c3b --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-builtin-subject-int-case/fixture.wo @@ -0,0 +1,20 @@ +-- haxe-parity Task 3, re-review fix (Critical 2 residual): the switch +-- subject is a BUILTIN CALL, not a variable -- `int_to_text(n)` is +-- confidently `Text` because the builtin's return type is declared. +-- Before the fix, types.ml's `builtin_confident_ret` had no +-- `int_to_text` entry (drifted from emit.ml's `builtin_ret`, which +-- does), so the E201 check stayed silent while the emitter still +-- chose EQS -- and EQS str_check'd the raw int case label at runtime: +-- a zero-diagnostic compile that segfaulted the VM. This fixture pins +-- the two tables back in sync. +fn classify(n: Int) -> Int { + let v = switch int_to_text(n) { + case 1: 0; + default: 1; + }; + return v; +} + +fn main() -> Int { + return 0; +} diff --git a/tests/corpus/compile-fail/lang-switch-int-subject-text-case/fixture.code b/tests/corpus/compile-fail/lang-switch-int-subject-text-case/fixture.code new file mode 100644 index 0000000..f03205b --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-int-subject-text-case/fixture.code @@ -0,0 +1 @@ +WO-E201 diff --git a/tests/corpus/compile-fail/lang-switch-int-subject-text-case/fixture.wo b/tests/corpus/compile-fail/lang-switch-int-subject-text-case/fixture.wo new file mode 100644 index 0000000..61429d4 --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-int-subject-text-case/fixture.wo @@ -0,0 +1,19 @@ +-- haxe-parity Task 3, review fix (Critical 2): the reverse direction +-- of the Text/Int representation mismatch -- an `Int` subject against +-- a `Text` case label doesn't crash the VM (EQ just compares two +-- int64s), but it is equally wrong: the case value's own register +-- never holds the subject's representation, so the comparison is +-- silently always-false, and the case can never fire. `n` is +-- confidently `Int` (a declared parameter), so this is a real, +-- statically-provable mismatch, not a guess. +fn describe(n: Int) -> Text { + let v = switch n { + case "one": "matched"; + default: "other"; + }; + return v; +} + +fn main() -> Int { + return 0; +} diff --git a/tests/corpus/compile-fail/lang-switch-int-subject-variant-case/fixture.code b/tests/corpus/compile-fail/lang-switch-int-subject-variant-case/fixture.code new file mode 100644 index 0000000..f03205b --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-int-subject-variant-case/fixture.code @@ -0,0 +1 @@ +WO-E201 diff --git a/tests/corpus/compile-fail/lang-switch-int-subject-variant-case/fixture.wo b/tests/corpus/compile-fail/lang-switch-int-subject-variant-case/fixture.wo new file mode 100644 index 0000000..344400b --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-int-subject-variant-case/fixture.wo @@ -0,0 +1,18 @@ +-- haxe-parity Task 4, fix round 1 (review Major): the inverse of the +-- union-subject direction — a case naming a KNOWN variant over an `Int` +-- subject silently ordinal-matched (`Lo` is tag 0, so `f(0)` took the +-- `case Lo:` arm). WO-E201, the same family as the existing +-- lang-switch-int-subject-text-case. +type K = Lo | Mid | Hi + +fn f(n: Int) -> Int { + return switch n { + case Lo: 99; + default: 0; + } +} + +fn main() -> Int { + print_int(f(0)) + return 0 +} diff --git a/tests/corpus/compile-fail/lang-switch-missing-default/fixture.code b/tests/corpus/compile-fail/lang-switch-missing-default/fixture.code new file mode 100644 index 0000000..3825224 --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-missing-default/fixture.code @@ -0,0 +1 @@ +WO-E208 diff --git a/tests/corpus/compile-fail/lang-switch-missing-default/fixture.wo b/tests/corpus/compile-fail/lang-switch-missing-default/fixture.wo new file mode 100644 index 0000000..c9a4172 --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-missing-default/fixture.wo @@ -0,0 +1,15 @@ +-- haxe-parity Task 3: scalars/Text require `default` -- no union type +-- exists yet (Task 4), so this is unconditional for every subject this +-- task supports; `n` is confidently `Int` (a declared parameter), so +-- this is a real, statically-provable gap, not a guess. +fn classify(n: Int) -> Text { + let label = switch n { + case 1: "one"; + case 2: "two"; + }; + return label; +} + +fn main() -> Int { + return 0; +} diff --git a/tests/corpus/compile-fail/lang-switch-text-subject-int-case/fixture.code b/tests/corpus/compile-fail/lang-switch-text-subject-int-case/fixture.code new file mode 100644 index 0000000..f03205b --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-text-subject-int-case/fixture.code @@ -0,0 +1 @@ +WO-E201 diff --git a/tests/corpus/compile-fail/lang-switch-text-subject-int-case/fixture.wo b/tests/corpus/compile-fail/lang-switch-text-subject-int-case/fixture.wo new file mode 100644 index 0000000..4f8e87c --- /dev/null +++ b/tests/corpus/compile-fail/lang-switch-text-subject-int-case/fixture.wo @@ -0,0 +1,19 @@ +-- haxe-parity Task 3, review fix (Critical 2): a `Text` subject +-- compared against an `Int` case label is not merely a type error -- +-- unchecked, it is a real VM segfault: emit.ml's EQ-vs-EQS choice +-- reads only the SUBJECT's type, so `s: Text` picks EQS, and EQS's +-- own `str_check` dereferences whatever sits in the case value's +-- register as a `wo_str*` -- a raw int64 (`1`) read as a heap address. +-- `s` is confidently `Text` (a declared parameter), so this is a +-- real, statically-provable mismatch, not a guess. +fn describe(s: Text) -> Text { + let v = switch s { + case 1: "one"; + default: "other"; + }; + return v; +} + +fn main() -> Int { + return 0; +} diff --git a/tests/corpus/compile-fail/lang-use-collision/a/a.wo b/tests/corpus/compile-fail/lang-use-collision/a/a.wo new file mode 100644 index 0000000..03c7e7d --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-collision/a/a.wo @@ -0,0 +1,3 @@ +pub fn thing() -> Int { + return 1 +} diff --git a/tests/corpus/compile-fail/lang-use-collision/b/b.wo b/tests/corpus/compile-fail/lang-use-collision/b/b.wo new file mode 100644 index 0000000..bb94294 --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-collision/b/b.wo @@ -0,0 +1,3 @@ +pub fn thing() -> Int { + return 2 +} diff --git a/tests/corpus/compile-fail/lang-use-collision/fixture.code b/tests/corpus/compile-fail/lang-use-collision/fixture.code new file mode 100644 index 0000000..f0523e2 --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-collision/fixture.code @@ -0,0 +1 @@ +WO-E218 diff --git a/tests/corpus/compile-fail/lang-use-collision/fixture.wo b/tests/corpus/compile-fail/lang-use-collision/fixture.wo new file mode 100644 index 0000000..ef7bd32 --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-collision/fixture.wo @@ -0,0 +1,11 @@ +-- haxe-parity Task 1 (modules): `a` and `b` both export a `pub fn +-- thing`. Resolution goes file -> own module -> used modules -> stdlib +-- (this file's own module has no `thing` at all), and at the "used +-- modules" tier both `a` and `b` match — collisions diagnose rather +-- than shadow silently (WO-E218), never a first-used-wins pick. +use a +use b + +fn main() { + print_int(thing()) +} diff --git a/tests/corpus/compile-fail/lang-use-private-access/fixture.code b/tests/corpus/compile-fail/lang-use-private-access/fixture.code new file mode 100644 index 0000000..eb22599 --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-private-access/fixture.code @@ -0,0 +1 @@ +WO-E217 diff --git a/tests/corpus/compile-fail/lang-use-private-access/fixture.wo b/tests/corpus/compile-fail/lang-use-private-access/fixture.wo new file mode 100644 index 0000000..f1ec09c --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-private-access/fixture.wo @@ -0,0 +1,8 @@ +-- haxe-parity Task 1 (modules): `secret.hidden()` names a real fn in a +-- real, `use`d module — but `hidden` is not `pub` (see secret/secret.wo), +-- so this is WO-E217, not a lookup failure. +use secret + +fn main() { + print_int(secret.hidden()) +} diff --git a/tests/corpus/compile-fail/lang-use-private-access/secret/secret.wo b/tests/corpus/compile-fail/lang-use-private-access/secret/secret.wo new file mode 100644 index 0000000..f0953b4 --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-private-access/secret/secret.wo @@ -0,0 +1,7 @@ +-- haxe-parity Task 1 (modules): `hidden` has no `pub` marker, so it is +-- private to this module — visible to every file in `secret/` itself, +-- but not to a `use secret` caller elsewhere. That is exactly what +-- fixture.wo tries and WO-E217 catches. +fn hidden() -> Int { + return 1 +} diff --git a/tests/corpus/compile-fail/lang-use-stdlib-not-linked/fixture.code b/tests/corpus/compile-fail/lang-use-stdlib-not-linked/fixture.code new file mode 100644 index 0000000..08ee1f6 --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-stdlib-not-linked/fixture.code @@ -0,0 +1 @@ +WO-E406 diff --git a/tests/corpus/compile-fail/lang-use-stdlib-not-linked/fixture.wo b/tests/corpus/compile-fail/lang-use-stdlib-not-linked/fixture.wo new file mode 100644 index 0000000..bb82b24 --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-stdlib-not-linked/fixture.wo @@ -0,0 +1,12 @@ +-- haxe-parity Task 1 (modules): `fs` is a reserved stdlib namespace — +-- `use fs` resolves and `fs.stat(...)` typechecks as UNKNOWN-BUT- +-- RESERVED (no E207/E225/arity error; the six namespaces' members +-- arrive in plan 9). A call through it that survives all the way to +-- emission is WO-E406, not silently accepted and not a generic +-- WO-E403 "cannot resolve the receiver" -- there is nothing wrong with +-- the reference, only nothing to lower it to yet. +use fs + +fn main() { + print_int(fs.stat("x")) +} diff --git a/tests/corpus/compile-fail/lang-use-unknown-module/fixture.code b/tests/corpus/compile-fail/lang-use-unknown-module/fixture.code new file mode 100644 index 0000000..7d324ad --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-unknown-module/fixture.code @@ -0,0 +1 @@ +WO-E216 diff --git a/tests/corpus/compile-fail/lang-use-unknown-module/fixture.wo b/tests/corpus/compile-fail/lang-use-unknown-module/fixture.wo new file mode 100644 index 0000000..35b894a --- /dev/null +++ b/tests/corpus/compile-fail/lang-use-unknown-module/fixture.wo @@ -0,0 +1,8 @@ +-- haxe-parity Task 1 (modules): `nosuchmodule` is neither one of the +-- six reserved stdlib namespaces (fs, proc, net, time, json, env) nor a +-- directory this program actually discovers -- WO-E216. +use nosuchmodule + +fn main() { + print("x") +} diff --git a/tests/corpus/compile-fail/lang-variant-arity/fixture.code b/tests/corpus/compile-fail/lang-variant-arity/fixture.code new file mode 100644 index 0000000..fec75f6 --- /dev/null +++ b/tests/corpus/compile-fail/lang-variant-arity/fixture.code @@ -0,0 +1 @@ +WO-E203 diff --git a/tests/corpus/compile-fail/lang-variant-arity/fixture.wo b/tests/corpus/compile-fail/lang-variant-arity/fixture.wo new file mode 100644 index 0000000..386db84 --- /dev/null +++ b/tests/corpus/compile-fail/lang-variant-arity/fixture.wo @@ -0,0 +1,10 @@ +-- haxe-parity Task 4: constructing a payload variant with the wrong +-- number of payload arguments is WO-E203 (bad arity -- reserved since +-- plan 2 Task 6, this is its first real emission site). `Failed` +-- declares exactly one payload field. +type Status = Pending | Failed(reason: Text) + +fn main() -> Int { + let st = Failed("a", "b") + return 0 +} diff --git a/tests/corpus/compile-fail/lang-variant-cross-union-eq/fixture.code b/tests/corpus/compile-fail/lang-variant-cross-union-eq/fixture.code new file mode 100644 index 0000000..f03205b --- /dev/null +++ b/tests/corpus/compile-fail/lang-variant-cross-union-eq/fixture.code @@ -0,0 +1 @@ +WO-E201 diff --git a/tests/corpus/compile-fail/lang-variant-cross-union-eq/fixture.wo b/tests/corpus/compile-fail/lang-variant-cross-union-eq/fixture.wo new file mode 100644 index 0000000..3a156b3 --- /dev/null +++ b/tests/corpus/compile-fail/lang-variant-cross-union-eq/fixture.wo @@ -0,0 +1,12 @@ +-- haxe-parity Task 4, fix round 1 (review Major): two bare unions share +-- the ordinal-tag representation, so `X == P` across DIFFERENT unions +-- was silently true (both ordinal 0). WO-E201 — values of different +-- unions never compare equal. +type A = X | Yv + +type B = P | Qv + +fn main() -> Int { + if X == P { print("cross-eq") } + return 0 +} diff --git a/tests/corpus/compile-fail/lang-variant-missing-variant/fixture.code b/tests/corpus/compile-fail/lang-variant-missing-variant/fixture.code new file mode 100644 index 0000000..3825224 --- /dev/null +++ b/tests/corpus/compile-fail/lang-variant-missing-variant/fixture.code @@ -0,0 +1 @@ +WO-E208 diff --git a/tests/corpus/compile-fail/lang-variant-missing-variant/fixture.wo b/tests/corpus/compile-fail/lang-variant-missing-variant/fixture.wo new file mode 100644 index 0000000..d966eb5 --- /dev/null +++ b/tests/corpus/compile-fail/lang-variant-missing-variant/fixture.wo @@ -0,0 +1,16 @@ +-- haxe-parity Task 4: WO-E208's union exhaustiveness rule -- a switch +-- over a union with no `default` must cover every variant; the +-- diagnostic names the missing ones (`Hi` here). Scalars/Text keep the +-- unconditional default-required rule (lang-switch-missing-default). +type Kind = Lo | Mid | Hi + +fn f(k: Kind) -> Int { + return switch k { + case Lo: 1; + case Mid: 2; + } +} + +fn main() -> Int { + return 0 +} diff --git a/tests/corpus/compile-fail/lang-variant-nullable-subject/fixture.code b/tests/corpus/compile-fail/lang-variant-nullable-subject/fixture.code new file mode 100644 index 0000000..f03205b --- /dev/null +++ b/tests/corpus/compile-fail/lang-variant-nullable-subject/fixture.code @@ -0,0 +1 @@ +WO-E201 diff --git a/tests/corpus/compile-fail/lang-variant-nullable-subject/fixture.wo b/tests/corpus/compile-fail/lang-variant-nullable-subject/fixture.wo new file mode 100644 index 0000000..3b15852 --- /dev/null +++ b/tests/corpus/compile-fail/lang-variant-nullable-subject/fixture.wo @@ -0,0 +1,21 @@ +-- haxe-parity Task 4, fix round 1 (review Critical 2): a variant-named +-- case over a `?Union` subject can NEVER match (the subject is not +-- narrowed by `switch` — `?T` forced handling is Task 6's), so it +-- compiled clean and always took `default`. WO-E201, pointing at the +-- nil case first. +type St = Pending | Failed(m: Text) + +typedef R = { ?st: St } + +fn f(r: R) -> Text { + return switch r.st { + case Pending: "p"; + default: "nil"; + } +} + +fn main() -> Int { + let a = R { st: Pending } + print(f(a)) + return 0 +} diff --git a/tests/corpus/run/emit-ctor-tail-position/fixture.out b/tests/corpus/run/emit-ctor-tail-position/fixture.out new file mode 100644 index 0000000..0571a2e --- /dev/null +++ b/tests/corpus/run/emit-ctor-tail-position/fixture.out @@ -0,0 +1,3 @@ +3 +1 +2 diff --git a/tests/corpus/run/emit-ctor-tail-position/fixture.wo b/tests/corpus/run/emit-ctor-tail-position/fixture.wo new file mode 100644 index 0000000..fa0dd23 --- /dev/null +++ b/tests/corpus/run/emit-ctor-tail-position/fixture.wo @@ -0,0 +1,35 @@ +-- pre-existing emit_ctor register collision, found during haxe-parity +-- Task 3's re-review (out-of-scope encounter, fixed as its own hotfix): +-- a constructor in TAIL position (`return Box{...}`) gets its dst from +-- emit_tail's allocate-then-un-reserve convention, so dst sits AT +-- f_temp -- and emit_ctor's per-field value temp then lands in dst +-- itself, clobbering the just-NEW'd object pointer before SETF reads +-- it (NEW r0; LOADK r0,k; SETF r0,f0,r0 -- an int64 stored through as +-- a heap pointer, VM segfault with zero diagnostics). A `let`-bound +-- ctor never collides (its dst is a local, below f_temp), which is why +-- the whole milestone-1 corpus missed it. Same defect family as the +-- Task 3 emit_switch placeholder-dst collision, different call site. +class Box { + n: Int +} + +class Pair { + a: Int + b: Int +} + +fn make() -> Box { + return Box{n: 3}; +} + +fn make_pair() -> Pair { + return Pair{a: 1, b: 2}; +} + +fn main() -> Int { + print_int(make().n); + let p = make_pair(); + print_int(p.a); + print_int(p.b); + return 0; +} diff --git a/tests/corpus/run/lang-and-or-short-circuit/fixture.out b/tests/corpus/run/lang-and-or-short-circuit/fixture.out new file mode 100644 index 0000000..5aa0921 --- /dev/null +++ b/tests/corpus/run/lang-and-or-short-circuit/fixture.out @@ -0,0 +1,3 @@ +and-precedence-ok +and-short-circuit-ok +or-short-circuit-ok diff --git a/tests/corpus/run/lang-and-or-short-circuit/fixture.wo b/tests/corpus/run/lang-and-or-short-circuit/fixture.wo new file mode 100644 index 0000000..bfece0c --- /dev/null +++ b/tests/corpus/run/lang-and-or-short-circuit/fixture.wo @@ -0,0 +1,26 @@ +-- haxe-parity Task 2: `and`/`or` -- real keywords, own precedence level +-- (looser than comparison, so `a == 1 and b == 2` needs no parens), +-- short-circuit lowering to compare-and-jump (JZ + JMP, no new opcode). +-- The short-circuit proof is real, not asserted: `1 / zero` traps +-- (division by zero) if it is ever actually evaluated, so a broken +-- (always-evaluate-both-sides) lowering would crash this fixture +-- outright instead of merely printing a wrong answer. +fn main() -> Int { + let a = 1 + let b = 2 + if a == 1 and b == 2 { + print("and-precedence-ok") + } + let zero = 0 + if false and (1 / zero == 0) { + print("SHOULD-NOT-PRINT-and") + } else { + print("and-short-circuit-ok") + } + if true or (1 / zero == 0) { + print("or-short-circuit-ok") + } else { + print("SHOULD-NOT-PRINT-or") + } + return 0 +} diff --git a/tests/corpus/run/lang-break-owned-drop/fixture.out b/tests/corpus/run/lang-break-owned-drop/fixture.out new file mode 100644 index 0000000..3e50f7e --- /dev/null +++ b/tests/corpus/run/lang-break-owned-drop/fixture.out @@ -0,0 +1,2 @@ +1 +done diff --git a/tests/corpus/run/lang-break-owned-drop/fixture.wo b/tests/corpus/run/lang-break-owned-drop/fixture.wo new file mode 100644 index 0000000..b40b058 --- /dev/null +++ b/tests/corpus/run/lang-break-owned-drop/fixture.wo @@ -0,0 +1,159 @@ +-- haxe-parity Task 2: break/continue drop-set correctness. +-- `Big` has 130 Int fields (runtime/test's own malloc-path trick, +-- test_rc.c's doc comment: field_cnt*8 bytes exceeds the arena's +-- 1024-byte size-class ceiling, so a missed DROP is a hard ASan leak, +-- not a silent, unobservable miss). At i == 1, `big` is still live +-- (never returned or moved) when `break` fires -- this is the DROP +-- under test: owner.ml's DBreak table entry, emitted at the break site +-- itself, must destroy it there, not leave it to leak. Verified under +-- `runtime/build/wovm_asan` (see task-2-report.md for the RED/GREEN +-- ASan evidence); this fixture's own oop-e2e.sh check (plain wovm) +-- pins the *output*, not the leak-freedom -- the two are complementary, +-- not redundant (a correct DROP is also silently correct output-wise; +-- only ASan's leak checker actually proves the destructor ran). +class Big { + f0: Int + f1: Int + f2: Int + f3: Int + f4: Int + f5: Int + f6: Int + f7: Int + f8: Int + f9: Int + f10: Int + f11: Int + f12: Int + f13: Int + f14: Int + f15: Int + f16: Int + f17: Int + f18: Int + f19: Int + f20: Int + f21: Int + f22: Int + f23: Int + f24: Int + f25: Int + f26: Int + f27: Int + f28: Int + f29: Int + f30: Int + f31: Int + f32: Int + f33: Int + f34: Int + f35: Int + f36: Int + f37: Int + f38: Int + f39: Int + f40: Int + f41: Int + f42: Int + f43: Int + f44: Int + f45: Int + f46: Int + f47: Int + f48: Int + f49: Int + f50: Int + f51: Int + f52: Int + f53: Int + f54: Int + f55: Int + f56: Int + f57: Int + f58: Int + f59: Int + f60: Int + f61: Int + f62: Int + f63: Int + f64: Int + f65: Int + f66: Int + f67: Int + f68: Int + f69: Int + f70: Int + f71: Int + f72: Int + f73: Int + f74: Int + f75: Int + f76: Int + f77: Int + f78: Int + f79: Int + f80: Int + f81: Int + f82: Int + f83: Int + f84: Int + f85: Int + f86: Int + f87: Int + f88: Int + f89: Int + f90: Int + f91: Int + f92: Int + f93: Int + f94: Int + f95: Int + f96: Int + f97: Int + f98: Int + f99: Int + f100: Int + f101: Int + f102: Int + f103: Int + f104: Int + f105: Int + f106: Int + f107: Int + f108: Int + f109: Int + f110: Int + f111: Int + f112: Int + f113: Int + f114: Int + f115: Int + f116: Int + f117: Int + f118: Int + f119: Int + f120: Int + f121: Int + f122: Int + f123: Int + f124: Int + f125: Int + f126: Int + f127: Int + f128: Int + f129: Int +} + +fn main() -> Int { + let i = 0 + while i < 3 { + let big = Big { f0: 1, f1: 1, f2: 1, f3: 1, f4: 1, f5: 1, f6: 1, f7: 1, f8: 1, f9: 1, f10: 1, f11: 1, f12: 1, f13: 1, f14: 1, f15: 1, f16: 1, f17: 1, f18: 1, f19: 1, f20: 1, f21: 1, f22: 1, f23: 1, f24: 1, f25: 1, f26: 1, f27: 1, f28: 1, f29: 1, f30: 1, f31: 1, f32: 1, f33: 1, f34: 1, f35: 1, f36: 1, f37: 1, f38: 1, f39: 1, f40: 1, f41: 1, f42: 1, f43: 1, f44: 1, f45: 1, f46: 1, f47: 1, f48: 1, f49: 1, f50: 1, f51: 1, f52: 1, f53: 1, f54: 1, f55: 1, f56: 1, f57: 1, f58: 1, f59: 1, f60: 1, f61: 1, f62: 1, f63: 1, f64: 1, f65: 1, f66: 1, f67: 1, f68: 1, f69: 1, f70: 1, f71: 1, f72: 1, f73: 1, f74: 1, f75: 1, f76: 1, f77: 1, f78: 1, f79: 1, f80: 1, f81: 1, f82: 1, f83: 1, f84: 1, f85: 1, f86: 1, f87: 1, f88: 1, f89: 1, f90: 1, f91: 1, f92: 1, f93: 1, f94: 1, f95: 1, f96: 1, f97: 1, f98: 1, f99: 1, f100: 1, f101: 1, f102: 1, f103: 1, f104: 1, f105: 1, f106: 1, f107: 1, f108: 1, f109: 1, f110: 1, f111: 1, f112: 1, f113: 1, f114: 1, f115: 1, f116: 1, f117: 1, f118: 1, f119: 1, f120: 1, f121: 1, f122: 1, f123: 1, f124: 1, f125: 1, f126: 1, f127: 1, f128: 1, f129: 1 } + if i == 1 { + break + } + print_int(big.f0) + i = i + 1 + } + print("done") + return 0 +} diff --git a/tests/corpus/run/lang-const-usage/fixture.out b/tests/corpus/run/lang-const-usage/fixture.out new file mode 100644 index 0000000..ff22d25 --- /dev/null +++ b/tests/corpus/run/lang-const-usage/fixture.out @@ -0,0 +1,3 @@ +hi +hi +box diff --git a/tests/corpus/run/lang-const-usage/fixture.wo b/tests/corpus/run/lang-const-usage/fixture.wo new file mode 100644 index 0000000..2c8900b --- /dev/null +++ b/tests/corpus/run/lang-const-usage/fixture.wo @@ -0,0 +1,26 @@ +-- haxe-parity Task 2: `const NAME = literal` -- top-level and +-- (bare, non-static) class-level, both usable in expressions. Resolved +-- by parser.ml's own post-parse substitution: by the time typecheck/ +-- owner/emit see this file, GREETING_COUNT and LABEL are already the +-- literals they name. +const GREETING_COUNT = 2 + +class Box { + const LABEL = "box" + n: Int + + fn describe() -> Text { + return LABEL + } +} + +fn main() -> Int { + let i = 0 + while i < GREETING_COUNT { + print("hi") + i = i + 1 + } + let b = Box { n: 1 } + print(b.describe()) + return 0 +} diff --git a/tests/corpus/run/lang-continue/fixture.out b/tests/corpus/run/lang-continue/fixture.out new file mode 100644 index 0000000..6fd3b9e --- /dev/null +++ b/tests/corpus/run/lang-continue/fixture.out @@ -0,0 +1,5 @@ +1 +2 +4 +5 +done diff --git a/tests/corpus/run/lang-continue/fixture.wo b/tests/corpus/run/lang-continue/fixture.wo new file mode 100644 index 0000000..200d21e --- /dev/null +++ b/tests/corpus/run/lang-continue/fixture.wo @@ -0,0 +1,24 @@ +-- haxe-parity Task 2: `continue` in a `for` loop -- re-enters right +-- before the increment step (not `while`'s condition-check target), +-- so the loop still advances past the skipped element instead of +-- looping forever on it. +class Nums { + items: multi Int +} + +fn main() -> Int { + let box = Nums { items: multi_new() } + push(box.items, 1) + push(box.items, 2) + push(box.items, 3) + push(box.items, 4) + push(box.items, 5) + for n in box.items { + if n == 3 { + continue + } + print_int(n) + } + print("done") + return 0 +} diff --git a/tests/corpus/run/lang-ctor-temp-arg-drop/fixture.out b/tests/corpus/run/lang-ctor-temp-arg-drop/fixture.out new file mode 100644 index 0000000..29d6383 --- /dev/null +++ b/tests/corpus/run/lang-ctor-temp-arg-drop/fixture.out @@ -0,0 +1 @@ +100 diff --git a/tests/corpus/run/lang-ctor-temp-arg-drop/fixture.wo b/tests/corpus/run/lang-ctor-temp-arg-drop/fixture.wo new file mode 100644 index 0000000..af6d1bb --- /dev/null +++ b/tests/corpus/run/lang-ctor-temp-arg-drop/fixture.wo @@ -0,0 +1,159 @@ +-- haxe-parity Task 4, fix round 2 (review NEW 2): an OWNED heap +-- temporary passed as a borrow argument — a record/class constructor +-- literal or an owned-returning call, not just a variant construction +-- (fix round 1's scope) — is reaped by the caller after the call. +-- Before: `peek(Pay{})` in a loop leaked one object per iteration +-- (reviewer's m5c probe: maxrss 10,780 KB vs a 1,532 KB control over +-- 300k iterations; arena-backed and LSan-invisible, so this fixture +-- uses `Big` — 130 Int fields, past the arena's 1024-byte ceiling — +-- to make any miss a hard ASan failure). `take` arguments stay the +-- callee's to drop (the m6a/m6c-proven path) and places stay their +-- scope's; both are pinned by runner.ml assertions. +typedef Big = { + f0: Int = 1 + f1: Int = 1 + f2: Int = 1 + f3: Int = 1 + f4: Int = 1 + f5: Int = 1 + f6: Int = 1 + f7: Int = 1 + f8: Int = 1 + f9: Int = 1 + f10: Int = 1 + f11: Int = 1 + f12: Int = 1 + f13: Int = 1 + f14: Int = 1 + f15: Int = 1 + f16: Int = 1 + f17: Int = 1 + f18: Int = 1 + f19: Int = 1 + f20: Int = 1 + f21: Int = 1 + f22: Int = 1 + f23: Int = 1 + f24: Int = 1 + f25: Int = 1 + f26: Int = 1 + f27: Int = 1 + f28: Int = 1 + f29: Int = 1 + f30: Int = 1 + f31: Int = 1 + f32: Int = 1 + f33: Int = 1 + f34: Int = 1 + f35: Int = 1 + f36: Int = 1 + f37: Int = 1 + f38: Int = 1 + f39: Int = 1 + f40: Int = 1 + f41: Int = 1 + f42: Int = 1 + f43: Int = 1 + f44: Int = 1 + f45: Int = 1 + f46: Int = 1 + f47: Int = 1 + f48: Int = 1 + f49: Int = 1 + f50: Int = 1 + f51: Int = 1 + f52: Int = 1 + f53: Int = 1 + f54: Int = 1 + f55: Int = 1 + f56: Int = 1 + f57: Int = 1 + f58: Int = 1 + f59: Int = 1 + f60: Int = 1 + f61: Int = 1 + f62: Int = 1 + f63: Int = 1 + f64: Int = 1 + f65: Int = 1 + f66: Int = 1 + f67: Int = 1 + f68: Int = 1 + f69: Int = 1 + f70: Int = 1 + f71: Int = 1 + f72: Int = 1 + f73: Int = 1 + f74: Int = 1 + f75: Int = 1 + f76: Int = 1 + f77: Int = 1 + f78: Int = 1 + f79: Int = 1 + f80: Int = 1 + f81: Int = 1 + f82: Int = 1 + f83: Int = 1 + f84: Int = 1 + f85: Int = 1 + f86: Int = 1 + f87: Int = 1 + f88: Int = 1 + f89: Int = 1 + f90: Int = 1 + f91: Int = 1 + f92: Int = 1 + f93: Int = 1 + f94: Int = 1 + f95: Int = 1 + f96: Int = 1 + f97: Int = 1 + f98: Int = 1 + f99: Int = 1 + f100: Int = 1 + f101: Int = 1 + f102: Int = 1 + f103: Int = 1 + f104: Int = 1 + f105: Int = 1 + f106: Int = 1 + f107: Int = 1 + f108: Int = 1 + f109: Int = 1 + f110: Int = 1 + f111: Int = 1 + f112: Int = 1 + f113: Int = 1 + f114: Int = 1 + f115: Int = 1 + f116: Int = 1 + f117: Int = 1 + f118: Int = 1 + f119: Int = 1 + f120: Int = 1 + f121: Int = 1 + f122: Int = 1 + f123: Int = 1 + f124: Int = 1 + f125: Int = 1 + f126: Int = 1 + f127: Int = 1 + f128: Int = 1 + f129: Int = 1 +} + +fn mk() -> Big { return Big {} } + +fn peek(b: Big) -> Int { return b.f0 } + +fn main() -> Int { + let i = 0 + let acc = 0 + while i < 50 { + acc = acc + peek(Big {}) + acc = acc + peek(mk()) + i = i + 1 + } + print_int(acc) + return 0 +} diff --git a/tests/corpus/run/lang-do-while/fixture.out b/tests/corpus/run/lang-do-while/fixture.out new file mode 100644 index 0000000..e2180d4 --- /dev/null +++ b/tests/corpus/run/lang-do-while/fixture.out @@ -0,0 +1,2 @@ +5 +done diff --git a/tests/corpus/run/lang-do-while/fixture.wo b/tests/corpus/run/lang-do-while/fixture.wo new file mode 100644 index 0000000..d60a7c1 --- /dev/null +++ b/tests/corpus/run/lang-do-while/fixture.wo @@ -0,0 +1,14 @@ +-- haxe-parity Task 2: `do { body } while cond` -- body runs at least +-- once. `n` starts already past the condition (5, not < 3) so the +-- printed "0" below only happens because the body ran unconditionally +-- before the condition was ever checked; a `while`-shaped (check-first) +-- lowering would print nothing at all. +fn main() -> Int { + let n = 5 + do { + print_int(n) + n = n + 1 + } while n < 3 + print("done") + return 0 +} diff --git a/tests/corpus/run/lang-interp-string/fixture.out b/tests/corpus/run/lang-interp-string/fixture.out new file mode 100644 index 0000000..98b1a13 --- /dev/null +++ b/tests/corpus/run/lang-interp-string/fixture.out @@ -0,0 +1,3 @@ +log-watcher: 3 lines +price is ${100} exactly +a lone $ stays literal diff --git a/tests/corpus/run/lang-interp-string/fixture.wo b/tests/corpus/run/lang-interp-string/fixture.wo new file mode 100644 index 0000000..66e7188 --- /dev/null +++ b/tests/corpus/run/lang-interp-string/fixture.wo @@ -0,0 +1,13 @@ +-- haxe-parity Task 2: string interpolation. Text interpolants pass +-- through untouched; an Int interpolant (`count`) desugars through the +-- new `int_to_text` builtin. `\$` produces a literal `$` (so a whole +-- `${...}` sequence stays literal text when the `$` was escaped); a +-- lone `$` not followed by `{` also stays literal, unconditionally. +fn main() -> Int { + let count = 3 + let name = "log-watcher" + print("${name}: ${count} lines") + print("price is \${100} exactly") + print("a lone $ stays literal") + return 0 +} diff --git a/tests/corpus/run/lang-switch-arm-drop/fixture.out b/tests/corpus/run/lang-switch-arm-drop/fixture.out new file mode 100644 index 0000000..8df7607 --- /dev/null +++ b/tests/corpus/run/lang-switch-arm-drop/fixture.out @@ -0,0 +1,4 @@ +skip +1 +skip +done diff --git a/tests/corpus/run/lang-switch-arm-drop/fixture.wo b/tests/corpus/run/lang-switch-arm-drop/fixture.wo new file mode 100644 index 0000000..cbdc7d8 --- /dev/null +++ b/tests/corpus/run/lang-switch-arm-drop/fixture.wo @@ -0,0 +1,166 @@ +-- haxe-parity Task 3: `switch` arm-local drop correctness. `Big` has +-- 130 Int fields (the same runtime/test malloc-path trick +-- tests/corpus/run/lang-break-owned-drop/fixture.wo already uses: +-- field_cnt*8 bytes exceeds the arena's 1024-byte size-class ceiling, +-- so a missed DROP is a hard ASan leak, not a silent, unobservable +-- miss). `big` is created inside `case 1:` only (i == 1, one of three +-- loop iterations), never moved, never returned -- this is the DROP +-- under test: owner.ml's `analyze_switch` must record a DScope drop +-- for it at that ARM's own end (the switch's own drop-scope contract, +-- not the enclosing `while`'s), and emit.ml's `emit_switch` must +-- actually place it there. Proven under `runtime/build/wovm_asan` +-- (task-3-report.md has the RED/GREEN evidence: RED was a real bug +-- this fixture itself found, not a hypothetical -- a statement-position +-- switch's own placeholder `dst` register collided with `big`'s own +-- register, so the arm's trailing `print_int(big.f0)` silently +-- overwrote `big`'s only reference before the DROP ran); this +-- fixture's own oop-e2e.sh check (plain wovm) pins the *output*, not +-- the leak-freedom -- the two are complementary, not redundant. +class Big { + f0: Int + f1: Int + f2: Int + f3: Int + f4: Int + f5: Int + f6: Int + f7: Int + f8: Int + f9: Int + f10: Int + f11: Int + f12: Int + f13: Int + f14: Int + f15: Int + f16: Int + f17: Int + f18: Int + f19: Int + f20: Int + f21: Int + f22: Int + f23: Int + f24: Int + f25: Int + f26: Int + f27: Int + f28: Int + f29: Int + f30: Int + f31: Int + f32: Int + f33: Int + f34: Int + f35: Int + f36: Int + f37: Int + f38: Int + f39: Int + f40: Int + f41: Int + f42: Int + f43: Int + f44: Int + f45: Int + f46: Int + f47: Int + f48: Int + f49: Int + f50: Int + f51: Int + f52: Int + f53: Int + f54: Int + f55: Int + f56: Int + f57: Int + f58: Int + f59: Int + f60: Int + f61: Int + f62: Int + f63: Int + f64: Int + f65: Int + f66: Int + f67: Int + f68: Int + f69: Int + f70: Int + f71: Int + f72: Int + f73: Int + f74: Int + f75: Int + f76: Int + f77: Int + f78: Int + f79: Int + f80: Int + f81: Int + f82: Int + f83: Int + f84: Int + f85: Int + f86: Int + f87: Int + f88: Int + f89: Int + f90: Int + f91: Int + f92: Int + f93: Int + f94: Int + f95: Int + f96: Int + f97: Int + f98: Int + f99: Int + f100: Int + f101: Int + f102: Int + f103: Int + f104: Int + f105: Int + f106: Int + f107: Int + f108: Int + f109: Int + f110: Int + f111: Int + f112: Int + f113: Int + f114: Int + f115: Int + f116: Int + f117: Int + f118: Int + f119: Int + f120: Int + f121: Int + f122: Int + f123: Int + f124: Int + f125: Int + f126: Int + f127: Int + f128: Int + f129: Int +} + +fn main() -> Int { + let i = 0; + while i < 3 { + switch i { + case 1: + let big = Big { f0: 1, f1: 1, f2: 1, f3: 1, f4: 1, f5: 1, f6: 1, f7: 1, f8: 1, f9: 1, f10: 1, f11: 1, f12: 1, f13: 1, f14: 1, f15: 1, f16: 1, f17: 1, f18: 1, f19: 1, f20: 1, f21: 1, f22: 1, f23: 1, f24: 1, f25: 1, f26: 1, f27: 1, f28: 1, f29: 1, f30: 1, f31: 1, f32: 1, f33: 1, f34: 1, f35: 1, f36: 1, f37: 1, f38: 1, f39: 1, f40: 1, f41: 1, f42: 1, f43: 1, f44: 1, f45: 1, f46: 1, f47: 1, f48: 1, f49: 1, f50: 1, f51: 1, f52: 1, f53: 1, f54: 1, f55: 1, f56: 1, f57: 1, f58: 1, f59: 1, f60: 1, f61: 1, f62: 1, f63: 1, f64: 1, f65: 1, f66: 1, f67: 1, f68: 1, f69: 1, f70: 1, f71: 1, f72: 1, f73: 1, f74: 1, f75: 1, f76: 1, f77: 1, f78: 1, f79: 1, f80: 1, f81: 1, f82: 1, f83: 1, f84: 1, f85: 1, f86: 1, f87: 1, f88: 1, f89: 1, f90: 1, f91: 1, f92: 1, f93: 1, f94: 1, f95: 1, f96: 1, f97: 1, f98: 1, f99: 1, f100: 1, f101: 1, f102: 1, f103: 1, f104: 1, f105: 1, f106: 1, f107: 1, f108: 1, f109: 1, f110: 1, f111: 1, f112: 1, f113: 1, f114: 1, f115: 1, f116: 1, f117: 1, f118: 1, f119: 1, f120: 1, f121: 1, f122: 1, f123: 1, f124: 1, f125: 1, f126: 1, f127: 1, f128: 1, f129: 1 }; + print_int(big.f0); + default: + print("skip"); + } + i = i + 1; + } + print("done"); + return 0; +} diff --git a/tests/corpus/run/lang-switch-class-arm-leak/fixture.out b/tests/corpus/run/lang-switch-class-arm-leak/fixture.out new file mode 100644 index 0000000..e8183f0 --- /dev/null +++ b/tests/corpus/run/lang-switch-class-arm-leak/fixture.out @@ -0,0 +1,3 @@ +1 +1 +1 diff --git a/tests/corpus/run/lang-switch-class-arm-leak/fixture.wo b/tests/corpus/run/lang-switch-class-arm-leak/fixture.wo new file mode 100644 index 0000000..7124af6 --- /dev/null +++ b/tests/corpus/run/lang-switch-class-arm-leak/fixture.wo @@ -0,0 +1,161 @@ +-- haxe-parity Task 3, review fix (Critical 3): `let w = switch ...` +-- with NO `: Type` annotation used to leak every single iteration -- +-- owner.ml's `expr_ty` returned `None` for a `Switch` (a deliberate, +-- but wrong, "not chased" call from the original task), and +-- `analyze_let`'s own fallback for `expr_ty = None` is `Scalar "Int"` +-- (Copy-classified, never dropped) -- so an unannotated switch-valued +-- `let` binding a plain class (no union involved) was silently never +-- freed. `Big` has 130 Int fields (the same arena-ceiling trick +-- lang-break-owned-drop/lang-switch-arm-drop already use: 1040 bytes +-- crosses the 1024-byte size-class ceiling, so a missed DROP is a +-- hard, observable ASan leak, not a silent miss lost in the arena's +-- own small-object reuse). RED (fix disabled): 3168 bytes leaked +-- across the 3 loop iterations, one object each, confirmed under +-- `runtime/build/wovm_asan` (task-3-report.md has the transcript). +-- GREEN (fix restored, this fixture): clean under both plain `wovm` +-- and `wovm_asan`. +class Big { + f0: Int + f1: Int + f2: Int + f3: Int + f4: Int + f5: Int + f6: Int + f7: Int + f8: Int + f9: Int + f10: Int + f11: Int + f12: Int + f13: Int + f14: Int + f15: Int + f16: Int + f17: Int + f18: Int + f19: Int + f20: Int + f21: Int + f22: Int + f23: Int + f24: Int + f25: Int + f26: Int + f27: Int + f28: Int + f29: Int + f30: Int + f31: Int + f32: Int + f33: Int + f34: Int + f35: Int + f36: Int + f37: Int + f38: Int + f39: Int + f40: Int + f41: Int + f42: Int + f43: Int + f44: Int + f45: Int + f46: Int + f47: Int + f48: Int + f49: Int + f50: Int + f51: Int + f52: Int + f53: Int + f54: Int + f55: Int + f56: Int + f57: Int + f58: Int + f59: Int + f60: Int + f61: Int + f62: Int + f63: Int + f64: Int + f65: Int + f66: Int + f67: Int + f68: Int + f69: Int + f70: Int + f71: Int + f72: Int + f73: Int + f74: Int + f75: Int + f76: Int + f77: Int + f78: Int + f79: Int + f80: Int + f81: Int + f82: Int + f83: Int + f84: Int + f85: Int + f86: Int + f87: Int + f88: Int + f89: Int + f90: Int + f91: Int + f92: Int + f93: Int + f94: Int + f95: Int + f96: Int + f97: Int + f98: Int + f99: Int + f100: Int + f101: Int + f102: Int + f103: Int + f104: Int + f105: Int + f106: Int + f107: Int + f108: Int + f109: Int + f110: Int + f111: Int + f112: Int + f113: Int + f114: Int + f115: Int + f116: Int + f117: Int + f118: Int + f119: Int + f120: Int + f121: Int + f122: Int + f123: Int + f124: Int + f125: Int + f126: Int + f127: Int + f128: Int + f129: Int +} + +fn main() -> Int { + let i = 0; + while i < 3 { + let w = switch i { + case 0: Big { f0: 1, f1: 1, f2: 1, f3: 1, f4: 1, f5: 1, f6: 1, f7: 1, f8: 1, f9: 1, f10: 1, f11: 1, f12: 1, f13: 1, f14: 1, f15: 1, f16: 1, f17: 1, f18: 1, f19: 1, f20: 1, f21: 1, f22: 1, f23: 1, f24: 1, f25: 1, f26: 1, f27: 1, f28: 1, f29: 1, f30: 1, f31: 1, f32: 1, f33: 1, f34: 1, f35: 1, f36: 1, f37: 1, f38: 1, f39: 1, f40: 1, f41: 1, f42: 1, f43: 1, f44: 1, f45: 1, f46: 1, f47: 1, f48: 1, f49: 1, f50: 1, f51: 1, f52: 1, f53: 1, f54: 1, f55: 1, f56: 1, f57: 1, f58: 1, f59: 1, f60: 1, f61: 1, f62: 1, f63: 1, f64: 1, f65: 1, f66: 1, f67: 1, f68: 1, f69: 1, f70: 1, f71: 1, f72: 1, f73: 1, f74: 1, f75: 1, f76: 1, f77: 1, f78: 1, f79: 1, f80: 1, f81: 1, f82: 1, f83: 1, f84: 1, f85: 1, f86: 1, f87: 1, f88: 1, f89: 1, f90: 1, f91: 1, f92: 1, f93: 1, f94: 1, f95: 1, f96: 1, f97: 1, f98: 1, f99: 1, f100: 1, f101: 1, f102: 1, f103: 1, f104: 1, f105: 1, f106: 1, f107: 1, f108: 1, f109: 1, f110: 1, f111: 1, f112: 1, f113: 1, f114: 1, f115: 1, f116: 1, f117: 1, f118: 1, f119: 1, f120: 1, f121: 1, f122: 1, f123: 1, f124: 1, f125: 1, f126: 1, f127: 1, f128: 1, f129: 1 }; + default: Big { f0: 1, f1: 1, f2: 1, f3: 1, f4: 1, f5: 1, f6: 1, f7: 1, f8: 1, f9: 1, f10: 1, f11: 1, f12: 1, f13: 1, f14: 1, f15: 1, f16: 1, f17: 1, f18: 1, f19: 1, f20: 1, f21: 1, f22: 1, f23: 1, f24: 1, f25: 1, f26: 1, f27: 1, f28: 1, f29: 1, f30: 1, f31: 1, f32: 1, f33: 1, f34: 1, f35: 1, f36: 1, f37: 1, f38: 1, f39: 1, f40: 1, f41: 1, f42: 1, f43: 1, f44: 1, f45: 1, f46: 1, f47: 1, f48: 1, f49: 1, f50: 1, f51: 1, f52: 1, f53: 1, f54: 1, f55: 1, f56: 1, f57: 1, f58: 1, f59: 1, f60: 1, f61: 1, f62: 1, f63: 1, f64: 1, f65: 1, f66: 1, f67: 1, f68: 1, f69: 1, f70: 1, f71: 1, f72: 1, f73: 1, f74: 1, f75: 1, f76: 1, f77: 1, f78: 1, f79: 1, f80: 1, f81: 1, f82: 1, f83: 1, f84: 1, f85: 1, f86: 1, f87: 1, f88: 1, f89: 1, f90: 1, f91: 1, f92: 1, f93: 1, f94: 1, f95: 1, f96: 1, f97: 1, f98: 1, f99: 1, f100: 1, f101: 1, f102: 1, f103: 1, f104: 1, f105: 1, f106: 1, f107: 1, f108: 1, f109: 1, f110: 1, f111: 1, f112: 1, f113: 1, f114: 1, f115: 1, f116: 1, f117: 1, f118: 1, f119: 1, f120: 1, f121: 1, f122: 1, f123: 1, f124: 1, f125: 1, f126: 1, f127: 1, f128: 1, f129: 1 }; + }; + print_int(w.f0); + i = i + 1; + } + return 0; +} diff --git a/tests/corpus/run/lang-switch-default-not-last/fixture.out b/tests/corpus/run/lang-switch-default-not-last/fixture.out new file mode 100644 index 0000000..dd79d18 --- /dev/null +++ b/tests/corpus/run/lang-switch-default-not-last/fixture.out @@ -0,0 +1,3 @@ +one +two +many diff --git a/tests/corpus/run/lang-switch-default-not-last/fixture.wo b/tests/corpus/run/lang-switch-default-not-last/fixture.wo new file mode 100644 index 0000000..2de7ba3 --- /dev/null +++ b/tests/corpus/run/lang-switch-default-not-last/fixture.wo @@ -0,0 +1,27 @@ +-- haxe-parity Task 3, review fix (Critical 1): `default` textually +-- BEFORE some `case` arms used to silently kill every arm after it -- +-- `default` has no comparison of its own, so lowering the arms in raw +-- source order meant nothing ever jumped into a `case` written after +-- it, and `default`'s own body jumped straight past it to the +-- switch's exit. Reviewer-reproduced repro shape, verbatim: with the +-- bug, `classify(2)` returned "many" (default's own value) instead of +-- "two". Fixed by lowering `default` last regardless of source +-- position (ast.ml's `switch_lowering_order`); this fixture pins the +-- corrected *runtime* behavior (a `--dump-owner`/typecheck assertion +-- can't see this — only actually running the compare-and-jump chain +-- proves the arm was reachable again). +fn classify(n: Int) -> Text { + let v = switch n { + default: "many"; + case 1: "one"; + case 2: "two"; + }; + return v; +} + +fn main() -> Int { + print(classify(1)); + print(classify(2)); + print(classify(3)); + return 0; +} diff --git a/tests/corpus/run/lang-switch-stmt/fixture.out b/tests/corpus/run/lang-switch-stmt/fixture.out new file mode 100644 index 0000000..dd79d18 --- /dev/null +++ b/tests/corpus/run/lang-switch-stmt/fixture.out @@ -0,0 +1,3 @@ +one +two +many diff --git a/tests/corpus/run/lang-switch-stmt/fixture.wo b/tests/corpus/run/lang-switch-stmt/fixture.wo new file mode 100644 index 0000000..c6e33fc --- /dev/null +++ b/tests/corpus/run/lang-switch-stmt/fixture.wo @@ -0,0 +1,27 @@ +-- haxe-parity Task 3: `switch` in statement position -- "one construct, +-- not two" (the brief's own words): this is the exact same `Ast.Switch` +-- node as the value-yielding fixture, just reached as a bare +-- `ExprStmt`, its value discarded. Each arm ends in a plain +-- `print(...)` (an `ExprStmt`, not `return`) so this exercises the +-- real discard-mode write-then-ignore path -- the register-aliasing +-- bug this task's own ASan fixture (lang-switch-arm-drop) found lived +-- exactly here (a statement-position switch's own placeholder `dst` +-- colliding with an arm's own register), so a plain, ownership-free +-- version of the same shape is worth pinning on its own. +fn describe(n: Int) { + switch n { + case 1: + print("one"); + case 2: + print("two"); + default: + print("many"); + } +} + +fn main() -> Int { + describe(1); + describe(2); + describe(3); + return 0; +} diff --git a/tests/corpus/run/lang-switch-value/fixture.out b/tests/corpus/run/lang-switch-value/fixture.out new file mode 100644 index 0000000..c79e441 --- /dev/null +++ b/tests/corpus/run/lang-switch-value/fixture.out @@ -0,0 +1,9 @@ +OK +Gone +Gone +Server Error +Unknown +hi alice +hi bob +hi bob +hi stranger diff --git a/tests/corpus/run/lang-switch-value/fixture.wo b/tests/corpus/run/lang-switch-value/fixture.wo new file mode 100644 index 0000000..5fb6c94 --- /dev/null +++ b/tests/corpus/run/lang-switch-value/fixture.wo @@ -0,0 +1,38 @@ +-- haxe-parity Task 3: `switch` as an expression -- value-yielding over +-- both subjects this task covers (Int, Text), proving arm selection +-- (each case fires only for its own value, multi-value `case a, b:` +-- fires for either) and the required `default` fires for anything +-- else. `status_of`/`greet` mirror the sample's own shape +-- (docs/examples/log-watcher/mcp.wo's `status_text`/`dispatch`) closely +-- enough to be a real proof, not a toy: a `let`-bound switch result, +-- multiple values per case, `default` last. +fn status_of(code: Int) -> Text { + let text = switch code { + case 200: "OK"; + case 404, 410: "Gone"; + case 500: "Server Error"; + default: "Unknown"; + }; + return text; +} + +fn greet(name: Text) -> Text { + return switch name { + case "alice": "hi alice"; + case "bob", "bobby": "hi bob"; + default: "hi stranger"; + }; +} + +fn main() -> Int { + print(status_of(200)); + print(status_of(404)); + print(status_of(410)); + print(status_of(500)); + print(status_of(1)); + print(greet("alice")); + print(greet("bob")); + print(greet("bobby")); + print(greet("carol")); + return 0; +} diff --git a/tests/corpus/run/lang-typedef-record/fixture.out b/tests/corpus/run/lang-typedef-record/fixture.out new file mode 100644 index 0000000..5c37307 --- /dev/null +++ b/tests/corpus/run/lang-typedef-record/fixture.out @@ -0,0 +1,5 @@ +7 +seven +1 +one +noted diff --git a/tests/corpus/run/lang-typedef-record/fixture.wo b/tests/corpus/run/lang-typedef-record/fixture.wo new file mode 100644 index 0000000..6e6e38a --- /dev/null +++ b/tests/corpus/run/lang-typedef-record/fixture.wo @@ -0,0 +1,23 @@ +-- haxe-parity Task 4: `typedef` record round-trip. Field defaults fill +-- the fields a brace literal omits (`Rec {}` is the sample's own +-- `TailState {}` pattern), and a `?field` is nullable-by-shape: omitted +-- means nil (the zero word NEW already leaves there), supplied means the +-- value sticks. `note` is only ever read from the literal that supplied +-- it -- reading an omitted `?field` is Task 6's forced-handling story, +-- not this fixture's. +typedef Rec = { + n: Int = 7 + name: Text = "seven" + ?note: Text +} + +fn main() -> Int { + let r = Rec {} + print_int(r.n) + print(r.name) + let s = Rec { n: 1, name: "one", note: "noted" } + print_int(s.n) + print(s.name) + print(s.note) + return 0 +} diff --git a/tests/corpus/run/lang-typedef-structural/fixture.out b/tests/corpus/run/lang-typedef-structural/fixture.out new file mode 100644 index 0000000..a54ac08 --- /dev/null +++ b/tests/corpus/run/lang-typedef-structural/fixture.out @@ -0,0 +1,2 @@ +answer +42 diff --git a/tests/corpus/run/lang-typedef-structural/fixture.wo b/tests/corpus/run/lang-typedef-structural/fixture.wo new file mode 100644 index 0000000..64ea127 --- /dev/null +++ b/tests/corpus/run/lang-typedef-structural/fixture.wo @@ -0,0 +1,19 @@ +-- haxe-parity Task 4: typedef records are STRUCTURAL aliases -- two +-- typedefs with the same shape (same fields, same order, same types) +-- are the same type. `A` and `B` below share one compiler-generated +-- class-table entry (pinned by a runner.ml direct assertion over the +-- disassembly; this fixture pins the observable half: a value built as +-- `A` flows through a parameter declared `B` and back out unchanged). +typedef A = { n: Int, tag: Text } +typedef B = { n: Int, tag: Text } + +fn show(r: B) -> Int { + print(r.tag) + return r.n +} + +fn main() -> Int { + let a = A { n: 42, tag: "answer" } + print_int(show(a)) + return 0 +} diff --git a/tests/corpus/run/lang-use-crossmodule/fixture.out b/tests/corpus/run/lang-use-crossmodule/fixture.out new file mode 100644 index 0000000..d96a66e --- /dev/null +++ b/tests/corpus/run/lang-use-crossmodule/fixture.out @@ -0,0 +1 @@ +hi from greet diff --git a/tests/corpus/run/lang-use-crossmodule/fixture.wo b/tests/corpus/run/lang-use-crossmodule/fixture.wo new file mode 100644 index 0000000..56b1e48 --- /dev/null +++ b/tests/corpus/run/lang-use-crossmodule/fixture.wo @@ -0,0 +1,11 @@ +-- haxe-parity Task 1 (modules): a cross-module call through `use`. +-- `greet` (this fixture's own `greet/` subdirectory) is a project- +-- relative module, resolved by directory — not one of the six reserved +-- stdlib namespaces. `greet.hello()` lowers exactly like a bare free-fn +-- call (emit.ml): the `use` alias's only job was proving, at typecheck +-- time, that the reference was legitimately in scope. +use greet + +fn main() { + print(greet.hello()) +} diff --git a/tests/corpus/run/lang-use-crossmodule/greet/greet.wo b/tests/corpus/run/lang-use-crossmodule/greet/greet.wo new file mode 100644 index 0000000..cce3263 --- /dev/null +++ b/tests/corpus/run/lang-use-crossmodule/greet/greet.wo @@ -0,0 +1,8 @@ +-- haxe-parity Task 1 (modules): a project-relative module. Its +-- directory (relative to the fixture root, `greet/`) IS its module +-- identity — no manifest, no declared name. `pub` exports `hello` to +-- callers that `use greet`; without `pub` this would be WO-E217 +-- (private-name-access) from fixture.wo. +pub fn hello() -> Text { + return "hi from greet" +} diff --git a/tests/corpus/run/lang-use-local-shadows-alias/fixture.out b/tests/corpus/run/lang-use-local-shadows-alias/fixture.out new file mode 100644 index 0000000..d81cc07 --- /dev/null +++ b/tests/corpus/run/lang-use-local-shadows-alias/fixture.out @@ -0,0 +1 @@ +42 diff --git a/tests/corpus/run/lang-use-local-shadows-alias/fixture.wo b/tests/corpus/run/lang-use-local-shadows-alias/fixture.wo new file mode 100644 index 0000000..20b62ae --- /dev/null +++ b/tests/corpus/run/lang-use-local-shadows-alias/fixture.wo @@ -0,0 +1,22 @@ +-- haxe-parity Task 1 (modules), review fix IMPORTANT 2: `secret` is +-- both a real `use` alias (secret/secret.wo) AND, inside `main`, a local +-- variable of type `Box`. `secret.hidden()` must be Box's own method +-- call on the local — lexical scope wins over a module alias, exactly +-- like everywhere else in every language with both. A regression that +-- let the module alias win instead would either misresolve this call +-- entirely or bogusly demand `secret.hidden` (secret/secret.wo's free +-- fn) be `pub` — see compile-fail/lang-use-private-access for the +-- companion case where no local intervenes and E217 still fires. +use secret + +class Box { + n: Int + fn hidden() -> Int { + return self.n + } +} + +fn main() { + let secret = Box { n: 42 } + print_int(secret.hidden()) +} diff --git a/tests/corpus/run/lang-use-local-shadows-alias/secret/secret.wo b/tests/corpus/run/lang-use-local-shadows-alias/secret/secret.wo new file mode 100644 index 0000000..5cbaae5 --- /dev/null +++ b/tests/corpus/run/lang-use-local-shadows-alias/secret/secret.wo @@ -0,0 +1,7 @@ +-- Present only to make `secret` a real, discoverable module — this +-- fixture's whole point is that fixture.wo's own local variable named +-- `secret` must win over this module's alias, so nothing here is ever +-- meant to be reached. +fn hidden() -> Int { + return -1 +} diff --git a/tests/corpus/run/lang-use-qualified-dispatch/a/a.wo b/tests/corpus/run/lang-use-qualified-dispatch/a/a.wo new file mode 100644 index 0000000..9320d8d --- /dev/null +++ b/tests/corpus/run/lang-use-qualified-dispatch/a/a.wo @@ -0,0 +1,3 @@ +pub fn thing() -> Text { + return "from a" +} diff --git a/tests/corpus/run/lang-use-qualified-dispatch/b/b.wo b/tests/corpus/run/lang-use-qualified-dispatch/b/b.wo new file mode 100644 index 0000000..92c9082 --- /dev/null +++ b/tests/corpus/run/lang-use-qualified-dispatch/b/b.wo @@ -0,0 +1,3 @@ +pub fn thing() -> Text { + return "from b" +} diff --git a/tests/corpus/run/lang-use-qualified-dispatch/fixture.out b/tests/corpus/run/lang-use-qualified-dispatch/fixture.out new file mode 100644 index 0000000..31d253c --- /dev/null +++ b/tests/corpus/run/lang-use-qualified-dispatch/fixture.out @@ -0,0 +1,2 @@ +from a +from b diff --git a/tests/corpus/run/lang-use-qualified-dispatch/fixture.wo b/tests/corpus/run/lang-use-qualified-dispatch/fixture.wo new file mode 100644 index 0000000..9a3a032 --- /dev/null +++ b/tests/corpus/run/lang-use-qualified-dispatch/fixture.wo @@ -0,0 +1,16 @@ +-- haxe-parity Task 1 (modules), review fix CRITICAL 1: `a` and `b` both +-- declare `pub fn thing()`. Bare `thing()` would be WO-E218 (ambiguous — +-- see compile-fail/lang-use-collision); qualifying disambiguates, and +-- each qualified call MUST dispatch to its own module's own +-- implementation, never silently share whichever one a name-only merge +-- happened to keep. Pinned by two genuinely different strings, not just +-- "it compiles" — a regression that made both calls execute the same +-- body would still compile clean and only be caught by this exact +-- byte-for-byte stdout check. +use a +use b + +fn main() { + print(a.thing()) + print(b.thing()) +} diff --git a/tests/corpus/run/lang-variant-arm-drop/fixture.out b/tests/corpus/run/lang-variant-arm-drop/fixture.out new file mode 100644 index 0000000..d679731 --- /dev/null +++ b/tests/corpus/run/lang-variant-arm-drop/fixture.out @@ -0,0 +1,7 @@ +tick +1 +boot 1 +2 +tick +3 +done diff --git a/tests/corpus/run/lang-variant-arm-drop/fixture.wo b/tests/corpus/run/lang-variant-arm-drop/fixture.wo new file mode 100644 index 0000000..2b55181 --- /dev/null +++ b/tests/corpus/run/lang-variant-arm-drop/fixture.wo @@ -0,0 +1,193 @@ +-- haxe-parity Task 4: drop correctness around payload-binding switch +-- arms (lang-switch-arm-drop is the model). Everything here must hold +-- under runtime/build/wovm_asan, not just plain wovm: +-- 1. the subject (`ev`, an owned variant object) is dropped exactly +-- once, at its own scope end -- its per-variant class-table kinds +-- free the payload recursively (Log's CONCAT-built Text; Boxed's +-- embedded Big -- 130 Int fields, past the arena's 1024-byte +-- ceiling, so any miss is a hard ASan failure, not a silent one); +-- 2. `line`/`b`, the arms' payload bindings, are BORROWS of the +-- subject's fields -- never dropped by their arm, or the subject's +-- own drop double-frees; +-- 3. `big` (arm-local owned value in `case Log`) still gets its +-- ordinary arm-scope drop alongside the binding; +-- 4. `mk(2)`'s local Big is MOVED into `Boxed(big)` -- the variant +-- construction is a ctor-field escape (owner.ml), so the local +-- must NOT also drop at mk's return: that would double-free the +-- Big the variant object now owns; +-- 5. `w`, a variant object from a DIRECT construction (not through a +-- declared-return fn), is classified owned through the +-- construction itself and dropped at main's end. +type Ev = Tick | Log(line: Text) | Boxed(b: Big) + +class Big { + f0: Int + f1: Int + f2: Int + f3: Int + f4: Int + f5: Int + f6: Int + f7: Int + f8: Int + f9: Int + f10: Int + f11: Int + f12: Int + f13: Int + f14: Int + f15: Int + f16: Int + f17: Int + f18: Int + f19: Int + f20: Int + f21: Int + f22: Int + f23: Int + f24: Int + f25: Int + f26: Int + f27: Int + f28: Int + f29: Int + f30: Int + f31: Int + f32: Int + f33: Int + f34: Int + f35: Int + f36: Int + f37: Int + f38: Int + f39: Int + f40: Int + f41: Int + f42: Int + f43: Int + f44: Int + f45: Int + f46: Int + f47: Int + f48: Int + f49: Int + f50: Int + f51: Int + f52: Int + f53: Int + f54: Int + f55: Int + f56: Int + f57: Int + f58: Int + f59: Int + f60: Int + f61: Int + f62: Int + f63: Int + f64: Int + f65: Int + f66: Int + f67: Int + f68: Int + f69: Int + f70: Int + f71: Int + f72: Int + f73: Int + f74: Int + f75: Int + f76: Int + f77: Int + f78: Int + f79: Int + f80: Int + f81: Int + f82: Int + f83: Int + f84: Int + f85: Int + f86: Int + f87: Int + f88: Int + f89: Int + f90: Int + f91: Int + f92: Int + f93: Int + f94: Int + f95: Int + f96: Int + f97: Int + f98: Int + f99: Int + f100: Int + f101: Int + f102: Int + f103: Int + f104: Int + f105: Int + f106: Int + f107: Int + f108: Int + f109: Int + f110: Int + f111: Int + f112: Int + f113: Int + f114: Int + f115: Int + f116: Int + f117: Int + f118: Int + f119: Int + f120: Int + f121: Int + f122: Int + f123: Int + f124: Int + f125: Int + f126: Int + f127: Int + f128: Int + f129: Int +} + +fn mk_big() -> Big { + return Big { f0: 1, f1: 2, f2: 3, f3: 1, f4: 1, f5: 1, f6: 1, f7: 1, f8: 1, f9: 1, f10: 1, f11: 1, f12: 1, f13: 1, f14: 1, f15: 1, f16: 1, f17: 1, f18: 1, f19: 1, f20: 1, f21: 1, f22: 1, f23: 1, f24: 1, f25: 1, f26: 1, f27: 1, f28: 1, f29: 1, f30: 1, f31: 1, f32: 1, f33: 1, f34: 1, f35: 1, f36: 1, f37: 1, f38: 1, f39: 1, f40: 1, f41: 1, f42: 1, f43: 1, f44: 1, f45: 1, f46: 1, f47: 1, f48: 1, f49: 1, f50: 1, f51: 1, f52: 1, f53: 1, f54: 1, f55: 1, f56: 1, f57: 1, f58: 1, f59: 1, f60: 1, f61: 1, f62: 1, f63: 1, f64: 1, f65: 1, f66: 1, f67: 1, f68: 1, f69: 1, f70: 1, f71: 1, f72: 1, f73: 1, f74: 1, f75: 1, f76: 1, f77: 1, f78: 1, f79: 1, f80: 1, f81: 1, f82: 1, f83: 1, f84: 1, f85: 1, f86: 1, f87: 1, f88: 1, f89: 1, f90: 1, f91: 1, f92: 1, f93: 1, f94: 1, f95: 1, f96: 1, f97: 1, f98: 1, f99: 1, f100: 1, f101: 1, f102: 1, f103: 1, f104: 1, f105: 1, f106: 1, f107: 1, f108: 1, f109: 1, f110: 1, f111: 1, f112: 1, f113: 1, f114: 1, f115: 1, f116: 1, f117: 1, f118: 1, f119: 1, f120: 1, f121: 1, f122: 1, f123: 1, f124: 1, f125: 1, f126: 1, f127: 1, f128: 1, f129: 1 } +} + +fn mk(n: Int) -> Ev { + if n == 1 { return Log("boot " .. int_to_text(n)) } + if n == 2 { + let big = mk_big(); + return Boxed(big); + } + return Tick +} + +fn main() -> Int { + let i = 0; + while i < 4 { + let ev = mk(i); + switch ev { + case Log(line): + let big = mk_big(); + print_int(big.f0); + print(line); + case Boxed(b): + print_int(b.f1); + case Tick: + print("tick"); + } + i = i + 1; + } + let w = Boxed(mk_big()); + switch w { + case Boxed(b): print_int(b.f2); + case Log(line): print(line); + case Tick: print("tick"); + } + print("done"); + return 0; +} diff --git a/tests/corpus/run/lang-variant-bare-union/fixture.out b/tests/corpus/run/lang-variant-bare-union/fixture.out new file mode 100644 index 0000000..9188eed --- /dev/null +++ b/tests/corpus/run/lang-variant-bare-union/fixture.out @@ -0,0 +1,3 @@ +hi +hi-eq +mid diff --git a/tests/corpus/run/lang-variant-bare-union/fixture.wo b/tests/corpus/run/lang-variant-bare-union/fixture.wo new file mode 100644 index 0000000..350c7e7 --- /dev/null +++ b/tests/corpus/run/lang-variant-bare-union/fixture.wo @@ -0,0 +1,27 @@ +-- haxe-parity Task 4: an all-bare union (the sample's own CronResult/ +-- NameKind shape) is pure scalar tags -- no heap object, no class-table +-- entry, `==` and `switch` lower to plain EQ. The union value also sits +-- in a typedef record field, which must emit as a SCALAR slot (kind 0): +-- a drop plan treating the tag integer as a pointer would be a hard +-- ASan/segfault failure, which is exactly what this fixture guards. +-- The switch has no `default`: all three variants are covered, so +-- WO-E208's union exhaustiveness rule must stay silent. +type Kind = Lo | Mid | Hi + +typedef Item = { kind: Kind, label: Text } + +fn name_of(k: Kind) -> Text { + return switch k { + case Lo: "lo"; + case Mid: "mid"; + case Hi: "hi"; + } +} + +fn main() -> Int { + let it = Item { kind: Hi, label: "x" } + print(name_of(it.kind)) + if it.kind == Hi { print("hi-eq") } + print(name_of(Mid)) + return 0 +} diff --git a/tests/corpus/run/lang-variant-payload-escape/fixture.out b/tests/corpus/run/lang-variant-payload-escape/fixture.out new file mode 100644 index 0000000..951e35f --- /dev/null +++ b/tests/corpus/run/lang-variant-payload-escape/fixture.out @@ -0,0 +1,2 @@ +1 +50 diff --git a/tests/corpus/run/lang-variant-payload-escape/fixture.wo b/tests/corpus/run/lang-variant-payload-escape/fixture.wo new file mode 100644 index 0000000..133f0d1 --- /dev/null +++ b/tests/corpus/run/lang-variant-payload-escape/fixture.wo @@ -0,0 +1,174 @@ +-- haxe-parity Task 4, fix round 1 (review Critical 1): a payload +-- binding ESCAPING its arm as the switch's value is a MOVE OUT of the +-- variant object. Three shapes, all ASan-verified: +-- 1. local subject (`v`): the escape arm nulls the shell's field, so +-- `v`'s own scope-end drop frees the shell only — `out` owns the +-- payload; without the null this exact shape double-freed +-- (reviewer-reproduced, plain wovm rc=139); +-- 2. borrowed-param subject (`get`'s `ev`): the payload moves out +-- through the borrow and returns to the caller; +-- 3. the caller's OWNED VARIANT TEMPORARY argument (`get(Boxed(..))`) +-- is reaped by the caller after the call — before this fix the +-- shell leaked ~30 B per iteration (reviewer's h5 probe: maxrss +-- 10,508 KB vs a 1,532 KB control over 300k iterations). +-- `Big` is 130 Int fields: past the arena's 1024-byte ceiling, so any +-- miss is a hard ASan failure. Defaults keep the literals short. +type Ev = Tick | Boxed(b: Big) + +class Big { + f0: Int = 1 + f1: Int = 1 + f2: Int = 1 + f3: Int = 1 + f4: Int = 1 + f5: Int = 1 + f6: Int = 1 + f7: Int = 1 + f8: Int = 1 + f9: Int = 1 + f10: Int = 1 + f11: Int = 1 + f12: Int = 1 + f13: Int = 1 + f14: Int = 1 + f15: Int = 1 + f16: Int = 1 + f17: Int = 1 + f18: Int = 1 + f19: Int = 1 + f20: Int = 1 + f21: Int = 1 + f22: Int = 1 + f23: Int = 1 + f24: Int = 1 + f25: Int = 1 + f26: Int = 1 + f27: Int = 1 + f28: Int = 1 + f29: Int = 1 + f30: Int = 1 + f31: Int = 1 + f32: Int = 1 + f33: Int = 1 + f34: Int = 1 + f35: Int = 1 + f36: Int = 1 + f37: Int = 1 + f38: Int = 1 + f39: Int = 1 + f40: Int = 1 + f41: Int = 1 + f42: Int = 1 + f43: Int = 1 + f44: Int = 1 + f45: Int = 1 + f46: Int = 1 + f47: Int = 1 + f48: Int = 1 + f49: Int = 1 + f50: Int = 1 + f51: Int = 1 + f52: Int = 1 + f53: Int = 1 + f54: Int = 1 + f55: Int = 1 + f56: Int = 1 + f57: Int = 1 + f58: Int = 1 + f59: Int = 1 + f60: Int = 1 + f61: Int = 1 + f62: Int = 1 + f63: Int = 1 + f64: Int = 1 + f65: Int = 1 + f66: Int = 1 + f67: Int = 1 + f68: Int = 1 + f69: Int = 1 + f70: Int = 1 + f71: Int = 1 + f72: Int = 1 + f73: Int = 1 + f74: Int = 1 + f75: Int = 1 + f76: Int = 1 + f77: Int = 1 + f78: Int = 1 + f79: Int = 1 + f80: Int = 1 + f81: Int = 1 + f82: Int = 1 + f83: Int = 1 + f84: Int = 1 + f85: Int = 1 + f86: Int = 1 + f87: Int = 1 + f88: Int = 1 + f89: Int = 1 + f90: Int = 1 + f91: Int = 1 + f92: Int = 1 + f93: Int = 1 + f94: Int = 1 + f95: Int = 1 + f96: Int = 1 + f97: Int = 1 + f98: Int = 1 + f99: Int = 1 + f100: Int = 1 + f101: Int = 1 + f102: Int = 1 + f103: Int = 1 + f104: Int = 1 + f105: Int = 1 + f106: Int = 1 + f107: Int = 1 + f108: Int = 1 + f109: Int = 1 + f110: Int = 1 + f111: Int = 1 + f112: Int = 1 + f113: Int = 1 + f114: Int = 1 + f115: Int = 1 + f116: Int = 1 + f117: Int = 1 + f118: Int = 1 + f119: Int = 1 + f120: Int = 1 + f121: Int = 1 + f122: Int = 1 + f123: Int = 1 + f124: Int = 1 + f125: Int = 1 + f126: Int = 1 + f127: Int = 1 + f128: Int = 1 + f129: Int = 1 +} + +fn get(ev: Ev) -> Big { + return switch ev { + case Boxed(b): b; + case Tick: Big {}; + } +} + +fn main() -> Int { + let v = Boxed(Big {}) + let out = switch v { + case Tick: Big {}; + case Boxed(b): b; + } + print_int(out.f0) + let i = 0 + let acc = 0 + while i < 50 { + let x = get(Boxed(Big {})) + acc = acc + x.f0 + i = i + 1 + } + print_int(acc) + return 0 +} diff --git a/tests/corpus/run/lang-variant-payload/fixture.out b/tests/corpus/run/lang-variant-payload/fixture.out new file mode 100644 index 0000000..d66a070 --- /dev/null +++ b/tests/corpus/run/lang-variant-payload/fixture.out @@ -0,0 +1,3 @@ +pending +boom +direct 9 diff --git a/tests/corpus/run/lang-variant-payload/fixture.wo b/tests/corpus/run/lang-variant-payload/fixture.wo new file mode 100644 index 0000000..77fe979 --- /dev/null +++ b/tests/corpus/run/lang-variant-payload/fixture.wo @@ -0,0 +1,35 @@ +-- haxe-parity Task 4: enum payload variants. `Status` mixes a bare +-- variant and a payload variant, so every `Status` value is a variant +-- object (a compiler-generated class entry per variant; the tag is the +-- object header's own class id -- docs/plan/oop-vm/00-wob-format.md's +-- variant convention). Construction is by variant name (`Pending`, +-- `Failed("boom")`); the switch is exhaustive (both variants covered, +-- no `default` needed -- WO-E208's union rule) and `case +-- Failed(reason):` binds the payload field in its arm. +type Status = Pending | Failed(reason: Text) + +fn mk(n: Int) -> Status { + if n == 1 { return Failed("boom") } + return Pending +} + +fn classify(st: Status) -> Text { + return switch st { + case Pending: "pending"; + case Failed(reason): reason; + } +} + +fn main() -> Int { + let a = mk(0) + let b = mk(1) + print(classify(a)) + print(classify(b)) + -- direct construction (not through a declared-return fn): the owner + -- pass must classify `d` Owned through the variant construction + -- itself, or this CONCAT-built payload leaks (ASan-proven RED when + -- that classification is stubbed out -- task report). + let d = Failed("direct " .. int_to_text(9)) + print(classify(d)) + return 0 +} diff --git a/tests/corpus/run/lang-variant-scalar-payload/fixture.out b/tests/corpus/run/lang-variant-scalar-payload/fixture.out new file mode 100644 index 0000000..fd3c81a --- /dev/null +++ b/tests/corpus/run/lang-variant-scalar-payload/fixture.out @@ -0,0 +1,2 @@ +5 +5 diff --git a/tests/corpus/run/lang-variant-scalar-payload/fixture.wo b/tests/corpus/run/lang-variant-scalar-payload/fixture.wo new file mode 100644 index 0000000..1b68a64 --- /dev/null +++ b/tests/corpus/run/lang-variant-scalar-payload/fixture.wo @@ -0,0 +1,20 @@ +-- haxe-parity Task 4, fix round 2 (review NEW 1): escaping a SCALAR +-- payload field is a COPY, never a move — there is no ownership to +-- transfer, and the move-out's SETF-0 corrupted the subject (the +-- reviewer's m3d probe read 0 where 5 lived on a re-switch). The +-- second switch over the SAME subject must still see 5. +type Ev = Tick | Wrap(n: Int) + +fn main() -> Int { + let v = Wrap(5) + let x = switch v { + case Tick: 0; + case Wrap(n): n; + } + print_int(x) + switch v { + case Tick: print("tick"); + case Wrap(n): print_int(n); + } + return 0 +}