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 |

2010-01-04

KMRCLを眺める (58) READ-STREAM-TO-STRING

| 02:42 | KMRCLを眺める (58) READ-STREAM-TO-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める (58) READ-STREAM-TO-STRING - わだばLisperになる

今回はKMRCLのio.lisp中からREAD-STREAM-TO-STRINGです。

名前の通り、ストリームをREADして文字列にするというもので定義は、

(defun read-stream-to-string (in)
  (with-output-to-string (out)
    (let ((eof (gensym)))
      (do ((line (read-line in nil eof)
                 (read-line in nil eof)))
          ((eq line eof))
        (format out "~A~%" line)))))

です。

利用法は、

(WITH-OPEN-FILE (IN "/etc/motd")
  (READ-STREAM-TO-STRING IN))
;⇒ 
"Linux setq 2.6.31-14-generic #48-Ubuntu SMP Fri Oct 16 14:05:01 UTC 2009 x86_64

To access official Ubuntu documentation, please visit:
http://help.ubuntu.com/

"

のようになると思います。

前回は、EOFの判定に(cons 'eof)を使っていましたが、今回は、(gensym)しているようです。

ふと思ったのですが、上のコードだと最後の行が改行で終っているか否かを区別していないようです。

(WITH-INPUT-FROM-STRING (IN "いろはにほへとちりぬるをわかよたれそつねならむ")
  (READ-STREAM-TO-STRING IN))
;⇒ "いろはにほへとちりぬるをわかよたれそつねならむ
"

とすると改行が新たに追加されていることが分かります。

READ-LINEはEOFが来たときに、改行がなかったかどうかを多値の2値目で返すようになっていることもあり、折角なのでこれを判定してみることにしました。

(DEFUN MY-READ-STREAM-TO-STRING (IN)
  (WITH-OUTPUT-TO-STRING (OUT)
    (PROG ((EOF (GENSYM)) 
           LINE MISSING-NEWLINE-P)
       L  (SETF (VALUES LINE MISSING-NEWLINE-P)
                (READ-LINE IN NIL EOF))
          (WHEN (EQ LINE EOF) (RETURN NIL))
          (FORMAT OUT "~A~:[~%~;~]" LINE MISSING-NEWLINE-P)
          (GO L))))

DOで書こうと思いましたが、綺麗にまとまらなかったので、よりプリミティブなPROGで書いてみました。

(WITH-INPUT-FROM-STRING (IN "いろはにほへとちりぬるをわかよたれそつねならむ")
  (MY-READ-STREAM-TO-STRING IN))
;⇒ "いろはにほへとちりぬるをわかよたれそつねならむ"

という風に気合を入れてPROGで書きましたが、LOOPで普通に書けました…

MULTIPLE-VALUE-LISTでリストを作ったりするとちょっと遅くなるんじゃないかなと思いましたが、速度とコンスを計測してみると(SETF (VALUES))と変わらないみたいですね。

(DEFUN MY-READ-STREAM-TO-STRING (IN)
  (WITH-OUTPUT-TO-STRING (OUT)
    (LOOP :FOR (LINE MISSING-NEWLINE-P) 
            := (MULTIPLE-VALUE-LIST (READ-LINE IN NIL))
          :UNLESS LINE :RETURN NIL
          :DO (FORMAT OUT "~A~:[~%~;~]" LINE MISSING-NEWLINE-P))))

DOでも普通に書けました…

(DEFUN MY-READ-STREAM-TO-STRING (IN)
  (WITH-OUTPUT-TO-STRING (OUT)
    (DO ((LINEL (MULTIPLE-VALUE-LIST (READ-LINE IN NIL))
                (MULTIPLE-VALUE-LIST (READ-LINE IN NIL))))
        ((NOT (CAR LINEL)))
      (FORMAT OUT "~{~A~:[~%~;~]~}" LINEL))))