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-04-29

(10)CLOSによる作曲支援及び音響合成の統合環境:IRCAM OpenMusicの今日

| 17:11 | (10)CLOSによる作曲支援及び音響合成の統合環境:IRCAM OpenMusicの今日 - わだばLisperになる を含むブックマーク はてなブックマーク - (10)CLOSによる作曲支援及び音響合成の統合環境:IRCAM OpenMusicの今日 - わだばLisperになる

CiNiiのLISP関係の論文をのんびり漁っております。今回は、

です。

題名にCLOSとなっていますが、文中ではCommon Lispのことを指しているようです。

内容は、OpenMusicというCLで構築された作曲支援/音響合成の環境の紹介になっています。

OpenMusicは主にIRCAM周辺で開発されているとのこと。

自分は、フランスの現代音楽が好きで良く聴くのですが、こんなところでCLが使われているとは思いませんでした。

OpenMusicは名前は知っていたものの、触ったことはなかったので、いじって遊んでみたいです。

2010-04-28

KMRCLを眺める(146) COLLAPSE-WHITESPACE

| 13:49 | KMRCLを眺める(146) COLLAPSE-WHITESPACE - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(146) COLLAPSE-WHITESPACE - わだばLisperになる

今回はKMRCLのstrings.lispから、COLLAPSE-WHITESPACEです。

連続した空白を一つの空白に圧縮する関数のようで、動作は、

