feat(typecheck): #234 S2b — build the per-call-site effect side-table (ADR-016)

Builds on S2a (lib/effect_sites.ml shared numbering). `Typecheck`
gains `context.call_effects : (int, eff) Hashtbl.t`, keyed by the
shared `Effect_sites` ordinal, populated by `populate_call_effects`
after a successful check + quantity pass (only on the Ok path).

A call site's row is the callee's *declared* effect row when the
callee is a statically-named function (`f(..)`, `m.f(..)`, through
`ExprSpan`), else EPure. Extern fns parse as `TopFn` with
`FnExtern`/`fd_eff` (parser.mly:188,206), so the same `name -> eff`
map (via the existing `lower_effect_expr`) covers stdlib async
primitives (`http_request_thenable` → `/{Net,Async}`) and
user-defined `Async` functions uniformly. `lower_effect_expr` is
wrapped defensively (→ EPure) though the check pass already validated.

GATE-NEUTRAL by construction: the table is built and returned in the
context but NOTHING reads it yet. S3 threads it into codegen and
switches the WasmGC CPS boundary predicate onto it (structural
recogniser stays the sound table-miss fallback); S4 retires the
hardcoded `async_primitives` set.

Tests (test/test_effect_sites.ml +2): the table has one entry per
call site; a call to a `/{Net,Async}` extern carries Async while a
pure call does not; every `Effect_sites` ordinal is present
(producer/consumer-agreement contract). `dune test --force` 290/290.
Zero regression (no codegen/behaviour change).

Refs #234. Not Closes — staged campaign; owner closes per ISSUE-CLOSURE.

Author: hyperpolymath

lib/typecheck.ml

@@ -189,6 +189,14 @@ type context = {
   declared_effects : (string, unit) Hashtbl.t;
   (** User-declared effect names (`effect <name>;`). Consulted by
       [lower_effect_expr] alongside the v1 registry (issue #59). *)
+  call_effects : (int, eff) Hashtbl.t;
+  (** ADR-016 / #234 S2b: per-call-site effect rows, keyed by the
+      shared [Effect_sites] ordinal. Populated after a successful check
+      pass; the value is the callee's declared effect row (EPure when
+      the callee is not a statically-named function). Built here but
+      NOT yet consulted by codegen — S3 threads & switches the WasmGC
+      CPS boundary predicate onto it (the structural recogniser remains
+      the sound table-miss fallback). *)
 }
 
 type 'a result = ('a, type_error) Result.t
@@ -219,6 +227,7 @@ let create_context (symbols : Symbol.t) : context =
     current_eff = fresh_effvar 0;
     trait_registry = Trait.create_registry ();
     declared_effects = Hashtbl.create 16;
+    call_effects = Hashtbl.create 64;
   }
 
 (** Enter a deeper let-level. *)
@@ -1754,6 +1763,53 @@ let check_decl (ctx : context) (decl : top_level) : (unit, type_error) Result.t
     [Resolve.resolve_program_with_loader] so that [ExprApp (ExprVar f, ...)]
     can resolve [f] to the imported function's scheme even though [f] does
     not appear in [prog.prog_decls]. *)
+(* ADR-016 / #234 S2b: build the per-call-site effect side-table.
+   Keyed by the shared [Effect_sites] ordinal so the (future) codegen
+   consumer agrees with this producer. A call's effect row is the
+   callee's *declared* row when the callee is a statically-named
+   function (`f(..)`, `m.f(..)`, through `ExprSpan`); otherwise EPure
+   (sound: S3's predicate is "row ⊇ Async ⇒ boundary", and an
+   over-conservative EPure just defers to the structural fallback —
+   exactly today's behaviour). Extern fns parse as [TopFn] with
+   [FnExtern]/[fd_eff] (parser.mly), so this covers the stdlib async
+   primitives and user `Async` fns uniformly. Pure traversal; built,
+   not yet consumed. *)
+let populate_call_effects (ctx : context) (prog : Ast.program) : unit =
+  let fn_eff : (string, eff) Hashtbl.t = Hashtbl.create 64 in
+  List.iter
+    (function
+      | Ast.TopFn fd ->
+        let e =
+          match fd.fd_eff with
+          | Some ee -> (try lower_effect_expr ctx ee with _ -> EPure)
+          | None -> EPure
+        in
+        Hashtbl.replace fn_eff fd.fd_name.name e
+      | _ -> ())
+    prog.prog_decls;
+  let rec callee_name (e : Ast.expr) : string option =
+    match e with
+    | Ast.ExprVar id -> Some id.name
+    | Ast.ExprField (_, id) -> Some id.name
+    | Ast.ExprSpan (e, _) -> callee_name e
+    | _ -> None
+  in
+  Effect_sites.iter
+    (fun ord call ->
+      let row =
+        match call with
+        | Ast.ExprApp (head, _) ->
+          (match callee_name head with
+           | Some n ->
+             (match Hashtbl.find_opt fn_eff n with
+              | Some e -> e
+              | None -> EPure)
+           | None -> EPure)
+        | _ -> EPure
+      in
+      Hashtbl.replace ctx.call_effects ord row)
+    prog
+
 let check_program ?(import_types : (string, scheme) Hashtbl.t option)
     (symbols : Symbol.t) (prog : Ast.program)
     : (context, type_error) Result.t =
@@ -1799,7 +1855,11 @@ let check_program ?(import_types : (string, scheme) Hashtbl.t option)
        This runs after type checking succeeds so that we report type
        errors first (they are more fundamental). *)
     begin match Quantity.check_program_quantities prog with
