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)))
+
 

shared/static/scripts/sx-browser.js

@@ -31,7 +31,7 @@
   // =========================================================================
 
   var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
-  var SX_VERSION = "2026-04-26T19:02:22Z";
+  var SX_VERSION = "2026-05-01T07:58:35Z";
 
   function isNil(x) { return x === NIL || x === null || x === undefined; }
   function isSxTruthy(x) { return x !== false && !isNil(x); }
@@ -780,6 +780,7 @@
     if (isLambda(f)) return trampoline(callLambda(f, args, lambdaClosure(f)));
     return f.apply(null, args);
   };
+  PRIMITIVES["apply"] = apply;
 
   // Additional primitive aliases used by adapter/engine transpiled code
   var split = PRIMITIVES["split"];
@@ -2007,6 +2008,58 @@ PRIMITIVES["qq-expand"] = qqExpand;
 })(); };
 PRIMITIVES["sf-letrec"] = sfLetrec;
 
+  // call-with-values
+  var callWithValues = function(producer, consumer) { return (function() {
+  var result = apply(producer, []);
+  return (isSxTruthy((isSxTruthy(isDict(result)) && get(result, "_values", false))) ? apply(consumer, get(result, "_list")) : apply(consumer, [result]));
+})(); };
+PRIMITIVES["call-with-values"] = callWithValues;
+
+  // sf-let-values
+  var sfLetValues = function(args, env) { return (function() {
+  var clauses = first(args);
+  var body = rest(args);
+  var local = envExtend(env);
+  { var _c = clauses; for (var _i = 0; _i < _c.length; _i++) { var clause = _c[_i]; (function() {
+  var names = first(clause);
+  var valExpr = nth(clause, 1);
+  return (function() {
+  var result = trampoline(evalExpr(valExpr, local));
+  return (function() {
+  var vs = (isSxTruthy((isSxTruthy(isDict(result)) && get(result, "_values", false))) ? get(result, "_list") : [result]);
+  return forEachIndexed(function(idx, name) { return envBind(local, symbolName(name), nth(vs, idx)); }, names);
+})();
+})();
+})(); } }
+  return (function() {
+  var lastVal = NIL;
+  { var _c = body; for (var _i = 0; _i < _c.length; _i++) { var e = _c[_i]; lastVal = trampoline(evalExpr(e, local)); } }
+  return lastVal;
+})();
+})(); };
+PRIMITIVES["sf-let-values"] = sfLetValues;
+
+  // sf-define-values
+  var sfDefineValues = function(args, env) { return (function() {
+  var names = first(args);
+  var valExpr = nth(args, 1);
+  return (function() {
+  var result = trampoline(evalExpr(valExpr, env));
+  return (function() {
+  var vs = (isSxTruthy((isSxTruthy(isDict(result)) && get(result, "_values", false))) ? get(result, "_list") : [result]);
+  forEachIndexed(function(idx, name) { return envBind(env, symbolName(name), nth(vs, idx)); }, names);
+  return NIL;
+})();
+})();
+})(); };
+PRIMITIVES["sf-define-values"] = sfDefineValues;
+
+  // (register-special-form! ...)
+  registerSpecialForm("define-values", sfDefineValues);
+
+  // (register-special-form! ...)
+  registerSpecialForm("let-values", sfLetValues);
+
   // step-sf-letrec
   var stepSfLetrec = function(args, env, kont) { return (function() {
   var thk = sfLetrec(args, env);
@@ -2200,6 +2253,10 @@ PRIMITIVES["step-eval-list"] = stepEvalList;
 })(); };
 PRIMITIVES["sf-define-type"] = sfDefineType;
 
+  // values
+  var values = function() { var vs = Array.prototype.slice.call(arguments, 0); return (isSxTruthy(sxEq(len(vs), 1)) ? first(vs) : {"_values": true, "_list": vs}); };
+PRIMITIVES["values"] = values;
+
   // (register-special-form! ...)
   registerSpecialForm("define-type", sfDefineType);
 
