よくないかもしれないけど、楽だから

こんなふうに名前がぶつかることを期待して書くのはよくないのかな。でも楽。マクロ使えなかったら、もっと綺麗に書きゃなかいけないんだろうな。 Common Lisp でよかった。

(defmacro define-write-method (name
                               (&rest lambda-list)
                               length
                               under-mmap-size
                               over-mmap-size
                               cross-over-mmap-size
                               return-value)
  `(defmethod ,name ,lambda-list
     (with-slots (base-stream file-length mmap-size sap position ext lock) stream
       (with-recursive-spinlock (lock)
         (let* ((length ,length)
                (end-position (+ length position)))
           (flet ((ensure-file-length ()
                    (let ((current-len file-length))
                      (when (< current-len end-position)
                        (stream-truncate stream
                                         (if ext
                                             (min mmap-size (ceiling (* current-len ext)))
                                             end-position))))))
             (cond ((< end-position mmap-size)
                    (ensure-file-length)
                    ,under-mmap-size)
                   ((<= mmap-size position)
                    ,over-mmap-size)
                   (t
                    (ensure-file-length)
                    ,cross-over-mmap-size))
             (setf position end-position)
             ,return-value))))))

(define-write-method sb-gray:stream-write-sequence ((stream mmap-stream)
                                                    (buffer sequence)
                                                    &optional (start 0) end)
  (if end (- end start) (length buffer))
  (copy-vector-to-sap buffer start sap position length)
  (progn
    (file-position base-stream position)
    (write-sequence buffer base-stream)
    (setf file-length end-position))
  (let ((mlen (- mmap-size position)))
    (copy-vector-to-sap buffer start sap position mlen)
    (file-position base-stream (1- mmap-size))
    (write-sequence buffer base-stream :start (1- mlen) :end end))
  buffer)

(define-write-method sb-gray:stream-write-byte ((stream mmap-stream) integer)
  1
  (setf (sb-sys:sap-ref-8 sap position) integer)
  (progn
    (file-position base-stream position)
    (write-byte integer base-stream))
  ()
  integer)