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:
File diff suppressed because one or more lines are too long
@@ -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))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user