@@ -307,7 +307,7 @@ let rec find_free_vars (bound_vars : string list) (expr : expr) : string list =
307307 List. concat (List. map (find_free_vars bound_vars) args)
308308 | ExprBlock blk ->
309309 (* Statements may introduce bindings *)
310- let (_ , free) = List. fold_left (fun (bound , acc_free ) stmt ->
310+ let (bound_after , free) = List. fold_left (fun (bound , acc_free ) stmt ->
311311 match stmt with
312312 | StmtLet sl ->
313313 let rhs_free = find_free_vars bound sl.sl_value in
@@ -320,8 +320,13 @@ let rec find_free_vars (bound_vars : string list) (expr : expr) : string list =
320320 (bound, acc_free @ find_free_vars bound e)
321321 | _ -> (bound, acc_free)
322322 ) (bound_vars, [] ) blk.blk_stmts in
323+ (* The tail expression is in scope of the block's own `let`
324+ bindings, so its free vars must exclude them — use the
325+ threaded [bound_after], not the original [bound_vars]. (Prior
326+ code used [bound_vars], spuriously reporting block-local
327+ binders as free; surfaced by #225 PR3c chained continuations.) *)
323328 let expr_free = match blk.blk_expr with
324- | Some e -> find_free_vars bound_vars e
329+ | Some e -> find_free_vars bound_after e
325330 | None -> []
326331 in
327332 free @ expr_free
@@ -417,6 +422,21 @@ let gen_unop (op : unary_op) : instr result =
417422 | OpRef -> Error (UnsupportedFeature " OpRef handled in ExprUnary" )
418423 | OpDeref -> Error (UnsupportedFeature " OpDeref handled in ExprUnary" )
419424
425+ (* * ADR-013 #225 PR3c — recursive CPS hook. The async-boundary transform
426+ ([detect_async_base_case] + [gen_async_base_case]) is defined below
427+ [gen_expr] but must be reachable from *inside* the continuation
428+ lambda's body generation so that a continuation which is itself an
429+ async boundary is transformed too (Async→Async chaining). A forward
430+ reference, populated once at module init, breaks the definition-order
431+ cycle without relocating the whole transform into the rec group.
432+ Returns [Some result] when [expr] matched the async shape (and
433+ `thenableThen` is importable), else [None] ⇒ caller lowers normally.
434+ Recursion terminates: each application peels exactly one async
435+ boundary off a finite, strictly-smaller continuation. *)
436+ let async_transform_hook
437+ : (context -> expr -> (context * instr list ) result option ) ref
438+ = ref (fun _ _ -> None )
439+
420440(* * Generate code for an expression, returning instructions and updated context *)
421441let rec gen_expr (ctx : context ) (expr : expr ) : (context * instr list) result =
422442 match expr with
@@ -567,8 +587,14 @@ let rec gen_expr (ctx : context) (expr : expr) : (context * instr list) result =
567587 (ctx, [I32Const 0l ])
568588 in
569589
570- (* Create fresh context for lambda function *)
571- let lambda_ctx = { ctx_after_env with locals = [] ; next_local = 0 ; loop_depth = 0 } in
590+ (* Create fresh context for lambda function. [next_lambda_id] is
591+ advanced *before* body generation so a nested lambda created
592+ while lowering this body (e.g. a chained CPS continuation, #225
593+ PR3c) gets a distinct id rather than re-using [lambda_id]. *)
594+ let lambda_ctx =
595+ { ctx_after_env with
596+ locals = [] ; next_local = 0 ; loop_depth = 0 ;
597+ next_lambda_id = lambda_id + 1 } in
572598
573599 (* Environment is always first parameter (even if unused) for uniform calling convention *)
574600 let (ctx_with_env, _) = alloc_local lambda_ctx " __env" in
@@ -598,7 +624,14 @@ let rec gen_expr (ctx : context) (expr : expr) : (context * instr list) result =
598624 let param_count = env_param_offset + List. length lam.elam_params in
599625
600626 (* Generate lambda body *)
601- let * (ctx_final, body_code) = gen_expr ctx_with_captured lam.elam_body in
627+ (* #225 PR3c: if the lambda body is itself an async boundary (a
628+ continuation that chains another async call), transform it so
629+ Thenables compose up the chain; otherwise lower normally. *)
630+ let * (ctx_final, body_code) =
631+ match ! async_transform_hook ctx_with_captured lam.elam_body with
632+ | Some r -> r
633+ | None -> gen_expr ctx_with_captured lam.elam_body
634+ in
602635
603636 (* Compute additional locals (beyond parameters and captured vars) *)
604637 let local_count = ctx_final.next_local - param_count in
@@ -613,9 +646,36 @@ let rec gen_expr (ctx : context) (expr : expr) : (context * instr list) result =
613646 let result_type = [I32 ] in
614647 let func_type = { ft_params = param_types; ft_results = result_type } in
615648
649+ (* Thread the POST-body module-level state forward while keeping the
650+ enclosing scope's local state. The body may have mutated module
651+ accumulators (a nested lambda + its types/globals/datas, #225
652+ PR3c chaining); rebuilding from [ctx_after_env] would silently
653+ drop them. Enclosing locals/next_local/loop_depth/field_layouts
654+ stay from [ctx_after_env] (the lambda's inner locals must not
655+ leak out). For a non-nested body these module fields equal
656+ [ctx_after_env]'s, so behaviour is unchanged. *)
657+ let ctx_post = { ctx_after_env with
658+ types = ctx_final.types;
659+ funcs = ctx_final.funcs;
660+ exports = ctx_final.exports;
661+ imports = ctx_final.imports;
662+ globals = ctx_final.globals;
663+ func_indices = ctx_final.func_indices;
664+ lambda_funcs = ctx_final.lambda_funcs;
665+ next_lambda_id = ctx_final.next_lambda_id;
666+ heap_ptr = ctx_final.heap_ptr;
667+ struct_layouts = ctx_final.struct_layouts;
668+ fn_ret_structs = ctx_final.fn_ret_structs;
669+ variant_tags = ctx_final.variant_tags;
670+ string_data = ctx_final.string_data;
671+ next_string_offset = ctx_final.next_string_offset;
672+ datas = ctx_final.datas;
673+ ownership_annots = ctx_final.ownership_annots;
674+ } in
675+
616676 (* Add type to types list *)
617- let type_idx = List. length ctx_after_env .types in
618- let ctx_with_type = { ctx_after_env with types = ctx_after_env .types @ [func_type] } in
677+ let type_idx = List. length ctx_post .types in
678+ let ctx_with_type = { ctx_post with types = ctx_post .types @ [func_type] } in
619679
620680 (* Create lambda function *)
621681 let lambda_func = {
@@ -624,11 +684,19 @@ let rec gen_expr (ctx : context) (expr : expr) : (context * instr list) result =
624684 f_body = load_captured_code @ body_code;
625685 } in
626686
627- (* Add lambda function to lifted functions *)
687+ (* The closure's stored function id MUST be this lambda's index in
688+ the final [lambda_funcs] list, because the element segment maps
689+ table slot i -> the i-th lambda's wasm func (see gen_module), and
690+ wrapHandler dispatches via `table.get(fnId)`. The pre-reserved
691+ [lambda_id] equals the list position ONLY for non-nested lambdas
692+ (id order == append order). A nested lambda (e.g. a chained CPS
693+ continuation, #225 PR3c) is appended *before* its enclosing
694+ lambda yet has a *higher* id, so id ≠ position there. Use the
695+ append position (= current list length) instead. *)
696+ let lambda_slot = List. length ctx_with_type.lambda_funcs in
628697 let ctx_with_lambda = {
629698 ctx_with_type with
630699 lambda_funcs = ctx_with_type.lambda_funcs @ [lambda_func];
631- next_lambda_id = lambda_id + 1 ;
632700 } in
633701
634702 (* Return a closure: (function_id, env_pointer) as a 2-element tuple *)
@@ -647,7 +715,7 @@ let rec gen_expr (ctx : context) (expr : expr) : (context * instr list) result =
647715 let closure_code = closure_alloc @ [LocalSet closure_idx] @ [
648716 (* Store function ID at offset 0 *)
649717 LocalGet closure_idx;
650- I32Const (Int32. of_int lambda_id );
718+ I32Const (Int32. of_int lambda_slot );
651719 I32Store (2 , 0 );
652720 ] @ [
653721 (* Store environment pointer at offset 4 *)
@@ -1819,18 +1887,27 @@ let mentions_async_prim (e : expr) : bool =
18191887 are captured into the continuation env by the proven #199
18201888 ExprLambda path (which already marshals N captures). [pre] is
18211889 restricted to simple `let`s so the captured set is well-defined.
1822-
1823- Single boundary only: no recognised async primitive may appear in
1824- [pre] values or in [cont] (chaining = PR3c). Capture soundness: every
1825- free name in [cont] must be the binder, a param, a top-level
1826- func/const/global, or a [pre]-bound local — anything else ⇒ [None]
1827- (fall back to the unchanged synchronous lowering, zero regression).
1828- The affine/linear single-use obligation (ADR-013 obl. 1) is
1829- discharged by composition: borrow-check runs on this straight-line
1830- AST before the transform, and the once-resumption trap guarantees
1831- [cont] executes exactly once — so no new static machinery here. *)
1832- let detect_async_base_case ~(globals : string list ) (params : string list )
1833- (body : expr )
1890+ - PR3c: [cont] may itself be an async boundary. It is NOT rejected
1891+ here; the recursive [async_transform_hook] re-applies this
1892+ recogniser to the continuation lambda's body, so a chain
1893+ `let a = async(); let b = async(); …` lowers to nested
1894+ continuations whose Thenables compose up the call chain.
1895+
1896+ [extra] is the set of live-local names available for #199 capture at
1897+ the call site (the enclosing context's locals — including, for a
1898+ recursively-transformed continuation, the *outer* binder and outer
1899+ captured locals). Capture soundness: every free name in [cont] must
1900+ be the binder, a param, a top-level func/const/global, a [pre]-bound
1901+ local, or one of [extra] — anything else ⇒ [None] (fall back to the
1902+ unchanged synchronous lowering, zero regression). A recognised async
1903+ primitive nested inside a [pre] value (i.e. not in `let`-binding
1904+ head position) is an unsupported shape ⇒ [None]. The affine/linear
1905+ single-use obligation (ADR-013 obl. 1) is discharged by composition
1906+ (PR3b): borrow-check runs on this straight-line AST before the
1907+ transform, and the once-resumption trap guarantees each continuation
1908+ executes exactly once — no new static machinery here. *)
1909+ let detect_async_base_case ~(globals : string list ) ~(params : string list )
1910+ ~(extra : string list ) (body : expr )
18341911 : (stmt list * string * expr * expr) option =
18351912 let rec unwrap = function
18361913 | ExprBlock { blk_stmts = [] ; blk_expr = Some e } -> unwrap e
@@ -1848,13 +1925,14 @@ let detect_async_base_case ~(globals : string list) (params : string list)
18481925 if List. exists (fun n -> n = None ) pre_names then None
18491926 else
18501927 let pre_bound = List. filter_map (fun x -> x) pre_names in
1851- (* Single boundary: no async primitive in pre values or cont. *)
1928+ (* A nested async primitive in a pre value is unsupported (the
1929+ boundary must be the `let`-binding head); cont MAY chain. *)
18521930 let pre_vals = List. filter_map
18531931 (function StmtLet sl -> Some sl.sl_value | _ -> None ) pre in
1854- if mentions_async_prim cont
1855- || List. exists mentions_async_prim pre_vals then None
1932+ if List. exists mentions_async_prim pre_vals then None
18561933 else
1857- let allowed = binder :: params @ globals @ pre_bound in
1934+ let allowed =
1935+ binder :: params @ globals @ pre_bound @ extra in
18581936 let escaping =
18591937 List. filter (fun v -> not (List. mem v allowed))
18601938 (dedup (find_free_vars [] cont))
@@ -1949,6 +2027,31 @@ let gen_async_base_case (ctx : context) (pre : stmt list) (binder : string)
19492027 in
19502028 Ok (ctx5, body)
19512029
2030+ (* #225 PR3c: populate the forward reference (declared before [gen_expr])
2031+ so the continuation-body site in the [ExprLambda] lowering re-applies
2032+ the transform — giving Async→Async chaining where Thenables compose
2033+ up the call chain. A continuation has no params (everything it needs
2034+ is captured), hence [~params:[]]; [~extra] is the live-local set the
2035+ #199 path can capture, which for a recursively-transformed inner
2036+ continuation includes the *outer* binder and outer captures. Requires
2037+ `thenableThen` to be importable; otherwise [None] ⇒ the ExprLambda
2038+ site lowers the body normally (no behaviour change). *)
2039+ let () =
2040+ async_transform_hook :=
2041+ (fun ctx body ->
2042+ match List. assoc_opt " thenableThen" ctx.func_indices with
2043+ | None -> None
2044+ | Some tt ->
2045+ begin match detect_async_base_case
2046+ ~globals: (List. map fst ctx.func_indices)
2047+ ~params: []
2048+ ~extra: (List. map fst ctx.locals)
2049+ body with
2050+ | Some (pre , binder , call , cont ) ->
2051+ Some (gen_async_base_case ctx pre binder call cont tt)
2052+ | None -> None
2053+ end )
2054+
19522055let gen_function (ctx : context ) (fd : fn_decl ) : (context * func) result =
19532056 (* Create fresh context for function scope, but preserve lambda_funcs and next_lambda_id *)
19542057 let fn_ctx = { ctx with locals = [] ; next_local = 0 ; loop_depth = 0 } in
@@ -1988,7 +2091,8 @@ let gen_function (ctx : context) (fd : fn_decl) : (context * func) result =
19882091 if fn_is_async fd then
19892092 match detect_async_base_case
19902093 ~globals: (List. map fst ctx_with_params.func_indices)
1991- (List. map (fun p -> p.p_name.name) fd.fd_params)
2094+ ~params: (List. map (fun p -> p.p_name.name) fd.fd_params)
2095+ ~extra: (List. map fst ctx_with_params.locals)
19922096 body_expr with
19932097 | Some (pre , binder , call , cont ) ->
19942098 begin match List. assoc_opt " thenableThen"
0 commit comments