Posted 2021-12-28 20:06:38 GMT
KMRCLを眺めるの240回目。今回は、color.lispを眺めます。
(defun make-fields-buffer (&optional (max-fields +max-fields-per-line+)
(max-field-len +max-field+))
(let ((bufs (make-array max-fields :element-type 'vector :fill-pointer 0 :adjustable nil)))
(dotimes (i +max-fields-per-line+)
(setf (aref bufs i) (make-array max-field-len :element-type 'character :fill-pointer 0 :adjustable nil)))
bufs))(defun read-buffered-fields (fields strm &optional (field-delim +field-delim+)
(eof 'eof))
"Read a line from a stream into a field buffers"
(declare (type base-char field-delim)
(type vector fields))
(setf (fill-pointer fields) 0)
(do ((ifield 0 (1+ ifield))
(linedone nil)
(is-eof nil))
(linedone (if is-eof eof fields))
(declare (type fixnum ifield)
(type boolean linedone is-eof))
(let ((field (aref fields ifield)))
(declare (type base-string field))
(do ((ipos 0)
(fielddone nil)
(rc (read-char strm nil +eof-char+)
(read-char strm nil +eof-char+)))
(fielddone (unread-char rc strm))
(declare (type fixnum ipos)
(type base-char rc)
(type boolean fielddone))
(cond
((char= rc field-delim)
(setf (fill-pointer field) ipos)
(setq fielddone t))
((char= rc +newline+)
(setf (fill-pointer field) ipos)
(setf (fill-pointer fields) ifield)
(setq fielddone t)
(setq linedone t))
((char= rc +eof-char+)
(setf (fill-pointer field) ipos)
(setf (fill-pointer fields) ifield)
(setq fielddone t)
(setq linedone t)
(setq is-eof t))
(t
(setf (char field ipos) rc)
(incf ipos)))))))
make-fields-buffer
は行単位のバッファを作成するユーティリティで、指定した数のフィールドを持ちます。デフォルトのデリミタは#\|
ですが、csvやtsvのようにフィールドの間に置くのではなく、フィールドの後に置くタイプのようです。
read-buffered-fields
は、ストリームから読んだ内容をバッファに保存します。
ちなみに、UTF-8の文字列を扱う場合は、(declare (type base-string field))
では制限が強過ぎるのでstring
あたりにする必要があります。
フィルポインタ付きの配列で何かバッファリングして読み込むようなコードの例としては、一番シンプルで参考になるかなと思いました。
(with-input-from-string (in "*print-miser-width* 0
*print-pprint-dispatch* 0
*print-readably* 0
*print-right-margin* 0
*read-eval* 0
abort 0
add-method 0
allocate-instance 0
arithmetic-error 0
arithmetic-error-operands 0
arithmetic-error-operation 0
array 1
array-displacement 0
base-char 0
base-string 0
bignum 1
bit-vector 1
boolean 0 ")
(loop :repeat 10 :collect (kl:read-buffered-fields (kl:make-fields-buffer) in #\Tab)))
→ (#("*print-miser-width*" "0")
#("*print-pprint-dispatch*" "0")
#("*print-readably*" "0")
#("*print-right-margin*" "0")
#("*read-eval*" "0")
#("abort" "0")
#("add-method" "0")
#("allocate-instance" "0")
#("arithmetic-error" "0")
#("arithmetic-error-operands" "0"))
なお、buff-input.lisp
にはこれらの亜種のような定義が数点ありますが、どうもつくりかけっぽくエクスポートもされていません。
■
HTML generated by 3bmd in LispWorks 8.0.0