diff -c /home/max/.sbcl/site/iterate-1.4.3/iterate.lisp.orig /home/max/.sbcl/site/iterate-1.4.3/iterate.lisp
*** /home/max/.sbcl/site/iterate-1.4.3/iterate.lisp.orig	Sat May  6 11:55:38 2006
--- /home/max/.sbcl/site/iterate-1.4.3/iterate.lisp	Tue May 29 14:13:50 2007
***************
*** 180,185 ****
--- 180,203 ----
  
  (defvar *result-var*)
  
+ ;;; *result-var-n* 2 thru 9 are also bound to gensym
+ ;;; and can be set in a same manner as *result-var*
+ ;;; If any of these variables are used, then the iterate
+ ;;; will return (values *result-var* *result-var-2* ...) 
+ ;;; instead of a single var
+ 
+ (defvar *result-var-2*)
+ (defvar *result-var-3*)
+ (defvar *result-var-4*)
+ (defvar *result-var-5*)
+ (defvar *result-var-6*)
+ (defvar *result-var-7*)
+ (defvar *result-var-8*)
+ (defvar *result-var-9*)
+ 
+ ;;; list of all the result vars
+ (defvar *result-var-list*)
+ 
  ;;; Iterate binds *type-alist* to an alist of variables and their
  ;;; types before processing clauses.  It does this by looking at
  ;;; (declare (type ...)) forms in the clauses and recording the information