@@ -2692,11 +2749,19 @@ PRIMITIVES["step-sf-let"] = stepSfLet;
 
   // step-sf-define
   var stepSfDefine = function(args, env, kont) { return (function() {
-  var nameSym = first(args);
-  var hasEffects = (isSxTruthy((len(args) >= 4)) && isSxTruthy(sxEq(typeOf(nth(args, 1)), "keyword")) && sxEq(keywordName(nth(args, 1)), "effects"));
-  var valIdx = (isSxTruthy((isSxTruthy((len(args) >= 4)) && isSxTruthy(sxEq(typeOf(nth(args, 1)), "keyword")) && sxEq(keywordName(nth(args, 1)), "effects"))) ? 3 : 1);
-  var effectList = (isSxTruthy((isSxTruthy((len(args) >= 4)) && isSxTruthy(sxEq(typeOf(nth(args, 1)), "keyword")) && sxEq(keywordName(nth(args, 1)), "effects"))) ? nth(args, 2) : NIL);
-  return makeCekState(nth(args, valIdx), env, kontPush(makeDefineFrame(symbolName(nameSym), env, hasEffects, effectList), kont));
+  var resolvedArgs = (isSxTruthy(sxEq(typeOf(first(args)), "list")) ? (function() {
+  var fnName = first(first(args));
+  var params = rest(first(args));
+  var bodyParts = rest(args);
+  return [fnName, concat([makeSymbol("fn")], [params], bodyParts)];
+})() : args);
+  return (function() {
+  var nameSym = first(resolvedArgs);
+  var hasEffects = (isSxTruthy((len(resolvedArgs) >= 4)) && isSxTruthy(sxEq(typeOf(nth(resolvedArgs, 1)), "keyword")) && sxEq(keywordName(nth(resolvedArgs, 1)), "effects"));
+  var valIdx = (isSxTruthy((isSxTruthy((len(resolvedArgs) >= 4)) && isSxTruthy(sxEq(typeOf(nth(resolvedArgs, 1)), "keyword")) && sxEq(keywordName(nth(resolvedArgs, 1)), "effects"))) ? 3 : 1);
+  var effectList = (isSxTruthy((isSxTruthy((len(resolvedArgs) >= 4)) && isSxTruthy(sxEq(typeOf(nth(resolvedArgs, 1)), "keyword")) && sxEq(keywordName(nth(resolvedArgs, 1)), "effects"))) ? nth(resolvedArgs, 2) : NIL);
+  return makeCekState(nth(resolvedArgs, valIdx), env, kontPush(makeDefineFrame(symbolName(nameSym), env, hasEffects, effectList), kont));
+})();
 })(); };
 PRIMITIVES["step-sf-define"] = stepSfDefine;
 

spec/evaluator.sx

@@ -1384,6 +1384,79 @@
 ;; Creates a Macro with rules/literals stored in closure env.
 ;; Body is a marker symbol; expand-macro detects it and calls
 ;; the pattern matcher directly.
+(define
+  call-with-values
+  (fn
+    (producer consumer)
+    (let
+      ((result (apply producer (list))))
+      (if
+        (and (dict? result) (get result :_values false))
+        (apply consumer (get result :_list))
+        (apply consumer (list result))))))
+
+(define
+  sf-let-values
+  (fn
+    (args env)
+    (let
+      ((clauses (first args))
+        (body (rest args))
+        (local (env-extend env)))
+      (for-each
+        (fn
+          (clause)
+          (let
+            ((names (first clause)) (val-expr (nth clause 1)))
+            (let
+              ((result (trampoline (eval-expr val-expr local))))
+              (let
+                ((vs (if (and (dict? result) (get result :_values false)) (get result :_list) (list result))))
+                (for-each-indexed
+                  (fn
+                    (idx name)
+                    (env-bind! local (symbol-name name) (nth vs idx)))
+                  names)))))
+        clauses)
+      (let
+        ((last-val nil))
+        (for-each
+          (fn (e) (set! last-val (trampoline (eval-expr e local))))
+          body)
+        last-val))))
+
+;; R7RS records (SRFI-9)
+;;
+;; (define-record-type <point>
+;;   (make-point x y)
+;;   point?
+;;   (x point-x)
+;;   (y point-y set-point-y!))
+;;
+;; Creates: constructor, predicate, accessors, optional mutators.
+;; Opaque — only accessible through generated functions.
+;; Generative — each call creates a unique type.
+(define
+  sf-define-values
+  (fn
+    (args env)
+    (let
+      ((names (first args)) (val-expr (nth args 1)))
+      (let
+        ((result (trampoline (eval-expr val-expr env))))
+        (let
+          ((vs (if (and (dict? result) (get result :_values false)) (get result :_list) (list result))))
+          (for-each-indexed
+            (fn (idx name) (env-bind! env (symbol-name name) (nth vs idx)))
+            names)
+          nil)))))
+
+;; Delimited continuations
+(register-special-form! "define-values" sf-define-values)
+
+(register-special-form! "let-values" sf-let-values)
+
+;; Signal dereferencing with reactive dependency tracking
 (define
   step-sf-letrec
   (fn
@@ -1392,6 +1465,13 @@
       ((thk (sf-letrec args env)))
       (make-cek-state (thunk-expr thk) (thunk-env thk) kont))))
 
