diff --git a/mes.c b/mes.c index 1e67f26e..e9daf78d 100644 --- a/mes.c +++ b/mes.c @@ -499,10 +499,12 @@ call (scm *fn, scm *x) { if (fn->type == FUNCTION0) return fn->function0 (); - if (x->car->type == VALUES) - x = cons (x->car->cdr->car, &scm_nil); + if (x != &scm_nil && x->car->type == VALUES) + x = cons (x->car->cdr->car, x->cdr); if (fn->type == FUNCTION1) return fn->function1 (car (x)); + if (x != &scm_nil && x->cdr->car->type == VALUES) + x = cons (x->car, cons (x->cdr->car->cdr->car, x->cdr)); if (fn->type == FUNCTION2) return fn->function2 (car (x), cadr (x)); if (fn->type == FUNCTION3) diff --git a/module/mes/mes-0.mes b/module/mes/mes-0.mes index 2fda9f71..2003d0f3 100644 --- a/module/mes/mes-0.mes +++ b/module/mes/mes-0.mes @@ -87,7 +87,7 @@ ((atom? fn) (cond ((builtin? fn) (call fn x)) - ((eq? fn 'call-with-values) (c:apply-env 'call-with-values x a)) + ((eq? fn 'call-with-values) (call call-with-values-env (append x (cons a '())))) ((eq? fn 'current-module) a) (#t (apply-env (eval fn a) x a)))) ((eq? (car fn) 'lambda) diff --git a/tests/scm.test b/tests/scm.test index 3d33e71e..751b14ee 100755 --- a/tests/scm.test +++ b/tests/scm.test @@ -99,24 +99,12 @@ exit $? (pass-if "assq-set! 2" (sequal? (assq-set! '((a . 0)) 'a 1) '((a . 1)))) (pass-if "assoc" (sequal? (assoc '(a . 0) '((a . 0) (b . 1) ((a . 0) aa))) '((a . 0) aa))) -;; works, but debugging is foo -;; (cond ((defined? 'loop2) -;; (display "mes:values broken after loop2") -;; (newline)) -;; (#t -;; (values 0 1) -;; (display "(values 0 1): ") -;; (display (values 0 1)) -;; (newline) - -;; (display "call-with-values ==> 6: ") -;; (display -;; (call-with-values (lambda () (values 1 2 3)) -;; (lambda (a b c) (+ a b c)))) -;; (newline) -;; (display "call-with-values ==> 1: ") -;; (display ((lambda (x) x) (values 1 2 3))) -;; (newline))) +(pass-if "values" (seq? (values 0 1) 0)) +(pass-if "values 2" (seq? ((lambda (x) x) (values 1 2 3)) 1)) +(pass-if "values 3" (seq? 1 ((lambda (x) x) (values 1 2 3)))) +(pass-if "call-with-values" (seq? (call-with-values (lambda () (values 1 2 3)) + (lambda (a b c) (+ a b c))) + 6)) (pass-if "builtin? car" (builtin? car)) (pass-if "builtin? cdr" (builtin? cdr))