define-values: Blackhole 'dummy'; work around lack of toplevel hygiene.
authorMark H Weaver <mhw@netris.org>
Mon, 3 Feb 2014 02:13:47 +0000 (21:13 -0500)
committerMark H Weaver <mhw@netris.org>
Mon, 3 Feb 2014 02:43:35 +0000 (21:43 -0500)
* module/ice-9/boot-9.scm (define-values): Use 'generate-temporaries' to
  generate a fresh name for 'dummy', to work around the lack of hygiene
  for macro-introduced toplevel identifiers.  Blackhole 'dummy' to avoid
  keeping garbage alive.  Add more comments.

module/ice-9/boot-9.scm

index c6cdcd3..42d7d78 100644 (file)
@@ -596,11 +596,13 @@ If there is no handler at all, Guile prints an error and then exits."
   (lambda (orig-form)
     (syntax-case orig-form ()
       ((_ () expr)
-       #`(define dummy
-           (call-with-values (lambda () expr)
-             (case-lambda
-               (() #f)
-               (_ (%define-values-arity-error))))))
+       ;; XXX Work around the lack of hygienic top-level identifiers
+       (with-syntax (((dummy) (generate-temporaries '(dummy))))
+         #`(define dummy
+             (call-with-values (lambda () expr)
+               (case-lambda
+                 (() #f)
+                 (_ (%define-values-arity-error)))))))
       ((_ (var) expr)
        (identifier? #'var)
        #`(define var
@@ -610,19 +612,25 @@ If there is no handler at all, Guile prints an error and then exits."
                (_ (%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))))
+       ;; 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)
+                 (case-lambda
+                   ((var0 ... varn)
+                    (list var0 ... varn))
+                   (_ (%define-values-arity-error)))))
+             (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
@@ -630,19 +638,25 @@ If there is no handler at all, Guile prints an error and then exits."
              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)))))))
+       ;; 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)
+                 (case-lambda
+                   ((var0 ... . varn)
+                    (list var0 ... varn))
+                   (_ (%define-values-arity-error)))))
+             (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)))