SERIES の producing の中での setf

次のように SERIES の producing の中での setf を使うと (setf b (car a)) のところが (setf nil (car a)) になりエラーとなる。

(defun foo ()
  (declare (optimizable-series-function))
  (producing (z) ((a '(1 2 3)) b)
             (loop
               (tagbody
                  (if (endp a)
                      (terminate-producing))
                  (setf b (car a))
                  (setf a (cdr a))
                  (next-out z b)))))

(collect (foo))

s-code.lisp をながめると

;;;; 13. Allow `SETF like SETQ' in PRODUCING forms.

とあるのだけど、

        (cond ((and (consp f) (case (car f) ((setq) t))) ; setf removed for now
               (cl:multiple-value-bind (vars lastbind binds) (detangle2 (cdr f))
                 (unless (cdr lastbind)
                   (ers 50 "~%missing value in assignment: " f))
                 ;; setf still not supported - need to make caller setf-aware
                 (cl:let ((expr (cons 'setq ; should be setf
                                      (mapcan #'xform-assignment vars binds))))
                   ;;(format t "~s" expr)
                   (push expr revbody))))
              ...)

今はみたいなことになっている。

きっと何か問題があったんだろうけど、なんだろう？とりあえず、case のところだけ

(case (car f) ((setq setf) t))

にしてみたら上記の foo は動いたけど

(defun foo ()
  (declare (optimizable-series-function))
  (producing (z) ((a '(1 2 3)) (b (list nil)) c)
             (loop
               (tagbody
                  (if (endp a)
                      (terminate-producing))
                  (setf (car b) (car a))
                  (setf c b)
                  (setf a (cdr a))
                  (next-out z c)))))

みたいのは動かない。 ; should be setf のところを setf にしたら、 (SETQ NIL #:OUT-2) になってだめ。

ってところで力つきた。。。

[2011-06-21] ちょっとちがったので修正した。