feat(effect-sites): #234 S2a — shared call-site numbering (ADR-016) (#275)

ADR-016 mechanism foundation. The AST has no loc/id on `ExprApp` and
the ADR rejects annotating it, so the effect side-table is keyed by a
*deterministic shared call-site numbering*: `lib/effect_sites.ml` is a
single, total, pure pre-order traversal that assigns every `ExprApp` a
0-based ordinal. Typecheck (producer) and the WasmGC CPS detector
(consumer) will both obtain ordinals by calling THIS function on the
same `prog`, so keys cannot drift — with no AST shape change.

This slice is `effect_sites.ml` ONLY (the keying primitive). No
typecheck/codegen change ⇒ pure, gate-neutral. S2b adds the typecheck
table on top; S3 threads + switches codegen; S4 retires the hardcoded
set (per ADR-016 staging).

API: `fold_calls` / `count` / `to_list` / `iter`. Ordering contract
(documented, stable, do-not-change-without-amending-ADR-016):
strict left-to-right pre-order; a call node is numbered before its
callee/argument sub-exprs are descended. Exhaustive over every
expr/stmt/block/match/handler/unsafe/fn-body/top-level position
(TopFn/Const/Impl/Trait-default bodies).

Tests: `test/test_effect_sites.ml` (5 cases — count, contiguous
pre-order ordinals, determinism+purity across runs/re-parses, zero
calls, calls nested in arg/while/for/match/lambda/block positions).
Registered in test_main. `dune test --force` 287/287. Zero regression.

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

Author: hyperpolymath

lib/dune

@@ -13,6 +13,7 @@
   codegen_node
   desugar_traits
   effect
+  effect_sites
   error
   error_collector
   error_formatter

lib/effect_sites.ml

