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 |

2008-06-11

TCONC

| 13:54 | TCONC - わだばLisperになる を含むブックマーク はてなブックマーク - TCONC - わだばLisperになる

先日のCL勉強会で、TCONCのことを知ったのですが、TCONCの解説で、古いINTERLISPのマニュアルでTCONCをリストで表現していたのが気に入ったので、作ってみることにしました。

TCONCという構造は、リストとリストの末尾のペアをすぐ取り出せる構造なので、末尾への要素の追加のコストが低いというのが特長です。

今回再現してみるリスト表現のTCONCは、CARにリスト、CDRに末尾のペアのポインタを保持する構造になっています。

つまり

(1 2 3 4)

というリストならば、

((1 2 3 4) . (4)) 
 ≡ ((1 2 3 4) 4) 

となります。

見た目はリストなので、ちょっと区別し難かったりしますが、なるほど!という表現で、どんなにリストが長くても、TCONCをCDRすれば、末尾のペアが取り出せます。

ちなみに、PCLのLOOP章の註釈で解説があるのですが、LOOPマクロのcollectもTCONCなことが多いのかもしれません。

INTERLISP-10のマニュアルには、TCONCの他にリストとリストを継ぐLCONC、CONSと似ていますが、リストのポインタは変化しないATTACHの解説もあり、これも面白そうなのでついでに作ってみました。

;; tconcの動作
(loop :with start := 1 :and end := 10
      :with tc := (tconc () start)
      :for i :from (1+ start) :to end :do (tconc tc i) 
      :finally (return (car tc)))

;==> (1 2 3 4 5 6 7 8 9 10)

;; lconcの動作
(loop :with start := 1 :and end := 10
      :with lc := (lconc (list ()) (list start))
      :for i :from (1+ start) :to end :do (lconc lc (list i)) 
      :finally (return (car lc)))

;==> (1 2 3 4 5 6 7 8 9 10)

;; attachの動作
(setq foo (list 100))

(eq foo (attach 0 foo))
;==> T

foo
;==> (0 100)

;; 定義
(defpackage #:tconc
  (:use #:cl)
  (:export #:tconc
           #:lconc
           #:attach))

(in-package :tconc)

(defun TCONC (ptr x)
  (declare (list ptr))
  (let ((x (list x)))
    (if (null ptr)
        (cons x x)
        (progn (psetf (cddr ptr) x             
                      (cdr ptr) x)
               ptr))))

(defun LCONC (ptr x)
  (declare (cons ptr x))
  (let ((last (last x)))
    (rplaca ptr (nconc (car ptr) x))
    (rplacd ptr last)))

(defun ATTACH (x y)
  (declare (cons y))
  (let ((ptr y)
        (tail (cons (car y) (cdr y))))
    (setf (car ptr) x
          (cdr ptr) tail)
    ptr))