Merge commit '866af5da3d11ac4a9df44ee8c5b1781a0073c288'

Removes the special arity handler, and instead relies on the procedure
returning the correct number of values.

1 files changed, 58 insertions, 0 deletions

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index bfcce0a59..b6ba03c4d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -717,6 +717,64 @@ file with the given name already exists, the effect is unspecified."
     ((do "step" x y)
      y)))
 
+(define-syntax define-values
+  (lambda (orig-form)
+    (syntax-case orig-form ()
+      ((_ () expr)
+       ;; XXX Work around the lack of hygienic top-level identifiers
+       (with-syntax (((dummy) (generate-temporaries '(dummy))))
+         #`(define dummy
+             (call-with-values (lambda () expr)
+               (lambda () #f)))))
+      ((_ (var) expr)
+       (identifier? #'var)
+       #`(define var
+           (call-with-values (lambda () expr)
+             (lambda (v) v))))
+      ((_ (var0 ... varn) expr)
+       (and-map identifier? #'(var0 ... varn))
+       ;; XXX Work around the lack of hygienic toplevel identifiers
+       (with-syntax (((dummy) (generate-temporaries '(dummy))))
+         #`(begin
+             ;; Avoid mutating the user-visible variables
+             (define dummy
+               (call-with-values (lambda () expr)
+                 (lambda (var0 ... varn)
+                   (list var0 ... varn))))
+             (define var0
+               (let ((v (car dummy)))
+                 (set! dummy (cdr dummy))
+                 v))
+             ...
+             (define varn
+               (let ((v (car dummy)))
+                 (set! dummy #f)  ; blackhole dummy
+                 v)))))
+      ((_ var expr)
+       (identifier? #'var)
+       #'(define var
+           (call-with-values (lambda () expr)
+             list)))
+      ((_ (var0 ... . varn) expr)
+       (and-map identifier? #'(var0 ... varn))
+       ;; XXX Work around the lack of hygienic toplevel identifiers
+       (with-syntax (((dummy) (generate-temporaries '(dummy))))
+         #`(begin
+             ;; Avoid mutating the user-visible variables
+             (define dummy
+               (call-with-values (lambda () expr)
+                 (lambda (var0 ... . varn)
+                   (list var0 ... varn))))
+             (define var0
+               (let ((v (car dummy)))
+                 (set! dummy (cdr dummy))
+                 v))
+             ...
+             (define varn
+               (let ((v (car dummy)))
+                 (set! dummy #f)  ; blackhole dummy
+                 v))))))))
+
 (define-syntax-rule (delay exp)
   (make-promise (lambda () exp)))