mapf書いてみる

CommonLisp

【どう書く】MDL/Muddleのmapfを作る - 'T - cadr group
殆ど書き上げてからfinal-function省略時にleave, stop使わなかった場合の結果ってどうするんだ? ってことに気付いて初めて仕様書見に行くとかダメすぎる。

(with-gensyms
    (leave ret stop end)
  (defun mapleave (&optional arg)
    (values arg leave))

  (defun mapret (&rest args)
    (values args ret))

  (defun mapstop (&optional arg)
    (values arg stop))

  (defun mapf (fin fun &rest lists)
    (let (result lastvalue)
      (unless lists
        (setq fun (let ((fun0 fun)) (lambda (d) (funcall fun0)))
              lists (list '#1=(nil . #1#))))
      (catch end
          (apply #'mapc
                 #'(lambda (&rest args)
                     (multiple-value-bind (v flg) (apply fun args)
                       (setq lastvalue v)
                       (cond
                        ((eq flg leave) (throw end v))
                        ((eq flg ret) (setq result (nconc result v)))
                        ((eq flg stop)
                         (when v #2=(setq result (nconc result `(,v))))
                         (throw end #3=(if fin (apply fin result) lastvalue)))
                        (t #2#))))
                 lists)
        #3#))))

;;; tests
(defun mappend (fn &rest lists)
  (apply #'mapf #'append fn lists))

(defun first-nonzero (list)
  (mapf ()
        (lambda (x)
          (when (not (zerop x)) (mapleave x)))
        list))

(defun odd-list (list)
  (mapf #'list
        (lambda (x) (if (oddp x)
                        x
                        (mapret)))
        list))

(defun odd-list2 (list)
  (mapf #'list
        (lambda (x) (if (oddp x)
                        x
                        (mapret 'e 'ven)))
        list))

(defun first-ten (list)
  (let ((cnt 10))
    (mapf #'list
          (lambda (x)
            (when (zerop (decf cnt))
              (mapstop 10))
            x)
          list)))

(defun lnum (n &aux (cnt 0))
  (mapf #'list
        (lambda ()
          (if (<= n (incf cnt))
              (mapstop n)
              cnt))))

(defun mapf-tests ()
  (check= (equal)
    ((mapf #'list #'identity '(1 2 3 4)) '(1 2 3 4))
    ((mappend #'list '(1 2 3 4 5) '(a b c d e))
     '(1 a 2 b 3 c 4 d 5 e))
    ((first-nonzero '(0 0 0 0 9 0 0)) 9)
    ((odd-list '(1 2 3 4 5)) '(1 3 5))
    ((odd-list2 '(1 2 3 4 5)) '(1 e ven 3 e ven 5))
    ((first-ten '(1 2 3 4 5 6 7 8 9 10 11 12)) '(1 2 3 4 5 6 7 8 9 10))
    ((lnum 10) '(1 2 3 4 5 6 7 8 9 10))))

with-gensymsはonlispから。check=はこれ。

結果

CL-USER> (mapf-tests)
OK: (MAPF #'LIST #'IDENTITY '(1 2 3 4))
    = (1 2 3 4)
OK: (MAPPEND #'LIST '(1 2 3 4 5) '(A B C D E))
    = (1 A 2 B 3 C 4 D 5 E)
OK: (FIRST-NONZERO '(0 0 0 0 9 0 0))
    = 9
OK: (ODD-LIST '(1 2 3 4 5))
    = (1 3 5)
OK: (ODD-LIST2 '(1 2 3 4 5))
    = (1 E VEN 3 E VEN 5)
NG: (FIRST-TEN '(1 2 3 4 5 6 7 8 9 10 11 12))
    = (1 2 3 4 5 6 7 8 9 10 11 12)
   /= (1 2 3 4 5 6 7 8 9 10)
OK: (LNUM 10)
    = (1 2 3 4 5 6 7 8 9 10)
NIL

mapstopの動作勘違いしてた。多値でフラグ渡す方法じゃ駄目だorz
when〜が(if (zerop (decf cnt)) (mapstop 10) x)とかなら通るんだけど。
final-function省略時の結果も自信なし。gensymの使い方も合ってんのかなこれ。

御三方の解答読んで勉強しよう。

mapstop以外ではまった点

  • stop, leaveフラグがきたら(setq fun (lambda (&rest d) (mapret)))などとしていたが, final-function省略時の値の返し方で混乱→脱出する方向に
  • (case flg (leave ...) (stop ...) ...)と書いてて,うまく行かない理由がしばらくわからなかった
CL-USER> (macroexpand-1 '(case x (a (print 'a)) (b (print 'b)) (t (print 'x))))
(LET ((#:G878 X))
  (DECLARE (IGNORABLE #:G878))
  (COND ((EQL #:G878 'A) NIL (PRINT 'A)) ((EQL #:G878 'B) NIL (PRINT 'B))
        (T NIL (PRINT 'X))))

quoteされちゃうんだなぁ。評価されるバージョンどっかにあったっけ…
しかし展開後の条件式の後ろのNILは何だ??