From fadf52cd6573d1328fe66f3bc17f9d8bf15e6809 Mon Sep 17 00:00:00 2001 From: "shoney.arickathil" Date: Tue, 18 Aug 2026 16:37:31 +0200 Subject: [PATCH] feat(compiler): inferred GC classification + --dump-gc (7b Phase 1) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Structural half of the inference pass, additive — it backs `woc --dump-gc` and does NOT yet feed field-kind derivation (that is Phase 2 at the Types.is_gc_class seam), so no emitted bytecode or golden changes. - compiler/src/gcinfer.ml: build the class-reference graph (edges from Scalar/Multi/Map fields, unwrapping ?; ref and backlink contribute NO edge), run Tarjan SCC, classify any class in a non-trivial SCC or with a self-loop as `gc`, else `owned`; carry a cycle-path reason. - --dump-gc mode in bin/main.ml (mirrors --dump-owner) + usage line + dune. Verified: - docs/examples/gc-cycle -> `Node gc (cycle Node -> Node)`, `Segment owned`. - docs/examples/employee -> Department/Employee both `owned` (ref/backlink make no edge, so no false cycle) — the load-bearing correctness case. - just woc-test 566/0 (goldens untouched, build clean both flavors). Remaining Phase 1: a --dump-gc golden fixture (deferred — verified manually to avoid golden-harness churn this slice). Phases 2-4 per the plan. Co-Authored-By: Claude Opus 5 (1M context) --- compiler/bin/main.ml | 13 +++++ compiler/src/dune | 2 +- compiler/src/gcinfer.ml | 117 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 131 insertions(+), 1 deletion(-) create mode 100644 compiler/src/gcinfer.ml diff --git a/compiler/bin/main.ml b/compiler/bin/main.ml index fea8970..8b60a81 100644 --- a/compiler/bin/main.ml +++ b/compiler/bin/main.ml @@ -47,6 +47,7 @@ let usage_msg = usage: woc --dump-tokens \n\ usage: woc --dump-ast \n\ usage: woc --dump-owner \n\ + usage: woc --dump-gc \n\ usage: woc --dump-bc \n\ \n\ Compiles writeonce (.wo) source. is a single .wo file or a\n\ @@ -408,6 +409,17 @@ let dump_owner path = parsed; finish collector (build_lookup sources) +(* --dump-gc (iteration 7b, plan Phase 1): runs lex/parse/typecheck, then prints + the inferred GC classification (one line per class). Additive — it does not + change what is emitted; it exposes what the inference pass decided. *) +let dump_gc 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, _module_syms = typecheck_all collector ~root:path parsed in + print_string (Woc_lib.Gcinfer.render (Woc_lib.Gcinfer.classify syms)); + finish collector (build_lookup sources) + (* The bare `woc ` form (Task 8): runs the full pipeline with no dump — check-only. Nothing is printed to stdout on success, matching the exit-code contract's "0 = clean compile". *) @@ -723,6 +735,7 @@ let () = | [| _; "--dump-tokens"; path |] -> dump_tokens path | [| _; "--dump-ast"; path |] -> dump_ast path | [| _; "--dump-owner"; path |] -> dump_owner path + | [| _; "--dump-gc"; path |] -> dump_gc path | [| _; "--dump-bc"; path |] -> dump_bc path | [| _; "--emit"; path; "-o"; out |] -> emit_mode path out | [| _; "build"; path; "-o"; out |] -> build_mode ~runtime:None path out diff --git a/compiler/src/dune b/compiler/src/dune index 4a671bb..87dc4b3 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 owner emit disasm dump)) + (modules diag token ast lexer parser types gcinfer owner emit disasm dump)) diff --git a/compiler/src/gcinfer.ml b/compiler/src/gcinfer.ml new file mode 100644 index 0000000..c30119f --- /dev/null +++ b/compiler/src/gcinfer.ml @@ -0,0 +1,117 @@ +(* gcinfer.ml — inferred GC classification (spec 2026-08-11; plan Phase 1, + structural half). + + 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. + + 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. *) + +module SMap = Types.StringMap + +(* The user-class names one field type points at — the edges out of the class + that declares the field. Builtin scalars (Int/Bool/Text) and non-class names + resolve to no edge. *) +let rec refs_of_ty (classes : Types.class_info SMap.t) (t : Ast.field_ty) : + string list = + match t with + | Ast.Scalar n | Ast.Multi n -> if SMap.mem n classes then [ n ] else [] + | Ast.Map (k, v) -> List.filter (fun n -> SMap.mem n classes) [ k; v ] + | Ast.Nullable ft -> refs_of_ty classes ft + | Ast.Ref _ | Ast.Backlink _ -> [] (* id / virtual inverse: no pointer edge *) + +let edges (classes : Types.class_info SMap.t) (ci : Types.class_info) : + string list = + List.concat_map (fun (_, ft, _, _) -> refs_of_ty classes ft) ci.Types.fields + |> List.sort_uniq compare + +(* Tarjan's strongly-connected components over the class-name graph. Recursive; + class graphs are tiny, so recursion depth is a non-issue. *) +let sccs (nodes : string list) (adj : string -> string list) : string list list + = + let index = Hashtbl.create 64 and low = Hashtbl.create 64 in + let onstack = Hashtbl.create 64 and stack = ref [] in + let counter = ref 0 and out = ref [] in + let rec strong v = + Hashtbl.replace index v !counter; + Hashtbl.replace low v !counter; + incr counter; + stack := v :: !stack; + Hashtbl.replace onstack v true; + List.iter + (fun w -> + if not (Hashtbl.mem index w) then begin + strong w; + Hashtbl.replace low v (min (Hashtbl.find low v) (Hashtbl.find low w)) + end + else if Hashtbl.mem onstack w && Hashtbl.find onstack w then + Hashtbl.replace low v (min (Hashtbl.find low v) (Hashtbl.find index w))) + (adj v); + if Hashtbl.find low v = Hashtbl.find index v then begin + let comp = ref [] and stop = ref false in + while not !stop do + match !stack with + | [] -> stop := true + | w :: rest -> + stack := rest; + Hashtbl.replace onstack w false; + comp := w :: !comp; + if w = v then stop := true + done; + out := !comp :: !out + end + in + List.iter (fun v -> if not (Hashtbl.mem index v) then strong v) nodes; + !out + +type result = { + traced : string SMap.t; + (* traced class name -> human reason (for --dump-gc and, in Phase 2, the + promotion note) *) + order : string list; (* all class names, sorted — deterministic dump order *) +} + +let classify (syms : Types.symbols) : result = + let classes = syms.Types.classes in + let nodes = + SMap.fold (fun k _ acc -> k :: acc) classes [] |> List.sort compare + in + let adj v = + match SMap.find_opt v classes with Some ci -> edges classes ci | None -> [] + in + let comps = sccs nodes adj in + let traced = + List.fold_left + (fun acc comp -> + match comp with + | [ v ] -> + (* a singleton SCC is traced only if it points at itself *) + if List.mem v (adj v) then + SMap.add v (Printf.sprintf "cycle %s -> %s" v v) acc + else acc + | members -> + let ms = List.sort compare members in + let path = String.concat " -> " ms ^ " -> " ^ List.hd ms in + List.fold_left + (fun a m -> SMap.add m (Printf.sprintf "cycle %s" path) a) + acc ms) + SMap.empty comps + in + { traced; order = nodes } + +(* The `--dump-gc` artifact (spec §1): one line per class in sorted order, + `gc`/`owned`, with the reason in parens for traced classes. *) +let render (r : result) : string = + let buf = Buffer.create 256 in + List.iter + (fun name -> + match SMap.find_opt name r.traced with + | Some reason -> + Buffer.add_string buf (Printf.sprintf "%-10s gc (%s)\n" name reason) + | None -> Buffer.add_string buf (Printf.sprintf "%-10s owned\n" name)) + r.order; + Buffer.contents buf