配列スタック

配列を用いたスタック実装。
組み込みのlistを使ったスタックと比較したくて作成。
cl-igoでlistスタックを用いている箇所*1を、下記配列スタックで置換してみたが、特にメリットはなかった(逆に10%程度遅くなった。sbcl-1.0.34)。

またどこかで使いたいことがあるかもしれないので保存しておく。

(defpackage stack
  (:use :common-lisp)
  (:shadow push pop append front)
  (:export stack make
           push pop append front
           empty? eacn))
(in-package :stack)

(declaim (inline make push pop append empty? front)
         (optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0)))

(deftype array-index () `(integer 0 #.array-total-size-limit))

(defstruct (stack (:constructor make (&optional (size 10) 
                                      &aux (buf (make-array (the array-index size))))))
  (buf #() :type simple-vector)
  (pos 0   :type array-index))

;; スタックに要素を追加。追加された要素を返す。
(defun push (stack elem)
  (with-slots (buf pos) (the stack stack)
    (when (= pos (length buf))
      (setf buf (adjust-array buf (+ #x10 (* pos 2)))))
    (setf (svref buf (1- (the array-index (incf pos)))) elem)))

;; スタックから要素を除去。除去された要素を返す。
(defun pop (stack)
  (with-slots (buf pos) (the stack stack)
    (if (zerop pos)
        nil
      (prog1 (svref buf pos)
        (decf pos)))))

;; stack2の内容をstack1に追加する。stack1の新しいサイズを返す。
(defun append (stack1 stack2)
  (with-slots (buf pos) (the stack stack1)
    (let ((buf2 (stack-buf stack2))
          (new-pos (+ pos (stack-pos stack2))))
      (declare (array-index new-pos))

      (when (< (length buf) new-pos)
        (setf buf (adjust-array buf (* new-pos 2))))
      (setf (subseq buf pos new-pos) buf2
            pos new-pos))))

;; スタックが空かどうか
(defun empty? (stack)
  (zerop (stack-pos stack)))

;; スタックの先頭(= 一番最初に追加された)要素を取得する
;; XXX: スタックが空の場合に、範囲外アクセスエラーが発生
(defun front (stack)
  (svref (stack-buf stack) 0))

;; スタック内の要素を走査する
(defmacro each ((var stack &optional (start 0) end) &body body)
  (let ((i   (gensym))
        (pos (gensym))
        (buf (gensym)))
    `(let ((,buf (stack-buf ,stack))
           (,pos (stack-pos ,stack)))
       (do ((,i ,start (1+ ,i)))
           ((= ,i ,(or end pos)))
         (let ((,var (svref ,buf ,i)))
           ,@body)))))

*1:形態素の候補を一時的に蓄積/保存しておくため(及びそれを用いたコスト計算)にスタックを使用。平均して十数程度のサイズのスタックが多量に生成される。スタック中の要素のイテレートも多い。