行をバイト列として読み込む

テキストファイルの各行をバイト列として読み込むマクロを定義。
SBCL等のように文字列を内部的にユニコードとして表現している処理系では、テキストファイルを読み込む際、そのファイルが不正なバイト列を含んでいると読み込みに失敗することがあるので、その対処として。

;;;; エラーの例
;;;; sbcl-1.0.40

;;;;
;; 普通の行読み込みマクロを定義
(defmacro each-file-line ((line filepath) &body body)
  `(with-open-file (#1=#:in ,filepath)
      (loop FOR ,line = (read-line #1# nil nil)
            WHILE ,line
         DO (progn ,@BODY))))

;;;;
;; 不正なバイト列を含むテキストファイルの作成
(with-open-file (out "sample.txt" :direction :output 
                                  :element-type '(unsigned-byte 8))
  (write-sequence (sb-ext:string-to-octets "一行目") out)
  (write-byte (char-code #\Newline) out)

  ;; 二行目はバイト列を反転させる
  (write-sequence (reverse (sb-ext:string-to-octets "ニ行目")) out)
  (write-byte (char-code #\Newline) out)

  (write-sequence (sb-ext:string-to-octets "三行目") out)
  (write-byte (char-code #\Newline) out))

;;;
;; 読み込み
(each-file-line (line "sample.txt")
  (print line))
"一行目" 
;; これ以降はエラーメッセージ
debugger invoked on a SB-INT:STREAM-DECODING-ERROR in thread #<THREAD "initial thread" RUNNING {A9F5831}>:
  decoding error on stream
  #<SB-SYS:FD-STREAM for "file sample.txt" {BAF5001}> (:EXTERNAL-FORMAT :UTF-8):
    the octet sequence (174) cannot be decoded.

Type HELP for debugger help, or (SB-EXT:QUIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
  0: [ATTEMPT-RESYNC   ] Attempt to resync the stream at a character boundary
                         and continue.
  1: [FORCE-END-OF-FILE] Force an end of file.
  2: [INPUT-REPLACEMENT] Use string as replacement input, attempt to resync at
                         a character boundary and continue.
  3: [ABORT            ] Exit debugger, returning to top level.

(SB-INT:STREAM-DECODING-ERROR #<SB-SYS:FD-STREAM for "file sample.txt" {BAF5001}> (174))

こういったファイルを読み込むために作成したのが以下のマクロ(と関数)

;;;; ファイルの各行をバイト列として読み込むマクロの定義
;;;; バイト列の正当性は検査しないので、上述のようなエラーは起こらない

;;;;;;;;
;;;; 型やスペシャル変数の定義
(deftype octet  () '(unsigned-byte 8))           ; バイト
(deftype octets () '(vector octet))              ; バイト列
(deftype simple-octets () '(simple-array octet)) ; バイト列その2
(defparameter *line-feed* #\Newline)      ; 改行文字。簡単のために改行コードは一つの文字で指定されると仮定する。
(defparameter *BUFFER-SIZE-LIMIT* 102400) ; ファイル読み込み時のバッファのサイズ最大値

;;;;;;;;
;;;; バイト行読み込みマクロ
;;;;   (subseq line-bytes start end) => 各行のバイト列
(defmacro each-file-line-bytes ((line-bytes start end filepath) &body body)
  `(each-file-line-bytes-impl   ; 実際の処理はeach-file-line-bytes-impl関数に任せる
    (lambda (,line-bytes ,start ,end)
      (declare (simple-octets ,line-bytes)
               ((mod #.array-dimension-limit) ,start ,end))
      ,@body)
    ,filepath))

;;;;;;;;
;;;; 実際にバイト行の読み込みを行う関数
(declaim (inline each-file-line-bytes-impl))
(defun each-file-line-bytes-impl (fn filepath)
  (declare #+SBCL (sb-ext:muffle-conditions sb-ext:compiler-note)  ; コンパイル時の警告抑制
           (function fn)
           (optimize (speed 3) (safety 0) (debug 0)))
  (with-open-file (in filepath :element-type 'octet)
    (let* ((buffer-size (min (or (file-length in) #1=*BUFFER-SIZE-LIMIT*) #1#))
           (buf (make-array buffer-size :element-type 'octet))  ; 読み込み用のバッファ
           (read-start 0)                ; バッファの読み込み開始位置。前回読み込んだ内容がバッファに残っている場合に、0以上の値となる
           (lf (char-code *line-feed*))  ; 改行文字の値
           (stack '()))                  ; 一行がbuffer-size以上の場合に、溢れた分のバイト列を保持するスタック
      ;; バッファのサイズ分だけバイト列を読み込む
      (loop FOR read-len = (read-sequence buf in :start read-start)
        DO
        ;; バッファ内の改行文字を探して、(見つかった場合)ユーザが渡した関数を呼び出すループ
        (loop WITH start = 0 
              FOR lf-pos =  (position lf buf :start read-start :end read-len) ; 改行文字検索
                       THEN (position lf buf :start start      :end read-len)
              WHILE lf-pos
          DO
          ;; バイト列と行の範囲を渡して、fn関数を呼び出す
          (if (null stack)
              (funcall fn buf start lf-pos)        ; バッファサイズ内に行が収まっている場合
            (let ((bytes (apply #'concatenate 'octets 
                                (nreverse (cons (subseq buf start lf-pos) stack)))))
              (funcall fn bytes 0 (length bytes))  ; バッファサイズよりも大きい場合
              (setf stack nil)))
          
          ;; 行の開始位置更新
          (setf start (1+ lf-pos))

          FINALLY
          (setf read-start 0)
          (if (zerop start) 
              ;; バッファ内に改行が無かった場合: 内容をスタックに保存しておく
              (push (copy-seq buf) stack) 
            ;; バッファ内に改行が有った場合: 最後の改行以降のバイト列を、先頭に移動する
            (progn (setf read-start (- read-len start))
                   (replace buf buf :end1 read-start :start2 start :end2 read-len))))
        
        ;; EOFチェック
        (when (< read-len buffer-size)
          (return))))))

読み込み例。

;; each-file-lineで読み込みに失敗したファイルの各行の中身
(each-file-line-bytes (line-bytes start end "sample.txt")
  (print (subseq line-bytes start end)))
#(228 184 128 232 161 140 231 155 174) 
#(174 155 231 140 161 232 139 131 227) 
#(228 184 137 232 161 140 231 155 174) 
--> NIL

;; バイト列を自分で文字列に変換し、出力する
(require :creole) ; バイト列<->文字列変換ライブラリ: http://sourceforge.jp/projects/creole
(each-file-line-bytes (line-bytes start end "sample.txt")
  (print (creole:octets-to-string line-bytes :start start :end end)))
"一行目" 
"??&#29473;&#33475;?"  ; 変な文字列に変換されるが、エラーは起こらない
"三行目" 
--> NIL

linuxのwcコマンドとの比較。

$ ls huge.txt  # 大きなテキストファイル
-rw-r--r-- 1 user user 285M 2010-09-22 10:13 huge.txt

# wcコマンド
$ time wc -l huge.txt
549828 huge.txt   # 55万行

real	0m0.198s  # 0.2秒
user	0m0.120s
sys	0m0.076s
;; each-file-line-bytesを使った行数カウント関数を定義
(defun wc (filepath &aux (count 0))
  (declare (fixnum count))
  (each-file-line-bytes (bytes start end filepath)
    (declare (ignore bytes start end))
    (incf count))

(time 
  (wc "huge.txt"))
   count)
Evaluation took:
  0.519 seconds of real time   ; 0.5秒
  0.516032 seconds of total run time (0.404025 user, 0.112007 system)
  99.42% CPU
  1,034,343,720 processor cycles
  106,480 bytes consed
  
--> 549828                     ; 55万行

追記

不正なテキストファイル読み込み時のエラー対策として上記マクロを作成した、と書いたが、SBCLの場合、次の様にすれば不正なバイト列を含むテキストでも読み込むことが可能。

;; デコーディング失敗時のコンディション通知を受け取り、処理する
(handler-bind ((sb-int:stream-decoding-error
                (lambda (condition)
                  (declare (ignore condition))
                  ;; 不正なバイト列はスキップする
                  (invoke-restart (find-restart 'sb-int:attempt-resync))
                  
                  ;; 不正なバイト列を別の文字(文字列)で置き換えたい場合は、次のリスタートを使用する
                  ;; (invoke-restart (find-restart 'sb-impl::input-replacement) #\?)
                  )))
  (each-file-line (line "sample.txt")
    (print line)))
"一行目" 
"&#29473;&#33475;"   ; エラーが起こったバイト列は抜かしてデコードされた文字列
"三行目" 
--> NIL

なのでeach-file-line-bytesマクロは、せっかく作ったけど不要かもしれない。