;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; 
;;;; loop-values-path.lisp: Add a FOR ... BEING THE VALUES OF
;;;; ... iteration path to LOOP.
;;;; 
;;;; Written in October 2008, Richard M Kreuter <kreuter@progn.net>
;;;; Placed in the public domain.
;;;; 
;;;; Time-stamp: <2008-10-27 11:02:57 kreuter>

(defun loop-values-iteration-path (varspec typespec prep-phrases)
  (let* ((of-phrase
          (loop with of-phrase
                for (prep . rest) in prep-phrases
                do (ecase prep
                     ((:of) (if of-phrase
                                (sb-loop::loop-error "Too many prepositions")
                                (setq of-phrase rest))))
                finally (return of-phrase)))
         bindings
         post-steps
         destructure-p
         values-var)
    (if (and (consp varspec)
             (do ((cons varspec (cdr cons)))
                 ((null cons) nil)
               (unless (listp (cdr cons))
                 (return t))))
        (let ((tempvar (gensym "LOOP-VALUES-TEMP-")))
          (setq destructure-p t
                values-var tempvar
                post-steps `(,varspec ,values-var)
                bindings `((,tempvar nil)
                           (,varspec nil ,typespec))))
        (setq bindings (mapcar #'(lambda (var type) `(,var nil ,type))
                               varspec typespec)))
    `(,bindings
      ()
      ()
      nil
      (eq ,(if destructure-p
               ;; I can't think of a way to avoid consing up the
               ;; values list when we're destructuring.
               `(setq ,values-var (multiple-value-list ,(car of-phrase)))
               `(setf (values ,@varspec) ,(car of-phrase))) (gensym))
      ,post-steps)))

(sb-loop::add-loop-path
 '(values)
 'loop-values-iteration-path sb-loop::*loop-ansi-universe*
 :preposition-groups '((:of)) :inclusive-permitted nil)

;; This should expand into something involving (SETF (VALUES ...))
#+(or)
(loop for dividend fixnum in '(1 2 3 4 5)
      for (quotient remainder) (fixnum t) being the values of (floor dividend 2)
      do (print (list quotient remainder)))

;; This should expand into something involving LOOP-REALLY-DESETQ
#+(or)
(loop for l in '((1 (2 3 4) 5 6 7) (a (b c d) e f g))
      for (x (y . z) w . v) being the values of (apply #'values l)
      do (print (list  v w z y x)))