@@ -0,0 +1,140 @@
+(* SPDX-License-Identifier: PMPL-1.0-or-later *)
+(* SPDX-FileCopyrightText: 2026 hyperpolymath *)
+
+(** Shared call-site numbering for the effect-threaded async-boundary
+    side-table (ADR-016, issue #234).
+
+    The AST carries no location or node id on [ExprApp], and ADR-016
+    rejects annotating it. Instead this module defines a single,
+    deterministic pre-order traversal that assigns every [ExprApp] a
+    0-based ordinal. Both the producer ([Typecheck], which records
+    [ordinal -> effect_row]) and the consumer (the WasmGC CPS
+    boundary detector) obtain ordinals by calling *this same function*,
+    so the keys cannot drift — without changing the AST shape.
+
+    Ordering contract (stable; do not change without amending ADR-016):
+    a strict left-to-right *pre-order* walk of the program. An
+    [ExprApp] node is numbered *before* its callee and argument
+    sub-expressions are descended into. Sub-structures are visited in
+    source order. [TopFn]/[TopConst]/[TopImpl]/[TopTrait] default
+    bodies are walked in [prog_decls] order.
+
+    This module is pure and depends only on [Ast]; it has no notion of
+    effects itself (S2a). S2b/S3 build the table on top of it. *)
+
+open Ast
+
+(* The visitor threads an accumulator and a mutable next-ordinal
+   counter (held in a ref captured by the closures, so the ordinal is a
+   pure function of traversal position). *)
+
+let fold_calls (type a) (f : a -> int -> expr -> a) (init : a)
+    (prog : program) : a =
+  let acc = ref init in
+  let next = ref 0 in
+  let rec go_expr (e : expr) : unit =
+    (match e with
+     | ExprApp (fn, args) ->
+       (* Number THIS call site before descending (pre-order). *)
+       let ord = !next in
+       incr next;
+       acc := f !acc ord e;
+       go_expr fn;
+       List.iter go_expr args
+     | ExprLit _ | ExprVar _ | ExprVariant _ -> ()
+     | ExprLet l ->
+       go_expr l.el_value;
+       (match l.el_body with Some b -> go_expr b | None -> ())
+     | ExprIf i ->
+       go_expr i.ei_cond;
+       go_expr i.ei_then;
+       (match i.ei_else with Some e -> go_expr e | None -> ())
+     | ExprMatch m ->
+       go_expr m.em_scrutinee;
+       List.iter go_arm m.em_arms
+     | ExprLambda l -> go_expr l.elam_body
+     | ExprField (e, _) | ExprTupleIndex (e, _) | ExprRowRestrict (e, _)
+     | ExprSpan (e, _) | ExprUnary (_, e) ->
+       go_expr e
+     | ExprIndex (a, b) | ExprBinary (a, _, b) ->
+       go_expr a;
+       go_expr b
+     | ExprTuple es | ExprArray es -> List.iter go_expr es
+     | ExprRecord r ->
+       List.iter
+         (fun (_, eo) -> match eo with Some e -> go_expr e | None -> ())
+         r.er_fields;
+       (match r.er_spread with Some e -> go_expr e | None -> ())
+     | ExprBlock b -> go_block b
+     | ExprReturn eo | ExprResume eo ->
+       (match eo with Some e -> go_expr e | None -> ())
+     | ExprTry t ->
+       go_block t.et_body;
+       (match t.et_catch with Some arms -> List.iter go_arm arms | None -> ());
+       (match t.et_finally with Some b -> go_block b | None -> ())
+     | ExprHandle h ->
+       go_expr h.eh_body;
+       List.iter go_handler h.eh_handlers
+     | ExprUnsafe ops -> List.iter go_unsafe ops)
+  and go_arm (a : match_arm) : unit =
+    (match a.ma_guard with Some g -> go_expr g | None -> ());
+    go_expr a.ma_body
+  and go_handler = function
+    | HandlerReturn (_, e) -> go_expr e
+    | HandlerOp (_, _, e) -> go_expr e
+  and go_unsafe = function
+    | UnsafeRead e | UnsafeForget e -> go_expr e
+    | UnsafeWrite (a, b) | UnsafeOffset (a, b) ->
+      go_expr a;
+      go_expr b
+    | UnsafeTransmute (_, _, e) -> go_expr e
+  and go_block (b : block) : unit =
+    List.iter go_stmt b.blk_stmts;
+    (match b.blk_expr with Some e -> go_expr e | None -> ())
+  and go_stmt = function
+    | StmtLet l -> go_expr l.sl_value
+    | StmtExpr e -> go_expr e
+    | StmtAssign (a, _, b) ->
+      go_expr a;
+      go_expr b
+    | StmtWhile (c, b) ->
+      go_expr c;
+      go_block b
+    | StmtFor (_, e, b) ->
+      go_expr e;
+      go_block b
+  in
+  let go_fn_body = function
+    | FnBlock b -> go_block b
+    | FnExpr e -> go_expr e
+    | FnExtern -> ()
+  in
+  let go_top = function
+    | TopFn fd -> go_fn_body fd.fd_body
+    | TopConst c -> go_expr c.tc_value
+    | TopImpl ib ->
+      List.iter
+        (function ImplFn fd -> go_fn_body fd.fd_body | ImplType _ -> ())
+        ib.ib_items
+    | TopTrait trd ->
+      List.iter
+        (function
+          | TraitFnDefault fd -> go_fn_body fd.fd_body
+          | TraitFn _ | TraitType _ -> ())
+        trd.trd_items
+    | TopType _ | TopEffect _ | TopExternType _ | TopExternFn _ -> ()
+  in
+  List.iter go_top prog.prog_decls;
+  !acc
+
+(** Total number of call sites ([ExprApp] nodes) in [prog]. *)
+let count (prog : program) : int =
+  fold_calls (fun n _ _ -> n + 1) 0 prog
+
+(** All call sites as [(ordinal, node)] in traversal (= ordinal) order. *)
+let to_list (prog : program) : (int * expr) list =
+  List.rev (fold_calls (fun acc ord e -> (ord, e) :: acc) [] prog)
+
+(** [iter f prog] runs [f ordinal node] for every call site, in order. *)
+let iter (f : int -> expr -> unit) (prog : program) : unit =
+  fold_calls (fun () ord e -> f ord e) () prog

test/test_effect_sites.ml

@@ -0,0 +1,88 @@
+(* SPDX-License-Identifier: PMPL-1.0-or-later *)
+(* SPDX-FileCopyrightText: 2026 hyperpolymath *)
+
+(* ADR-016 / #234 S2a: the shared call-site numbering must be total,
+   deterministic, and pure (the keying contract for the effect
+   side-table — typecheck and codegen both call it on the same prog and
+   MUST agree). *)
+
+open Affinescript
+
+let parse src = Parse_driver.parse_string ~file:"<test_effect_sites>" src
+
+(* Calls: helper(1) helper(2) helper(3) helper(4) — across a let value,
+   an if-condition, and both if branches. `>` and `+` are ExprBinary,
+   not calls. *)
+let prog_src =
+  {|
+fn helper(x: Int) -> Int { x }
+
+fn main() -> Int {
+  let a = helper(1);
+  let b = if helper(2) > 0 { helper(3) } else { helper(4) };
+  a + b
+}
+|}
+
+let test_count () =
+  let p = parse prog_src in
+  Alcotest.(check int) "four call sites" 4 (Effect_sites.count p)
+
+let test_ordinals_contiguous_preorder () =
+  let p = parse prog_src in
+  let ords = List.map fst (Effect_sites.to_list p) in
+  (* 0..3 in order — pre-order, contiguous, no gaps/dupes. *)
+  Alcotest.(check (list int)) "ordinals 0..3 in order" [ 0; 1; 2; 3 ] ords
+
+let test_deterministic_and_pure () =
+  let p = parse prog_src in
+  let run () = Effect_sites.to_list p |> List.map fst in
+  Alcotest.(check (list int)) "two runs identical" (run ()) (run ());
+  (* Re-parsing the same source yields the same numbering. *)
+  let p2 = parse prog_src in
+  Alcotest.(check int) "stable across parses"
+    (Effect_sites.count p) (Effect_sites.count p2)
+
+let test_no_calls () =
+  let p = parse {|
+fn main() -> Int {
+  let a = 1;
+  let b = a + 2;
+  b
+}
+|} in
+  Alcotest.(check int) "no call sites" 0 (Effect_sites.count p)
+
+let test_calls_in_many_positions () =
+  (* arg-nested, block stmt, while, for, match arm, lambda body. *)
+  let p = parse {|
+fn f(x: Int) -> Int { x }
+
+fn main() -> Int {
+  let mut s = 0;
+  s = f(f(1));
+  while f(0) > 9 { s = s + f(2); }
+  for y in [f(3)] { s = s + y; }
+  let g = |z: Int| -> Int { f(z) };
+  s = g(f(4));
+  match f(5) {
+    _ => f(6)
+  }
+}
+|} in
+  (* f(f(1))=2, f(0)=1, f(2)=1, f(3)=1, g(f(4))=2, f(5)=1, f(6)=1
+     => 10 call sites (g(...) is itself a call). *)
+  Alcotest.(check int) "ten call sites across positions" 10
+    (Effect_sites.count p)
+
+let tests =
+  [
+    Alcotest.test_case "count" `Quick test_count;
+    Alcotest.test_case "ordinals contiguous pre-order" `Quick
+      test_ordinals_contiguous_preorder;
+    Alcotest.test_case "deterministic & pure" `Quick
+      test_deterministic_and_pure;
+    Alcotest.test_case "no calls" `Quick test_no_calls;
+    Alcotest.test_case "calls in many positions" `Quick
+      test_calls_in_many_positions;
+  ]

test/test_main.ml

@@ -11,4 +11,5 @@ let () =
       ("Golden", Test_golden.tests);
       ("Examples", Test_golden.example_tests);
       ("Effects (#59)", Test_effects.tests);
+      ("Effect-sites (#234 S2a)", Test_effect_sites.tests);
     ] @ Test_e2e.tests @ Test_stdlib_aot.tests)