+;; ═══════════════════════════════════════════════════════════════
+;; Part 8: Call Dispatch
+;;
+;; cek-call: invoke a function from native code (runs a nested
+;; trampoline). step-eval-call: CEK-native call dispatch for
+;; lambda, component, native fn, and continuations.
+;; ═══════════════════════════════════════════════════════════════
 (define
   step-sf-dynamic-wind
   (fn
@@ -1412,17 +1492,7 @@
             (list)
             (kont-push (make-wind-after-frame after winders-len env) kont)))))))
 
-;; R7RS records (SRFI-9)
-;;
-;; (define-record-type <point>
-;;   (make-point x y)
-;;   point?
-;;   (x point-x)
-;;   (y point-y set-point-y!))
-;;
-;; Creates: constructor, predicate, accessors, optional mutators.
-;; Opaque — only accessible through generated functions.
-;; Generative — each call creates a unique type.
+;; Reactive signal tracking — captures dependency continuation for re-render
 (define
   sf-scope
   (fn
@@ -1450,7 +1520,6 @@
         (scope-pop! name)
         result))))
 
-;; Delimited continuations
 (define
   sf-provide
   (fn
@@ -1467,6 +1536,13 @@
       (scope-pop! name)
       result)))
 
+;; ═══════════════════════════════════════════════════════════════
+;; Part 9: Higher-Order Form Machinery
+;;
+;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
+;; ho-swap-args auto-detects argument order. HoSetupFrame stages
+;; argument evaluation, then dispatches to the appropriate step-ho-*.
+;; ═══════════════════════════════════════════════════════════════
 (define
   expand-macro
   (fn
@@ -1502,7 +1578,6 @@
               (slice raw-args (len (macro-params mac)))))
           (trampoline (eval-expr (macro-body mac) local)))))))
 
-;; Signal dereferencing with reactive dependency tracking
 (define
   cek-step-loop
   (fn
@@ -1512,13 +1587,6 @@
       state
       (cek-step-loop (cek-step state)))))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 8: Call Dispatch
-;;
-;; cek-call: invoke a function from native code (runs a nested
-;; trampoline). step-eval-call: CEK-native call dispatch for
-;; lambda, component, native fn, and continuations.
-;; ═══════════════════════════════════════════════════════════════
 (define
   cek-run
   (fn
@@ -1530,7 +1598,6 @@
         (error "IO suspension in non-IO context")
         (cek-value final)))))
 
-;; Reactive signal tracking — captures dependency continuation for re-render
 (define
   cek-resume
   (fn
@@ -1550,13 +1617,6 @@
       (step-eval state)
       (step-continue state))))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 9: Higher-Order Form Machinery
-;;
-;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
-;; ho-swap-args auto-detects argument order. HoSetupFrame stages
-;; argument evaluation, then dispatches to the appropriate step-ho-*.
-;; ═══════════════════════════════════════════════════════════════
 (define
   step-eval
   (fn
@@ -1683,7 +1743,10 @@
             (list
               (quote and)
               (list (quote list?) (quote __guard-result))
-              (list (quote =) (list (quote len) (quote __guard-result)) 2)
+              (list
+                (quote =)
+                (list (quote len) (quote __guard-result))
+                2)
               (list
                 (quote =)
                 (list (quote first) (quote __guard-result))
@@ -1726,6 +1789,14 @@
         env
         kont))))
 
