;;;; -*- 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 ;;;; 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)))