coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix vm-global-get in native OCaml VM + transpiled VM ref

Browse Source 
The previous commit fixed lib/vm.sx (SX spec) but the server uses
sx_vm.ml (hand-maintained native OCaml) and sx_vm_ref.ml (transpiled).
Both had the same globals-first lookup bug. Now all three implementations
check closure env before vm.globals, matching vm-global-set.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-06 12:14:30 +00:00
parent 3a9d113537
commit 577d09f443
3 changed files with 34 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
hosts/ocaml/sx_vm_ref.ml
View File

@@ -432,7 +432,7 @@ let rec vm_call vm f args =
(* vm-resolve-ho-form *)
and vm_resolve_ho_form vm name =
(if sx_truthy ((prim_call "=" [name; (String "for-each")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (List.iter (fun x -> ignore ((vm_call_external (vm) (f) ((List [x]))))) (sx_to_list coll); Nil)) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [name; (String "map")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (List (List.map (fun x -> (vm_call_external (vm) (f) ((List [x])))) (sx_to_list coll)))) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [name; (String "map-indexed")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (List (List.mapi (fun i x -> let i = Number (float_of_int i) in (vm_call_external (vm) (f) ((List [i; x])))) (sx_to_list coll)))) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [name; (String "filter")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (List (List.filter (fun x -> sx_truthy ((vm_call_external (vm) (f) ((List [x]))))) (sx_to_list coll)))) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [name; (String "reduce")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; init; coll] -> (fun f init coll -> (List.fold_left (fun acc x -> (vm_call_external (vm) (f) ((List [acc; x])))) init (sx_to_list coll))) f init coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [name; (String "some")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (Bool (List.exists (fun x -> sx_truthy ((vm_call_external (vm) (f) ((List [x]))))) (sx_to_list coll)))) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [name; (String "every?")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (Bool (List.for_all (fun x -> sx_truthy ((vm_call_external (vm) (f) ((List [x]))))) (sx_to_list coll)))) f coll | _ -> Nil)) else (raise (Eval_error (value_to_str (String (sx_str [(String "VM undefined: "); name]))))))))))))
(let _match_val = name in (if sx_truthy ((prim_call "=" [_match_val; (String "for-each")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (List.iter (fun x -> ignore ((vm_call_external (vm) (f) ((List [x]))))) (sx_to_list coll); Nil)) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [_match_val; (String "map")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (List (List.map (fun x -> (vm_call_external (vm) (f) ((List [x])))) (sx_to_list coll)))) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [_match_val; (String "map-indexed")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (List (List.mapi (fun i x -> let i = Number (float_of_int i) in (vm_call_external (vm) (f) ((List [i; x])))) (sx_to_list coll)))) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [_match_val; (String "filter")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (List (List.filter (fun x -> sx_truthy ((vm_call_external (vm) (f) ((List [x]))))) (sx_to_list coll)))) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [_match_val; (String "reduce")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; init; coll] -> (fun f init coll -> (List.fold_left (fun acc x -> (vm_call_external (vm) (f) ((List [acc; x])))) init (sx_to_list coll))) f init coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [_match_val; (String "some")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (Bool (List.exists (fun x -> sx_truthy ((vm_call_external (vm) (f) ((List [x]))))) (sx_to_list coll)))) f coll | _ -> Nil)) else (if sx_truthy ((prim_call "=" [_match_val; (String "every?")])) then (NativeFn ("\206\187", fun _args -> match _args with [f; coll] -> (fun f coll -> (Bool (List.for_all (fun x -> sx_truthy ((vm_call_external (vm) (f) ((List [x]))))) (sx_to_list coll)))) f coll | _ -> Nil)) else (raise (Eval_error (value_to_str (String (sx_str [(String "VM undefined: "); name])))))))))))))
(* vm-call-external *)
and vm_call_external vm f args =
@@ -440,7 +440,7 @@ and vm_call_external vm f args =
(* vm-run *)
and vm_run vm =
(let () = ignore ((String "Execute bytecode until all frames are consumed.")) in (let rec loop = (fun () -> (if sx_truthy ((Bool (not (sx_truthy ((empty_p ((vm_frames (vm))))))))) then (let frame = (first ((vm_frames (vm)))) in let rest_frames = (rest ((vm_frames (vm)))) in (let bc = (code_bytecode ((closure_code ((frame_closure (frame)))))) in let consts = (code_constants ((closure_code ((frame_closure (frame)))))) in (if sx_truthy ((prim_call ">=" [(frame_ip (frame)); (len (bc))])) then (vm_set_frames_b (vm) ((List []))) else (let () = ignore ((vm_step (vm) (frame) (rest_frames) (bc) (consts))) in (if sx_truthy ((is_nil ((get ((vm_globals_ref (vm))) ((String "__io_request")))))) then (loop ()) else Nil))))) else Nil)) in (loop ())))
(let () = ignore ((String "Execute bytecode until all frames are done or IO suspension.")) in (let rec loop = (fun () -> (if sx_truthy ((Bool (not (sx_truthy ((empty_p ((vm_frames (vm))))))))) then (let frame = (first ((vm_frames (vm)))) in let rest_frames = (rest ((vm_frames (vm)))) in (let bc = (_> (frame) (frame_closure) (closure_code) (code_bytecode)) in let consts = (_> (frame) (frame_closure) (closure_code) (code_constants)) in (if sx_truthy ((prim_call ">=" [(frame_ip (frame)); (len (bc))])) then (vm_set_frames_b (vm) ((List []))) else (let () = ignore ((vm_step (vm) (frame) (rest_frames) (bc) (consts))) in (if sx_truthy ((is_nil ((get ((vm_globals_ref (vm))) ((String "__io_request")))))) then (loop ()) else Nil))))) else Nil)) in (loop ())))
(* vm-step *)
and vm_step vm frame rest_frames bc consts =