+;; ═══════════════════════════════════════════════════════════════
+;; Part 10: Continue Phase — Frame Dispatch
+;;
+;; When phase="continue", pop the top frame and process the value.
+;; Each frame type has its own handling: if frames check truthiness,
+;; let frames bind the value, arg frames accumulate it, etc.
+;; continue-with-call handles the final function/component dispatch.
+;; ═══════════════════════════════════════════════════════════════
 (define
   step-eval-list
   (fn
@@ -1784,7 +1855,12 @@
                       (inits (map (fn (b) (nth b 1)) bindings))
                       (steps
                         (map
-                          (fn (b) (if (> (len b) 2) (nth b 2) (first b)))
+                          (fn
+                            (b)
+                            (if
+                              (> (len b) 2)
+                              (nth b 2)
+                              (first b)))
                           bindings))
                       (test (first test-clause))
                       (result (rest test-clause)))
@@ -1898,6 +1974,9 @@
                   :else (step-eval-call head args env kont)))))
           (step-eval-call head args env kont))))))
 
+;; Final call dispatch from arg frame — all args evaluated, invoke function.
+;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
+;; native fn (direct call), continuation (resume), callcc continuation (escape).
 (define
   sf-define-type
   (fn
@@ -1957,6 +2036,17 @@
           ctor-specs)
         nil))))
 
+(define
+  values
+  (fn (&rest vs) (if (= (len vs) 1) (first vs) {:_values true :_list vs})))
+
+;; ═══════════════════════════════════════════════════════════════
+;; Part 11: Entry Points
+;;
+;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
+;; eval-expr / trampoline: top-level bindings that override the
+;; forward declarations from Part 5.
+;; ═══════════════════════════════════════════════════════════════
 (register-special-form! "define-type" sf-define-type)
 
 (define
@@ -1993,14 +2083,6 @@
             subs)
           (for-each (fn (sub) (cek-call sub (list kont))) subs))))))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 10: Continue Phase — Frame Dispatch
-;;
-;; When phase="continue", pop the top frame and process the value.
-;; Each frame type has its own handling: if frames check truthiness,
-;; let frames bind the value, arg frames accumulate it, etc.
-;; continue-with-call handles the final function/component dispatch.
-;; ═══════════════════════════════════════════════════════════════
 (define
   fire-provide-subscribers
   (fn
@@ -2020,9 +2102,6 @@
             subs)
           (for-each (fn (sub) (cek-call sub (list nil))) subs))))))
 
-;; Final call dispatch from arg frame — all args evaluated, invoke function.
-;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
-;; native fn (direct call), continuation (resume), callcc continuation (escape).
 (define
   batch-begin!
   (fn () (set! *provide-batch-depth* (+ *provide-batch-depth* 1))))
@@ -2039,13 +2118,6 @@
         (set! *provide-batch-queue* (list))
         (for-each (fn (sub) (cek-call sub (list nil))) queue)))))
 
