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
|
!Sx_types._cek_eval_lambda_ref f args
|
||||||
| Continuation (k, _) ->
|
| Continuation (k, _) ->
|
||||||
k (match args with x :: _ -> x | [] -> Nil)
|
k (match args with x :: _ -> x | [] -> Nil)
|
||||||
| CallccContinuation _ ->
|
| CallccContinuation (_, _) ->
|
||||||
raise (Eval_error "callcc continuations must be invoked through the CEK machine")
|
raise (Eval_error "callcc continuations must be invoked through the CEK machine")
|
||||||
| _ ->
|
| _ ->
|
||||||
let nargs = List.length args in
|
let nargs = List.length args in
|
||||||
@@ -156,6 +156,9 @@ let get_val container key =
|
|||||||
| "extra" -> f.cf_extra | "extra2" -> f.cf_extra2
|
| "extra" -> f.cf_extra | "extra2" -> f.cf_extra2
|
||||||
| "subscribers" -> f.cf_results
|
| "subscribers" -> f.cf_results
|
||||||
| "prev-tracking" -> f.cf_extra
|
| "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)
|
| _ -> Nil)
|
||||||
| VmFrame f, String k ->
|
| VmFrame f, String k ->
|
||||||
(match k with
|
(match k with
|
||||||
@@ -381,15 +384,20 @@ let continuation_data v = match v with
|
|||||||
| _ -> raise (Eval_error "not a continuation")
|
| _ -> raise (Eval_error "not a continuation")
|
||||||
|
|
||||||
(* Callcc (undelimited) continuation support *)
|
(* 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 =
|
let make_callcc_continuation captured winders_len =
|
||||||
CallccContinuation (sx_to_list captured)
|
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
|
let callcc_continuation_data v = match v with
|
||||||
| CallccContinuation frames -> List frames
|
| CallccContinuation (frames, _) -> List frames
|
||||||
| _ -> raise (Eval_error "not a callcc continuation")
|
| _ -> 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) *)
|
(* Dynamic wind — simplified for OCaml (no async) *)
|
||||||
let host_error msg =
|
let host_error msg =
|
||||||
raise (Eval_error (value_to_str msg))
|
raise (Eval_error (value_to_str msg))
|
||||||
|
|||||||
@@ -57,7 +57,7 @@ and value =
|
|||||||
| Macro of macro
|
| Macro of macro
|
||||||
| Thunk of value * env
|
| Thunk of value * env
|
||||||
| Continuation of (value -> value) * dict option
|
| 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)
|
| NativeFn of string * (value list -> value)
|
||||||
| Signal of signal
|
| Signal of signal
|
||||||
| RawHTML of string
|
| RawHTML of string
|
||||||
@@ -476,7 +476,7 @@ let type_of = function
|
|||||||
| Macro _ -> "macro"
|
| Macro _ -> "macro"
|
||||||
| Thunk _ -> "thunk"
|
| Thunk _ -> "thunk"
|
||||||
| Continuation (_, _) -> "continuation"
|
| Continuation (_, _) -> "continuation"
|
||||||
| CallccContinuation _ -> "continuation"
|
| CallccContinuation (_, _) -> "continuation"
|
||||||
| NativeFn _ -> "function"
|
| NativeFn _ -> "function"
|
||||||
| Signal _ -> "signal"
|
| Signal _ -> "signal"
|
||||||
| RawHTML _ -> "raw-html"
|
| RawHTML _ -> "raw-html"
|
||||||
@@ -506,7 +506,7 @@ let is_signal = function
|
|||||||
let is_record = function Record _ -> true | _ -> false
|
let is_record = function Record _ -> true | _ -> false
|
||||||
|
|
||||||
let is_callable = function
|
let is_callable = function
|
||||||
| Lambda _ | NativeFn _ | Continuation (_, _) | CallccContinuation _ | VmClosure _ -> true
|
| Lambda _ | NativeFn _ | Continuation (_, _) | CallccContinuation (_, _) | VmClosure _ -> true
|
||||||
| _ -> false
|
| _ -> false
|
||||||
|
|
||||||
|
|
||||||
@@ -815,7 +815,7 @@ let rec inspect = function
|
|||||||
Printf.sprintf "<%s(%s)>" tag (String.concat ", " m.m_params)
|
Printf.sprintf "<%s(%s)>" tag (String.concat ", " m.m_params)
|
||||||
| Thunk _ -> "<thunk>"
|
| Thunk _ -> "<thunk>"
|
||||||
| Continuation (_, _) -> "<continuation>"
|
| Continuation (_, _) -> "<continuation>"
|
||||||
| CallccContinuation _ -> "<callcc-continuation>"
|
| CallccContinuation (_, _) -> "<callcc-continuation>"
|
||||||
| NativeFn (name, _) -> Printf.sprintf "<native:%s>" name
|
| NativeFn (name, _) -> Printf.sprintf "<native:%s>" name
|
||||||
| Signal _ -> "<signal>"
|
| Signal _ -> "<signal>"
|
||||||
| RawHTML s -> Printf.sprintf "\"<raw-html:%d>\"" (String.length s)
|
| RawHTML s -> Printf.sprintf "\"<raw-html:%d>\"" (String.length s)
|
||||||
|
|||||||
@@ -256,6 +256,7 @@
|
|||||||
"callcc-continuation?"
|
"callcc-continuation?"
|
||||||
"callcc-continuation-data"
|
"callcc-continuation-data"
|
||||||
"make-callcc-continuation"
|
"make-callcc-continuation"
|
||||||
|
"callcc-continuation-winders-len"
|
||||||
"dynamic-wind-call"
|
"dynamic-wind-call"
|
||||||
"strip-prefix"
|
"strip-prefix"
|
||||||
"component-set-param-types!"
|
"component-set-param-types!"
|
||||||
@@ -295,7 +296,8 @@
|
|||||||
"*bind-tracking*"
|
"*bind-tracking*"
|
||||||
"*provide-batch-depth*"
|
"*provide-batch-depth*"
|
||||||
"*provide-batch-queue*"
|
"*provide-batch-queue*"
|
||||||
"*provide-subscribers*"))
|
"*provide-subscribers*"
|
||||||
|
"*winders*"))
|
||||||
|
|
||||||
(define
|
(define
|
||||||
ml-is-mutable-global?
|
ml-is-mutable-global?
|
||||||
@@ -533,13 +535,13 @@
|
|||||||
"; cf_env = "
|
"; cf_env = "
|
||||||
(ef "env")
|
(ef "env")
|
||||||
"; cf_name = "
|
"; 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 = "
|
"; cf_body = "
|
||||||
(if (= frame-type "if") (ef "then") (ef "body"))
|
(if (= frame-type "if") (ef "then") (ef "body"))
|
||||||
"; cf_remaining = "
|
"; cf_remaining = "
|
||||||
(ef "remaining")
|
(ef "remaining")
|
||||||
"; cf_f = "
|
"; 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 = "
|
"; cf_args = "
|
||||||
(cond
|
(cond
|
||||||
(some (fn (k) (= k "evaled")) items)
|
(some (fn (k) (= k "evaled")) items)
|
||||||
@@ -582,6 +584,8 @@
|
|||||||
(ef "prev-tracking")
|
(ef "prev-tracking")
|
||||||
(some (fn (k) (= k "extra")) items)
|
(some (fn (k) (= k "extra")) items)
|
||||||
(ef "extra")
|
(ef "extra")
|
||||||
|
(some (fn (k) (= k "winders-len")) items)
|
||||||
|
(ef "winders-len")
|
||||||
:else "Nil")
|
:else "Nil")
|
||||||
"; cf_extra2 = "
|
"; cf_extra2 = "
|
||||||
(cond
|
(cond
|
||||||
|
|||||||
Reference in New Issue
Block a user