spec: multiple values — values/call-with-values/let-values/define-values

25 tests pass on both JS and OCaml hosts. Uses dict marker
{:_values true :_list [...]} for 0/2+ values; 1 value passes
through directly. step-sf-define extended to desugar shorthand
(define (name params) body) forms on both hosts.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>

hosts/ocaml/bin/run_tests.ml

@@ -1120,6 +1120,27 @@ let make_test_env () =
     | _ :: _ -> String "confirmed"
     | _ -> Nil);
 
+  bind "values" (fun args ->
+    match args with
+    | [v] -> v
+    | vs ->
+      let d = Hashtbl.create 2 in
+      Hashtbl.replace d "_values" (Bool true);
+      Hashtbl.replace d "_list" (List vs);
+      Dict d);
+
+  bind "call-with-values" (fun args ->
+    match args with
+    | [producer; consumer] ->
+      let result = Sx_ref.cek_call producer (List []) in
+      let spread = (match result with
+        | Dict d when (match Hashtbl.find_opt d "_values" with Some (Bool true) -> true | _ -> false) ->
+          (match Hashtbl.find_opt d "_list" with Some (List l) -> l | _ -> [result])
+        | _ -> [result])
+      in
+      Sx_ref.cek_call consumer (List spread)
+    | _ -> raise (Eval_error "call-with-values: expected 2 args"));
+
   env
 
 (* ====================================================================== *)

hosts/ocaml/lib/sx_ref.ml

@@ -782,6 +782,14 @@ and step_sf_let args env kont =
 
 (* step-sf-define *)
 and step_sf_define args env kont =
+  (* Desugar shorthand: (define (name p ...) body) -> (define name (fn (p ...) body)) *)
+  let args = match first args with
+    | List (fn_name :: params) ->
+      let body_parts = sx_to_list (rest args) in
+      let lambda_expr = List (Symbol "fn" :: List params :: body_parts) in
+      List [fn_name; lambda_expr]
+    | _ -> args
+  in
   (let name_sym = (first (args)) in let has_effects = (let _and = (prim_call ">=" [(len (args)); (Number 4.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((nth (args) ((Number 1.0))))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((nth (args) ((Number 1.0))))); (String "effects")]))) in let val_idx = (if sx_truthy ((let _and = (prim_call ">=" [(len (args)); (Number 4.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((nth (args) ((Number 1.0))))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((nth (args) ((Number 1.0))))); (String "effects")])))) then (Number 3.0) else (Number 1.0)) in let effect_list = (if sx_truthy ((let _and = (prim_call ">=" [(len (args)); (Number 4.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((nth (args) ((Number 1.0))))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((nth (args) ((Number 1.0))))); (String "effects")])))) then (nth (args) ((Number 2.0))) else Nil) in (make_cek_state ((nth (args) (val_idx))) (env) ((kont_push ((make_define_frame ((symbol_name (name_sym))) (env) (has_effects) (effect_list))) (kont)))))
 
 (* step-sf-set! *)
@@ -1093,4 +1101,64 @@ let () = ignore (register_special_form (String "define-type")
     | [args; env] -> sf_define_type args env
     | _ -> Nil)))
 
+(* Multiple values — helpers shared by let-values, define-values *)
+let make_values_dict vs =
+  let d = Hashtbl.create 2 in
+  Hashtbl.replace d "_values" (Bool true);
+  Hashtbl.replace d "_list" (List vs);
+  Dict d
+
+let values_to_list result =
+  match result with
+  | Dict d when (match Hashtbl.find_opt d "_values" with Some (Bool true) -> true | _ -> false) ->
+    (match Hashtbl.find_opt d "_list" with Some (List l) -> l | _ -> [result])
+  | _ -> [result]
+
+(* (let-values (((a b) expr) ...) body...) *)
+let sf_let_values args env_val =
+  let items = match args with List l -> l | _ -> [] in
+  let clauses = match List.nth_opt items 0 with Some (List l) -> l | _ -> [] in
+  let body = if List.length items > 1 then List.tl items else [] in
+  let local_env = env_extend env_val in
+  List.iter (fun clause ->
+    let names = (match clause with List (List ns :: _) -> ns | _ -> []) in
+    let val_expr = (match clause with List (_ :: e :: _) -> e | _ -> Nil) in
+    let result = eval_expr val_expr local_env in
+    let vs = values_to_list result in
+    List.iteri (fun idx name ->
+      let n = (match name with Symbol s -> s | String s -> s | _ -> value_to_string name) in
+      let v = if idx < List.length vs then List.nth vs idx else Nil in
+      ignore (env_bind local_env (String n) v)
+    ) names
+  ) clauses;
+  let last_val = ref Nil in
+  List.iter (fun e -> last_val := eval_expr e local_env) body;
+  !last_val
+
+(* (define-values (a b ...) expr) *)
+let sf_define_values args env_val =
+  let items = match args with List l -> l | _ -> [] in
+  let names = (match List.nth_opt items 0 with Some (List l) -> l | _ -> []) in
+  let val_expr = (match List.nth_opt items 1 with Some e -> e | None -> Nil) in
+  let result = eval_expr val_expr env_val in
+  let vs = values_to_list result in
+  List.iteri (fun idx name ->
+    let n = (match name with Symbol s -> s | String s -> s | _ -> value_to_string name) in
+    let v = if idx < List.length vs then List.nth vs idx else Nil in
+    ignore (env_bind env_val (String n) v)
+  ) names;
+  Nil
+
+let () = ignore (register_special_form (String "let-values")
+  (NativeFn ("let-values", fun call_args ->
+    match call_args with
+    | [args; env] -> sf_let_values args env
+    | _ -> Nil)))
+
+let () = ignore (register_special_form (String "define-values")
+  (NativeFn ("define-values", fun call_args ->
+    match call_args with
+    | [args; env] -> sf_define_values args env
+    | _ -> Nil)))
+