-    | Ok () -> Ok ctx
+    | Ok () ->
+      (* ADR-016 / #234 S2b: build the per-call-site effect side-table
+         on the fully-checked program. Built, not yet consumed. *)
+      populate_call_effects ctx prog;
+      Ok ctx
     | Error (qerr, span) ->
       Error (QuantityError (qerr, span))
     end

test/test_effect_sites.ml

@@ -75,6 +75,63 @@ fn main() -> Int {
   Alcotest.(check int) "ten call sites across positions" 10
     (Effect_sites.count p)
 
+(* ── #234 S2b: typecheck populates the ordinal→effect side-table ── *)
+
+let rec eff_mentions (name : string) (e : Types.eff) : bool =
+  match e with
+  | Types.EPure | Types.EVar _ -> false
+  | Types.ESingleton s -> s = name
+  | Types.EUnion es -> List.exists (eff_mentions name) es
+
+let typecheck_ctx (src : string) : Typecheck.context =
+  let prog = parse src in
+  let loader = Module_loader.create (Module_loader.default_config ()) in
+  match Resolve.resolve_program_with_loader prog loader with
+  | Error (e, _) -> Alcotest.failf "resolve: %s" (Resolve.show_resolve_error e)
+  | Ok (rc, _) ->
+    (match Typecheck.check_program rc.Resolve.symbols prog with
+     | Ok ctx -> ctx
+     | Error e -> Alcotest.failf "typecheck: %s" (Typecheck.format_type_error e))
+
+(* helper(1)=ord0 (pure, no eff), prim(2)=ord1 (declared /{Net,Async}).
+   `a + b` is ExprBinary, not a call. *)
+let s2b_src =
+  {|
+extern fn prim(x: Int) -> Int / { Net, Async };
+
+fn helper(x: Int) -> Int { x }
+
+fn main() -> Int {
+  let a = helper(1);
+  let b = prim(2);
+  a + b
+}
+|}
+
+let test_s2b_table_built () =
+  let ctx = typecheck_ctx s2b_src in
+  Alcotest.(check int) "two table entries" 2
+    (Hashtbl.length ctx.Typecheck.call_effects);
+  let e0 = Hashtbl.find ctx.Typecheck.call_effects 0 in
+  let e1 = Hashtbl.find ctx.Typecheck.call_effects 1 in
+  Alcotest.(check bool) "helper(1) carries no Async" false
+    (eff_mentions "Async" e0);
+  Alcotest.(check bool) "prim(2) carries Async" true
+    (eff_mentions "Async" e1)
+
+let test_s2b_keyed_by_effect_sites_ordinals () =
+  (* Producer/consumer agreement contract: every Effect_sites ordinal
+     has an entry in the table. *)
+  let ctx = typecheck_ctx s2b_src in
+  let p = parse s2b_src in
+  List.iter
+    (fun (ord, _) ->
+      Alcotest.(check bool)
+        (Printf.sprintf "ordinal %d present" ord)
+        true
+        (Hashtbl.mem ctx.Typecheck.call_effects ord))
+    (Effect_sites.to_list p)
+
 let tests =
   [
     Alcotest.test_case "count" `Quick test_count;
@@ -85,4 +142,8 @@ let tests =
     Alcotest.test_case "no calls" `Quick test_no_calls;
     Alcotest.test_case "calls in many positions" `Quick
       test_calls_in_many_positions;
+    Alcotest.test_case "S2b: typecheck builds the effect side-table"
+      `Quick test_s2b_table_built;
+    Alcotest.test_case "S2b: keyed by Effect_sites ordinals" `Quick
+      test_s2b_keyed_by_effect_sites_ordinals;
   ]