Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2007-09-15

.2

| 03:12 | .2 - わだばLisperになる を含むブックマーク はてなブックマーク - .2 - わだばLisperになる

日課でコードを読むことの2回目

今日は、CMUCL 19のコードを写経してみることにしました。

お題は、list.lispの中のmap1です。

http://www.google.com/codesearch?hl=ja&q=show:vmxbnnEW51Q:knqQqWNc9uc:d4orNuqkr1I&sa=N&ct=rd&cs_p=http://gentoo.osuosl.org/distfiles/cmucl_19c-release-20051115.orig.tar.gz&cs_f=cmucl-19c-release-20051115.orig/src/code/list.lisp&start=1

map1は内部の関数で、mapcarや、mapconを作るための汎用的なものみたいです。

このコードはSpice lispの由来のものらしく、自分が調べた限りでは、少なくとも20年以上前のコードみたいです。

お題:

(defun map1 (function original-arglists accumulate take-car)
  "This function is called by mapc, mapcar, mapcan, mapl, maplist, and mapcon.
  It Maps function over the arglists in the appropriate way. It is done when any
  of the arglists runs out.  Until then, it CDRs down the arglists calling the
  function and accumulating results as desired."

  (let* ((arglists (copy-list original-arglists))
	 (ret-list (list nil))
	 (temp ret-list))
    (do ((res nil)
	 (args '() '()))
	((dolist (x arglists nil) (if (null x) (return t)))
	 (if accumulate
	     (cdr ret-list)
	     (car original-arglists)))
      (do ((l arglists (cdr l)))
	  ((null l))
	(push (if take-car (caar l) (car l)) args)
	(setf (car l) (cdar l)))
      (setq res (apply function (nreverse args)))
      (case accumulate
	(:nconc (setq temp (last (nconc temp res))))
	(:list (rplacd temp (list res))
	       (setq temp (cdr temp)))))))

初見時の感想:

  • dolistのところは、someの代りっぽい。
  • とりあえず、リストの破壊的操作が満載っぽい。

再現1:

  • とりあえず、一度、字面は再現したものの挙動が全然分からなくなってしまったので、自分の理解の為、動くものを作成。
(defun my-map1 (function lists accumulate take-car)
  (do ((l lists (mapcar #'cdr l))
       res
       (tem () () ))
      ((some #'endp l)
       (if accumulate
	   (case accumulate
	     (:nconc res)
	     (:append (nreverse res)))
	   (car lists)))
    (setq tem
	  (apply function (if take-car (mapcar #'car l) l)))
    (case accumulate
      (:nconc 
       (setq res (nconc res (apply function tem))))
      (:append
       (push (apply function tem) res)))))

部品を再現

  • 部品1.
(some #'endp lst)
=> (dolist (x lst nil) (if (null x) (return t)))
  • 部品2.
(do ((ls '((foo bar baz) (1 2 3 4)) (mapcar #'cdr ls)))
    ((some #'endp ls))
  (print ls))
=>
(let ((lists '((foo bar baz) (1 2 3 4))))
  (do ()
      ((dolist (x lists nil) (if (null x) (return t))))
    (do ((x lists (cdr x)))
	((null x))
      (setf (car x) (cdar x))
      (print lists))))
  • 部品3.
(push (apply function tem) res) ~ (nreverse res)
=>
(do* ((l '(foo bar baz) (cdr l))
      (res (list () ))			;'(())だと駄目なのはなんでだろう。
      (splice res))
     ((endp l) (cdr res))
  (setq splice (cdr (rplacd splice (list (car l))))))
  • 部品4.
(setq res (nconc res (apply function tem)))
=>
(setq temp (last (nconc temp res)))

再構成で再現2

(defun map1 (function original-arglists accumulate take-car)
  (let* ((arglists (copy-list original-arglists))
	 (ret-list (list () ))
	 (temp ret-list))
    (do ((xx arglists)                  ;不要だった。
	 (res nil)
	 (args '() '() ))
	((dolist (x xx nil) (if (null x) (return t)))
	 (if accumulate
	     (cdr ret-list)
	     (car original-arglists)))
      (do ((l arglists (cdr l)))
	  ((null l))
	(push (if take-car (caar l) (car l)) args)
	(setf (car l) (cdar l))) ;これがarglistsを更新している。
      (setq res (apply function (nreverse args)))
      (case accumulate
	(:nconc (setq temp (last (nconc temp res))))
	(:append (rplacd temp (list res))
		 (setq temp (cdr temp)))))))

(map1 #'list '((foo bar baz) (1 2)) :nconc nil)
=> (mapcon #'list '(foo bar baz) '(1 2))

(map1 #'list '((foo bar baz) (1 2)) :append t)
=> (mapcar #'list '(foo bar baz) '(1 2))

答え合わせ:

  • 外側のdoの(xx arglists)は不要だった。

感想:

イデオム的なものが、3つ程出てきたけれど、全部リストの破壊的操作関係だった。

  • 部品1. someに置き換えられるので、把握できたが、なんでループから抜けられるのかちょっと分からなかった。
  • 部品2. 入れ子になったdoがあり、外側のものが、ループを抜ける条件節だけを使ってるようなもので、実は内側のdoがsetfでリストの内容を更新していてその結果を判定していると分かるまでかなり悩んだ。
  • 部品3、4. 以前偶々del.icio.usのlispタグのとこに流れて来たリストのspliceというやつなのかなと思ったけれど、これもなんだか馴れないとトリッキーに感じる。

参考:

spliceについて

http://www.apl.jhu.edu/~hall/Lisp-Notes/Destructive-Ops.html