cl: multiple values — 15 new tests (174 eval, 346 total green)

VALUES wraps 2+ values in {:cl-type "mv"}; cl-mv-primary strips to
primary in IF/AND/OR/COND/cl-call-fn single-value contexts; cl-mv-vals
expands for MULTIPLE-VALUE-BIND, MULTIPLE-VALUE-CALL, NTH-VALUE.

lib/common-lisp/eval.sx

@@ -43,6 +43,18 @@
 (define cl-go-tag?
   (fn (v) (and (dict? v) (= (get v "cl-type") "go-tag"))))
 
+(define cl-mv?
+  (fn (v) (and (dict? v) (= (get v "cl-type") "mv"))))
+
+(define cl-mv-primary
+  (fn (v)
+    (if (cl-mv? v)
+      (if (> (len (get v "vals")) 0) (nth (get v "vals") 0) nil)
+      v)))
+
+(define cl-mv-vals
+  (fn (v) (if (cl-mv? v) (get v "vals") (list v))))
+
 (define cl-eval-body
   (fn (forms env)
     (cond
@@ -252,7 +264,7 @@
                  (reduce (fn (acc x) (concat (list x) acc))
                          (list) (nth args 0)))
     "IDENTITY" (fn (args) (nth args 0))
-    "VALUES"   (fn (args) (if (> (len args) 0) (nth args 0) nil))
+    "VALUES"   (fn (args) (cond ((= (len args) 0) nil) ((= (len args) 1) (nth args 0)) (:else {:cl-type "mv" :vals args})))
     "PRINT"    (fn (args) (nth args 0))
     "PRIN1"    (fn (args) (nth args 0))
     "PRINC"    (fn (args) (nth args 0))
@@ -309,6 +321,39 @@
                     (:else (run (+ i 1))))))))))
       (run 0))))
 
