diff --git a/compiler/bin/main.ml b/compiler/bin/main.ml index 7029464..0c395eb 100644 --- a/compiler/bin/main.ml +++ b/compiler/bin/main.ml @@ -360,13 +360,15 @@ let typecheck_all (collector : Woc_lib.Diag.Collector.t) ~(root : string) (* haxe-parity Task 5: the predeclared `Error` record joins the merged table only — see Types.with_builtin_records for why not per-file. *) let syms = Woc_lib.Types.with_builtin_records (merge_symbols (List.map snd per_file_syms)) in - (* iteration 7b Phase 2: classify GC-ness once (structural SCC over the class - graph, union'd with surviving @gc annotations) and inject the traced set - into the merged table AND every module table, so Types.is_gc_class answers - from inference everywhere (field kinds, owner exemptions, the class flag). *) - let traced = Woc_lib.Gcinfer.traced_names (Woc_lib.Gcinfer.classify syms) in - let syms = { syms with Woc_lib.Types.traced } in - Hashtbl.fold (fun k v acc -> (k, { v with Woc_lib.Types.traced }) :: acc) module_syms [] + (* iteration 7b: infer GC-ness once (structural SCC + demand promotion) and + inject the traced set into the merged table AND every module table, so + Types.is_gc_class answers from inference everywhere (field kinds, owner + exemptions, the class flag). One library call — the unit tests call the + same Gcinfer.infer, so classification is identical in both. *) + let syms = Woc_lib.Gcinfer.infer parsed syms in + Hashtbl.fold + (fun k v acc -> (k, { v with Woc_lib.Types.traced = syms.Woc_lib.Types.traced }) :: acc) + module_syms [] |> List.iter (fun (k, v) -> Hashtbl.replace module_syms k v); (* `~file_syms` (hotfix, multi-file double-report): `per_file_syms` and `parsed` are both `List.map`s over the same original file list, in @@ -379,38 +381,6 @@ let typecheck_all (collector : Woc_lib.Diag.Collector.t) ~(root : string) (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; - (* iteration 7b Phase 2b — demand promotion. Run ownership in collect mode - over every file (structural traced already in place); any owned class value - that would fail the escape rule (a shape that only a traced class can hold) - records its class. Fixpoint: promotions only grow (bounded by class count), - so this terminates — one or two passes in practice. The throwaway collector - is discarded; this pass reports nothing. *) - let traced_full = ref syms.Woc_lib.Types.traced in - let throwaway = Woc_lib.Diag.Collector.create () in - let changed = ref true in - while !changed do - let promoted = Hashtbl.create 16 in - let syms_c = { syms with Woc_lib.Types.traced = !traced_full } in - List.iter - (fun (f, prog) -> - ignore - (Woc_lib.Owner.analyze ~file:f - ~promote:(Some (fun c -> Hashtbl.replace promoted c ())) - prog syms_c throwaway)) - parsed; - let next = - Hashtbl.fold - (fun c () acc -> Woc_lib.Types.StringSet.add c acc) - promoted !traced_full - in - changed := not (Woc_lib.Types.StringSet.equal next !traced_full); - traced_full := next - done; - let syms = { syms with Woc_lib.Types.traced = !traced_full } in - Hashtbl.fold - (fun k v acc -> (k, { v with Woc_lib.Types.traced = !traced_full }) :: acc) - module_syms [] - |> List.iter (fun (k, v) -> Hashtbl.replace module_syms k v); (syms, module_syms) let dump_tokens path = diff --git a/compiler/src/dune b/compiler/src/dune index 87dc4b3..5df47f1 100644 --- a/compiler/src/dune +++ b/compiler/src/dune @@ -2,4 +2,4 @@ ; OCaml stdlib only: no Menhir, no ppx, no opam libraries. (library (name woc_lib) - (modules diag token ast lexer parser types gcinfer owner emit disasm dump)) + (modules diag token ast lexer parser types owner gcinfer emit disasm dump)) diff --git a/compiler/src/gcinfer.ml b/compiler/src/gcinfer.ml index 37a79bd..cda6a66 100644 --- a/compiler/src/gcinfer.ml +++ b/compiler/src/gcinfer.ml @@ -1,15 +1,22 @@ -(* gcinfer.ml — inferred GC classification (spec 2026-08-11; plan Phase 1, - structural half). +(* gcinfer.ml — inferred GC classification (spec 2026-08-11). - Build the class-reference graph and mark every class in a non-trivial SCC, - or with a self-loop, as traced (`gc`); everything else is `owned`. `ref B` - is a row id (Copy) and `backlink` is a virtual inverse (recomputed by index - scan) — neither stores a pointer, so neither contributes a graph edge, and - neither can force a cycle. + `infer` is the pass: it returns `syms` with `traced` populated from two + halves — + - STRUCTURAL: the class-reference graph + Tarjan SCC. A class in a + non-trivial SCC or with a self-loop is traced. `ref B` is a row id (Copy) + and `backlink` is a virtual inverse — neither stores a pointer, so + neither contributes an edge nor can force a cycle. + - DEMAND: ownership run in collect mode; a class whose value must escape + (a shape only a traced class can hold) is promoted. - Additive: this pass does not yet feed field-kind derivation (that is plan - Phase 2, at the `Types.is_gc_class` seam), so nothing it decides changes - emitted bytecode. It only backs the `woc --dump-gc` artifact today. *) + Every consumer (the driver's typecheck_all, the unit-test helpers) calls + `infer`, so `Types.is_gc_class` — which field-kind derivation, owner + exemptions, and the class flag all key off — answers identically everywhere. + + KNOWN LIMITATION (to refine with the Phase-3 landing): the demand hook + promotes the escaping *root local's* class, so `return h.box` over-promotes + `Holder` as well as `Box`. It should promote the escaping projection's type + only. Sound (never under-promotes) but imprecise. *) module SMap = Types.StringMap @@ -144,3 +151,33 @@ let render (r : result) : string = | None -> Buffer.add_string buf (Printf.sprintf "%-10s owned\n" name)) r.order; Buffer.contents buf + +(* The full inference pass: structural SCC (cycles) unioned with demand + promotion (a class value that must escape). Returns `syms` with `traced` + populated — the single entry point every consumer (the driver AND the unit + tests) calls, so `is_gc_class` answers identically everywhere. The demand + half runs ownership in collect mode over every program to a fixpoint; + promotions only grow (bounded by class count), so it terminates. *) +let infer (parsed : (string * Ast.program) list) (syms : Types.symbols) : + Types.symbols = + let structural = traced_names (classify syms) in + let throwaway = Diag.Collector.create () in + let traced = ref structural in + let changed = ref true in + while !changed do + let promoted = Hashtbl.create 16 in + let syms_c = { syms with Types.traced = !traced } in + List.iter + (fun (f, prog) -> + ignore + (Owner.analyze ~file:f + ~promote:(Some (fun c -> Hashtbl.replace promoted c ())) + prog syms_c throwaway)) + parsed; + let next = + Hashtbl.fold (fun c () acc -> Types.StringSet.add c acc) promoted !traced + in + changed := not (Types.StringSet.equal next !traced); + traced := next + done; + { syms with Types.traced = !traced }