diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index fe0b95a9..c002aa24 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/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 (* ====================================================================== *) diff --git a/hosts/ocaml/lib/sx_ref.ml b/hosts/ocaml/lib/sx_ref.ml index c22a1208..2ede8ea6 100644 --- a/hosts/ocaml/lib/sx_ref.ml +++ b/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))) + diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 5295a1f7..f5702e87 100644 --- a/shared/static/scripts/sx-browser.js +++ b/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; diff --git a/spec/evaluator.sx b/spec/evaluator.sx index 9d3407ea..7d072254 100644 --- a/spec/evaluator.sx +++ b/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 +;; (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 -;; (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! diff --git a/spec/tests/test-values.sx b/spec/tests/test-values.sx new file mode 100644 index 00000000..69c8cda0 --- /dev/null +++ b/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)))) \ No newline at end of file