Retranspile sx_ref.ml: &rest in spec, no &rest/JIT/mutable patches
bootstrap.py down from 11 post-processing patches to 3 platform-level: - make_raise_guard_frame injection (transpiler dedup bug) - cek_run error capture (OCaml try/catch for comp-trace) - JIT hook dispatch (OCaml-specific optimization) 2566/2568 tests pass. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -12,20 +12,14 @@ let trampoline v = !trampoline_fn v
|
||||
|
||||
|
||||
|
||||
(* === Mutable state for strict mode === *)
|
||||
(* These are defined as top-level refs because the transpiler cannot handle
|
||||
global set! mutation (it creates local refs that shadow the global). *)
|
||||
(* === Mutable globals — backing refs for transpiler's !_ref / _ref := === *)
|
||||
let _strict_ref = ref (Bool false)
|
||||
let _prim_param_types_ref = ref Nil
|
||||
let _last_error_kont_ref = ref Nil
|
||||
|
||||
(* JIT call hook — cek_call checks this before CEK dispatch for named
|
||||
lambdas. Registered by sx_server.ml after compiler loads. Tests
|
||||
run with hook = None (pure CEK, no compilation dependency). *)
|
||||
(* JIT call hook — platform-level optimization, registered by sx_server.ml *)
|
||||
let jit_call_hook : (value -> value list -> value option) option ref = ref None
|
||||
|
||||
(* Component trace — captures kont from last CEK error for diagnostics *)
|
||||
let _last_error_kont : value ref = ref Nil
|
||||
|
||||
|
||||
|
||||
(* === Transpiled from evaluator (frames + eval + CEK) === *)
|
||||
@@ -319,49 +313,13 @@ and value_matches_type_p val' expected_type =
|
||||
and strict_check_args name args =
|
||||
(if sx_truthy ((let _and = !_strict_ref in if not (sx_truthy _and) then _and else !_prim_param_types_ref)) then (let spec = (get (!_prim_param_types_ref) (name)) in (if sx_truthy (spec) then (let positional = (get (spec) ((String "positional"))) in let rest_type = (get (spec) ((String "rest-type"))) in (let () = ignore ((if sx_truthy (positional) then (List.iter (fun pair -> ignore ((let idx = (first (pair)) in let param = (nth (pair) ((Number 1.0))) in let p_name = (first (param)) in let p_type = (nth (param) ((Number 1.0))) in (if sx_truthy ((prim_call "<" [idx; (len (args))])) then (let val' = (nth (args) (idx)) in (if sx_truthy ((Bool (not (sx_truthy ((value_matches_type_p (val') (p_type))))))) then (raise (Eval_error (value_to_str (String (sx_str [(String "Type error: "); name; (String " expected "); p_type; (String " for param "); p_name; (String ", got "); (type_of (val')); (String " ("); (String (sx_str [val'])); (String ")")]))))) else Nil)) else Nil)))) (sx_to_list (List (List.mapi (fun i p -> let i = Number (float_of_int i) in (List [i; p])) (sx_to_list positional)))); Nil) else Nil)) in (if sx_truthy ((let _and = rest_type in if not (sx_truthy _and) then _and else (prim_call ">" [(len (args)); (len ((let _or = positional in if sx_truthy _or then _or else (List []))))]))) then (List.iter (fun pair -> ignore ((let idx = (first (pair)) in let val' = (nth (pair) ((Number 1.0))) in (if sx_truthy ((Bool (not (sx_truthy ((value_matches_type_p (val') (rest_type))))))) then (raise (Eval_error (value_to_str (String (sx_str [(String "Type error: "); name; (String " expected "); rest_type; (String " for rest arg "); idx; (String ", got "); (type_of (val')); (String " ("); (String (sx_str [val'])); (String ")")]))))) else Nil)))) (sx_to_list (List (List.mapi (fun i v -> let i = Number (float_of_int i) in (List [i; v])) (sx_to_list (prim_call "slice" [args; (len ((let _or = positional in if sx_truthy _or then _or else (List []))))]))))); Nil) else Nil))) else Nil)) else Nil)
|
||||
|
||||
|
||||
(* &rest lambda param binding — injected by bootstrap.py *)
|
||||
and bind_lambda_with_rest (params : value) (args : value) (local_val : value) : bool =
|
||||
let local = match local_val with Env e -> e | _ -> failwith "bind_lambda_with_rest: expected env" in
|
||||
let param_list = sx_to_list params in
|
||||
let arg_list = sx_to_list args in
|
||||
let rec find_rest i = function
|
||||
| [] -> None
|
||||
| h :: rp :: _ when value_to_str h = "&rest" -> Some (i, value_to_str rp)
|
||||
| _ :: tl -> find_rest (i + 1) tl
|
||||
in
|
||||
match find_rest 0 param_list with
|
||||
| Some (pos, rest_name) ->
|
||||
let positional = List.filteri (fun i _ -> i < pos) param_list in
|
||||
List.iteri (fun i p ->
|
||||
let v = if i < List.length arg_list then List.nth arg_list i else Nil in
|
||||
ignore (Sx_types.env_bind local (value_to_str p) v)
|
||||
) positional;
|
||||
let rest_args = if List.length arg_list > pos
|
||||
then List (List.filteri (fun i _ -> i >= pos) arg_list)
|
||||
else List [] in
|
||||
ignore (Sx_types.env_bind local rest_name rest_args);
|
||||
true
|
||||
| None -> false
|
||||
(* bind-lambda-params *)
|
||||
and bind_lambda_params params args local =
|
||||
(let rest_idx = (prim_call "index-of" [params; (String "&rest")]) in (if sx_truthy ((let _and = (number_p (rest_idx)) in if not (sx_truthy _and) then _and else (prim_call "<" [rest_idx; (len (params))]))) then (let positional = (prim_call "slice" [params; (Number 0.0); rest_idx]) in let rest_name = (nth (params) ((prim_call "+" [rest_idx; (Number 1.0)]))) in (let () = ignore ((for_each_indexed ((NativeFn ("\206\187", fun _args -> match _args with [i; p] -> (fun i p -> (env_bind local (sx_to_string p) (if sx_truthy ((prim_call "<" [i; (len (args))])) then (nth (args) (i)) else Nil))) i p | _ -> Nil))) (positional))) in (let () = ignore ((env_bind local (sx_to_string rest_name) (if sx_truthy ((prim_call ">" [(len (args)); rest_idx])) then (prim_call "slice" [args; rest_idx]) else (List [])))) in (Bool true)))) else (Bool false)))
|
||||
|
||||
(* call-lambda *)
|
||||
and call_lambda f args caller_env =
|
||||
let params = lambda_params f in
|
||||
let local = env_merge (lambda_closure f) caller_env in
|
||||
if not (bind_lambda_with_rest params args local) then begin
|
||||
let pl = sx_to_list params and al = sx_to_list args in
|
||||
if List.length al > List.length pl then
|
||||
raise (Eval_error (Printf.sprintf "%s expects %d args, got %d"
|
||||
(match lambda_name f with String s -> s | _ -> "lambda")
|
||||
(List.length pl) (List.length al)));
|
||||
List.iter (fun pair ->
|
||||
ignore (env_bind local (sx_to_string (first pair)) (nth pair (Number 1.0)))
|
||||
) (sx_to_list (prim_call "zip" [params; args]));
|
||||
List.iter (fun p ->
|
||||
ignore (env_bind local (sx_to_string p) Nil)
|
||||
) (sx_to_list (prim_call "slice" [params; len args]))
|
||||
end;
|
||||
make_thunk (lambda_body f) local
|
||||
(let params = (lambda_params (f)) in let local = (env_merge ((lambda_closure (f))) (caller_env)) in (let () = ignore ((if sx_truthy ((Bool (not (sx_truthy ((bind_lambda_params (params) (args) (local))))))) then (let () = ignore ((if sx_truthy ((prim_call ">" [(len (args)); (len (params))])) then (raise (Eval_error (value_to_str (String (sx_str [(let _or = (lambda_name (f)) in if sx_truthy _or then _or else (String "lambda")); (String " expects "); (len (params)); (String " args, got "); (len (args))]))))) else Nil)) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (nth (pair) ((Number 1.0)))))) (sx_to_list (prim_call "zip" [params; args])); Nil)) in (List.iter (fun p -> ignore ((env_bind local (sx_to_string p) Nil))) (sx_to_list (prim_call "slice" [params; (len (args))])); Nil))) else Nil)) in (make_thunk ((lambda_body (f))) (local))))
|
||||
|
||||
(* call-component *)
|
||||
and call_component comp raw_args env =
|
||||
@@ -444,7 +402,7 @@ and cek_run state =
|
||||
(if sx_truthy ((cek_terminal_p (state))) then (cek_value (state)) else
|
||||
try cek_run ((cek_step (state)))
|
||||
with Eval_error msg ->
|
||||
(if !_last_error_kont = Nil then _last_error_kont := cek_kont state);
|
||||
(if !_last_error_kont_ref = Nil then _last_error_kont_ref := cek_kont state);
|
||||
raise (Eval_error msg))
|
||||
|
||||
(* cek-step *)
|
||||
@@ -641,7 +599,7 @@ and step_continue state =
|
||||
|
||||
(* continue-with-call *)
|
||||
and continue_with_call f args env raw_args kont =
|
||||
(if sx_truthy ((callcc_continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let captured = (callcc_continuation_data (f)) in (make_cek_value (arg) (env) (captured))) else (if sx_truthy ((continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let cont_data = (continuation_data (f)) in (let captured = (get (cont_data) ((String "captured"))) in (let result' = (cek_run ((make_cek_value (arg) (env) (captured)))) in (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((let _and = (is_callable (f)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_lambda (f)))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_component (f)))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_island (f)))))))))) then (make_cek_value ((sx_apply f args)) (env) (kont)) else (if sx_truthy ((is_lambda (f))) then (let params = (lambda_params (f)) in let local = (env_merge ((lambda_closure (f))) (env)) in (if not (bind_lambda_with_rest params args local) then begin let pl = sx_to_list params and al = sx_to_list args in if List.length al > List.length pl then raise (Eval_error (Printf.sprintf "%s expects %d args, got %d" (match lambda_name f with String s -> s | _ -> "lambda") (List.length pl) (List.length al))); List.iter (fun pair -> ignore (env_bind local (sx_to_string (first pair)) (nth pair (Number 1.0)))) (sx_to_list (prim_call "zip" [params; args])); List.iter (fun p -> ignore (env_bind local (sx_to_string p) Nil)) (sx_to_list (prim_call "slice" [params; len args])) end; (match !jit_call_hook, f with | Some hook, Lambda l when l.l_name <> None -> let args_list = match args with List a | ListRef { contents = a } -> a | _ -> [] in (match hook f args_list with Some result -> make_cek_value result local kont | None -> make_cek_state (lambda_body f) local kont) | _ -> make_cek_state ((lambda_body (f))) (local) (kont)))) else (if sx_truthy ((let _or = (is_component (f)) in if sx_truthy _or then _or else (is_island (f)))) then (let parsed = (parse_keyword_args (raw_args) (env)) in let kwargs = (first (parsed)) in let children = (nth (parsed) ((Number 1.0))) in let local = (env_merge ((component_closure (f))) (env)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) (let _or = (dict_get (kwargs) (p)) in if sx_truthy _or then _or else Nil)))) (sx_to_list (component_params (f))); Nil)) in (let () = ignore ((if sx_truthy ((component_has_children (f))) then (env_bind local (sx_to_string (String "children")) children) else Nil)) in (make_cek_state ((component_body (f))) (local) ((kont_push ((make_comp_trace_frame ((component_name (f))) ((component_file (f))))) (kont))))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Not callable: "); (inspect (f))]))))))))))
|
||||
(if sx_truthy ((callcc_continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let captured = (callcc_continuation_data (f)) in (make_cek_value (arg) (env) (captured))) else (if sx_truthy ((continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let cont_data = (continuation_data (f)) in (let captured = (get (cont_data) ((String "captured"))) in (let result' = (cek_run ((make_cek_value (arg) (env) (captured)))) in (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((let _and = (is_callable (f)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_lambda (f)))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_component (f)))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_island (f)))))))))) then (make_cek_value ((sx_apply f args)) (env) (kont)) else (if sx_truthy ((is_lambda (f))) then (let params = (lambda_params (f)) in let local = (env_merge ((lambda_closure (f))) (env)) in (let () = ignore ((if sx_truthy ((Bool (not (sx_truthy ((bind_lambda_params (params) (args) (local))))))) then (let () = ignore ((if sx_truthy ((prim_call ">" [(len (args)); (len (params))])) then (raise (Eval_error (value_to_str (String (sx_str [(let _or = (lambda_name (f)) in if sx_truthy _or then _or else (String "lambda")); (String " expects "); (len (params)); (String " args, got "); (len (args))]))))) else Nil)) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (nth (pair) ((Number 1.0)))))) (sx_to_list (prim_call "zip" [params; args])); Nil)) in (List.iter (fun p -> ignore ((env_bind local (sx_to_string p) Nil))) (sx_to_list (prim_call "slice" [params; (len (args))])); Nil))) else Nil)) in (make_cek_state ((lambda_body (f))) (local) (kont)))) else (if sx_truthy ((let _or = (is_component (f)) in if sx_truthy _or then _or else (is_island (f)))) then (let parsed = (parse_keyword_args (raw_args) (env)) in let kwargs = (first (parsed)) in let children = (nth (parsed) ((Number 1.0))) in let local = (env_merge ((component_closure (f))) (env)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) (let _or = (dict_get (kwargs) (p)) in if sx_truthy _or then _or else Nil)))) (sx_to_list (component_params (f))); Nil)) in (let () = ignore ((if sx_truthy ((component_has_children (f))) then (env_bind local (sx_to_string (String "children")) children) else Nil)) in (make_cek_state ((component_body (f))) (local) ((kont_push ((make_comp_trace_frame ((component_name (f))) ((component_file (f))))) (kont))))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Not callable: "); (inspect (f))]))))))))))
|
||||
|
||||
(* sf-case-step-loop *)
|
||||
and sf_case_step_loop match_val clauses env kont =
|
||||
@@ -679,7 +637,7 @@ let cek_run_iterative state =
|
||||
done;
|
||||
cek_value !s
|
||||
with Eval_error msg ->
|
||||
_last_error_kont := cek_kont !s;
|
||||
_last_error_kont_ref := cek_kont !s;
|
||||
raise (Eval_error msg))
|
||||
|
||||
(* Collect component trace from a kont value *)
|
||||
@@ -720,8 +678,8 @@ let format_comp_trace trace =
|
||||
|
||||
(* Enhance an error message with component trace *)
|
||||
let enhance_error_with_trace msg =
|
||||
let trace = collect_comp_trace !_last_error_kont in
|
||||
_last_error_kont := Nil;
|
||||
let trace = collect_comp_trace !_last_error_kont_ref in
|
||||
_last_error_kont_ref := Nil;
|
||||
msg ^ (format_comp_trace trace)
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user