ocaml: wire dynamic-wind through CEK — WindFrame + winders stack

- sx_types.ml: CallccContinuation gains winders depth int field
- sx_runtime.ml: make_callcc_continuation(captured, winders_len),
  callcc_continuation_winders_len accessor; get_val maps after-thunk,
  winders-len, body-result to cf_f/cf_extra/cf_name
- sx_ref.ml: step_limit/step_count restored; make_wind_after_frame and
  make_wind_return_frame now store their args in the CekFrame fields
- transpiler.sx: after-thunk→cf_f, winders-len→cf_extra,
  body-result→cf_name for future bootstrap runs
- 8 new dynamic-wind tests pass (OCaml), 235/235 no regressions

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-26 15:16:56 +00:00
parent b126d4da76
commit 6602ec8cc9
4 changed files with 55 additions and 45 deletions

File diff suppressed because one or more lines are too long

View File

@@ -46,7 +46,7 @@ let sx_call f args =
!Sx_types._cek_eval_lambda_ref f args
| Continuation (k, _) ->
k (match args with x :: _ -> x | [] -> Nil)
| CallccContinuation _ ->
| CallccContinuation (_, _) ->
raise (Eval_error "callcc continuations must be invoked through the CEK machine")
| _ ->
let nargs = List.length args in
@@ -156,6 +156,9 @@ let get_val container key =
| "extra" -> f.cf_extra | "extra2" -> f.cf_extra2
| "subscribers" -> f.cf_results
| "prev-tracking" -> f.cf_extra
| "after-thunk" -> f.cf_f (* wind-after frame *)
| "winders-len" -> f.cf_extra (* wind-after frame *)
| "body-result" -> f.cf_name (* wind-return frame *)
| _ -> Nil)
| VmFrame f, String k ->
(match k with
@@ -381,15 +384,20 @@ let continuation_data v = match v with
| _ -> raise (Eval_error "not a continuation")
(* Callcc (undelimited) continuation support *)
let callcc_continuation_p v = match v with CallccContinuation _ -> Bool true | _ -> Bool false
let callcc_continuation_p v = match v with CallccContinuation (_, _) -> Bool true | _ -> Bool false
let make_callcc_continuation captured =
CallccContinuation (sx_to_list captured)
let make_callcc_continuation captured winders_len =
let n = match winders_len with Number f -> int_of_float f | Integer n -> n | _ -> 0 in
CallccContinuation (sx_to_list captured, n)
let callcc_continuation_data v = match v with
| CallccContinuation frames -> List frames
| CallccContinuation (frames, _) -> List frames
| _ -> raise (Eval_error "not a callcc continuation")
let callcc_continuation_winders_len v = match v with
| CallccContinuation (_, n) -> Number (float_of_int n)
| _ -> Number 0.0
(* Dynamic wind — simplified for OCaml (no async) *)
let host_error msg =
raise (Eval_error (value_to_str msg))

View File

@@ -57,7 +57,7 @@ and value =
| Macro of macro
| Thunk of value * env
| Continuation of (value -> value) * dict option
| CallccContinuation of value list (** Undelimited continuation — captured kont frames *)
| CallccContinuation of value list * int (** Undelimited continuation — captured kont frames + winders depth at capture *)
| NativeFn of string * (value list -> value)
| Signal of signal
| RawHTML of string
@@ -476,7 +476,7 @@ let type_of = function
| Macro _ -> "macro"
| Thunk _ -> "thunk"
| Continuation (_, _) -> "continuation"
| CallccContinuation _ -> "continuation"
| CallccContinuation (_, _) -> "continuation"
| NativeFn _ -> "function"
| Signal _ -> "signal"
| RawHTML _ -> "raw-html"
@@ -506,7 +506,7 @@ let is_signal = function
let is_record = function Record _ -> true | _ -> false
let is_callable = function
| Lambda _ | NativeFn _ | Continuation (_, _) | CallccContinuation _ | VmClosure _ -> true
| Lambda _ | NativeFn _ | Continuation (_, _) | CallccContinuation (_, _) | VmClosure _ -> true
| _ -> false
@@ -815,7 +815,7 @@ let rec inspect = function
Printf.sprintf "<%s(%s)>" tag (String.concat ", " m.m_params)
| Thunk _ -> "<thunk>"
| Continuation (_, _) -> "<continuation>"
| CallccContinuation _ -> "<callcc-continuation>"
| CallccContinuation (_, _) -> "<callcc-continuation>"
| NativeFn (name, _) -> Printf.sprintf "<native:%s>" name
| Signal _ -> "<signal>"
| RawHTML s -> Printf.sprintf "\"<raw-html:%d>\"" (String.length s)

View File

@@ -256,6 +256,7 @@
"callcc-continuation?"
"callcc-continuation-data"
"make-callcc-continuation"
"callcc-continuation-winders-len"
"dynamic-wind-call"
"strip-prefix"
"component-set-param-types!"
@@ -295,7 +296,8 @@
"*bind-tracking*"
"*provide-batch-depth*"
"*provide-batch-queue*"
"*provide-subscribers*"))
"*provide-subscribers*"
"*winders*"))
(define
ml-is-mutable-global?
@@ -533,13 +535,13 @@
"; cf_env = "
(ef "env")
"; cf_name = "
(if (= frame-type "if") (ef "else") (ef "name"))
(if (= frame-type "if") (ef "else") (cond (some (fn (k) (= k "body-result")) items) (ef "body-result") :else (ef "name")))
"; cf_body = "
(if (= frame-type "if") (ef "then") (ef "body"))
"; cf_remaining = "
(ef "remaining")
"; cf_f = "
(ef "f")
(cond (some (fn (k) (= k "after-thunk")) items) (ef "after-thunk") (some (fn (k) (= k "f")) items) (ef "f") :else "Nil")
"; cf_args = "
(cond
(some (fn (k) (= k "evaled")) items)
@@ -582,6 +584,8 @@
(ef "prev-tracking")
(some (fn (k) (= k "extra")) items)
(ef "extra")
(some (fn (k) (= k "winders-len")) items)
(ef "winders-len")
:else "Nil")
"; cf_extra2 = "
(cond