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-09

Paul Graham氏のユーティリティ

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

たまには普通に勉強になりそうなコードに挑戦しようと思い、del.icio.usのlispタグから流れて来たPaul Graham氏のユーティリティを読んでみることにしました。

これは、On LispやANSI Common Lispには載ってないものを纏めたもののようです。

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

http://lib.store.yahoo.net/lib/paulgraham/utx.lisp

大きいものはないので数点纏めてます。いきなり途中から始まってますが、これより前はもう読んでいたので、途中からになってます。

お題

delete-nth

暗記で再現

(defun delete-nth (n lst)
  (cond ((< n 0) (error "Bad arg to delete-nth"))
        ((= n 0) (cdr lst))
        (t (let ((rest (nthcdr (1- n) lst)))
             (pop (cdr rest))
             lst))))

とりあえず同じにできた。

副作用あったりなかったり。

だからdelete系なんだろうけども。

お題

pull-nth

暗記で再現

(defmacro pull-nth (n place)
  (multiple-value-bind (vars forms var set access) (get-setf-expansion place)
    (let ((g (gensym)))
      `(let* ((,g ,n)
	      ,@(mapcar #'list vars forms)
	      (,(car var) (delete-nth ,g ,access)))
	 ,set))))

;; 実行例
(let ((l '(a (1 2 3 4 5) b c)))
  (pull-nth 3 (cadr l))
  l)
;=>(A (1 2 3 5) B C) 

とりあえずできた。

上記のdelete-nthを使ったもの。

get-setf-methodってのが分からなくて、HyperSpecにも該当なしだしなんだろうと思って調べたら、ANSI Common Lispでは、get-setf-expansionとなっているらしい。

紫藤さんのページが参考になりました。

http://www.shido.info/lisp/macro4.html

お題

ninsert-nth

暗記で再現

(defun ninsert-nth (n obj lst)
  (if (< n 0)
      (error "Bad arg to ninsert-nth.")
      (let ((rest (nthcdr n lst)))
	(push obj (cdr rest))
	lst)))

とりあえずできた。

挿入される場所がなんとなくしっくりこない…。

お題

push-nth

暗記で再現

(defmacro push-nth (n obj place)
  (multiple-value-bind (vars forms var set access) (get-setf-expansion place)
    (with-gensyms (g h)
      `(let* ((,g ,n)
	      (,h ,obj)
	      ,@(mapcar #'list vars forms)
	      (,(car var) (ninsert-nth ,g ,h ,access)))
	 ,set))))

;; 実行例
(let ((l '((a b c d) 2 3 4 5 6 7)))
  (push-nth 1 '('-'*) (car l))
  l)
;=>((A B ('- '*) C D) 2 3 4 5 6 7) 

お題

insert-elt-after

暗記で再現

(defun insert-elt-after (elt ins lst)
  (if (null lst)
      nil
      (if (eql (car lst) elt)
	  (cons (car lst) (cons ins (cdr lst)))
	  (cons (car lst) (insert-elt-after elt ins (cdr lst))))))

;; 実行例
(insert-elt-after 'x 'foo '(x y z))
=>(X FOO Y Z) 

とりあえずできた。

感想

レトロなコードを読むより勉強になってるというか、ためになってる感は強く感じる…。

当たり前か…。