diff options
-rw-r--r-- | doc/ref/api-binding.texi | 27 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 61 | ||||
-rw-r--r-- | test-suite/tests/syntax.test | 175 |
3 files changed, 261 insertions, 2 deletions
diff --git a/doc/ref/api-binding.texi b/doc/ref/api-binding.texi index e3a991871..5857e782f 100644 --- a/doc/ref/api-binding.texi +++ b/doc/ref/api-binding.texi @@ -1,7 +1,7 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2011 -@c Free Software Foundation, Inc. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2011, +@c 2014 Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @node Binding Constructs @@ -17,6 +17,7 @@ and expressions. This is important for modularity and data abstraction. * Local Bindings:: Local variable bindings. * Internal Definitions:: Internal definitions. * Binding Reflection:: Querying variable bindings. +* Binding Multiple Values:: Binding multiple return values. @end menu @@ -321,6 +322,28 @@ the current module when @var{module} is not specified; otherwise return @end deffn +@node Binding Multiple Values +@subsection Binding multiple return values + +@deffn {Syntax} define-values formals expression +The @var{expression} is evaluated, and the @var{formals} are bound to +the return values in the same way that the formals in a @code{lambda} +expression are matched to the arguments in a procedure call. +@end deffn + +@example +(define-values (q r) (floor/ 10 3)) +(list q r) @result{} (3 1) + +(define-values (x . y) (values 1 2 3)) +x @result{} 1 +y @result{} (2 3) + +(define-values x (values 1 2 3)) +x @result{} (1 2 3) +@end example + + @c Local Variables: @c TeX-master: "guile.texi" @c End: diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 98cefe9c4..c6cdcd365 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -583,6 +583,67 @@ If there is no handler at all, Guile prints an error and then exits." ((do "step" x y) y))) +;; XXX FIXME: When 'call-with-values' is fixed to no longer do automatic +;; truncation of values (in 2.2 ?), then this hack can be removed. +(define (%define-values-arity-error) + (throw 'wrong-number-of-args + #f + "define-values: wrong number of return values returned by expression" + '() + #f)) + +(define-syntax define-values + (lambda (orig-form) + (syntax-case orig-form () + ((_ () expr) + #`(define dummy + (call-with-values (lambda () expr) + (case-lambda + (() #f) + (_ (%define-values-arity-error)))))) + ((_ (var) expr) + (identifier? #'var) + #`(define var + (call-with-values (lambda () expr) + (case-lambda + ((v) v) + (_ (%define-values-arity-error)))))) + ((_ (var0 ... varn) expr) + (and-map identifier? #'(var0 ... varn)) + #`(begin + (define dummy + (call-with-values (lambda () expr) + (case-lambda + ((var0 ... varn) + (list var0 ... varn)) + (_ (%define-values-arity-error))))) + (define var0 + (let ((v (car dummy))) + (set! dummy (cdr dummy)) + v)) + ... + (define varn (car dummy)))) + ((_ var expr) + (identifier? #'var) + #'(define var + (call-with-values (lambda () expr) + list))) + ((_ (var0 ... . varn) expr) + (and-map identifier? #'(var0 ... varn)) + #`(begin + (define dummy + (call-with-values (lambda () expr) + (case-lambda + ((var0 ... . varn) + (list var0 ... varn)) + (_ (%define-values-arity-error))))) + (define var0 + (let ((v (car dummy))) + (set! dummy (cdr dummy)) + v)) + ... + (define varn (car dummy))))))) + (define-syntax-rule (delay exp) (make-promise (lambda () exp))) diff --git a/test-suite/tests/syntax.test b/test-suite/tests/syntax.test index a1129e9dc..faed56245 100644 --- a/test-suite/tests/syntax.test +++ b/test-suite/tests/syntax.test @@ -85,6 +85,9 @@ (define exception:zero-expression-sequence "sequence of zero expressions") +(define exception:define-values-wrong-number-of-return-values + (cons 'wrong-number-of-args "^define-values: wrong number of return values returned by expression")) + ;; (put 'pass-if-syntax-error 'scheme-indent-function 1) (define-syntax pass-if-syntax-error @@ -911,6 +914,178 @@ (eval '(let () (define x #t)) (interaction-environment)))) +(with-test-prefix "top-level define-values" + + (pass-if "zero values" + (eval '(begin (define-values () (values)) + #t) + (interaction-environment))) + + (pass-if-equal "one value" + 1 + (eval '(begin (define-values (x) 1) + x) + (interaction-environment))) + + (pass-if-equal "two values" + '(2 3) + (eval '(begin (define-values (x y) (values 2 3)) + (list x y)) + (interaction-environment))) + + (pass-if-equal "three values" + '(4 5 6) + (eval '(begin (define-values (x y z) (values 4 5 6)) + (list x y z)) + (interaction-environment))) + + (pass-if-equal "one value with tail" + '(a (b c d)) + (eval '(begin (define-values (x . y) (values 'a 'b 'c 'd)) + (list x y)) + (interaction-environment))) + + (pass-if-equal "two values with tail" + '(x y (z w)) + (eval '(begin (define-values (x y . z) (values 'x 'y 'z 'w)) + (list x y z)) + (interaction-environment))) + + (pass-if-equal "just tail" + '(1 2 3) + (eval '(begin (define-values x (values 1 2 3)) + x) + (interaction-environment))) + + (pass-if-exception "expected 0 values, got 1" + exception:define-values-wrong-number-of-return-values + (eval '(define-values () 1) + (interaction-environment))) + + (pass-if-exception "expected 1 value, got 0" + exception:define-values-wrong-number-of-return-values + (eval '(define-values (x) (values)) + (interaction-environment))) + + (pass-if-exception "expected 1 value, got 2" + exception:define-values-wrong-number-of-return-values + (eval '(define-values (x) (values 1 2)) + (interaction-environment))) + + (pass-if-exception "expected 1 value with tail, got 0" + exception:define-values-wrong-number-of-return-values + (eval '(define-values (x . y) (values)) + (interaction-environment))) + + (pass-if-exception "expected 2 value with tail, got 1" + exception:define-values-wrong-number-of-return-values + (eval '(define-values (x y . z) 1) + (interaction-environment))) + + (pass-if "redefinition" + (let ((m (make-module))) + (beautify-user-module! m) + + ;; The previous values of `floor' and `round' must still be + ;; visible at the time the new `floor' and `round' are defined. + (eval '(define-values (floor round) (values floor round)) m) + (and (eq? (module-ref m 'floor) floor) + (eq? (module-ref m 'round) round)))) + + (with-test-prefix "missing expression" + + (pass-if-syntax-error "(define-values)" + exception:generic-syncase-error + (eval '(define-values) + (interaction-environment))))) + +(with-test-prefix "internal define-values" + + (pass-if "zero values" + (let () + (define-values () (values)) + #t)) + + (pass-if-equal "one value" + 1 + (let () + (define-values (x) 1) + x)) + + (pass-if-equal "two values" + '(2 3) + (let () + (define-values (x y) (values 2 3)) + (list x y))) + + (pass-if-equal "three values" + '(4 5 6) + (let () + (define-values (x y z) (values 4 5 6)) + (list x y z))) + + (pass-if-equal "one value with tail" + '(a (b c d)) + (let () + (define-values (x . y) (values 'a 'b 'c 'd)) + (list x y))) + + (pass-if-equal "two values with tail" + '(x y (z w)) + (let () + (define-values (x y . z) (values 'x 'y 'z 'w)) + (list x y z))) + + (pass-if-equal "just tail" + '(1 2 3) + (let () + (define-values x (values 1 2 3)) + x)) + + (pass-if-exception "expected 0 values, got 1" + exception:define-values-wrong-number-of-return-values + (eval '(let () + (define-values () 1) + #f) + (interaction-environment))) + + (pass-if-exception "expected 1 value, got 0" + exception:define-values-wrong-number-of-return-values + (eval '(let () + (define-values (x) (values)) + #f) + (interaction-environment))) + + (pass-if-exception "expected 1 value, got 2" + exception:define-values-wrong-number-of-return-values + (eval '(let () + (define-values (x) (values 1 2)) + #f) + (interaction-environment))) + + (pass-if-exception "expected 1 value with tail, got 0" + exception:define-values-wrong-number-of-return-values + (eval '(let () + (define-values (x . y) (values)) + #f) + (interaction-environment))) + + (pass-if-exception "expected 2 value with tail, got 1" + exception:define-values-wrong-number-of-return-values + (eval '(let () + (define-values (x y . z) 1) + #f) + (interaction-environment))) + + (with-test-prefix "missing expression" + + (pass-if-syntax-error "(define-values)" + exception:generic-syncase-error + (eval '(let () + (define-values) + #f) + (interaction-environment))))) + (with-test-prefix "set!" (with-test-prefix "missing or extra expressions" |