diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index e4b9cd2..2b77928 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -84,10 +84,10 @@ let () = register "abs" (fun args -> match args with [a] -> Number (Float.abs (as_number a)) | _ -> raise (Eval_error "abs: 1 arg")); register "floor" (fun args -> - match args with [a] -> Number (Float.of_int (int_of_float (Float.round (as_number a -. 0.5)))) + match args with [a] -> Number (floor (as_number a)) | _ -> raise (Eval_error "floor: 1 arg")); register "ceil" (fun args -> - match args with [a] -> Number (Float.of_int (int_of_float (Float.round (as_number a +. 0.5)))) + match args with [a] -> Number (ceil (as_number a)) | _ -> raise (Eval_error "ceil: 1 arg")); register "round" (fun args -> match args with @@ -570,6 +570,14 @@ let () = match args with [a] -> String (type_of a) | _ -> raise (Eval_error "type-of: 1 arg")); register "inspect" (fun args -> match args with [a] -> String (inspect a) | _ -> raise (Eval_error "inspect: 1 arg")); + register "serialize" (fun args -> + match args with + | [a] -> String (inspect a) (* used for dedup keys in compiler *) + | _ -> raise (Eval_error "serialize: 1 arg")); + register "make-symbol" (fun args -> + match args with + | [String s] -> Symbol s + | _ -> raise (Eval_error "make-symbol: expected string")); register "error" (fun args -> match args with [String msg] -> raise (Eval_error msg) | [a] -> raise (Eval_error (to_string a)) diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index 1b04122..6d0cc39 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -246,7 +246,12 @@ let rec run vm = let args = List.init argc (fun _ -> pop vm) |> List.rev in let result = try - (match Sx_primitives.get_primitive name with + (* Check globals first (has env bindings like set-render-active!), + then fall back to registered primitives *) + let fn_val = try Hashtbl.find vm.globals name with Not_found -> + Sx_primitives.get_primitive name + in + (match fn_val with | NativeFn (_, fn) -> fn args | _ -> Nil) with Eval_error msg ->