-;; ═══════════════════════════════════════════════════════════════
-;; Part 11: Entry Points
-;;
-;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
-;; eval-expr / trampoline: top-level bindings that override the
-;; forward declarations from Part 5.
-;; ═══════════════════════════════════════════════════════════════
 (define
   step-sf-bind
   (fn
@@ -2736,7 +2808,12 @@
       (= value (nth pattern 1))
       (symbol? pattern)
       (do (env-bind! env (symbol-name pattern) value) true)
-      (and (list? pattern) (not (empty? pattern)) (symbol? (first pattern)) (dict? value) (get value :_adt))
+      (and
+        (list? pattern)
+        (not (empty? pattern))
+        (symbol? (first pattern))
+        (dict? value)
+        (get value :_adt))
       (let
         ((ctor-name (symbol-name (first pattern)))
           (field-patterns (rest pattern))
@@ -2745,7 +2822,9 @@
           (= (get value :_ctor) ctor-name)
           (= (len field-patterns) (len fields))
           (every?
-            (fn (pair) (match-pattern (first pair) (nth pair 1) env))
+            (fn
+              (pair)
+              (match-pattern (first pair) (nth pair 1) env))
             (zip field-patterns fields))))
       (and (dict? pattern) (dict? value))
       (every?
@@ -2791,7 +2870,10 @@
         ((result (match-find-clause val clauses env)))
         (if
           (nil? result)
-          (make-cek-value (str "match: no clause matched " (inspect val)) env (kont-push (make-raise-eval-frame env false) kont))
+          (make-cek-value
+            (str "match: no clause matched " (inspect val))
+            env
+            (kont-push (make-raise-eval-frame env false) kont))
           (make-cek-state (nth result 1) (first result) kont))))))
 
 (define
@@ -2973,38 +3055,40 @@
   (fn
     (args env kont)
     (let
-      ((name-sym (first args))
-        (has-effects
-          (and
-            (>= (len args) 4)
-            (= (type-of (nth args 1)) "keyword")
-            (= (keyword-name (nth args 1)) "effects")))
-        (val-idx
-          (if
+      ((resolved-args (if (= (type-of (first args)) "list") (let ((fn-name (first (first args))) (params (rest (first args))) (body-parts (rest args))) (list fn-name (concat (list (make-symbol "fn")) (list params) body-parts))) args)))
+      (let
+        ((name-sym (first resolved-args))
+          (has-effects
             (and
-              (>= (len args) 4)
-              (= (type-of (nth args 1)) "keyword")
-              (= (keyword-name (nth args 1)) "effects"))
-            3
-            1))
-        (effect-list
-          (if
-            (and
-              (>= (len args) 4)
-              (= (type-of (nth args 1)) "keyword")
-              (= (keyword-name (nth args 1)) "effects"))
-            (nth args 2)
-            nil)))
-      (make-cek-state
-        (nth args val-idx)
-        env
-        (kont-push
-          (make-define-frame
-            (symbol-name name-sym)
-            env
-            has-effects
-            effect-list)
-          kont)))))
+              (>= (len resolved-args) 4)
+              (= (type-of (nth resolved-args 1)) "keyword")
+              (= (keyword-name (nth resolved-args 1)) "effects")))
+          (val-idx
+            (if
+              (and
+                (>= (len resolved-args) 4)
+                (= (type-of (nth resolved-args 1)) "keyword")
+                (= (keyword-name (nth resolved-args 1)) "effects"))
+              3
+              1))
+          (effect-list
+            (if
+              (and
+                (>= (len resolved-args) 4)
+                (= (type-of (nth resolved-args 1)) "keyword")
+                (= (keyword-name (nth resolved-args 1)) "effects"))
+              (nth resolved-args 2)
+              nil)))
+        (make-cek-state
+          (nth resolved-args val-idx)
+          env
+          (kont-push
+            (make-define-frame
+              (symbol-name name-sym)
+              env
+              has-effects
+              effect-list)
+            kont))))))
 
 (define
   step-sf-set!

spec/tests/test-values.sx

@@ -0,0 +1,172 @@
+(defsuite
+  "multiple-values"
+  (deftest
+    "values single returns value directly"
+    (do
+      (assert= 42 (values 42))
+      (assert= "hi" (values "hi"))
+      (assert= nil (values nil))))
+  (deftest
+    "values multiple returns marker dict"
+    (do
+      (let
+        ((v (values 1 2 3)))
+        (assert (dict? v))
+        (assert= true (get v :_values false))
+        (assert-equal (list 1 2 3) (get v :_list)))))
+  (deftest
+    "call-with-values basic two values"
+    (do
+      (assert=
+        3
+        (call-with-values
+          (fn () (values 1 2))
+          (fn (a b) (+ a b))))))
+  (deftest
+    "call-with-values three values"
+    (do
+      (assert=
+        6
+        (call-with-values
+          (fn () (values 1 2 3))
+          (fn (a b c) (+ a b c))))))
+  (deftest
+    "call-with-values single value passthrough"
+    (do
+      (assert= 10 (call-with-values (fn () 10) (fn (x) x)))))
+  (deftest
+    "call-with-values passes non-values result as single arg"
+    (do (assert= "hello" (call-with-values (fn () "hello") (fn (x) x)))))
+  (deftest
+    "call-with-values with string concat"
+    (do
+      (assert=
+        "ab"
+        (call-with-values (fn () (values "a" "b")) (fn (a b) (str a b))))))
+  (deftest
+    "let-values basic two bindings"
+    (do
+      (let-values
+        (((a b) (values 10 20)))
+        (assert= 10 a)
+        (assert= 20 b))))
+  (deftest
+    "let-values computes with bindings"
+    (do
+      (let-values
+        (((x y) (values 3 4)))
+        (assert= 7 (+ x y)))))
+  (deftest
+    "let-values three values"
+    (do
+      (let-values
+        (((a b c) (values 1 2 3)))
+        (assert= 6 (+ a b c)))))
+  (deftest
+    "let-values single value binding"
+    (do (let-values (((x) (values 42))) (assert= 42 x))))
+  (deftest
+    "let-values multiple binding clauses"
+    (do
+      (let-values
+        (((a b) (values 1 2))
+          ((c d) (values 3 4)))
+        (assert= 10 (+ a b c d)))))
+  (deftest
+    "let-values body is multiple expressions"
+    (do
+      (let-values
+        (((a b) (values 5 6)))
+        (define sum (+ a b))
+        (assert= 11 sum))))
+  (deftest
+    "let-values with no bindings evals body"
+    (do (let-values () (assert= 99 99))))
+  (deftest
+    "define-values binds multiple names"
+    (do
+      (define-values (x y) (values 7 8))
+      (assert= 7 x)
+      (assert= 8 y)))
+  (deftest
+    "define-values three names"
+    (do
+      (define-values (a b c) (values 10 20 30))
+      (assert= 10 a)
+      (assert= 20 b)
+      (assert= 30 c)))
+  (deftest
+    "define-values single name"
+    (do (define-values (n) (values 42)) (assert= 42 n)))
+  (deftest
+    "define-values used in computation"
+    (do
+      (define-values (w h) (values 6 7))
+      (assert= 42 (* w h))))
+  (deftest
+    "values in let binding"
+    (do
+      (let
+        ((v (values 100 200)))
+        (assert= true (get v :_values false))
+        (assert= 100 (first (get v :_list))))))
+  (deftest
+    "call-with-values with swap"
+    (do
+      (define (swap a b) (values b a))
+      (assert=
+        5
+        (call-with-values
+          (fn () (swap 3 5))
+          (fn (first-val second-val) first-val)))))
+  (deftest
+    "let-values from function returning values"
+    (do
+      (define (min-max a b) (values (min a b) (max a b)))
+      (let-values
+        (((lo hi) (min-max 7 3)))
+        (assert= 3 lo)
+        (assert= 7 hi))))
+  (deftest
+    "nested let-values"
+    (do
+      (let-values
+        (((a b) (values 1 2)))
+        (let-values
+          (((c d) (values 3 4)))
+          (assert= 10 (+ a b c d))))))
+  (deftest
+    "call-with-values chained"
+    (do
+      (define
+        result
+        (call-with-values
+          (fn
+            ()
+            (call-with-values
+              (fn () (values 4 6))
+              (fn (a b) (* a b))))
+          (fn (x) x)))
+      (assert= 24 result)))
+  (deftest
+    "values zero args produces dict"
+    (do
+      (let
+        ((v (values)))
+        (assert (dict? v))
+        (assert (get v :_values false))
+        (assert-equal (list) (get v :_list)))))
+  (deftest
+    "let-values strings"
+    (do
+      (let-values
+        (((first-name last-name) (values "Alice" "Smith")))
+        (assert= "Alice Smith" (str first-name " " last-name)))))
+  (deftest
+    "define-values with list values"
+    (do
+      (define-values
+        (head tail)
+        (values 1 (list 2 3 4)))
+      (assert= 1 head)
+      (assert-equal (list 2 3 4) tail))))