(KL:COLLAPSE-WHITESPACE "foo

bar 
baz

    quux")
⇒
"foo bar baz quux"

という感じ。

定義は、

(defun collapse-whitespace (s)
  "Convert multiple whitespace characters to a single space character."
  (declare (simple-string s)
           (optimize (speed 3) (safety 0)))
  (with-output-to-string (stream)
    (do ((pos 0 (1+ pos))
         (in-white nil)
         (len (length s)))
        ((= pos len))
      (declare (fixnum pos len))
      (let ((c (schar s pos)))
        (declare (character c))
        (cond
         ((kl:is-char-whitespace c)
          (unless in-white
            (write-char #\space stream))
          (setq in-white t))
         (t
          (setq in-white nil)
          (write-char c stream)))))))

という風にストレートなものです。

2010-04-27

KMRCLを眺める(145) SPLIT-ALPHANUMERIC-STRING

| 14:07 | KMRCLを眺める(145) SPLIT-ALPHANUMERIC-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(145) SPLIT-ALPHANUMERIC-STRING - わだばLisperになる

今回はKMRCLのstrings.lispから、SPLIT-ALPHANUMERIC-STRINGです。

前回の LEX-STRING はデリミタが空白/改行文字でしたが、今回は、 non alpanumetricな文字が区切りになります

(KL:SPLIT-ALPHANUMERIC-STRING "いろはにほへと,ちりぬるを,わかよたれそ,つねならむ")
=> ("いろはにほへと" "ちりぬるを" "わかよたれそ" "つねならむ")

というところです。

定義も殆ど同じで、LEX-STRINGと2行位違うだけで

(defun split-alphanumeric-string (string)
  "Separates a string at any non-alphanumeric chararacter"
  (declare (simple-string string)
           (optimize (speed 3) (safety 0)))
  (flet ((is-sep (char)
           (declare (character char))
           (and (non-alphanumericp char)
                (not (char= #\_ char)))))
    (let ((tokens nil))
      (do* ((token-start
             (position-if-not #'is-sep string)
             (when token-end
               (position-if-not #'is-sep string :start (1+ token-end))))
            (token-end
             (when token-start
               (position-if #'is-sep string :start token-start))
             (when token-start
               (position-if #'is-sep string :start token-start))))
           ((null token-start) (nreverse tokens))
        (push (subseq string token-start token-end) tokens)))))

となっています。

なんとなく、コピペ的に似たような関数を書くよりは、区切りを判定する関数を受けとる関数を書く方すっきりする気がします。

(SPLIT-STRING "いろはにほへと ちりぬるを,わかよたれそ,つねならむ")
              :TEST #'KL:NON-ALPHANUMERICP)
=> ("いろはにほへと" "ちりぬるを" "わかよたれそ" "つねならむ")

のような感じで。

2010-04-26

(9)TUPLE: SIMD型超並列計算のための拡張 Common Lisp(1994)

| 20:38 | (9)TUPLE: SIMD型超並列計算のための拡張 Common Lisp(1994) - わだばLisperになる を含むブックマーク はてなブックマーク - (9)TUPLE: SIMD型超並列計算のための拡張 Common Lisp(1994) - わだばLisperになる

CiNiiのLISP関係の論文をのんびり漁っております。今回は、

です。

SIMD型超並列計算機のLISPといえば、Connection MachineのConnection Machine Lispや*Lispが有名だと思いますが、TUPLEは、各々のプロセッサでCL処理系のサブセットを動かすというのが特徴のようです。

マシンは、MasPar社のMP-1というマシンで、1024のプロセッサを搭載ということなので、1024のCLサブセットが稼動し、それをフロントエンドのフルセットのCLが制御するという形式。

論文の内容は、TUPLEの仕組みと、実装、性能評価が主になっています。

*Lispと同様に、TUPLEにもシミュレーターが用意されているというところにぐっと来ました。動かして遊んでみれたら面白そうです。

2010-04-25

(8)Tachyon Common Lispにおけるウインドウ・インタフェース(1993)

| 15:08 | (8)Tachyon Common Lispにおけるウインドウ・インタフェース(1993) - わだばLisperになる を含むブックマーク はてなブックマーク - (8)Tachyon Common Lispにおけるウインドウ・インタフェース(1993) - わだばLisperになる

CiNiiのLISP関係の論文をのんびり漁っております。今回は、

です。

Tachyon CL上にMotif対応のウィンドウ・インターフェイスを開発したという論文で、例としてデバッガを取り上げています。

Tachyon CLは今のAllegro CLやLispWorksのように色々付属していたようです。

そんなTachyon CLは、当時どれ位のお値段で売られていたんでしょうね。

2010-04-24

KMRCLを眺める(144) LEX-STRING

| 17:24 | KMRCLを眺める(144) LEX-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(144) LEX-STRING - わだばLisperになる

今回はKMRCLのstrings.lispから、LEX-STRINGです。

動作は、以前眺めた DELIMITED-STRING-TO-LIST と大体同じですが、LEX-STRINGは空白文字を複数指定できるところが違うようです。(デフォルトだと、#\Spaceと#\Newline)

(SUBSEQ (KL:LEX-STRING (KL:READ-FILE-TO-STRING "/usr/share/dict/words")
                       :WHITESPACE '(#\Newline))
        10000
        10010)
⇒ ("Loyola" "Loyola's" "Lr" "Lt" "Lt's" "Ltd" "Ltd's" "Lu" "Lu's" "Luanda")

という感じで、定義は

(defun lex-string (string &key (whitespace '(#\space #\newline)))
  "Separates a string at whitespace and returns a list of strings"
  (flet ((is-sep (char) (member char whitespace :test #'char=)))
    (let ((tokens nil))
      (do* ((token-start
             (position-if-not #'is-sep string)
             (when token-end
               (position-if-not #'is-sep string :start (1+ token-end))))
            (token-end
             (when token-start
               (position-if #'is-sep string :start token-start))
             (when token-start
               (position-if #'is-sep string :start token-start))))
           ((null token-start) (nreverse tokens))
        (push (subseq string token-start token-end) tokens)))))

です。

DOの中身が長くなるので縦に伸びています。

2010-04-23

(7)スーパコンピュータ(ベクトル計算機)のための並列Lispコンパイラ(1990)

| 13:17 | (7)スーパコンピュータ(ベクトル計算機)のための並列Lispコンパイラ(1990) - わだばLisperになる を含むブックマーク はてなブックマーク - (7)スーパコンピュータ(ベクトル計算機)のための並列Lispコンパイラ(1990) - わだばLisperになる

CiNiiのLISP関係の論文をのんびり漁っております。今回は、

です。

ベクトルプロセッサ上のLISPの高速化について。

並列処理用の(vmap fnβ fnα arg....)というマクロを定義したり、car、cdr等のリスト処理をベクトル化する方法についての考察等々。

実際にコードを書いて仕組みを考えてみるのも面白そうです。

2010-04-22

KMRCLを眺める(143) SHRINK-VECTOR

| 14:05 | KMRCLを眺める(143) SHRINK-VECTOR - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(143) SHRINK-VECTOR - わだばLisperになる

今回はKMRCLのstrings.lispから、SHRINK-VECTORです。

定義をみると仮引数にstrとあって文字列を取るのかと思ってしまいますが、VECTOR全般で使えるようです。

(defun shrink-vector (str size)
  #+allegro
  (excl::.primcall 'sys::shrink-svector str size)
  #+cmu
  (lisp::shrink-vector str size)
  #+lispworks
  (system::shrink-vector$vector str size)
  #+sbcl
  (sb-kernel:shrink-vector str size)
  #+scl
  (common-lisp::shrink-vector str size)
  #-(or allegro cmu lispworks sbcl scl)
  (setq str (subseq str 0 size))
  str)

動作は、

(LET ((S (MAKE-STRING 10 :INITIAL-ELEMENT #\X)))
  (KL:SHRINK-VECTOR S 5))
⇒ "XXXXX"

という感じだと思いますが、SBCLだと内部で呼び出しているSB-KERNEL:SHRINK-VECTORは破壊的変更をする関数ではないようで、

(LET ((S (MAKE-STRING 10 :INITIAL-ELEMENT #\X)))
  (KL:SHRINK-VECTOR S 5))
⇒ "XXXXXXXXXX"

となってしまいます。

2010-04-21

(6)Common Lisp言語処理系による64ビット環境の評価(2006)

| 20:28 | (6)Common Lisp言語処理系による64ビット環境の評価(2006) - わだばLisperになる を含むブックマーク はてなブックマーク - (6)Common Lisp言語処理系による64ビット環境の評価(2006) - わだばLisperになる

CiNiiのLISP関係の論文をのんびり漁っております。今回は、

です。

Common Lisp言語処理系の64ビット化(2004)で述べられていた処理系の性能を評価するという内容でした。

メモリアクセスが遅いプロセッサだと32bitから64bit化しても性能向上が芳しくないことがあるとのこと。

2010-04-20

KMRCLを眺める(142) STRING-MAYBE-SHORTEN

| 13:18 | KMRCLを眺める(142) STRING-MAYBE-SHORTEN - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(142) STRING-MAYBE-SHORTEN - わだばLisperになる

今回はKMRCLのstrings.lispから、STRING-MAYBE-SHORTENです。

前回のSTRING-ELIDEの:ENDを指定したものです

(DEFVAR *IROHA*
  "いろはにほへとちりぬるをわかよたれそつねならむうゐのおくやまけふこえてあさきゆめみしゑひもせす")

(KL:STRING-MAYBE-SHORTEN *IROHA* 10)
⇒
"いろはにほへと..."

定義は、そのまま

(defun string-maybe-shorten (str maxlen)
  (string-elide str maxlen :end))

となっています。

2010-04-19

(5)Common Lisp言語処理系の64ビット化(2004)

| 14:05 | (5)Common Lisp言語処理系の64ビット化(2004) - わだばLisperになる を含むブックマーク はてなブックマーク - (5)Common Lisp言語処理系の64ビット化(2004) - わだばLisperになる

CiNiiのLISP関係の論文をのんびり漁っております。今回は、

です。

KCL(Kyoto Common Lisp)を64bitのSolaris 9に移植し、64bit化したという論文です。

移植する際に問題になったところが述べられていました。

ちなみに、論文とは関係ないですが、GCLはKCLから分岐したものというのは有名だと思います。

オリジナルのKCLは今でもSolarisだと比較的簡単にコンパイルできたりするんでしょうか。

2010-04-18

KMRCLを眺める(141) STRING-ELIDE

| 16:10 | KMRCLを眺める(141) STRING-ELIDE - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(141) STRING-ELIDE - わだばLisperになる

今回はKMRCLのstrings.lispから、STRING-ELIDEです。

動作は、指定した長さを越える文字列は、省略の...を付けて切り詰めるというものです。

(DEFVAR *IROHA*
  "いろはにほへとちりぬるをわかよたれそつねならむうゐのおくやまけふこえてあさきゆめみしゑひもせす")

(KL:STRING-ELIDE " 10 :END)
⇒
"いろはにほへと..."

(KL:STRING-ELIDE *IROHA* 47 :END)
⇒
"いろはにほへとちりぬるをわかよたれそつねならむうゐのおくやまけふこえてあさきゆめみしゑひもせす"

(KL:STRING-ELIDE *IROHA* 46 :END)
⇒
"いろはにほへとちりぬるをわかよたれそつねならむうゐのおくやまけふこえてあさきゆめみしゑ..."

(KL:STRING-ELIDE *IROHA* 46 :MIDDLE)
⇒
"いろはにほへとちりぬるをわかよたれそつねなら...おくやまけふこえてあさきゆめみしゑひもせす"

という風に、デフォルトの動作は、:ENDを指定したものを一緒で、最後に"..."を、:MIDDLEを指定すると中央に"..."が入ります。

定義は、

(defun string-elide (str maxlen position)
  (declare (fixnum maxlen))
  (let ((len (length str)))
    (declare (fixnum len))
    (cond
     ((<= len maxlen)
      str)
     ((<= maxlen 3)
      "...")
     ((eq position :middle)
      (multiple-value-bind (mid remain) (truncate maxlen 2)
        (let ((end1 (- mid 1))
              (start2 (- len (- mid 2) remain)))
          (concatenate 'string (subseq str 0 end1) "..." (subseq str start2)))))
     ((or (eq position :end) t)
      (concatenate 'string (subseq str 0 (- maxlen 3)) "...")))))

となっています。

ぱっと見たところ

(or (eq position :end) t)

が結局どういうことなんだと思ってしまいますが、良く良く考えると気持ちはなんとなく分かります。

2010-04-17

(4)Common Lispサブセットの試作(1986)

| 19:50 | (4)Common Lispサブセットの試作(1986) - わだばLisperになる を含むブックマーク はてなブックマーク - (4)Common Lispサブセットの試作(1986) - わだばLisperになる

CiNiiのLISP関係の論文をのんびり漁っております。今回は、

です。

NECのV60という32bitプロセッサ上にCommon Lispのサブセット処理系を試作するという内容。

後ろの方で少し触れされていますが、電子協にLISP技術専門委員会というものがあり、Common Lispのサブセットである、Common Lisp/Coreというものを作ろうとしていたんですね。

サブセットCommon Lispの必要性ですが、当時のパソコンで稼動させるために小さくまとめようということだった様子。

2010-04-16

KMRCLを眺める(140) STRING-STRIP-ENDING

| 13:27 | KMRCLを眺める(140) STRING-STRIP-ENDING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(140) STRING-STRIP-ENDING - わだばLisperになる

今回はKMRCLのstrings.lispから、STRING-STRIP-ENDINGです。

動作は、与えた文字列の末尾が指定した文字列群のうちのどれかと一致するなら、一致した部分を取り除いて返すというもので

(DEFVAR *FILES* '("FOO.LSP" "BAR.LISP" "BAZ.L"))

(MAPCAR (LAMBDA (X) 
          (KL:STRING-STRIP-ENDING X '(".lsp" ".lisp" ".l")))
        *FILES*)
⇒
("FOO" "BAR" "BAZ")

というところ。

定義は、

(defun string-strip-ending (str endings)
  (if (stringp endings)
      (setq endings (list endings)))
  (let ((len (length str)))
    (dolist (ending endings str)
      (when (and (>= len (length ending))
                 (string-equal ending
                               (subseq str (- len
                                              (length ending)))))
        (return-from string-strip-ending
          (subseq str 0 (- len (length ending))))))))

となっています。

endingsにはリストを与えても良いし、文字列単品でも良いみたいです。個人的な趣味ですがifよりwhenの方が読み易いですね。

2010-04-15

(3)Tachyon Common LispのPA-RISCへの移植(1994)

| 13:31 | (3)Tachyon Common LispのPA-RISCへの移植(1994) - わだばLisperになる を含むブックマーク はてなブックマーク - (3)Tachyon Common LispのPA-RISCへの移植(1994) - わだばLisperになる

まったりとCiNiiのLISP関係の論文を漁っておりますが、今回は、

です。

Tachyon CLは移植性を高めるために、Cとアセンブラで記述されたPlispと呼ばれている核言語と、ライブラリに分かれていて、このPlispをPA-RISCへ移植したという論文のようです。

Plispを記述するアセンブラはLISPに似たものにしてあり強力なマクロを持っているとのこと。

15万行の処理系のプログラムを3.25人月でPA-RISCに移植できたそうです。

Tachyon CL関係の論文を読む度に、今流通してないのが非常にもったいないというか残念だなあと思ってしまいます。

2010-04-14

KMRCLを眺める(139) REMOVE-CHAR-STRING

| 13:56 | KMRCLを眺める(139) REMOVE-CHAR-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(139) REMOVE-CHAR-STRING - わだばLisperになる

今回はKMRCLのstrings.lispから、REMOVE-CHAR-STRINGです。

動作は、文字列から指定した文字を取り除くもののようで

(KL:REMOVE-CHAR-STRING #\o "looooooooooooooooooooooooooooop")
⇒ "lp"

というところ。

定義は、

(defun remove-char-string (char str)
  (declare (character char)
           (string str))
  (do* ((len (length str))
        (out (make-string len))
        (pos 0 (1+ pos))
        (opos 0))
       ((= pos len) (subseq out 0 opos))
    (declare (fixnum pos opos len)
             (simple-string out))
    (let ((c (char str pos)))
      (declare (character c))
      (when (char/= c char)
        (setf (schar out opos) c)
        (incf opos)))))

となっています。

元の文字列と同じ長さで文字列を作成して、後は指定した文字と一致していない文字を順に埋めていき、最後に必要な部分だけ返す、という方式です。

文字列の余ったところが、なんだか余っいてもったいなく感じたので、単純に文字列ストリームを使ったり、リストにして集めたのを変換したのと比べてどうなのかということで計測してみましたが、KMRCLの方式の方が効率が良いみたいです。

(DEFVAR *WORDS*
  (KL:READ-FILE-TO-STRING "/usr/share/dict/words"))

(LENGTH *WORDS*)
⇒ 931467

;; KMRCL
(PROG () (KL:REMOVE-CHAR-STRING #\o *WORDS*))
;⇒ NIL
----------
Evaluation took:
  0.029 seconds of real time
  0.030000 seconds of total run time (0.030000 user, 0.000000 system)
  [ Run times consist of 0.010 seconds GC time, and 0.020 seconds non-GC time. ]
  103.45% CPU
  70,205,436 processor cycles
  7,258,080 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

;; 文字列ストリーム
(DEFUN MY-REMOVE-CHAR-STRING (CHAR STR)
  (DECLARE (CHARACTER CHAR)
           (STRING STR))
  (WITH-OUTPUT-TO-STRING (OUT)
    (LOOP :FOR C :ACROSS STR 
          :IF (CHAR/= CHAR C) :DO (PRINC C OUT))))

(PROG () (MY-REMOVE-CHAR-STRING #\o *WORDS*))
;⇒ NIL
----------
Evaluation took:
  0.166 seconds of real time
  0.170000 seconds of total run time (0.150000 user, 0.020000 system)
  102.41% CPU
  397,283,913 processor cycles
  7,737,024 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

;; リストで集めて文字列に変換
(DEFUN MY-REMOVE-CHAR-STRING-2 (CHAR STR)
  (DECLARE (CHARACTER CHAR)
           (STRING STR))
  (COERCE 
   (LOOP :FOR C :ACROSS STR 
         :IF (CHAR/= CHAR C) :COLLECT C)
   'STRING))

(PROG () (MY-REMOVE-CHAR-STRING-2 #\o *WORDS*))
;⇒ NIL
----------
Evaluation took:
  0.087 seconds of real time
  0.080000 seconds of total run time (0.080000 user, 0.000000 system)
  [ Run times consist of 0.030 seconds GC time, and 0.050 seconds non-GC time. ]
  91.95% CPU
  209,846,160 processor cycles
  17,674,400 bytes consed
  
Intel(R) Core(TM)2 Duo CPU     P8600  @ 2.40GHz

2010-04-13

(2)マルチプロセッサLispマシンMacELIS IIのアーキテクチャ(1989)

| 14:11 | (2)マルチプロセッサLispマシンMacELIS IIのアーキテクチャ(1989) - わだばLisperになる を含むブックマーク はてなブックマーク - (2)マルチプロセッサLispマシンMacELIS IIのアーキテクチャ(1989) - わだばLisperになる

CiNiiのLISP関係の論文を漁る、今回は、

です。

Symbolicsや、TI-Explorerでは、MacintoshのNuBusにプロセッサのカードを接続してLispマシン化することができたようなのですが、なんと、ELISにもMacintosh IIのNuBusに接続するバージョンがあったんですね。

実際に市販されていたのかは謎ですがどんな環境だったのか興味深いです。

海外では、わざわざ古いNuBusの68k Macを購入してMacIvory(Symbolics)を動かしている人がいますが、MacELISのカードが見付かれば自分も古いMacを発掘して試してみたいなあと思わないでもありません。

2010-04-12

KMRCLを眺める(138) STRING-RIGHT-TRIM-ONE-CHAR

| 13:31 | KMRCLを眺める(138) STRING-RIGHT-TRIM-ONE-CHAR - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(138) STRING-RIGHT-TRIM-ONE-CHAR - わだばLisperになる

今回はKMRCLのstrings.lispから、STRING-RIGHT-TRIM-ONE-CHARです。

指定した文字が文字列の最後に現われるなら文字を切り詰めるというもので、動作は、

(KL:STRING-RIGHT-TRIM-ONE-CHAR #\o "foo")
⇒
"fo"

(KL:STRING-RIGHT-TRIM-ONE-CHAR #\r "foo")
⇒
"foo"

というところ。

定義は、

(defun string-right-trim-one-char (char str)
  (declare (simple-string str))
  (let* ((len (length str))
         (last (1- len)))
    (declare (fixnum len last))
    (if (char= char (schar str last))
        (subseq str 0 last)
      str)))

となっています。

2010-04-11

(1)ELIS Common LispのGCフリーコーディング機能 : 実時間応用をねらいとして(1991)

| 20:02 | (1)ELIS Common LispのGCフリーコーディング機能 : 実時間応用をねらいとして(1991) - わだばLisperになる を含むブックマーク はてなブックマーク - (1)ELIS Common LispのGCフリーコーディング機能 : 実時間応用をねらいとして(1991) - わだばLisperになる

あまりにもKMRCL紹介ブログと化しているので他に面白そうなことはないかと考えてみましたが、アカデミックな歴史の蓄積があるLISPならではということで、CiNiiの論文を漁って読んで感想を書いてみることにしました。

学術論文に対してズブの素人が適当な感想を書くというのもなんだかなという感じなので、こういう研究もあったのか面白い位で当たり障りなく紹介できたら良いなと思っています。

今回は、

です。

リアルタイム処理で問題になるのが、GCによる停止時間ですが、この論文では、最初からGCが発生しないようにプログラムを書くという、GCフリー・コーディングというスタイルを紹介していて、このスタイルでのプログラミングを支援するELIS Common Lisp上の機能を紹介しています。

ポール・グレアム著のANSI Common Lispや、ダグ・ホ<イト著のLet Over Lambdaでもこういうスタイルは紹介されていますが、処理系に支援機能があるというのが面白いです。

2010-04-10

KMRCLを眺める(137) ENSURE-STRING

| 19:31 | KMRCLを眺める(137) ENSURE-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(137) ENSURE-STRING - わだばLisperになる

今回はKMRCLのstrings.lispから、ENSURE-STRINGです。

ENSURE-〜という命名もCLでは良く見掛けますが、任意の入力を目的の所望の形式に叶うように良きに計らって変換して返したりするようなものにこういう名前が用いられることが多いようです。

動作は、

(MAPCAR #'KL:ENSURE-STRING 
        (LIST "foo"
              'FOO
              '|foo|
              #\F
              42
              (make-broadcast-stream)))
⇒
("foo" "FOO" "foo" "F" "42" "#<BROADCAST-STREAM {100DB8A351}>")

というところ。

定義は、

(defun ensure-string (v)
  (typecase v
    (string v)
    (character (string v))
    (symbol (symbol-name v))
    (otherwise (write-to-string v))))

となっています。

2010-04-09

KMRCLを眺める(136) LAST-CHAR

| 14:07 | KMRCLを眺める(136) LAST-CHAR - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(136) LAST-CHAR - わだばLisperになる

今回はKMRCLのstrings.lispから、LAST-CHARです。

前回のFIRST-CHARの逆で文字列の最後の文字を返すものです。

動作は

(KL:LAST-CHAR "fooooooo")
;⇒ #\o

定義は、

(defun last-char (s)
  (declare (simple-string s))
  (when (stringp s)
    (let ((len (length s)))
      (when (plusp len))
      (schar s (1- len)))))

となっていますが、

(defun last-char (s)
  (declare (simple-string s))
  (when (stringp s)
    (let ((len (length s)))
      (when (plusp len)
        (schar s (1- len))))))

ですよね。

2010-04-08

KMRCLを眺める(135) FIRST-CHAR

| 14:50 | KMRCLを眺める(135) FIRST-CHAR - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(135) FIRST-CHAR - わだばLisperになる

今回はKMRCLのstrings.lispから、FIRST-CHARです。

動作は

(KL:FIRST-CHAR "first")
⇒ #\f

というところです。定義は、

(defun first-char (s)
  (declare (simple-string s))
  (when (and (stringp s) (plusp (length s)))
    (schar s 0)))

となっています。

引数が文字列でない、もしくは空文字列の場合は、nilを返すようになっていますが、型宣言も付いているので、文字列でない場合は、エラーを上げる処理系も多いのではないかと思います(SBCL等)

単にLENGTHに文字列以外が渡らないようにするためのガードなのかもしれません。

2010-04-07

KMRCLを眺める(134) RANDOM-STRING

| 13:47 | KMRCLを眺める(134) RANDOM-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(134) RANDOM-STRING - わだばLisperになる

今回はKMRCLのstrings.lispから、RANDOM-STRINGです。

動作は

(LOOP :REPEAT 10
      :COLLECT (KL:RANDOM-STRING :LENGTH 8 :SET :UNAMBIGUOUS))
⇒ 
("JZXQz956" "Ck4HrVZw" "rZYJFrLK" "Z93rPrw3" "jcNvxkyC"
 "ggv578Xm" "SanChNn8" "52HZ6Gbm" "d4ABh8JT" "ahBcKt5L")

というところです。前回のRANDOM-CHARを利用してランダムな文字で文字列を作成します。

(defun random-string (&key (length 10) (set :lower-alpha))
  "Returns a random lower-case string."
  (declare (optimize (speed 3)))
  (let ((s (make-string length)))
    (declare (simple-string s))
    (dotimes (i length s)
      (setf (schar s i) (random-char set)))))

いつものごとく長さ分の文字列を作成しておき、RANDOM-CHARから返ってきた文字で埋めてゆくという流れです。

2010-04-06

KMRCLを眺める(133) RANDOM-CHAR

| 14:55 | KMRCLを眺める(133) RANDOM-CHAR - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(133) RANDOM-CHAR - わだばLisperになる

今回はKMRCLのstrings.lispから、RANDOM-CHARです。

(LOOP :FOR TYPE :IN '(:LOWER-ALPHA 
                      :LOWER-ALPHANUMERIC
                      :UPPER-LOWER-ALPHA
                      :UNAMBIGUOUS
                      :UPPER-LOWER-ALPHA)
      :COLLECT (LIST TYPE
                     (COERCE (LOOP :REPEAT 10 
                                   :COLLECT (KL::RANDOM-CHAR TYPE))
                             'STRING)))
⇒ 
((:LOWER-ALPHA        "gnuwknujwl")
 (:LOWER-ALPHANUMERIC "zpbgazxla7")
 (:UPPER-LOWER-ALPHA  "OrqKoBLBxQ") 
 (:UNAMBIGUOUS        "1EqnJ2baP4")
 (:UPPER-LOWER-ALPHA  "tyfguMsAgo"))

というように大文字/小文字/数字の色々な組み合わせでランダムな文字を出力するもののようです。

定義は、

(defconstant* +char-code-lower-a+ (char-code #\a))
(defconstant* +char-code-upper-a+ (char-code #\A))
(defconstant* +char-code-0+ (char-code #\0))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defvar +unambiguous-charset+
    "abcdefghjkmnpqrstuvwxyz123456789ABCDEFGHJKLMNPQSRTUVWXYZ")
  (defconstant* +unambiguous-length+ (length +unambiguous-charset+)))

(defun random-char (&optional (set :lower-alpha))
  (ecase set
    (:lower-alpha
     (code-char (+ +char-code-lower-a+ (random 26))))
    (:lower-alphanumeric
     (let ((n (random 36)))
       (if (>= n 26)
           (code-char (+ +char-code-0+ (- n 26)))
         (code-char (+ +char-code-lower-a+ n)))))
    (:upper-alpha
     (code-char (+ +char-code-upper-a+ (random 26))))
    (:unambiguous
     (schar +unambiguous-charset+ (random +unambiguous-length+)))
    (:upper-lower-alpha
     (let ((n (random 52)))
       (if (>= n 26)
           (code-char (+ +char-code-upper-a+ (- n 26)))
         (code-char (+ +char-code-lower-a+ n)))))))

今回も、DEFVARと、DEFCONSTANT*の使い分けが良く分かりません。

どういう必然があってこうなっているのか…。

2010-04-05

KMRCLを眺める(132) URI-QUERY-TO-ALIST

| 13:44 | KMRCLを眺める(132) URI-QUERY-TO-ALIST - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(132) URI-QUERY-TO-ALIST - わだばLisperになる

今回はKMRCLのstrings.lispから、URI-QUERY-TO-ALISTです。

URLのクエリパラメータを分解して、ALISTにするもののようです

動作は、

(KL:URI-QUERY-TO-ALIST "ls=%2Fusr%2Fbin%2Fls&bash=%2Fusr%2Flocal%2Fbin%2Fbash")
;⇒ (("ls" . "/usr/bin/ls") ("bash" . "/usr/local/bin/bash"))

というところ

定義は、以前の眺めたKMRCL:DECODE-URI-STRING、KMRCL:DELIMITED-STRING-TO-LISTを利用していて

(defun uri-query-to-alist (query)
  "Converts non-decoded URI query to an alist of settings"
  (mapcar (lambda (set)
            (let ((lst (kmrcl:delimited-string-to-list set #\=)))
              (cons (first lst) (second lst))))
          (kmrcl:delimited-string-to-list
           (kmrcl:decode-uri-string query) #\&)))

となっています。

2010-04-04

KMRCLを眺める(131) DECODE-URI-STRING

| 21:36 | KMRCLを眺める(131) DECODE-URI-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(131) DECODE-URI-STRING - わだばLisperになる

今回はKMRCLのstrings.lispから、DECODE-URI-STRINGです。

名前のとおり前回のENCODE-URI-STRINGの逆でデコードを行ないます。

動作は、

(KL:DECODE-URI-STRING "R6RS%20Scheme")
⇒ "R6RS Scheme"

というところ

定義は

(defun decode-uri-string (query)
  "Unescape non-alphanumeric characters for URI fields"
  (declare (simple-string query)
           (optimize (speed 3) (safety 0) (space 0)))
  (do* ((count (count-string-char query #\%))
        (len (length query))
        (new-len (- len (* 2 count)))
        (str (make-string new-len))
        (spos 0 (1+ spos))
        (dpos 0 (1+ dpos)))
      ((= spos len) str)
    (declare (fixnum count len new-len spos dpos)
             (simple-string str))
    (let ((ch (schar query spos)))
      (if (char= #\% ch)
          (let ((c1 (charhex (schar query (1+ spos))))
                (c2 (charhex (schar query (+ spos 2)))))
            (declare (fixnum c1 c2))
            (setf (schar str dpos)
                  (code-char (logior c2 (ash c1 4))))
            (incf spos 2))
        (setf (schar str dpos) ch)))))

となっていて中身の処理手順も大体、ENCODE-URI-STRINGの逆になっています。

ENCODE-URI-STRINGと同様ASCII以外の処理は考慮されていない様子。

2010-04-03

KMRCLを眺める(130) ENCODE-URI-STRING

| 13:45 | KMRCLを眺める(130) ENCODE-URI-STRING - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(130) ENCODE-URI-STRING - わだばLisperになる

今回はKMRCLのstrings.lispから、ENCODE-URI-STRINGです。

動作は、

(KL:ENCODE-URI-STRING "/usr/bin/ls")
⇒ "%2Fusr%2Fbin%2Fls"

というところ

定義は

(defun encode-uri-string (query)
  "Escape non-alphanumeric characters for URI fields"
  (declare (simple-string query)
           (optimize (speed 3) (safety 0) (space 0)))
  (do* ((count (count-string-char-if #'non-alphanumericp query))
        (len (length query))
        (new-len (+ len (* 2 count)))
        (str (make-string new-len))
        (spos 0 (1+ spos))
        (dpos 0 (1+ dpos)))
      ((= spos len) str)
    (declare (fixnum count len new-len spos dpos)
             (simple-string str))
    (let ((ch (schar query spos)))
      (if (non-alphanumericp ch)
          (let ((c (char-code ch)))
            (setf (schar str dpos) #\%)
            (incf dpos)
            (setf (schar str dpos) (hexchar (logand (ash c -4) 15)))
            (incf dpos)
            (setf (schar str dpos) (hexchar (logand c 15))))
        (setf (schar str dpos) ch)))))0

となっています。

  • non-alphanumericpでエンコードする必要のある文字を判定
  • エンコードして長くなる分の文字数を足した長さの文字列を新しく作成
  • 元の文字列を読みながら、新しい文字列にエンコードしつつコピー

という感じのようです。

(hexchar (logand (ash c -4) 15)と(hexchar (logand c 15))のところが気になりますが、一文字ずつ処理する必要があるため、20のような16進数を2と0の文字に分けている様子

ちなみに、以前眺めたnon-alphanumericpで判定しているのと、ASCII以外は考慮していないようなので、

;; UTF-8
(KL:ENCODE-URI-STRING "逆引き Scheme")
⇒ "逆引き%20Scheme"

ということになってしまいます。