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 |

2009-12-02

KMRCLを眺める (27) def-cached-vector

| 00:42 | KMRCLを眺める (27) def-cached-vector - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (27) def-cached-vector - わだばLisperになる

今回は、KMRCLのmacros.lispの中からDEF-CACHED-VECTORです。

いまいち用途が分からないのですが、名前からしてベクターをキャッシュして使い回すんだろうと思います。

(defmacro def-cached-vector (name element-type)
  (let ((get-name (concat-symbol "get-" name "-vector"))
        (release-name (concat-symbol "release-" name "-vector"))
        (table-name (concat-symbol "*cached-" name "-table*"))
        (lock-name (concat-symbol "*cached-" name "-lock*")))
    `(eval-when (:compile-toplevel :load-toplevel :execute)
       (defvar ,table-name (make-hash-table :test 'equal))
       (defvar ,lock-name (kmrcl::make-lock ,name))

         (defun ,get-name (size)
           (kmrcl::with-lock-held (,lock-name)
             (let ((buffers (gethash (cons size ,element-type) ,table-name)))
               (if buffers
                   (let ((buffer (pop buffers)))
                     (setf (gethash (cons size ,element-type) ,table-name) buffers)
                     buffer)
                 (make-array size :element-type ,element-type)))))

         (defun ,release-name (buffer)
           (kmrcl::with-lock-held (,lock-name)
             (let ((buffers (gethash (cons (array-total-size buffer)
                                           ,element-type)
                                     ,table-name)))
               (setf (gethash (cons (array-total-size buffer)
                                    ,element-type) ,table-name)
                 (cons buffer buffers))))))))

という定義で、これを展開すると、

(DEF-CACHED-VECTOR :FOO 'INTEGER)
;>>> 展開
(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
  (DEFPARAMETER *CACHED-FOO-TABLE* (MAKE-HASH-TABLE :TEST 'EQUAL))
  (DEFVAR *CACHED-FOO-LOCK* (MAKE-LOCK :FOO))
  (DEFUN GET-FOO-VECTOR (SIZE)
    (WITH-LOCK-HELD (*CACHED-FOO-LOCK*)
      (LET ((BUFFERS (GETHASH (CONS SIZE 'INTEGER) *CACHED-FOO-TABLE*)))
        (IF BUFFERS
            (LET ((BUFFER (POP BUFFERS)))
              (SETF (GETHASH (CONS SIZE 'INTEGER) *CACHED-FOO-TABLE*) BUFFERS)
              BUFFER)
            (MAKE-ARRAY SIZE :ELEMENT-TYPE 'INTEGER)))))
  (DEFUN RELEASE-FOO-VECTOR (BUFFER)
    (WITH-LOCK-HELD (*CACHED-FOO-LOCK*)
      (LET ((BUFFERS
             (GETHASH (CONS (ARRAY-TOTAL-SIZE BUFFER) 'INTEGER)
                      *CACHED-FOO-TABLE*)))
        (SETF (GETHASH (CONS (ARRAY-TOTAL-SIZE BUFFER) 'INTEGER)
                       *CACHED-FOO-TABLE*)
              (CONS BUFFER BUFFERS))))))

になります。

この展開形から使われ方を想像するに、

(DEF-CACHED-VECTOR :FOO 'INTEGER)

;; 0〜3個のINTEGERを要素とするベクターを3個ずつ作成
(DOTIMES (X 3)
  (DOTIMES (SIZE 4)
    (RELEASE-FOO-VECTOR (MAKE-ARRAY SIZE :ELEMENT-TYPE 'INTEGER))))

(ALEXANDRIA:HASH-TABLE-ALIST *CACHED-FOO-TABLE*)
;⇒ (((3 . INTEGER) #(0 0 0) #(0 0 0) #(0 0 0))
;    ((2 . INTEGER) #(0 0) #(0 0) #(0 0)) 
;    ((1 . INTEGER) #(0) #(0) #(0))
;    ((0 . INTEGER) #() #() #()))

;; 3個の要素のベクターを5つ取り出す(※作成しておいたのは3つ)
(DO ((ANS () (CONS (GET-FOO-VECTOR 3) ANS))
     (TIMES 5 (1- TIMES)))
    ((ZEROP TIMES) ANS))
;⇒ (#(0 0 0) #(0 0 0) #(0 0 0) #(0 0 0) #(0 0 0))

(ALEXANDRIA:HASH-TABLE-ALIST *CACHED-FOO-TABLE*)
;⇒ (((3 . INTEGER)) ;空になった
;   ((2 . INTEGER) #(0 0) #(0 0) #(0 0))
;   ((1 . INTEGER) #(0) #(0) #(0)) 
;   ((0 . INTEGER) #() #() #()))

という感じなのかなあと。

RELEASE-FOO-VECTORは、ベクターの大きさと、要素の型をキーとして、ベクターを貯めているリストを作成

GET-FOO-VECTORは、上記のキーで、ベクターを貯めているリストをポップする。空なら新規にベクターを作成

という感じでしょうか。

上の例では、RELEASE-FOO-VECTORしているときに、MAKE-ARRAYで新規に作成していますが、GET-FOO-VECTORで作成するようにすると、決まった個数以上は新規に作成しないということもできる気がします(といっても予め使う個数を新規で準備しておく必要あり)。

しかし、本来はどういう使い方を意図しているのかは結局良く分からず…。