***************
*** 537,542 ****
--- 555,573 ----
  Evaluate (iterate:display-iterate-clauses) for an overview of clauses"
    (let* ((*env* env)
  	 (*result-var* (genvar 'result))
+ 	 (*result-var-2* (genvar 'result-2))
+ 	 (*result-var-3* (genvar 'result-3))
+ 	 (*result-var-4* (genvar 'result-4))
+ 	 (*result-var-5* (genvar 'result-5))
+ 	 (*result-var-6* (genvar 'result-6))
+ 	 (*result-var-7* (genvar 'result-7))
+ 	 (*result-var-8* (genvar 'result-8))
+ 	 (*result-var-9* (genvar 'result-9))
+          (*result-var-list* (list *result-var* *result-var-2*
+                                      *result-var-3* *result-var-4*
+                                      *result-var-5* *result-var-6*
+                                      *result-var-7* *result-var-8*
+                                      *result-var-9*))
  	 (*type-alist* nil)
  	 (*declare-variables* *always-declare-variables*)
  	 (*bindings* nil)
***************
*** 568,585 ****
  	(augment steppers step))
        (prepend (default-driver-code) body)
        (let ((it-bod `(block ,*block-name*
! 		      (tagbody
! 			 ,.init-code
! 			 ,*loop-top*
! 			 ,.body
! 			 ,.(if *loop-step-used?* (list *loop-step*))
! 			 ,.steppers
! 			 (go ,*loop-top*)
! 			 ,.(if *loop-end-used?* (list *loop-end*))
! 			 ,.final-code)
! 		      ,(if (member *result-var* *bindings* :key #'car)
! 			   *result-var*
! 			   nil))))
  	(wrap-form *loop-body-wrappers*
  		   `(let* ,(nreverse *bindings*)
  		     ,.(if *declarations*
--- 599,624 ----
  	(augment steppers step))
        (prepend (default-driver-code) body)
        (let ((it-bod `(block ,*block-name*
!                        (tagbody
!                           ,.init-code
!                           ,*loop-top*
!                           ,.body
!                           ,.(if *loop-step-used?* (list *loop-step*))
!                           ,.steppers
!                           (go ,*loop-top*)
!                           ,.(if *loop-end-used?* (list *loop-end*))
!                           ,.final-code)
!                        ,(let* 
!                          ((last-res (position nil *result-var-list*
!                                               :from-end t 
!                                               :test (lambda (item elem)
!                                                       (declare (ignore item))
!                                                       (member elem *bindings* 
!                                                               :key #'car)))))
!                          (if last-res 
!                              `(values 
!                                ,@(subseq *result-var-list* 0 (1+ last-res)))
!                              nil)))))
  	(wrap-form *loop-body-wrappers*
  		   `(let* ,(nreverse *bindings*)
  		     ,.(if *declarations*
***************
*** 3034,3039 ****
--- 3073,3080 ----
  
  (defun return-find-extremum-code (expr m-expr var kind)
    ;; VALUE: expr corresponding to max/min-expr so far.
+   ;; Expr can be a (values ...) expression, in which case
+   ;; the clause and the whole iteration returns multiple values
    ;; Variable can be a list of two variables, in which case the first
    ;; is used for the expr and the second for the extremum.
    ;; The update code looks something like this:
***************
*** 3042,3104 ****
    ;;     (cond
    ;;      ((> temp m-var)
    ;;       (setq m-var temp)
!   ;;       (setq expr-var expr))
!   ;;      (t expr-var))
    ;;
    ;; When m-expr is a function:
!   ;;     (setq temp2 expr)
    ;;     (setq temp (funcall m-expr temp2)) ;; or (m-expr temp2)
    ;;     (cond 
    ;;      ((> temp m-var)
    ;;       (setq m-var temp)
!   ;;       (setq expr-var temp2))
!   ;;      (t expr-var))
    ;;
    (setq expr (walk-expr expr))
    (setq m-expr (walk-expr m-expr))
!   (let* ((function? (function-quoted? m-expr))
  	 (temp-var (make-var-and-default-binding 'temp :using-type-of 
  						 (if (not function?) m-expr)))
! 	 (temp-var-2 (if (and function? (not (duplicable? expr)))
! 			 (make-var-and-default-binding 'temp
! 						       :using-type-of expr)))
  	 (test (if (eq kind :max) '> '<))
! 	 expr-var m-var)
      (cond
       ((null var)   
        ;; no var means return expr as a result
!       (setq expr-var *result-var*)
        (setq m-var (genvar kind)))
       ((var-spec? var)
        ;; a single var-spec means set expr to that var
!       (setq expr-var var)
        (setq m-var (genvar kind)))
       ((and (consp var) (= (length var) 2) (every #'var-spec? var))
        ;; a two-element list means set expr to 1st, m to 2nd
!       (setq expr-var (first var))
        (setq m-var (second var)))
       (t
        (clause-error "The value for INTO, ~a, should be a variable specifier ~
    or a list of two variable specifiers." var)))
!     (make-default-binding expr-var :using-type-of expr)
      (make-accum-var-default-binding m-var kind :using-type-of m-expr)
!     (setq expr-var (extract-var expr-var))
      (setq m-var (extract-var m-var))
!     (let* ((expr-code (or temp-var-2 expr))
! 	   (esetq-code (if temp-var-2 `((setq ,temp-var-2 ,expr))))
  	   (m-code (if function?
! 		       (make-funcall m-expr expr-code)
  		       m-expr)))
        (return-code :body `(,.esetq-code
  			   (setq ,temp-var ,m-code)
  			   ,(if-1st-time 
  			     `((setq ,m-var ,temp-var)
! 			       (setq ,expr-var ,expr-code))
  			     `((cond
  				((,test ,temp-var ,m-var)
  				 (setq ,m-var ,temp-var)
! 				 (setq ,expr-var ,expr-code))
! 				(t ,expr-var)))))))))
  				 
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
--- 3083,3153 ----
    ;;     (cond
    ;;      ((> temp m-var)
    ;;       (setq m-var temp)
!   ;;       (multiple-value-setq (expr-var) expr))
!   ;;      (t (values expr-var))
    ;;
    ;; When m-expr is a function:
!   ;;     (multiple-value-setq (temp2..) expr)
    ;;     (setq temp (funcall m-expr temp2)) ;; or (m-expr temp2)
    ;;     (cond 
    ;;      ((> temp m-var)
    ;;       (setq m-var temp)
!   ;;       (multiple-value-setq (expr-vars) (values temp2...))
!   ;;      (t (values expr-vars))
    ;;
    (setq expr (walk-expr expr))
    (setq m-expr (walk-expr m-expr))
!   (let* ((values? (and (consp expr) (eq (car expr) 'values)))
!          (expr-list (if values? (cdr expr) (list expr)))
!          (function? (function-quoted? m-expr))
  	 (temp-var (make-var-and-default-binding 'temp :using-type-of 
  						 (if (not function?) m-expr)))
! 	 (temp-vars-2 
!           (if (and function? (not (every #'duplicable? expr-list)))
!               (loop for expr in expr-list collect 
!                    (make-var-and-default-binding 'temp :using-type-of expr))))
  	 (test (if (eq kind :max) '> '<))
! 	 expr-vars m-var)
      (cond
       ((null var)   
        ;; no var means return expr as a result
!       (setq expr-vars (subseq *result-var-list* 0 (length expr-list)))
        (setq m-var (genvar kind)))
       ((var-spec? var)
        ;; a single var-spec means set expr to that var
!       (setq expr-vars (list var))
        (setq m-var (genvar kind)))
       ((and (consp var) (= (length var) 2) (every #'var-spec? var))
        ;; a two-element list means set expr to 1st, m to 2nd
!       (setq expr-vars (list (first var)))
        (setq m-var (second var)))
       (t
        (clause-error "The value for INTO, ~a, should be a variable specifier ~
    or a list of two variable specifiers." var)))
!     (loop 
!        for expr-var in expr-vars
!        for expr in expr-list
!        do (make-default-binding expr-var :using-type-of expr))
      (make-accum-var-default-binding m-var kind :using-type-of m-expr)
!     (setq expr-vars (extract-vars expr-vars))
      (setq m-var (extract-var m-var))
!     (let* ((expr-codes (if temp-vars-2 `(values ,@temp-vars-2) expr))
! 	   (esetq-code (if temp-vars-2 `((multiple-value-setq ,temp-vars-2 
!                                            ,expr))))
  	   (m-code (if function?
!                        ;; don't understand why expr-code is passed here?
! 		       (make-funcall m-expr expr-codes)
  		       m-expr)))
        (return-code :body `(,.esetq-code
  			   (setq ,temp-var ,m-code)
  			   ,(if-1st-time 
  			     `((setq ,m-var ,temp-var)
! 			       (multiple-value-setq ,expr-vars ,expr-codes))
  			     `((cond
  				((,test ,temp-var ,m-var)
  				 (setq ,m-var ,temp-var)
! 				 (multiple-value-setq ,expr-vars ,expr-codes))
! 				(t (values ,@expr-vars))))))))))
  				 
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Diff finished.  Tue May 29 14:17:57 2007