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-02-28
KMRCLを眺める IS-STRING-EMPTY (100)
Common Lisp, KMRCL | | 
今回はKMRCLのstrings.lispから、IS-STRING-EMPTYです。
動作は、名前どおりという感じで、
(KL:IS-STRING-EMPTY "") ;⇒ T (KL:IS-STRING-EMPTY "foo") ;⇒ NIL
です。
定義は、
(defun is-string-empty (str) (zerop (length str)))
となっています。
■
これだと、
(KL:IS-STRING-EMPTY '() ) ;⇒ T
にもなってしまいます。
KMRCLの他の定義だと型宣言が多く出てきますが、これに指定がないのが意外なところ。
(DECLAIM (FTYPE (FUNCTION (STRING) BOOLEAN) IS-STRING-EMPTY))
等の指定があっても良さそうなものだなと。
■
2010-02-27
KMRCLを眺める STRING-HASH (99)
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、STRING-HASHです。
動作は、
(KL:STRING-HASH "Aa") ;⇒ 162
という感じで文字列からハッシュ値を出すもののようです。
(defun string-hash (str &optional (bitmask 65535))
(let ((hash 0))
(declare (fixnum hash)
(simple-string str))
(dotimes (i (length str))
(declare (fixnum i))
(setq hash (+ hash (char-code (char str i)))))
(logand hash bitmask)))
という定義になっていますが、文字コードを足しこむ感じなので
(KL:STRING-HASH "Aa") ;⇒ 162 (KL:STRING-HASH "aA") ;⇒ 162
という風に同じ値になりやすい気がします。
標準だと、SXHASHがありますが
(SXHASH "Aa") ;⇒ 20184128143102 (SXHASH "aA") ;⇒ 30096039371269
これだと駄目なんでしょうか。
速度は、
(DOTIMES (I 100000000) (KL:STRING-HASH "aA")) ;⇒ NIL ---------- Evaluation took: 1.820 seconds of real time 1.820000 seconds of total run time (1.820000 user, 0.000000 system) 100.00% CPU 4,357,212,408 processor cycles 252,128 bytes consed Intel(R) Core(TM)2 Duo CPU P8600 @ 2.40GHz (DOTIMES (I 100000000) (SXHASH "aA")) ;⇒ NIL ---------- Evaluation took: 0.042 seconds of real time 0.040000 seconds of total run time (0.040000 user, 0.000000 system) 95.24% CPU 98,789,364 processor cycles 0 bytes consed Intel(R) Core(TM)2 Duo CPU P8600 @ 2.40GHz
という風にSXHASHの方が大分速いようです。
自分は文字列からハッシュ値を取り出したい局面にあまり遭遇したことがないのでいまいち分かっていません。
■
2010-02-26
KMRCLを眺める NSTRING-TRIM-LAST-CHARACTER (98)
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、NSTRING-TRIM-LAST-CHARACTERです。
前回眺めたNSUBSEQを利用しています。
(defun nstring-trim-last-character (s)
"Return the string less the last character"
(let ((len (length s)))
(if (plusp len)
(nsubseq s 0 (1- len))
s)))
動作は、
(LET* ((STR "foo
")
(CHOPPED (KL:NSTRING-TRIM-LAST-CHARACTER STR)))
(SETF (AREF CHOPPED 0) #\F)
(LIST STR CHOPPED))
⇒ ("Foo
"
"Foo")
(LET* ((STR "foo
")
(CHOPPED (KL:STRING-TRIM-LAST-CHARACTER STR)))
(SETF (AREF CHOPPED 0) #\F)
(LIST STR CHOPPED))
⇒ ("foo
"
"Foo")
というところ。
前回のNSUBSEQでid:lkozimaさんよりNSUBSEQの存在意義は、破壊的関数と組合せるというより、元のシーケンスとメモリを共有したい(しても良い)状況で利用するところにあるのではないか、というご指摘がありました。
確かにN〜系の関数はNo consingということで、元々はそういう意味合いで使われていたのではないかという気がします。
■
2010-02-25
KMRCLを眺める NSUBSEQ (97)
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispではなくて、seqs.lispから、NSUBSEQです。
strings.lispの関数から呼び出されているので先に眺めます。
命名規則からするとNが付いたSUBSEQということで、破壊的変更を加えるSUBSEQなのかと思いますが、どうやら新規のシーケンスを作成して返すのではなく、元のシーケンスを返すのでNが付いている様子。
(defun nsubseq (sequence start &optional end)
"Return a subsequence by pointing to location in original sequence"
(unless end (setq end (length sequence)))
(make-array (- end start)
:element-type (array-element-type sequence)
:displaced-to sequence
:displaced-index-offset start))
SUBSEQとの違いは
(LET ((SEQ (MAKE-ARRAY 6 :INITIAL-ELEMENT 42)))
(SETF (AREF (KL:NSUBSEQ SEQ 3) 0)
0)
SEQ)
;⇒ #(42 42 42 0 42 42)
(LET ((SEQ (MAKE-ARRAY 6 :INITIAL-ELEMENT 42)))
(SETF (AREF (SUBSEQ SEQ 3) 0)
0)
SEQ)
;⇒ #(42 42 42 42 42 42)
(LET ((SEQ (COPY-SEQ "-------")))
(REPLACE (SUBSEQ SEQ 3 6)
"foo")
SEQ)
;⇒ "-------"
(LET ((SEQ (COPY-SEQ "-------")))
(REPLACE (KL:NSUBSEQ SEQ 3 6)
"foo")
SEQ)
;⇒ "---foo-"
というところでしょうか。
■
なるほどなとも思うのですが、しかし似たようなものに(SETF SUBSEQ)があり、
(LET ((SEQ (COPY-SEQ "-------")))
(REPLACE (KL:NSUBSEQ SEQ 3 6)
"foo")
SEQ)
;⇒ "---foo-"
(LET ((SEQ (COPY-SEQ "-------")))
(SETF (SUBSEQ SEQ 3 6)
"foo")
SEQ)
;⇒ "---foo-"
(SETF SUBSEQ)でも殆ど同じことができるんじゃないかなと思うんですが、どうなんでしょう。(しかし、処理系に用意されているSETF関数/マクロはどこからどこまでが処理系依存なのか…)
■
2010-02-24
KMRCLを眺める STRING-TRIM-LAST-CHARACTER (96)
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、STRING-TRIM-LAST-CHARACTERです。
Perlでいうchopのようです。定義は、
(defun string-trim-last-character (s)
"Return the string less the last character"
(let ((len (length s)))
(if (plusp len)
(subseq s 0 (1- len))
s)))
となっていて、動作は、
(KL:STRING-TRIM-LAST-CHARACTER "foo ") ;⇒ "foo" (KL:STRING-TRIM-LAST-CHARACTER "1234") ;⇒ "123"
しかし、名前がちょっと長いです。
■
2010-02-23
KMRCLを眺める STRING-INVERT (95)
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、STRING-INVERTです。
定義は、
(defun string-invert (str)
"Invert case of a string"
(declare (optimize (speed 3) (compilation-speed 0) (debug 0) (safety 0))
(simple-string str))
(let ((up nil) (down nil))
(block skip
(loop for char of-type character across str do
(cond ((upper-case-p char)
(if down (return-from skip str) (setf up t)))
((lower-case-p char)
(if up (return-from skip str) (setf down t)))))
(if up (string-downcase str) (string-upcase str)))))
となっていて、どうやら文字列中の文字が全部大文字もしくは小文字ならば、ケースを逆にするもののようです。
(KL:STRING-INVERT "foo") ;⇒ "FOO" (KL:STRING-INVERT "Foo") ;⇒ "Foo" (KL:STRING-INVERT "FOO") ;⇒ "foo" (KL:STRING-INVERT "fOO") ;⇒ "fOO"
この動きどこかで覚えがあるなと思ったら、リードテーブルでREADTABLE-CASEを:INVERTにしたときと同じ動きですね。
(LET ((*READTABLE* (COPY-READTABLE NIL)))
(SETF (READTABLE-CASE *READTABLE*) :INVERT)
(LIST (READ-FROM-STRING "foo")
(READ-FROM-STRING "Foo")
(READ-FROM-STRING "FOO")
(READ-FROM-STRING "fOO")))
;⇒ (FOO |Foo| |foo| |fOO|)
■
2010-02-21
KMRCLを眺める LIST-TO-DELIMITED-STRING (94)
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、LIST-TO-DELIMITED-STRINGです。
前回は、splitでしたが、今回は、PerlやRubyでいうjoinのようです。
(defun list-to-delimited-string (list &optional (separator " "))
(format nil (concatenate 'string "~{~A~^" (string separator) "~}") list))
という定義
動作は、
(KL:LIST-TO-DELIMITED-STRING '("foo" "bar" "baz") #\,)
;⇒ "foo,bar,baz"
(KL:LIST-TO-DELIMITED-STRING '("foo" "bar" "baz") ",")
;⇒ "foo,bar,baz"
(KL:LIST-TO-DELIMITED-STRING '("foo" "bar" "baz" #\.))
;⇒ "foo bar baz ."
(KL:LIST-TO-DELIMITED-STRING '("foo" "bar" "baz" #\A #\.))
;⇒ "foo bar baz ."
という風になっています。
デリミタは文字でも文字列でもどちらでも良いようですね。
■
2010-02-20
KMRCLを眺める (93) DELIMITED-STRING-TO-LIST
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、DELIMITED-STRING-TO-LISTです。
PerlやRubyでいうsplitのようです。
(defun delimited-string-to-list (string &optional (separator #\space)
skip-terminal)
"split a string with delimiter"
(declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0))
(type string string)
(type character separator))
(do* ((len (length string))
(output '())
(pos 0)
(end (position-char separator string pos len)
(position-char separator string pos len)))
((null end)
(if (< pos len)
(push (subseq string pos) output)
(when (or (not skip-terminal) (zerop len))
(push "" output)))
(nreverse output))
(declare (type fixnum pos len)
(type (or null fixnum) end))
(push (subseq string pos end) output)
(setq pos (1+ end))))
前回、前々回と定義していた、POSITION-(NOT-)CHARを利用しています。
この場合は、文字列の長さを越えてアクセスしていないので前回、前々回触れた問題には遭遇しません。
動作例は、
(KL:DELIMITED-STRING-TO-LIST "foo bar baz")
;⇒ ("foo" "bar" "baz")
(KL:DELIMITED-STRING-TO-LIST "foo,bar,baz" #\,)
(KL:DELIMITED-STRING-TO-LIST "foo,bar,baz," #\, 'T)
;⇒ ("foo" "bar" "baz")
(KL:DELIMITED-STRING-TO-LIST "foo,bar,baz," #\, NIL)
("foo" "bar" "baz" "")
というところでしょうか。デリミタ文字が最後に来る場合の処理を(&OPTIONAL SKIP-TERMINAL)で選択できます。
■
2010-02-19
KMRCLを眺める (92) POSITION-NOT-CHAR
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、POSITION-NOT-CHARです。
名前の通り前回のPOSITION-CHARの逆の動作をする関数です
(defun position-not-char (char string start max)
(declare (optimize (speed 3) (safety 0) (space 0))
(fixnum start max) (simple-string string))
(do* ((i start (1+ i)))
((= i max) nil)
(declare (fixnum i))
(when (char/= char (schar string i)) (return i))))
定義も、前回からの変更は、CHAR=がCHAR/=だけのもの
動作は、
(KL:POSITION-NOT-CHAR #\X "XXXXXXXXX" 0 100) ;⇒ 1 (KL:POSITION-NOT-CHAR #\0 "0123401234" 2 100) ;⇒ 2 ;; SBCL (KL:POSITION-NOT-CHAR #\X "XXXXXXXXX" 0 10)0 ;⇒ 9 ;??? (LET ((STR "XXXXXXXXX")) (KL:POSITION-NOT-CHAR #\X STR 0 (LENGTH STR))) ;⇒ NIL
という感じでSBCLでエラーの代りに妙な値が出てくるのも一緒です。
■
2010-02-18
KMRCLを眺める (91) POSITION-CHAR
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、POSITION-CHARです。
名前の通り、指定した文字が、文字列の中で何番目に出現するかを調べる関数。
定義は、
(defun position-char (char string start max)
(declare (optimize (speed 3) (safety 0) (space 0))
(fixnum start max) (simple-string string))
(do* ((i start (1+ i)))
((= i max) nil)
(declare (fixnum i))
(when (char= char (schar string i)) (return i))))
動作は、
(KL:POSITION-CHAR #\0 "0123401234" 0 100) ;⇒ 0 (KL:POSITION-CHAR #\0 "0123401234" 1 100) ;⇒ 5
というところ
最初SBCLで試してみていたのですが
;; SBCL 1.0.35 (KL:POSITION-CHAR #\0 "0123401234" 6 100) ;⇒ 16
となりました。16とはこれ如何に。
文字列の長さを越えると動作がおかしくなる様子。試しに、Allegro CLで実行してみました。
;; Allegro CL (KL:POSITION-CHAR #\0 "0123401234" 6 100) ;>>> Index 10 out of bounds for schar of "0123401234"
なるほど、文字列の長さを越えるとエラーです。定義からすると、エラーになるのが正しそうです。
この辺は、最適化の影響かなということで、
(optimize (speed 3) (safety 0) (space 0))
を
(optimize (speed 3) (safety 3) (space 0))
に変えてみたところ普通にエラーを出すようになりました。
安心した動作をさせるためには、
(LET ((STR "0123401234")) (KL:POSITION-CHAR #\0 STR 6 (LENGTH STR))) ;⇒ NIL
のように書く必要がありそうですが、最適化された関数は使い方もそれなりに面倒になるようです。
■
2010-02-17
KMRCLを眺める (90) COUNT-STRING-WORDS
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、COUNT-STRING-WORDSです。
定義はは、
(defun count-string-words (str)
(declare (simple-string str)
(optimize (speed 3) (safety 0) (space 0)))
(let ((n-words 0)
(in-word nil))
(declare (fixnum n-words))
(do* ((len (length str))
(i 0 (1+ i)))
((= i len) n-words)
(declare (fixnum i))
(if (alphanumericp (schar str i))
(unless in-word
(incf n-words)
(setq in-word t))
(setq in-word nil)))))
となっていて、ALPHANUMERICPがNILを返す文字を区切りにして文字列が何単語で構成されているかを調べるものです。
■
ALPHANUMERICPを利用するので、日本語の文字列では上手く動かないんだろうと試してみたところ
;; SBCL (KL:COUNT-STRING-WORDS "なにはつに さくやこのはな ふゆこもり") ;⇒ 3 (KL:COUNT-STRING-WORDS "なにはつに、さくやこのはな、ふゆこもり") ;⇒ 3 ;; Allegro CL (KL:COUNT-STRING-WORDS "なにはつに さくやこのはな ふゆこもり") ;⇒ 3 (KL:COUNT-STRING-WORDS "なにはつに、さくやこのはな、ふゆこもり") ;⇒ 1
意外にもSBCLが細かいところに対応していました。
;; SBCL (ALPHANUMERICP #\、) ;⇒ NIL
なんですね。
なんにしろこの辺りは、HyperSpecによると処理系依存なので、あまり期待はしない方が良いのかもしれません。
■
2010-02-16
KMRCLを眺める (89) LIST-TO-STRING
Common Lisp, KMRCL | |
今回はKMRCLのstrings.lispから、LIST-TO-STRINGです。
動作は、
(KL::LIST-TO-STRING '("aaa" "bbb" "ccc" :D E))
⇒ "aaabbbcccDE"
というところ。
リストの印字表現をくつけて文字列にして返します
この関数は、エクスポートはされていません。
定義は、
(defun list-to-string (lst)
"Converts a list to a string, doesn't include any delimiters between elements"
(format nil "~{~A~}" lst))
となっていて、そのままずばりな実装です。
■
2010-02-15
KMRCLを眺める (88) STRING-APPEND
Common Lisp, KMRCL | |
今回からKMRCLのstrings.lispを眺めてゆくことにしました。
KMRCLのなかでも一番大きなファイルで約700行。これだけ半年位続けられそうな気がします。
今回は、STRING-APPENDです。
古くは、LispマシンのLISPであるZetalispなどに同名の関数があるので
(STRING-APPEND "foo" "BAR" "baz") ;⇒ "fooBARbaz"
のような動きを期待してしまいますが、(Zetalispはこの動き)
定義を眺めるに、
(defmacro string-append (outputstr &rest args) `(setq ,outputstr (concatenate 'string ,outputstr ,@args)))
となっているので第一引数には変数が来ることになり
(LET ((X "foo")) (STRING-APPEND X "BAR" "baz") X) ;⇒ "fooBARbaz"
と使うようです。
■
文字列を連結する関数には、LISP方言によって
Zetalisp => STRING-APPEND
Franz Lisp => concat
Emacs Lisp => concat
TAO => sconc
という風に色々ありますが、Common Lispだと、
(CONCATENATE 'STRING "foo" "BAR" "baz") ;⇒ "fooBARbaz"
や、
(FORMAT NIL "~@{~A~}" "foo" 'BAR '|baz|)
;⇒ "fooBARbaz"
とすることになると思います。
■
また、近頃だと、処理系に専用の関数が定義されていることもあるようで、Allegro CLなどでは、STRING+というものが定義されているようです。
(UTIL.STRING:STRING+ "foo" 'BAR '|baz|) ;⇒ "fooBARbaz"
専用だけに、FORMATより速いようです。
去年のFranzのLispチュートリアル&セミナーで、黒田さんが、こういう専用関数を作って使うより、FORMATの最適化を頑張るべきだ!と主張していたのをふと思い出しました。
確かに標準の関数で速い方が嬉しいですね('-'*)
■
2010-02-14
KMRCLを眺める (87) DIRECTORY-TREE
Common Lisp, KMRCL | |
今回はKMRCLのio.lisp中からDIRECTORY-TREEです。
io.lispを眺めるのも今回で終り。今回のDIRECTORY-TREEの内部で、PROBE-DIRECTORY等が使われていたためimpl.lispに回り道していました。
動作は名前そのままの感じで、ディレクトリ構造をツリーで返してくれるというものです。再帰的にディレクトリを辿って行きますが、通常のファイルは返されるツリーには含まれません。
(DIRECTORY-TREE "/opt")
⇒
(#P"/opt/"
(#P"/opt/google/"
(#P"/opt/google/chrome/"
(#P"/opt/google/chrome/locales/")
(#P"/opt/google/chrome/resources/"
(#P"/opt/google/chrome/resources/inspector/"
(#P"/opt/google/chrome/resources/inspector/Images/")))))
(#P"/opt/scl/"
(#P"/opt/scl/bin/")
(#P"/opt/scl/lib/")))
定義は、
(defun directory-tree (filename)
"Returns a tree of pathnames for sub-directories of a directory"
(let* ((root (canonicalize-directory-name filename))
(subdirs (loop for path in (directory
(make-pathname :name :wild
:type :wild
:defaults root))
when (probe-directory path)
collect (canonicalize-directory-name path))))
(when (find nil subdirs)
(error "~A" subdirs))
(when (null root)
(error "~A" root))
(if subdirs
(cons root (mapcar #'directory-tree subdirs))
(if (probe-directory root)
(list root)
(error "root not directory ~A" root)))))
という風。
さて次回からどのファイルを眺めようかなと。
■
2010-02-12
KMRCLを眺める (86) PROBE-DIRECTORY
Common Lisp, KMRCL | |
今回はKMRCLのimpl.lisp中からPROBE-DIRECTORYです。
今回もimpl.lispです。
PROBE-DIRECTORYも、名前そのままのディレクトリを検出する関数です。
動作は、
(KL::PROBE-DIRECTORY "/etc") ;⇒ #P"/etc/" (KL::PROBE-DIRECTORY "/et") ;⇒ NIL (KL::PROBE-DIRECTORY "/etc" :ERROR-IF-DOES-NOT-EXIST T) ;⇒ #P"/etc/" (KL::PROBE-DIRECTORY "/et" :ERROR-IF-DOES-NOT-EXIST T) >>> Directory /et does not exist.
という感じです。これくらい標準でできそうな気もしますが、OSや処理系に依存するところがあったりする様子。
定義は、
(defun probe-directory (filename &key (error-if-does-not-exist nil))
(let* ((path (canonicalize-directory-name filename))
(probe
#+allegro (excl:probe-directory path)
#+clisp (values
(ignore-errors
(#+lisp=cl ext:probe-directory
#-lisp=cl lisp:probe-directory
path)))
#+(or cmu scl) (when (eq :directory
(unix:unix-file-kind (namestring path)))
path)
#+lispworks (when (lw:file-directory-p path)
path)
#+sbcl
(let ((file-kind-fun
(or (find-symbol "NATIVE-FILE-KIND" :sb-impl)
(find-symbol "UNIX-FILE-KIND" :sb-unix))))
(when (eq :directory (funcall file-kind-fun (namestring path)))
path))
#-(or allegro clisp cmu lispworks sbcl scl)
(probe-file path)))
(if probe
probe
(when error-if-does-not-exist
(error "Directory ~A does not exist." filename)))))
という風になっていて、:ERROR-IF-DOES-NOT-EXISTを指定することによってディレクトリが存在しない場合、エラーを上げることもできます。
(FIND-SYMBOL "NATIVE-FILE-KIND" :SB-IMPL)
という風にFIND-SYMBOLしたりしているのは、もし存在しなかった場合に、無駄なシンボルをINTERNしないためでしょうか。
■
2010-02-11
KMRCLを眺める (85) CANONICALIZE-DIRECTORY-NAME
Common Lisp, KMRCL | |
今回はKMRCLのimpl.lisp中からCANONICALIZE-DIRECTORY-NAMEです。
io.lispも残すところあと一つなのですが、その関数が他のファイルの関数を呼び出しているのでそちらを先に眺めます。
impl.lispは、主に実装依存の定義を纒めたファイルの様子。
CANONICALIZE-DIRECTORY-NAMEは、名前からすると、与えられたディレクトリの名前を正規化するもののようです。
動作は、
(KL::CANONICALIZE-DIRECTORY-NAME "/foo") ;⇒ #P"/foo/"
という風。
定義は、
(defun canonicalize-directory-name (filename)
(flet ((un-unspecific (value)
(if (eq value :unspecific) nil value)))
(let* ((path (pathname filename))
(name (un-unspecific (pathname-name path)))
(type (un-unspecific (pathname-type path)))
(new-dir
(cond ((and name type) (list (concatenate 'string name "." type)))
(name (list name))
(type (list type))
(t nil))))
(if new-dir
(make-pathname
:directory (append (un-unspecific (pathname-directory path))
new-dir)
:name nil :type nil :version nil :defaults path)
path))))
となっています。:UNSPECIFICが返ってきた場合にNILに置き換える、UN-UNSPECIFICという内部関数を定義して使っています。
しかし、PATHNAME-DIRECTORYなどで、:UNSPECIFICが返ってきたりするんですね。全然知りませんでした。
■
2010-02-10
KMRCLを眺める (84) COPY-BINARY-STREAM
Common Lisp, KMRCL | |
今回はKMRCLのio.lisp中からCOPY-BINARY-STREAMです。
動作は
(WITH-OPEN-FILE (IN "/usr/share/dict/words" :ELEMENT-TYPE '(UNSIGNED-BYTE 8))
(WITH-OPEN-FILE (OUT "/tmp/k.txt" :DIRECTION :OUTPUT
:IF-EXISTS :SUPERSEDE
:IF-DOES-NOT-EXIST :CREATE)
(COPY-BINARY-STREAM IN OUT)))
;⇒ NIL
;; /tmp/k.txtに/usr/share/dict/wordsと同じ内容のファイルができる
というところでしょうか。
定義は、
(defun copy-binary-stream (in out &key (chunk-size 16384))
(do* ((buf (make-array chunk-size :element-type '(unsigned-byte 8)))
(pos (read-sequence buf in) (read-sequence buf in)))
((zerop pos))
(write-sequence buf out :end pos)))
となっています。
■
まとめてチャンクで読み書きしているのは、きっとこの方が速くなるからだろう、ということで計測してみました。
;; COPY-BINARY-STREAM利用
(LOOP :REPEAT 100
:DO (WITH-OPEN-FILE (IN "/usr/share/dict/words" :ELEMENT-TYPE '(UNSIGNED-BYTE 8))
(WITH-OPEN-FILE (OUT "/tmp/k.txt" :DIRECTION :OUTPUT
:IF-EXISTS :SUPERSEDE
:IF-DOES-NOT-EXIST :CREATE
:ELEMENT-TYPE '(UNSIGNED-BYTE 8))
(COPY-BINARY-STREAM IN OUT))))
;⇒ NIL
;----------
; cpu time (non-gc) 0.070000 sec user, 0.750000 sec system
; cpu time (gc) 0.000000 sec user, 0.000000 sec system
; cpu time (total) 0.070000 sec user, 0.750000 sec system
; real time 2.299199 sec
; space allocation:
; 11,815 cons cells, 2,450,064 other bytes, 0 static bytes
;; READ-BYTEしてWRITE-BYTE
(LOOP :REPEAT 100
:DO (WITH-OPEN-FILE (IN "/usr/share/dict/words" :ELEMENT-TYPE '(UNSIGNED-BYTE 8))
(WITH-OPEN-FILE (OUT "/tmp/k.txt" :DIRECTION :OUTPUT
:IF-EXISTS :SUPERSEDE
:IF-DOES-NOT-EXIST :CREATE
:ELEMENT-TYPE '(UNSIGNED-BYTE 8))
(LOOP :FOR B := (READ-BYTE IN NIL -1) :UNTIL (MINUSP B)
:DO (WRITE-BYTE B OUT)))))
;⇒ NIL
;----------
; cpu time (non-gc) 5.040000 sec user, 0.750000 sec system
; cpu time (gc) 0.000000 sec user, 0.000000 sec system
; cpu time (total) 5.040000 sec user, 0.750000 sec system
; real time 6.685070 sec
; space allocation:
; 17,645 cons cells, 430,736 other bytes, 0 static bytes
やっぱり、それなりに速いみたいですね。
■
2010-02-08
KMRCLを眺める (83) WRITE-UTIME-YMDHM
Common Lisp, KMRCL | |
今回はKMRCLのio.lisp中からWRITE-UTIME-YMDHMです。
やっとこさ日付シリーズが終りです。
動作は
(WRITE-UTIME-YMDHM 0 :UTC-OFFSET 0) ;⇒ "1900/01/01 00:00"
で、定義は、
(defun write-utime-ymdhm (utime &key stream utc-offset)
(if stream
(write-utime-ymdhm-stream utime stream utc-offset)
(with-output-to-string (s)
(write-utime-ymdhm-stream utime s utc-offset))))
となっています。
文字ストリームに出力するか指定のストリームに出力するかをもっと簡潔に書けたりしないものかと考えましたが、いまいちこれといった書き方も見付からず。
■
2010-02-07
KMRCLを眺める (82) WRITE-UTIME-YMDHM-STREAM
Common Lisp, KMRCL | |
今回はKMRCLのio.lisp中からWRITE-UTIME-YMDHM-STREAMです。
名前が似たようなのが多いので、どこまで読んだのかを見失います…。
動作は
(WITH-OUTPUT-TO-STRING (OUT) (WRITE-UTIME-YMDHM-STREAM (GET-UNIVERSAL-TIME) OUT)) ;⇒ "2010/02/07 15:12"
で、前のWRITE-UTIME-YMDHMS-STREAMとは秒があるかないかの違いです。
定義は、
(defun write-utime-ymdhm-stream (utime stream &optional utc-offset)
(with-utime-decoding-utc-offset (utime utc-offset)
(write-string (prefixed-fixnum-string year nil 4) stream)
(write-char #\/ stream)
(write-string (aref +datetime-number-strings+ month) stream)
(write-char #\/ stream)
(write-string (aref +datetime-number-strings+ day-of-month) stream)
(write-char #\space stream)
(write-string (aref +datetime-number-strings+ hour) stream)
(write-char #\: stream)
(write-string (aref +datetime-number-strings+ minute) stream)))
となっています。
■
2010-02-06
KMRCLを眺める (81) WRITE-UTIME-YMDHMS
Common Lisp, KMRCL | |
今回はKMRCLのio.lisp中からWRITE-UTIME-YMDHMSです。
前回のWRITE-UTIME-YMDHMS-STREAMをWITH-OUTPUT-TO-STRINGで包んだものです。
(WRITE-UTIME-YMDHMS (GET-UNIVERSAL-TIME)) ;⇒ "2010/02/06 22:27:37"
定義は、
(defun write-utime-ymdhms (utime &key stream utc-offset)
(if stream
(write-utime-ymdhms-stream utime stream utc-offset)
(with-output-to-string (s)
(write-utime-ymdhms-stream utime s utc-offset))))
ちなみに、このパターンがもう何日か続きます…
■
2010-02-05
KMRCLを眺める (80) WRITE-UTIME-YMDHMS-STREAM
Common Lisp, KMRCL | |
今回はKMRCLのio.lisp中からWRITE-UTIME-YMDHM-STREAMです。
動作は
(WITH-OUTPUT-TO-STRING (OUT) (WRITE-UTIME-YMDHM-STREAM (GET-UNIVERSAL-TIME) OUT)) ;⇒ "2010/02/05 23:15:37"
というところです。割と良く使う形式かもしれません。
定義は、
(defun write-utime-ymdhms-stream (utime stream &optional utc-offset)
(with-utime-decoding-utc-offset (utime utc-offset)
(write-string (prefixed-fixnum-string year nil 4) stream)
(write-char #\/ stream)
(write-string (aref +datetime-number-strings+ month) stream)
(write-char #\/ stream)
(write-string (aref +datetime-number-strings+ day-of-month) stream)
(write-char #\space stream)
(write-string (aref +datetime-number-strings+ hour) stream)
(write-char #\: stream)
(write-string (aref +datetime-number-strings+ minute) stream)
(write-char #\: stream)
(write-string (aref +datetime-number-strings+ second) stream)))
となっていますが、この定義の中のPREFIXED-FIXNUM-STRINGは、string.lispで定義されていて、ここでは、0でパディングされた数字を出力するのに利用しているようです。
(PREFIXED-FIXNUM-STRING 77 NIL 8) ;⇒ "00000077"
どうもKMRCL(というかKMR氏)は、FORMATでがんばったりはあまりしないスタイルなのかなと思えてきました。
そういうスタイルもありですね。
■
2010-02-04
KMRCLを眺める (79) WRITE-UTIME-HM
Common Lisp, KMRCL | |
今回はKMRCLのio.lisp中からWRITE-UTIME-HMです。
似たような関数が続くので一度にまとめた方が良いような気もしてきました。
前回のWRITE-UTIME-HM-STREAMをWITH-OUTPUT-TO-STRINGで包んだものです。
(defun write-utime-hm (utime &key utc-offset stream)
(if stream
(write-utime-hm-stream utime stream utc-offset)
(with-output-to-string (s)
(write-utime-hm-stream utime s utc-offset))))
動作は、
(WRITE-UTIME-HM (GET-UNIVERSAL-TIME)) ;⇒ "22:45"
となっています。
■
2010-02-03
KMRCLを眺める (78) WRITE-UTIME-HM-STREAM
Common Lisp, KMRCL | |
今回はKMRCLのio.lisp中からWRITE-UTIME-HM-STREAMです。
最近紹介したWRITE-UTIME-HMM-STREAMと何が違うかといえば、秒(S)がないというだけのものです。
定義も殆ど同じで
(defun (utime stream &optional utc-offset)
(with-utime-decoding-utc-offset (utime utc-offset)
(write-string (aref +datetime-number-strings+ hour) stream)
(write-char #\: stream)
(write-string (aref +datetime-number-strings+ minute) stream)))
となっています。
動作は、
(WITH-OUTPUT-TO-STRING (OUT) (WRITE-UTIME-HM-STREAM (GET-UNIVERSAL-TIME) OUT)) ;⇒ "23:06"
です。そしてWRITE-UTIME-HMにつづく…
■
2010-02-01
Lispjobs.jpにCLerの募集が掲載!
lispjobs.jp | |
先日、Lispjobs.jpではとんがったプログラマさんの募集が掲載されましたが、今回は、CLerの募集です!
自分も腕があったら働いてみたかったｗ
仕事で使う処理系はどうもAllegro CLのようです。
Allegro CLが仕事で使えるなんて羨しい!!
我こそはと思う方は、検討してみては如何でしょうか!