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-10-15

Paul Graham氏のユーティリティ その4

| 01:58 | Paul Graham氏のユーティリティ その4 - わだばLisperになる を含むブックマーク はてなブックマーク - Paul Graham氏のユーティリティ その4 - わだばLisperになる

PG氏のユーティリティを読んでみることの4回目。

引き続き繰り返し系(do系)のユーティリティ編です。

Lisp utilities that were not included in On Lisp or ANSI Common Lisp

お題

do-cyclic

暗記で再現

(defmacro do-cyclic (parms source &body body)
  (with-gensyms (g)
    `(let ((,g ,source))
       (case (length ,g)
	 (0 nil)
	 (1 (let ((,(first parms) (first ,g))
		  (,(second parms) (first ,g))
		  (,(third parms) (first ,g)))
	      ,@body))
	 (2 (let ((,(first parms) (second ,g))
		  (,(second parms) (first ,g))
		  (,(third parms) (second ,g)))
	      ,@body)
	    (let ((,(first parms) (first ,g))
		  (,(second parms) (second ,g))
		  (,(third parms) (first ,g)))
	      ,@body))
	 (otherwise 
	  (do-tuples/c ,parms (rotlist ,g)
	    ,@body))))))

とりあえずできた。ややこしい。そして、使い道が良く分からない。

rotlistは、このutx.lisp内で、do-tuples/cはonlispで定義されている。

動作
(do-cyclic (x y z) '(a b c d e f g h i j k)
  (print `(,x ,y ,z)))
=>
(K A B) 
(A B C) 
(B C D) 
(C D E) 
(D E F) 
(E F G) 
(F G H) 
(G H I) 
(H I J) 
(I J K) 
(J K A) 

お題

(defmacro do-plist (v1 v2 plist &rest body)
  (with-gensyms (rec rest pl)
    `(labels ((,rec (,v1 ,v2 ,rest)
                 ,@body
                 (when ,rest
                   (,rec (car ,rest) (cadr ,rest) (cddr ,rest)))))
       (let ((,pl ,plist))
         (when (consp ,pl)
           (,rec (car ,pl) (cadr ,pl) (cddr ,pl)))))))

暗記で再現:失敗

(defmacro do-plist (v1 v2 plist &body body)
  (with-gensyms (rec rest pl)
    `(labels ((,rec (,v1 ,v2 ,rest)
		(when ,rest
		  ,@body ;ここではない
		  (,rec ,(car rest) ,(cadr rest) ,(cddr rest)))))
       (let ((,pl ,plist)) 
	 (,rec ,(car pl) ,(cadr pl) ,(caddr pl)))))) ;consかどうかの判定を抜かした。
;; 動作
(do-plist i j '(a 1 b 2 c 3 d 4)
  (setf (get 'foo i) j))

(do-plist i j '(a 1 b 2 c 3 d 4)
  (print (get 'foo i)))
=>
1 
2 
3 
4 

動かしてみれば、そんなに難しいものでもなかったけれど、plistの構造が良く分かってないせいで上手く把握できてなくて、途中で何だか良く分からなくなって間違えてしまった。