+;; ── MULTIPLE VALUES ──────────────────────────────────────────────
+
+(define cl-eval-multiple-value-bind
+  (fn (args env)
+    (let ((vars  (nth args 0))
+          (form  (nth args 1))
+          (body  (rest (rest args))))
+      (let ((vals (cl-mv-vals (cl-eval form env))))
+        (define bind-vars
+          (fn (names i e)
+            (if (= (len names) 0)
+              e
+              (bind-vars (rest names) (+ i 1)
+                (cl-env-bind-var e (nth names 0)
+                  (if (< i (len vals)) (nth vals i) nil))))))
+        (cl-eval-body body (bind-vars vars 0 env))))))
+
+(define cl-eval-multiple-value-call
+  (fn (args env)
+    (let ((fn-obj (cl-eval (nth args 0) env))
+          (forms  (rest args)))
+      (let ((all-vals (reduce
+                        (fn (acc f)
+                          (concat acc (cl-mv-vals (cl-eval f env))))
+                        (list) forms)))
+        (cl-apply fn-obj all-vals)))))
+
+(define cl-eval-multiple-value-prog1
+  (fn (args env)
+    (let ((first-result (cl-eval (nth args 0) env)))
+      (for-each (fn (f) (cl-eval f env)) (rest args))
+      first-result)))
+
 ;; ── UNWIND-PROTECT ───────────────────────────────────────────────
 
 (define cl-eval-unwind-protect
@@ -341,7 +386,7 @@
 
 (define cl-eval-if
   (fn (args env)
-    (let ((cond-val  (cl-eval (nth args 0) env))
+    (let ((cond-val  (cl-mv-primary (cl-eval (nth args 0) env)))
           (then-form (nth args 1))
           (else-form (if (> (len args) 2) (nth args 2) nil)))
       (if cond-val
@@ -352,7 +397,7 @@
   (fn (args env)
     (if (= (len args) 0)
       true
-      (let ((val (cl-eval (nth args 0) env)))
+      (let ((val (cl-mv-primary (cl-eval (nth args 0) env))))
         (if (not val)
           nil
           (if (= (len args) 1)
@@ -363,7 +408,7 @@
   (fn (args env)
     (if (= (len args) 0)
       nil
-      (let ((val (cl-eval (nth args 0) env)))
+      (let ((val (cl-mv-primary (cl-eval (nth args 0) env))))
         (if val
           val
           (cl-eval-or (rest args) env))))))
@@ -373,7 +418,7 @@
     (if (= (len clauses) 0)
       nil
       (let ((clause (nth clauses 0)))
-        (let ((test-val (cl-eval (nth clause 0) env)))
+        (let ((test-val (cl-mv-primary (cl-eval (nth clause 0) env))))
           (if test-val
             (if (= (len clause) 1)
               test-val
@@ -523,7 +568,7 @@
 ;; Function call: evaluate name → look up fns, builtins; evaluate args
 (define cl-call-fn
   (fn (name args env)
-    (let ((evaled (map (fn (a) (cl-eval a env)) args)))
+    (let ((evaled (map (fn (a) (cl-mv-primary (cl-eval a env))) args)))
       (cond
         ;; FUNCALL: (funcall fn arg...)
         ((= name "FUNCALL")
@@ -615,6 +660,13 @@
           ((= head "TAGBODY")      (cl-eval-tagbody args env))
           ((= head "GO")
             {:cl-type "go-tag" :tag (nth args 0)})
+          ((= head "MULTIPLE-VALUE-BIND")  (cl-eval-multiple-value-bind args env))
+          ((= head "MULTIPLE-VALUE-CALL")  (cl-eval-multiple-value-call args env))
+          ((= head "MULTIPLE-VALUE-PROG1") (cl-eval-multiple-value-prog1 args env))
+          ((= head "NTH-VALUE")
+            (let ((n (cl-mv-primary (cl-eval (nth args 0) env)))
+                  (vals (cl-mv-vals (cl-eval (nth args 1) env))))
+              (if (< n (len vals)) (nth vals n) nil)))
           ((= head "UNWIND-PROTECT") (cl-eval-unwind-protect args env))
           ((= head "BLOCK")        (cl-eval-block args env))
           ((= head "RETURN-FROM")  (cl-eval-return-from args env))

lib/common-lisp/tests/eval.sx

@@ -388,3 +388,51 @@
 (cl-test "unwind-protect: nested, inner cleanup first"
   (ev "(let ((n 0)) (unwind-protect (unwind-protect 1 (setq n (+ n 10))) (setq n (+ n 1))) n)")
   11)
+
+;; ── VALUES / MULTIPLE-VALUE-BIND / NTH-VALUE ────────────────────
+
+(cl-test "values: single returns plain"
+  (ev "(values 42)")
+  42)
+(cl-test "values: zero returns nil"
+  (ev "(values)")
+  nil)
+(cl-test "values: multi — primary via funcall"
+  (ev "(car (list (values 1 2)))")
+  1)
+(cl-test "multiple-value-bind: basic"
+  (ev "(multiple-value-bind (a b) (values 1 2) (+ a b))")
+  3)
+(cl-test "multiple-value-bind: extra vars get nil"
+  (ev "(multiple-value-bind (a b c) (values 10 20) (list a b c))")
+  (list 10 20 nil))
+(cl-test "multiple-value-bind: extra values ignored"
+  (ev "(multiple-value-bind (a) (values 1 2 3) a)")
+  1)
+(cl-test "multiple-value-bind: single value source"
+  (ev "(multiple-value-bind (a b) 42 (list a b))")
+  (list 42 nil))
+(cl-test "nth-value: 0"
+  (ev "(nth-value 0 (values 10 20 30))")
+  10)
+(cl-test "nth-value: 1"
+  (ev "(nth-value 1 (values 10 20 30))")
+  20)
+(cl-test "nth-value: out of range"
+  (ev "(nth-value 5 (values 10 20))")
+  nil)
+(cl-test "multiple-value-call: basic"
+  (ev "(multiple-value-call #'+ (values 1 2) (values 3 4))")
+  10)
+(cl-test "multiple-value-prog1: returns first"
+  (ev "(multiple-value-prog1 1 2 3)")
+  1)
+(cl-test "multiple-value-prog1: side effects run"
+  (ev "(let ((x 0)) (multiple-value-prog1 99 (setq x 7)) x)")
+  7)
+(cl-test "values: nil primary in if"
+  (ev "(if (values nil t) 'yes 'no)")
+  "NO")
+(cl-test "values: truthy primary in if"
+  (ev "(if (values 42 nil) 'yes 'no)")
+  "YES")

plans/common-lisp-on-sx.md

@@ -60,7 +60,7 @@ Core mapping:
 - [x] `block` + `return-from` via captured continuation
 - [x] `tagbody` + `go` via per-tag continuations
 - [x] `unwind-protect` cleanup frame
-- [ ] `multiple-value-bind`, `multiple-value-call`, `multiple-value-prog1`, `values`, `nth-value`
+- [x] `multiple-value-bind`, `multiple-value-call`, `multiple-value-prog1`, `values`, `nth-value`
 - [x] `defun`, `defparameter`, `defvar`, `defconstant`, `declaim`, `proclaim` (no-op)
 - [ ] Dynamic variables — `defvar`/`defparameter` produce specials; `let` rebinds via parameterize-style scope
 - [x] 127 tests in `lib/common-lisp/tests/eval.sx`
@@ -128,6 +128,7 @@ _Newest first._
 - 2026-05-05: Phase 3 interactive-debugger.sx — cl-debugger-hook global, cl-invoke-debugger, cl-error-with-debugger, make-policy-debugger; 7 tests (143 total). Tests wired into test.sh program suite runner. Phase 3 condition core complete.
 - 2026-05-05: Phase 3 classic programs — `tests/programs/restart-demo.sx` (7 tests: safe-divide with use-zero + retry restarts) and `tests/programs/parse-recover.sx` (6 tests: token parser with skip-token + use-zero restarts, handler-case abort). Key gotcha: use `=` not `equal?` for list comparison in sx_server.
 - 2026-05-05: Phase 3 conditions + restarts — `cl-condition-classes` hierarchy (15 types), `cl-condition?`/`cl-condition-of-type?`, `cl-make-condition`, `cl-define-condition`, `cl-signal`/`cl-error`/`cl-warn`/`cl-cerror`, `cl-handler-bind` (non-unwinding), `cl-handler-case` (call/cc escape), `cl-restart-case`/`cl-with-simple-restart`, `cl-find-restart`/`cl-invoke-restart`/`cl-compute-restarts`, `cl-with-condition-restarts`; 55 new tests in `tests/conditions.sx` (123 total runtime tests). Key gotcha: `cl-condition-classes` must be captured at define-time via `let` in `cl-condition-of-type?` — free-variable lookup at call-time fails through env_merge parent chain.
+- 2026-05-05: multiple values — VALUES returns {:cl-type "mv"} wrapper for 2+ values; cl-mv-primary/cl-mv-vals helpers; MULTIPLE-VALUE-BIND binds vars to value list; MULTIPLE-VALUE-CALL/PROG1/NTH-VALUE; cl-mv-primary applied in IF/AND/OR/COND/cl-call-fn for single-value contexts; 15 new tests (174 eval, 346 total green).
 - 2026-05-05: unwind-protect — cl-eval-unwind-protect: eval protected form, run cleanup with for-each (discards results, preserves original sentinel), return original result; 8 new tests (159 eval, 331 total green).
 - 2026-05-05: tagbody + go — cl-go-tag? sentinel; cl-eval-tagbody runs body with tag-index map (keys str-normalised for integer tags); go-tag propagation in cl-eval-body alongside block-return; 11 new tests (151 eval, 323 total green).
 - 2026-05-05: block + return-from — sentinel propagation in cl-eval-body; cl-eval-block catches matching sentinels; BLOCK/RETURN-FROM/RETURN dispatch in cl-eval-list; 13 new tests (140 eval, 312 total green). Parser: CL strings → {:cl-type "string"} dicts.