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 |

2008-06-27

UbuntuでCUSP

| 20:31 | UbuntuでCUSP - わだばLisperになる を含むブックマーク はてなブックマーク - UbuntuでCUSP - わだばLisperになる

何度かCUSPはセットアップしては放置を繰り返しているのですが、セットアップの度に忘れるのでメモってみることにしました。

以下、Ubuntu 8.0.4でのセットアップです。

用意するもの、

セットアップ

1. Eclipseを導入

$ sudo apt-get install eclipse

2. CUPSのファイルを展開

$ cd /usr/lib/eclipse
$ sudo tar zxvf /tmp/cusp_linux.tar.gz

3. 展開しただけだと動かないので、features、pluginに中身を展開

$ cd /usr/lib/eclipse/features
$ sudo lndir ../cusp_linux/features

$ cd /usr/lib/eclipse/plugin
$ sudo lndir ../cusp_linux/plugin

4. Eclipse起動

5. Window -> Open Perspective -> Other -> Lisp

完了

はまりどころ

他で、SLIMEが起動していて、4005番のポートが使われていると、ポートが塞がっているのでエラーになる。

機能

プロジェクトを開くと、ASDFのファイルや、パッケージの雛型を一通り準備してくれて便利そうです。

また、SLIMEを横取りして動いているようなものなので、SLIMEの機能は一通りあるようで、コンパイル、マクロの展開、関数名の補完等、必須の所は装備されています。

Eclispeに馴れた人ならば結構良い環境なのではないでしょうか。

参考

  • Windowsでの導入

cadr group

サンプルコードによるLOOPマクロ入門 (3)

| 16:38 | サンプルコードによるLOOPマクロ入門 (3) - わだばLisperになる を含むブックマーク はてなブックマーク - サンプルコードによるLOOPマクロ入門 (3) - わだばLisperになる

値の蓄積

LOOPマクロの実際のコードでは、なんらかの値を蓄積してリスト等にして返すものが多いかと思います。

値を蓄積するキーワードとしては、:collect、:sum、:count〜等色々ありますが、実際に使われるのは、:collectが殆どだと思います。

  • :collect
(loop :repeat 5 
      :collect (random 5)
      :collect 'a
      :collect (random 100)
      :collect 'b
      :collect (gensym))
;=> (2 A 41 B #:G3407 1 A 10 B #:G3408 4 A 13 B #:G3409 4 A 6 B #:G3410 0 A 83
     B #:G3411)

何の役にも立たなそうな例ですが、:collectが複数回使えることを強調してみました。

:repeatが急に登場しましたが、これは、単純に指定した回数だけループを回すというものです。

  • :append
(loop :repeat 5 
      :append (list (random 5) 'a (random 100) 'b (gensym)))

上と同じ結果になるものを:appendで作成してみています。

:appendは、関数のappendから類推できるようにリストを継げて行きます。

そのため:append以下はリストになっている必要があります。

  • :nconc
(loop :repeat 5 
      :nconc (list (random 5) 'a (random 100) 'b (gensym)))

:appendはリストを新規に作成して継げてゆきますが、nconcは、既存のものを破壊的に連結して行きます。

上の例では、新規に作られたリストが連結されて行くので問題ありませんが、

(let* ((foo '((a) (b) (c) (d) (e)))
       (bar (copy-tree foo)))
  (loop :for x :in bar
        :nconc x)
  bar))
;=> ((A B C D E) (B C D E) (C D E) (D E) (E))

のような場合に、元リストが変更されるので、取り扱い注意になります。

数値篇

リスト系の操作の他に、数値を扱う操作もあります。

リストに比べると使用頻度は下がるかと思いますが、数値計算をしている場合には、便利なものが多いかもしれません。

Project Eulerのような問題を解くのには割と便利に使えるような気がします。

  • :maximize
(loop :repeat 5 :maximize (random 100))
;=> 76

値の最大値を返します。

  • :minimize
(loop :repeat 5 :minimize (random 100))
;=> 10

値の最小最大値を返します。

(loop :repeat 5 :sum (random 100))
;=> 231

値の合計を返します。

(loop :repeat 5 :count (oddp (random 100)))
;=> 2

:countに与えられた引数が真の場合をカウントします。

2008-06-26

サンプルコードによるLOOPマクロ入門 (2)

| 23:11 | サンプルコードによるLOOPマクロ入門 (2) - わだばLisperになる を含むブックマーク はてなブックマーク - サンプルコードによるLOOPマクロ入門 (2) - わだばLisperになる

分割(Destructuring)

書くネタがある訳じゃないのですが、とりあえず続きもので行きます。

LOOPマクロの便利な機能として、LOOP変数で分割代入が使えるというのがあります。

for 変数 in

のところに、

for (変数 変数) in

という風に分割したい形式に合せて指定すると、それぞれの変数に分割された内容が代入されます。

(defvar *data* '((0 A) (1 B) (2 C) (3 D) (4 E) (5 F) (6 G) (7 H) (8 I)))
  • 各々の子リストの内容を逆転
(loop :for (x y) :in *data* :collect (list y x))
;=> ((A 0) (B 1) (C 2) (D 3) (E 4) (F 5) (G 6) (H 7) (I 8))
  • ドット対で指定
(loop :for (x . y) :in *data* :collect (list x y))
;=> ((0 (A)) (1 (B)) (2 (C)) (3 (D)) (4 (E)) (5 (F)) (6 (G)) (7 (H)) (8 (I)))
  • 複雑なもの
(defvar *data2* 
  '(((0 (A))) ((1 (B))) ((2 (C))) ((3 (D))) ((4 (E))) ((5 (F))) ((6 (G)))
    ((7 (H))) ((8 (I)))))

(loop :for ((x (y))) :in *data2* :collect x :collect y)
;=> (0 A 1 B 2 C 3 D 4 E 5 F 6 G 7 H 8 I)

:COLLECTは複数回使えます。

  • 他の構文との比較
;; dolistで
(let (res)
  (dolist (x *data2* (nreverse res))
    (destructuring-bind ((x (y))) x
      (push x res)
      (push y res))))

;;mapcanで
(mapcan (lambda (x)
          (destructuring-bind ((x (y))) x
            (list x y)))
        *data2*)

2008-06-25

サンプルコードによるLOOPマクロ入門 (1)

| 17:18 | サンプルコードによるLOOPマクロ入門 (1) - わだばLisperになる を含むブックマーク はてなブックマーク - サンプルコードによるLOOPマクロ入門 (1) - わだばLisperになる

LOOPマクロはCLerのなかでも賛否両論な感じなのですが、それなりに使われていることもあり、簡単なものの読み書き位はできるようになっておいたほうが良いかと思います。

複雑という評判だけに、色々とチュートリアルがあるのですが、実際のところ「どう使うのか」というよりは、機能を列記しているものが多いようで、リファレンス的な内容になっているものが多いようです。

ということで、レシピブックのように使い方に焦点を絞って、あまり使いそうもない機能は、応用ということで紹介してゆくのも良いかと思いました。

タイトルは、Perl入門ゼミさんをパクリました(笑)

LOOPマクロの構文

LOOPマクロは、ミニ言語と呼ばれるようにLOOPの節の中で一つの世界を形成しています。

どういう世界かといえば、中置記法が使える世界で、また、英文としても読み下しやすいように配慮されています。

ということで、LOOPマクロの文法をそれなりに憶える必要があり、色々組み合わせると複雑にもなるのですが、普段使うものは、比較的少なく、数種類のパターンを丸暗記してしまえば、9割方読み書きできるような気がするので、そんなパターンを列記して行くことにします。

見やすさの工夫

LOOPマクロは、中置記法を実現するために色々なキーワードを使っています。

(loop for i in '(1 2 3 4) collect (* i i))

という場合、for、in、collectはキーワードで、iは変数名なのですが、

人によっては、読みやすいようにキーワードを目立つように書く人もいます。

  • キーワードパッケージのシンボルでキーワードを書いた例(ややこしい表現)
(loop :for i :in '(1 2 3 4) :collect i)
  • キーワードを大文字にしてみた例(非常にまれ)
(LOOP FOR i IN '(1 2 3 4) COLLECT (* i i))

LIST -> LISTパターン (in)

LISPだけにリストを操作するパターンが多いと思うのですが、まず、このパターンを紹介してみます。

暗記するキーワードは、forと、inと、collectです。

(loop :for i :in '(1 2 3 4) :collect i)
;=> (1 2 3 4)

'(1 2 3 4)というリストを取って、'(1 2 3 4)というリストを返します。

同じような内容の処理は、

(mapcar (lambda (x) x) '(1 2 3 4))
;=> (1 2 3 4)

とも書けます。

繰り返しの内容としては、'(1 2 3 4)というリストの要素を先頭から順にiに格納し、繰り返します。

それで、:COLLECTというのは、値を収集するという指定で、繰り返しが終わると、その蓄積結果を全体の結果として返します。

ちなみに、:COLLECTを使わないLOOPマクロは、使ってもあまり旨味がないことが殆どで、他の繰り返し構文の方が綺麗に書けることが多いと思います。

応用(COLLECT節で色々実験する)

(loop :for i :in '(1 2 3 4) :collect (list i))
;=> ((1) (2) (3) (4))

(loop :for i :in '(1 2 3 4) :collect (* i i))
;=> (1 4 9 16)

(loop :for i :in '(1 2 3 4)
      :collect (list i '=> (format nil "~R" i)))
((1 => "one") (2 => "two") (3 => "three") (4 => "four"))

;; 元リストと同じ長さで内容がGENSYMのリストを返す
(loop :for i :in '(1 2 3 4) :collect (gensym))
;=> (#:G3362 #:G3363 #:G3364 #:G3365)

他の構文との比較

(loop :for i :in '(1 2 3 4) :collect (list i))
;=> ((1) (2) (3) (4))

;; mapcar
(mapcar #'list '(1 2 3 4))

;; do
(do ((i '(1 2 3 4) (cdr i))
     (res () (cons (list (car i)) res)))
    ((endp i) (nreverse res)))

;; dolist
(let (res)
  (dolist (i '(1 2 3 4) (nreverse res))
    (push (list i) res)))

;; reduce
(reduce (lambda (i res) (append (list i) res))
        '(1 2 3 4) :from-end 'T :initial-value () )

;; reduce #2
(nreverse
 (reduce (lambda (res i) (cons (list i) res))
         '(1 2 3 4) :initial-value () ))
  • mapcar
    • この例の場合、一番シンプル
  • do
    • 蓄積用の変数resを用意しないといけない
    • cdrを降りて行くので、リストのCARを取得する必要がある。
    • consして、最後にnreverseするのがイディオムだが、面倒といえば面倒(appendして順番を保持しても良いが、cons&nreverseの方が効率が良い)
  • dolist
    • 蓄積用の変数resを用意しないといけない
    • 結果をreverseする必要がある
  • reduce
    • do、dolistと同様に自由度は高いが、この程度の処理の場合、逆に繁雑

2008-06-24

第5回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知

| 17:12 | 第5回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる を含むブックマーク はてなブックマーク - 第5回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる

今週も、開催させて頂きます!

ここ2回は短めに時間を区切って複数のお題をこなしてみましたが、続きものになると、前回からの復帰にもそれなりに時間がかかるので、復帰の時間がそれなりに必要になってくることに気付きました。

また、チャットの性質上、手を動かしてみないと分からないような内容はちょっと難しいのではないか、と思いはじめました。

ということで、今回、お題は2つで、

  • マクロ
  • CLの落し穴集(コーディングではまるところ)

として、マクロの巻は今回を終わらせて、残った時間で、CLの落し穴の巻を検討してみる、ということにしてみました。

前回までのコンディションシステムは、チャットでは難しい気がするので、どういう風に展開したら良いかを考えなおしています。

場所:Lingr: Common Lisp部屋
日時6/28 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の進行テキストを最初から参加者が眺めてゆき、質問があったり、議論になりそうなことがあったら議論してゆきます。
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-THE POWER OF LISP MACROS (Edi Weitz氏)CLマクロ入門者的な方macros.lisp
-21:30位までCommon Lisp PitfallsCLでコーディングする方Common Lisp Pitfalls

また、「こういうのを勉強してみたい!」というのがあれば、このブログにコメント頂くか、Lingr等に書き置きしてみて下さい。好きなテーマを持ち込んでみて頂くというのも大歓迎です!

前回は、正味の勉強会より、終った後の方が盛り上がりましたので、21:30以降、LISP系の雑談をされたい方も歓迎しています!。別にお題があって話をしているわけではないので割とカオスですが(笑)…。

pfcでL-99 (P12 ランレングス圧縮の伸長)

| 16:14 | pfcでL-99 (P12 ランレングス圧縮の伸長) - わだばLisperになる を含むブックマーク はてなブックマーク - pfcでL-99 (P12 ランレングス圧縮の伸長) - わだばLisperになる

なんとなく無理矢理な感じですが、折角の遅延評価なので使ってみました。

(decode '((4 A) B (2 C) (2 A) D (4 E)))
;==> [A A A A B C C A A D E E E E]

(define (decode lst)
  (if (null lst)
      ()
      (let ((head (hd lst)))
        (++ (if (atom head)
                [head]
                (take (hd head)
                      (item-list (hd (tl head)))))
            (decode (tl lst))))))

(define (item-list item)
  (cons item (item-list item)))

オリジナルのSchemeインタープリタを動かそう

| 00:31 | オリジナルのSchemeインタープリタを動かそう - わだばLisperになる を含むブックマーク はてなブックマーク - オリジナルのSchemeインタープリタを動かそう - わだばLisperになる

Accesscom.com | SF Bay Area Internet Access Providerさんのページを眺めていたら、最初のSchemeの論文のインタープリタをCLに移植した(オリジナルはMacLISP)という面白そうなものがあったので早速試してみることにしました。

ここのlambda papersのリンクからファイルを取得できます。

このファイルをコンパイルして読み込ませたイメージをSBCLを使って実行ファイルにしてみました。

(compile-file "/tmp/scheme")
(load "/tmp/scheme")

(defun scheme-repl ()
  (handler-case (scheme)
    (error (cond)
      (declare (ignore cond))
      (format t "An error occurred.")
      (scheme-repl))))

(pushnew (lambda ()
           (scheme-repl))
         sb-ext:*init-hooks*)

(sb-ext:save-lisp-and-die "/tmp/scheme-1975" :purify 'T :executable 'T)

というようなファイルをmake-scheme.lispとでも名前を付けて、配布物の中のscheme.lispを/tmpに置いて、

$ sbcl --load make-scheme

と実行しすると、/tmp/にscheme-1975ができます。

実行可能ファイルになってますので、実行するとschemeのインタープリタが起動します。

そのままでは、エラー時にデバッガに落ちて面倒なので、適当に再度実行するようにしてありますが、もっとちゃんとした対処方法があると思います。

This is SCHEME 0 running in SBCL 1.0.17
SCHEME -- Toplevel

(define fact-iter
  (lambda (n)
    (labels ((fact1 (lambda (m ans)
                      (if (= m 0)
                          ans
                          (fact1 (- m 1)
                                 (* m ans))))))
      (fact1 n 1))))
==> 
FACT-ITER 
==> 
3628800 
==> 

まとめ/その他

にオリジナルのSchemeの論文があります。

また、EMACSで、(run-scheme "/tmp/scheme-1975")とすれば、EMACS経由で使えます。(quit)で終了。

どうも、doマクロ等がちゃんと動いてない気もするのですが、その辺をデバッグするのも一興ではないでしょうか(*'-')

2008-06-22

6/21第4回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ

| 18:51 | 6/21第4回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる を含むブックマーク はてなブックマーク - 6/21第4回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる

昨日、6/21 20:00から4回目の勉強会を開催させて頂きました!

発言して頂いた方約10名、observer(ROM)の約方10名で、大体20名前後を推移しつつでした。

今回も、30分x3本という感じで、1時間半の内容です。

反省と課題

  • 今回、お題に突っ込みを多く頂いたので、30分で区切りは、ちょっと短いかもしれない。
  • Lingrでチャット形式で展開するのに向いているお題と向かないお題があるようだ。
    • 向いてるお題
      • TIPS集等細切れで展開できて議論を展開しやすいもの。
    • 向いてないお題
      • 一冊の本を通しで読む、等。

関連資料

ログ:
  1. Common Lispの落し穴集
  2. The Power of LISP Macros
  3. Common Lispのコンディションシステム
今回の勉強会について言及のブログエントリ

謝辞

  • zickさん

予習/まとめのブログエントリありがとうございます!

勉強会の告知をして頂きありがとうございます!

今回も勉強会の一員に加えて頂いてありがとうございます!

次回…。

6/28日 20時から開催したいと思います!

お題は、今回の続き2品(マクロ/落し穴)でマクロの方を完結させて、コンディションの方は、ちょっとLingrで展開するのは厳しそうなので、策を練り直して再挑戦したいと思います。

何か、アイディア/要望等ありましたら、Lingrに書き置きでもしてみて下さい!。

2008-06-20

無限小/大との比較

| 16:42 | 無限小/大との比較 - わだばLisperになる を含むブックマーク はてなブックマーク - 無限小/大との比較 - わだばLisperになる

bit別冊 Common Lisp オブジェクトシステム - CLOSとその周辺を眺めていたところ、無限小や、無限大を定義し、総称関数でラップすることによって、数値の無限大/小との比較ができるだろう、というような文を読んで、「なるほど!、面白そうだ」と思ったので、早速試してみました。

  • inf.0 +inf.0という表現は、R6RSから、拝借しましたが、なんとなくキーワードにしました。
(defgeneric binary> (object1 object2)
  (:documentation "object1 object2 ==> boolean"))

(defmethod binary> ((obj1 (eql :+inf.0)) (obj2 (eql :-inf.0))) 'T)
(defmethod binary> ((obj1 (eql :+inf.0)) (obj2 (eql :+inf.0))) NIL)
(defmethod binary> ((obj1 (eql :-inf.0)) (obj2 (eql :-inf.0))) NIL)
(defmethod binary> ((obj1 number)        (obj2 (eql :-inf.0))) 'T)
(defmethod binary> ((obj1 (eql :-inf.0)) (obj2 number))        NIL)
(defmethod binary> ((obj1 number)        (obj2 number))        (> obj1 obj2))
(defmethod binary> ((obj1 (eql :-inf.0)) (obj2 (eql :+inf.0))) NIL)
(defmethod binary> ((obj1 number)        (obj2 (eql :+inf.0))) NIL)

;; LEXPR版
(defmethod g> (obj &rest objs)
  (loop :for prev := obj :then item
        :for item :in objs
         :always (binary> prev item)))

という感じで、割とごちゃごちゃな定義です。binary>という名前は、S式Dylanから拝借しましたが、面倒なので他の述語を作る気にはなれませんでした(;´Д`)

使い方

(defun max-number (lst)
  (flet ((pick-greater (a b)
           (if (binary> a b) a b)))
    (reduce #'pick-greater lst :initial-value :-inf.0)))

(max-number (list  1 :-inf.0 most-negative-long-float))
;=> 1

という風に、使えるんだと思います。

関数版

Dylanは、=等は総称関数で、文字列との比較にも使えますが、数値に限定するなら、関数でも良いかなと思って試してみました。

(deftype number* ()
  `(or number (member :-inf.0 :+inf.0)))

(defun bin> (x y)
  (declare (number* x y))
  (cond ((eql x y) NIL)
        ((eql :-inf.0 x) NIL)
        ((eql :-inf.0 y) 'T)
        ('T (> x y))))

(bin> most-negative-fixnum :-inf.0)
;=> t

という感じで、あっさり書けてしまいました…。

総称関数の場合、定義を生成してくれるマクロを書くと良いのかもしれません。

2008-06-18

GOOでL-99 (P21 指定した位置に要素を挿入する)

| 17:39 | GOOでL-99 (P21 指定した位置に要素を挿入する) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P21 指定した位置に要素を挿入する) - わだばLisperになる

先週さぼったの2連続で…。前回と同じでmy-splitを使っています。文字列の扱いをどうしたら良いかと思いましたが、とりあえず印字表現をそのまま挿し込むことにしました。

(insert-at 'alpha '(a b c d) 2) ;=> (a alpha b c d)
(insert-at 'alpha #(a b c d) 2) ;=> #(a alpha b c d)
(insert-at 'alpha #[a b c d] 2) ;=> #[a alpha b c d]
(insert-at 'alpha "abcd" 2)     ;=> "aalphabcd"

(dg insert-at (item|<any> u|<seq> p|<int> => <seq>))

(dm insert-at (item|<any> u|<seq> p|<int> => <seq>)
  (def (tup x y) (my-split u (1- p)))
  (cat x (lst item) y))

(dm insert-at (item|<any> u|<str> p|<int> => <str>)
  (def (tup x y) (my-split u (1- p)))
  (cat x (to-str item) y))

GOOでL-99 (P20 指定した要素を削除)

| 17:39 | GOOでL-99 (P20 指定した要素を削除) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P20 指定した要素を削除) - わだばLisperになる

以前に定義したmy-splitを使っています。GOOで分割代入/束縛させたい場合、変数のところをタプルにすると分割して束縛されます。

(remove-at '(a b c d) 2) ;=> (a c d)
(remove-at #(a b c d) 2) ;=> #(a c d)  
(remove-at #[a b c d] 2) ;=> #[a c d]  
(remove-at "abcd" 2)     ;=> "acd"

(dg remove-at (u|<seq> p|<int> => <seq>))

(dm remove-at (u|<seq> p|<int> => <seq>)
  (def (tup x y) (my-split u (1- p)))
  (cat x (sub* y 1)))

第4回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知

| 01:59 | 第4回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる を含むブックマーク はてなブックマーク - 第4回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる

今回も、懲りずに開催致します!

お題は全部で3つで。1枠25分+休憩5分で時間の枠に収まらなかった場合、次回へ持ち越しという流れで。

お題としては、

  • CLの落し穴集(コーディングではまるところ)
  • マクロ
  • コンディションシステム

「CLの落し穴集」が今回初で、マクロとコンディションシステムについては、前回からの引き続きです。

場所:Lingr: Common Lisp部屋
日時6/21 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の進行テキストを最初から参加者が眺めてゆき、質問があったり、議論になりそうなことがあったら議論してゆきます。
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-20:25Common Lisp PitfallsCLでコーディングする方Common Lisp Pitfalls
20:30-20:55THE POWER OF LISP MACROS (Edi Weitz氏)CLマクロ入門者的な方macros.lisp
21:00-21:25「Common Lisp における例外処理 〜Condition System の活用〜」(数理システムさん)CLのコンディションシステム入門者的な方(PDF)
21:25-反省/質問/お題の提案/雑談

のようなものをお題にすることを考えています。

また、「こういうのを勉強してみたい!」というのがあれば、このブログにコメント頂くか、Lingr等に書き置きしてみて下さい!

また、好きなテーマを持ち込んでみて頂くというのも大歓迎です!

2008-06-17

DylanでL-99 (P11 ランレングス圧縮 その2)

| 16:18 | DylanでL-99 (P11 ランレングス圧縮 その2) - わだばLisperになる を含むブックマーク はてなブックマーク - DylanでL-99 (P11 ランレングス圧縮 その2) - わだばLisperになる

CLのsubseqに相当するものがないか探したのですが見付からず。それらしきものの実装では、copy-sequenceして切り出していたので真似してみました。これで良いのでしょうか…。

また、良く考えると、文字列の圧縮表現は変かなあと思いはじめました(;´Д`)普通にリストにした方が良いかも。

format-out("%=\n",
           #(a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:).encode-modified);
//=> #(#(4, #"a"), #"b", #(2, #"c"), #(2, #"a"), #"d", #(4, #"e"))

format-out("%=\n",
           #[a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:].encode-modified);
//=> #[#(4, #"a"), #"b", #(2, #"c"), #(2, #"a"), #"d", #(4, #"e")]

format-out("%=\n", "aaaabccaadeeee".encode-modified);
//=> "4a;b;2c;2a;d;4e"

// Code:
define generic single?
    (sequence :: <sequence>)
 => (result :: <boolean>);

define method single?
    (sequence :: <sequence>)
 => (result :: <boolean>)
  ~sequence.empty?
    & copy-sequence(sequence, start: 1).empty?
end method single?;

define generic encode-modified
    (sequence :: <sequence>)
 => (result :: <sequence>);

define method encode-modified
    (sequence :: <list>)
 => (result :: <list>)
  as(<list>, next-method())
end method encode-modified;

define method encode-modified
    (sequence :: <vector>)
 => (result :: <vector>)
  as(<vector>, next-method())
end method encode-modified;

define method encode-modified
    (sequence :: <string>)
 => (result :: <string>)
  join(map(method(x)
               if (x.single?)
                 x
               else
                 format-to-string("%d%s", x.size, x.first) 
               end if
           end,
           sequence.pack1),
       ";")
end method encode-modified;

define method encode-modified
    (sequence :: <sequence>)
 => (result :: <sequence>)
  map(method(x) 
          if (x.single?)
            x.first
          else
            list(x.size, x.first) 
          end if
      end,
      sequence.pack1)
end method encode-modified;

2008-06-16

pfcでL-99 (P11 ランレングス圧縮 その2)

| 18:08 | pfcでL-99 (P11 ランレングス圧縮 その2) - わだばLisperになる を含むブックマーク はてなブックマーク - pfcでL-99 (P11 ランレングス圧縮 その2) - わだばLisperになる

ポール・グレアムで有名なsingleを定義して使ってみました。

(encode-modified '(a a a a b c c a a d e e e e))
;=> [[4 a] b [2 c] [2 a] d [4 e]]

(define (single? lst)
  (and [(consp lst)
        (null (tl lst))]))

(define (encode-modified lst)
  (map (lambda (x) 
         (if (single? x)
             (hd x)
             [(length x) (hd x)]))
       (pack lst)))

2008-06-15

メーリングリストでも勉強会

| 15:46 | メーリングリストでも勉強会 - わだばLisperになる を含むブックマーク はてなブックマーク - メーリングリストでも勉強会 - わだばLisperになる

メーリングリストでも勉強会ができないかと思い、Google Groupを作成してみることにしました!

メーリングリストならば、時間を気にせずに質問したり、ゆるゆると進行して行けるという長所があるので良いかなと思ったのですが、割と迷走気味かもしれません(笑)

メーリングリストなら参加してみたい!という方、大歓迎ですので参加してみて下さい!

ちなみに、現状、何ひとつ形も方針もありません(笑)

CL初心者の方への質問メーリングリストという役割でも良いかもしれません。

ちなみに、Googleにアカウントを作る必要があり、そこがちょっとネックではあります…。

LispマシンとCDR-Coding

| 14:50 | LispマシンとCDR-Coding - わだばLisperになる を含むブックマーク はてなブックマーク - LispマシンとCDR-Coding - わだばLisperになる

今回の勉強会でLispマシンを取り上げてみたのですが、zickさんのブログエントリでの反応で、CDR-Codingについて言及がありました。

「Lispマシンといえば、CDRコーディング」というというところがマニアックかつ正統派というか凄いですね(笑)

CDR-Codingについては、Lispマシンの最初のレポートにも記述がありまして、割と目玉なところだったようです。

今回自分もこのAIM-444を読んでみて、色々発見があったのですが、Lispマシンについてだけでなく、Lisp-machine Lispがどういう風に実装されていたかを知る資料としても面白いものかと思います。

今回勉強会で言及していないものは沢山あるのですが、「スタック」、「CDR-Coding」、「タグアーキテクチャとLISP」等は目玉のところかなと思いますし、LISP処理系を作る人にも面白い読み物かなと思いますのでお勧めです。

また、CDR-Codingについては、GLSがAI Memoで詳しく解説しているものがあってこれも面白いです。

6/14第3回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ

| 14:30 | 6/14第3回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる を含むブックマーク はてなブックマーク - 6/14第3回 慢性的CL勉強会@Lingr 8時だョ!全員集合まとめ - わだばLisperになる

昨日、6/14 20:00から3回目の勉強会を開催させて頂きました! 発言して頂いた方約10名、observer(ROM)の方6、7名で、大体16名前後を推移しつつという感じでした。 今回は、30分x3本という感じで、1時間半の内容です。

反省と課題

  • 30分で区切りは、ちょっと短いかもしれない。
  • スライドを使ってみたけれど、チャットなのでチャットの流れとの同期が難しいかもしれない。

関連資料

ログ:
  1. The Power of LISP Macros
  2. Common Lispのコンディションシステム
  3. Lispマシン入門
準備したスライド
今回の勉強会について言及のブログエントリ

謝辞

  • zickさん
予習/まとめのブログエントリありがとうございます! 勉強会の告知をして頂きありがとうございます!
  • IT 勉強会カレンダーさん
IT 勉強会カレンダー 勉強会の一員に加えて頂いてありがとうございます!

次回…。

6/21日 20時から開催したいと思います! お題は、今回の続き2品と、1つは明日位のエントリで告知させて頂こうかと思います。 何か、アイディア/要望等ありましたら、Lingrに書き置きでもしてみて下さい〜。

2008-06-13

CLOSでL-99 (P26 指定した個数を抜き出す組み合わせ)

| 18:14 | CLOSでL-99 (P26 指定した個数を抜き出す組み合わせ) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P26 指定した個数を抜き出す組み合わせ) - わだばLisperになる

call-next-methodの連鎖で行くと、stringの次は、vectorになってしまって面倒臭いので、combination1という共通の補助メソッドを作成して呼んでいるわけなのですが、一番特定度の低いメソッドを呼び出す定番の方法があったりするんでしょうか?

再帰と、call-next-methodと、ディスパッチが混ざると、大分スパゲッティな感じです…。

再帰の度にlengthが呼ばれるのもどうしたものかと…。

(combination 3 '(a b c d e f))
;==> ((A B C) (A B D) (A B E) (A B F) ...

(combination 3 #(a b c d e f))
;==> (#(A B C) #(A B D) #(A B E) #(A B F) ...

(combination 3 "abcdef")
;==> ("abc" "abd" "abe" "abf" "acd" "ace" "acf" ...

(defgeneric COMBINATION (n sequence)
  (:documentation 
   "P26 (**) Generate the combinations of K distinct objects 
chosen from the N elements of a list"))

(defmethod COMBINATION :around ((n integer) (sequence sequence))
  (if (not (<= 1 n (length sequence)))
      ()
      (call-next-method)))

(defmethod COMBINATION ((n integer) (sequence string))
  (combination1 n sequence 'string))
(defmethod COMBINATION ((n (eql 1)) (sequence string))
  (map 'list #'string sequence))

(defmethod COMBINATION ((n integer) (sequence vector))
  (combination1 n sequence 'vector))
(defmethod COMBINATION ((n (eql 1)) (sequence vector))
  (map 'list #'vector sequence))

(defmethod COMBINATION ((n integer) (sequence list))
  (combination1 n sequence 'list))
(defmethod COMBINATION ((n (eql 1)) (sequence list))
  (map 'list #'list sequence))

(defmethod COMBINATION1 ((n integer) (sequence sequence) type)
  `(,@(mapcar (lambda (i) (concatenate type (subseq sequence 0 1) i))
              (COMBINATION (1- n) (subseq sequence 1)))
      ,@(COMBINATION n (subseq sequence 1))))

2008-06-12

DylanでL-99 (P10 ランレングス圧縮)

| 17:07 | DylanでL-99 (P10 ランレングス圧縮) - わだばLisperになる を含むブックマーク はてなブックマーク - DylanでL-99 (P10 ランレングス圧縮) - わだばLisperになる

前回定義した、packの補助関数のpack1とjoinを使っています。

Dylanのライブラリの取り込み方と定義方法が良く分からない…。

#(a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:).encode
//=> #(#(4, a:), #(1, b:), #(2, c:), #(2, a:), #(1, d:), #(4, e:))

#[a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:].encode
//=> #[#(4, a:), #(1, b:), #(2, c:), #(2, a:), #(1, d:), #(4, e:)]

"aaaabccaadeeee".encode
//=> "4a;1b;2c;2a;1d;4e"

// Code:
define generic encode
    (sequence :: <sequence>)
 => (result :: <sequence>);

define method encode
    (sequence :: <list>)
 => (result :: <list>)
  as(<list>,next-method())
end method encode;

define method encode
    (sequence :: <vector>)
 => (result :: <vector>)
  as(<vector>,next-method())
end method encode;

define method encode
    (sequence :: <string>)
 => (result :: <string>)
  join(map(method(x)
               format-to-string("%d%s", x.size, x.first) 
           end,
           sequence.pack1),
       ";")
end method encode;

define method encode
    (sequence :: <sequence>)
 => (result :: <sequence>)
  map(method(x)
          list(x.size, x.first)
      end,
      sequence.pack1)
end method encode;

pfcでL-99 (P10 ランレングス圧縮)

| 15:58 | pfcでL-99 (P10 ランレングス圧縮) - わだばLisperになる を含むブックマーク はてなブックマーク - pfcでL-99 (P10 ランレングス圧縮) - わだばLisperになる

これもまた普通のLISP/Schemeみたいになってしまいました…。

(encode '(a a a a b c c a a d e e e e))
;==> [[4 a] [1 b] [2 c] [2 a] [1 d] [4 e]]

(define (encode lst)
  (map (lambda (x) [(length x) (hd x)])
       (pack lst)))

2008-06-11

TCONC

| 13:54 | TCONC - わだばLisperになる を含むブックマーク はてなブックマーク - TCONC - わだばLisperになる

先日のCL勉強会で、TCONCのことを知ったのですが、TCONCの解説で、古いINTERLISPのマニュアルでTCONCをリストで表現していたのが気に入ったので、作ってみることにしました。

TCONCという構造は、リストとリストの末尾のペアをすぐ取り出せる構造なので、末尾への要素の追加のコストが低いというのが特長です。

今回再現してみるリスト表現のTCONCは、CARにリスト、CDRに末尾のペアのポインタを保持する構造になっています。

つまり

(1 2 3 4)

というリストならば、

((1 2 3 4) . (4)) 
 ≡ ((1 2 3 4) 4) 

となります。

見た目はリストなので、ちょっと区別し難かったりしますが、なるほど!という表現で、どんなにリストが長くても、TCONCをCDRすれば、末尾のペアが取り出せます。

ちなみに、PCLのLOOP章の註釈で解説があるのですが、LOOPマクロのcollectもTCONCなことが多いのかもしれません。

INTERLISP-10のマニュアルには、TCONCの他にリストとリストを継ぐLCONC、CONSと似ていますが、リストのポインタは変化しないATTACHの解説もあり、これも面白そうなのでついでに作ってみました。

;; tconcの動作
(loop :with start := 1 :and end := 10
      :with tc := (tconc () start)
      :for i :from (1+ start) :to end :do (tconc tc i) 
      :finally (return (car tc)))

;==> (1 2 3 4 5 6 7 8 9 10)

;; lconcの動作
(loop :with start := 1 :and end := 10
      :with lc := (lconc (list ()) (list start))
      :for i :from (1+ start) :to end :do (lconc lc (list i)) 
      :finally (return (car lc)))

;==> (1 2 3 4 5 6 7 8 9 10)

;; attachの動作
(setq foo (list 100))

(eq foo (attach 0 foo))
;==> T

foo
;==> (0 100)

;; 定義
(defpackage #:tconc
  (:use #:cl)
  (:export #:tconc
           #:lconc
           #:attach))

(in-package :tconc)

(defun TCONC (ptr x)
  (declare (list ptr))
  (let ((x (list x)))
    (if (null ptr)
        (cons x x)
        (progn (psetf (cddr ptr) x             
                      (cdr ptr) x)
               ptr))))

(defun LCONC (ptr x)
  (declare (cons ptr x))
  (let ((last (last x)))
    (rplaca ptr (nconc (car ptr) x))
    (rplacd ptr last)))

(defun ATTACH (x y)
  (declare (cons y))
  (let ((ptr y)
        (tail (cons (car y) (cdr y))))
    (setf (car ptr) x
          (cdr ptr) tail)
    ptr))

第3回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知

| 06:44 | 第3回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる を含むブックマーク はてなブックマーク - 第3回 慢性的CL勉強会@Lingr 8時だョ!全員集合 告知 - わだばLisperになる

とりあえず、意味なく毎週Lingrでオンライン勉強会を開くことにしてみたのですが、次回は、若干細切れにしてみることにしました。

今回、お題は全部で3つ。1枠25分+休憩5分で時間の枠に収まらなかった場合、次回へ持ち越しとなります。

お題としては、

  • マクロ
  • コンディションシステム
  • Lispマシン

「興味があるものだけ、参加してみよう!」という感じにしてみました。

場所:Lingr: Common Lisp部屋
日時6/14 (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の進行テキストを最初から参加者が眺めてゆき、質問があったり、議論になりそうなことがあったら議論してゆきます。
勉強会の目標CLに関して一つ位賢くなった気になること
時刻お題対象者参考リンク
20:00-20:25THE POWER OF LISP MACROS (Edi Weitz氏)CLマクロ入門者的な方macros.lisp
20:30-20:55「Common Lisp における例外処理 〜Condition System の活用〜」(数理システムさん)CLのコンディションシステム入門者的な方(PDF)
21:00-21:25LISPマシン入門Lispマシンって何だか知りたい方適当に準備します
21:25-反省/質問/お題の提案/雑談

また、現在

  • LISPの落し穴(コーディングではまるところ)
  • LISPとデザインパターン
  • LOOPマクロ入門
  • FORMAT入門

のようなものをお題にすることを考えています。

また、「こういうのを勉強してみたい!」というのがあれば、このブログにコメント頂くか、Lingr等に書き置きしてみる、もしくは、時間枠を差し上げますので、そのテーマの進行役になって進めて下さい(笑)

2008-06-09

CLOSでL-99 (P25 ランダムに並び換え)

| 00:29 | CLOSでL-99 (P25 ランダムに並び換え) - わだばLisperになる を含むブックマーク はてなブックマーク - CLOSでL-99 (P25 ランダムに並び換え) - わだばLisperになる

以前に作ったものを組み合わせて解答せよとのことなのですが、以前に作ったremove-atが予期せぬ動きをしていたため、はまってしまいました。

原因は、

(concatenate (class-of '(a)) () ())

のような処理の個所で、class-ofでは、consと判定されるのですが、結果は、()なので、クラスはCONSではなくなってしまうということでした。

LISTならば、CONS+NULLなので大丈夫ですがLISTとCONSの扱いの違いで割とはまることが多いです(;´Д`)

(rnd-permu '(a b c d e f))
;==> (E A D F C B)
(rnd-permu #(a b c d e f))
;==> #(F E A C B D)
(rnd-permu "abcdef")
;==> "fdbaec"

(defgeneric RND-PERMU (sequence)
  (:documentation 
   "P25 (*) Generate a random permutation of the elements of a list."))

(defmethod RND-PERMU ((sequence sequence))
  (RND-SELECT sequence (length sequence)))

;; 修正版
(defmethod REMOVE-AT ((sequence sequence) (position integer))
  (let ((class (if (listp sequence) 'list (class-of sequence))))
    (values (concatenate class
                         (subseq sequence 0 (1- position)) 
                         (subseq sequence position))
            (elt sequence (1- position)))))

2008-06-08

6/7「第2回 突発性CL勉強会@Lingr 8時だョ!全員集合」まとめ報告

| 19:37 | 6/7「第2回 突発性CL勉強会@Lingr 8時だョ!全員集合」まとめ報告 - わだばLisperになる を含むブックマーク はてなブックマーク - 6/7「第2回 突発性CL勉強会@Lingr 8時だョ!全員集合」まとめ報告 - わだばLisperになる

昨日、6/7 20:00~から、「Tutorial on Good Lisp Programming Style」をテキストに、先頭から読んで行って、疑問があれば質問という形式で勉強会を開かせて頂きました。

発言して頂いた方約10名、observer(ROM)の方約10名で、大体20名前後を推移しつつという感じで、予想より大分参加者が多くて驚きました。

また、時間も3時間半位と思ったよりも時間がかかってしまったのですが、参加の皆さん長々とお付き合い頂いてありがとうございました!

反省と課題

  • お題が割と実際にCLでコードを書いてる人でないと実感が持てないようなものだったかもしれない。
    • お題を良く吟味して、告知する必要あり。
  • 進行が割と難しい。発言がどこを指しているのか、共有するのが難しい。
    • スライド等を組み合わせたらどうか。
勉強会の目標CLに関して一つ位賢くなった気になること

を掲げてみたのですが、どうだったでしょうか。

自分個人としては、zickさんの質問のお蔭でtconcについて学べ、また、lequeさんにGaucheのutil.queueはtconcであると教えてもらったので、1つは賢くなりました(笑)

関連資料

ログ:

今回の勉強会について言及のブログエントリ

謝辞

今回の勉強会については、特に準備もしておらず、質問の波に乗ればどうにかなるかなと気楽に考えていたのですが、zickさんに予習という形でブログエントリを書いて頂き、考えが甘かったことに気付きました(笑)

お蔭さまで、zickさんの質問を軸に展開させて頂くことができて、どうにか空中分解することを防げたと思います。

また、参加者の皆さんには助け船を何度も出して頂き、どうにか遭難は回避できました。

また、scheme-users.jp - さんも勉強会の告知をして頂きました。

この場を借りて御礼申し上げます。

次回…

「8時だョ!全員集合」ということで土曜の20時に皆様に飽きられるまでは、毎週やってみようかと、思っています(笑)

一回完結ではなく、集中できそうな、30分から1時間程度に時間を決めて、それを、細切れにして毎週やってみるのは、どうかと考えてもいます。

また、IRCを使うことも考えていますが、明日か明後日のエントリで第3回を告知したいと思います。

何か、アイディア/要望等ありましたら、Lingrに書き置きでもしてみて下さい〜。

2008-06-06

CLでのDylan風定義とCLOS系言語での型指定書法の比較

| 19:49 | CLでのDylan風定義とCLOS系言語での型指定書法の比較 - わだばLisperになる を含むブックマーク はてなブックマーク - CLでのDylan風定義とCLOS系言語での型指定書法の比較 - わだばLisperになる

CL界の巨人、Weinreb氏のSteve Yegge氏のブログへのコメントで、DEFINE-STRICT-FUNCTIONというものを社内で定義して使っている、というのを目にしました。

詳細は不明なのですが、型指定の記述を助けるようなマクロのようです。

型の指定といえば、CLでも可能ですが、上述のDEFINE-STRICT-FUNCTIONは、Dylanや、それに影響を受けているGOO風な書式に違いないと、勝手に決めこみ、Dylan風の関数定義マクロを作って使い勝手を探ってみることにしました。

どんな関数を定義するか

x、yのinteger型の2引数を取り、返り値は、多値を返し、値はすべてinteger型という指定

Dylanの書法

define function foo
    (x :: <integer>, y :: <integer>)
 => (#rest number :: <integer>)
  values(x, y)
end function foo;

S式Dylanの書法

(define-function foo ((x <integer>) (y <integer>) 
                      #values #rest (number <integer>))
  (values x y))
;; ※注 S式Dylanには、define-methodしかありません。

GOOの書法

;; 多値がないので、タプルを使うことになると思われるが、詳細不明…(^^;
;; こういう指定はできないのかも…。
(df foo (x|<int> y|<int> => (tup ,x|<int> ,@y|<int>))
  (tup x y))

という感じで、CLのDEFMETHODに返り値の型指定がついたような感じです。

DylanとGOOでは、=>以降が返り値の記述で、S式Dylanでは、#values以降が=>に相当します。

ということで、S式Dylan風のものをガチャガチャ作ってみました。

Dylanを真似たパチモノ

(define-function foo ((x <integer>) (y <integer>) 
                      &values &rest (number <integer>))
  (values x y))

これは、

(defun foo (x y)
  (declare (<integer> x) (<integer> y))
  (the (values &rest <integer>) (values x y)))

のように展開されます。

;; Dylan的な雰囲気づくりの準備
(deftype <integer> (&rest args)
  `(integer ,@args))

(deftype <fixnum> (&rest args)
  `(signed-byte 32 ,@args))

;; マクロ展開例

;; 1
(define-function foo (x y)
  (values x y 3))

;>>>
(defun foo (x y) (the t (values x y 3)))
;; 返り値チェックはtなので全部通過

;; 2
(define-function foo ((x <integer>) (y <integer>) 
                      &values &rest (number <integer>))
  (values x y 3))

;>>>
(defun foo (x y)
  (declare (<integer> x) (<integer> y))
  (the (values &rest <integer>) (values x Y 3)))

;; 3
(define-function foo ((x <integer>) (y <integer>) 
                      &values (x <integer>)
                              (y <integer>)
                              (z <integer>))
  (values x y 'foo))
;==> コンパイル時に警告 & 実行時エラー

(define-function foo ((x <integer>) (y <integer>) 
                      &values (x <integer>)
                              (y <integer>)
                              &rest (z <integer>))
  (values x y 'foo))

;==> コンパイル時に警告 & 実行時エラー

という感じです。

CLでの書法

(defun foo (x y) 
  (declare (integer x y))
  (the (values integer integer &rest integer)
    (values x y 'foo)))

CLでは、DECLAREで引数の型を指定して、THEで返り値をチェックするようです。

ただし、THEのフォームが複雑になるとコンパイラがチェックしきれない、と警告がでることがあるようです。

また、CMUCLや、それの流れのSBCLでは、DECLAREの中でvaluesというものが使え、返り値のチェックに使えるようです。

これは、THEに展開されるものとのこと。

;;CMUCL/SBCL拡張での書法
(defun foo (x y) 
  (declare (integer x y))
  (declare (values integer integer &rest integer))
  (values x y 'foo))

まとめ

Dylan風の方がわかりやすいかと思いましたが、複雑になると、普通のCLの書法の方がすっきりしてしまいます。

でも、3つ以上の多値で型チェックしたいというようなこともあまりない気もするので、Dylan風でも良いかなとは思ったり…。

…あんまり意義のある考察になりませんでした(笑)

おまけ
;; 不完全定義 (optional、key対応忘れ…)

(defpackage :dylan-compat 
  (:use :cl)
  (:nicknames :dylan))

(in-package :dylan)

(defun spec-vars (spec)
  (mapcar (lambda (x)
            (if (consp x) (car x) x))
          spec))

(defun spec-decls (spec)
  (reduce (lambda (x res)
            (if (consp x) 
                (cons (reverse x) res)
                res))
          spec
          :initial-value () 
          :from-end 'T))

(defun out-spec-decls (spec)
  (reduce (lambda (x res)
            (cons (cond ((consp x) (cadr x))
                        ((eq '&rest x) '&rest)
                        ('T 'T))
                  res))
          spec
          :initial-value () 
          :from-end 'T))

(defun in-&-out-spec (spec)
  (if (member '&values spec)
      (let ((pos (position '&values spec)))
        (list (subseq spec 0 pos)
              (subseq spec (1+ pos))))
      (list spec () )))

(defmacro define-function (name (&rest args) &body body)
  (destructuring-bind (in-spec out-spec) (in-&-out-spec args)
    (let ((vars (spec-vars in-spec))
          (decls (spec-decls in-spec))
          (out-spec (and out-spec (out-spec-decls out-spec))))
      `(defun ,name ,vars 
         ,@(if decls `((declare ,@decls)) () )
         (the ,@(if out-spec `((values ,@out-spec)) (list T))
           ,@body)))))

2008-06-05

GOOでL-99 (P19 指定した位置でローテーション)

| 23:11 | GOOでL-99 (P19 指定した位置でローテーション) - わだばLisperになる を含むブックマーク はてなブックマーク - GOOでL-99 (P19 指定した位置でローテーション) - わだばLisperになる

P17で定義したmy-splitを使います。

(rotate '(a b c d e f g h) 3)
;=> (d e f g h a b c)
(rotate '(a b c d e f g h) -2)
;=> (g h a b c d e f)
(rotate #[a b c d e f g h] 3)
;=> #[d e f g h a b c]
(rotate #(a b c d e f g h) -2)
;=> #(g h a b c d e f)
(rotate "abcdefgh" 3)
;=> "defghabc"
(rotate "abcdefgh" -2)
;=> "ghabcdef"

(dg rotate (u|<seq> p|<int> => <seq>))

(dm rotate (u|<seq> p|<int> => <seq>)
  (def p (if (> 0 p) (+ p (len u)) p))
  (app cat (rev (as <lst> (my-split u p)))))

LISP1.5でL-99 (P10 ランレングス圧縮)

| 22:17 | LISP1.5でL-99 (P10 ランレングス圧縮) - わだばLisperになる を含むブックマーク はてなブックマーク - LISP1.5でL-99 (P10 ランレングス圧縮) - わだばLisperになる

前回定義したMY-PACKを利用しつつ、MAPCARがないので、自作しました。LISP1.5ということで、引数の順番は逆に。

これまでLISP1.5がLISP1なのか、LISP2なのか全然気にしてませんでしたが、下のコードからすれば、LISP1のようですね。

;ENCODE ((a a a a b c c a a d e e e e))
;
;  FUNCTION   EVALQUOTE   HAS BEEN ENTERED, ARGUMENTS..
; ENCODE
;
; ((A A A A B C C A A D E E E E))
;
;
; END OF EVALQUOTE, VALUE IS ..
; ((4 A) (1 B) (2 C) (2 A) (1 D) (4 E))

DEFINE((
(MAPCAR (LAMBDA (LST FN)
          (COND ((NULL LST) () )
                (T (CONS (FN (CAR LST)) 
                         (MAPCAR (CDR LST) FN))))))

(ENCODE (LAMBDA (LST)
          (MAPCAR (MY-PACK LST)
                  (QUOTE (LAMBDA (X)
                           (LIST (LENGTH X) (CAR X)))))))
))

2008-06-04

DylanでL-99 (P09 連続して現われる要素を纏める)

| 19:25 | DylanでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる を含むブックマーク はてなブックマーク - DylanでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる

Perlのjoin的なものがないので、自作してみました。

なんだか無闇に長い…。

#(a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:).pack
//=>#(#(#"a", #"a", #"a", #"a"), #(#"b"), #(#"c", #"c"), #(#"a", #"a"), #(#"d"), #(#"e", #"e", #"e", #"e"))
#[a:, a:, a:, a:, b:, c:, c:, a:, a:, d:, e:, e:, e:, e:].pack
//=> #[#(#"a", #"a", #"a", #"a"), #(#"b"), #(#"c", #"c"), #(#"a", #"a"), #(#"d"), #(#"e", #"e", #"e", #"e")]
"aaaabccaadeeee".pack
//=> "aaaa,b,cc,aa,d,eeee"

// Code
module: l99-09

define generic pack
    (sequence :: <sequence>)
 => (result :: <sequence>);

define method pack
    (sequence :: <string>)
 => (result :: <string>)
  if (sequence.empty?)
    sequence
  else
    join(sequence.pack1, ",")
  end if
end method pack;

define method pack
    (sequence :: <sequence>)
 => (result :: <sequence>)
  if (sequence.empty?)
    sequence
  else
    as(select (sequence by instance?)
         <list> => <list>;
         <vector> => <vector>;
       end select, sequence.pack1) 
  end if
end method pack;

define function pack1
    (sequence :: <sequence>)
 => (result :: <sequence>)
  let prev = sequence.first;
  let res = make(<deque>);
  let tem = make(<deque>);
  for (x in sequence)
    unless (x = prev)
      push-last(res, as(<list>, tem));
      tem := make(<deque>);
    end unless;
    push-last(tem, x);
    prev := x;
  end for;
  as(<list>, push-last(res, as(<list>, tem)));
end function pack1;

define generic join 
    (sequence :: <sequence>, delim :: <string>)
 => (result :: <sequence>);

define method join 
    (sequence :: <sequence>, delim :: <string>)
 => (result :: <string>)
  let result = make(<deque>);
  for (c in sequence)
    push-last(result, c);
    push-last(result, delim);
  finally
    result.pop-last;
    apply(concatenate-as, <string>, result);
  end for
end method join;

pfcでL-99 (P09 連続して現われる要素を纏める)

| 04:20 | pfcでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる を含むブックマーク はてなブックマーク - pfcでL-99 (P09 連続して現われる要素を纏める) - わだばLisperになる

うーん、これだ!というようなpfcでの良い書き方がありそうな気がする問題ではあるのですが、全然思い付けません。

(pack '(a a a a b c c a a d e e e e))
;==> [[a a a a] [b] [c c] [a a] [d] [e e e e]]

(define (pack lst)
  (if (null lst)
      ()
      (pack1 lst () ())))

(define (pack1 lst tem res)
  (let ((head (hd lst))
        (tail (tl lst)))
    (if (consp tail)
        (if (= head (hd tail))
            (pack1 tail 
                   (++ [head] tem)
                   res)
            (pack1 tail 
                   ()
                   (++ res [(cons head tem)])))
        (++ res [(cons head tem)]))))

2008-06-01

Getting Started in *LISP (11)

| 18:14 | Getting Started in *LISP (11) - わだばLisperになる を含むブックマーク はてなブックマーク - Getting Started in *LISP (11) - わだばLisperになる

今回は、3章から再開です。

Chapter 3: Parallel Programming Tools

これまで、CLとの共通点が多くあることをみてきたが、この章では*Lisp特有のところをみてゆく、とのこと。

3.1 Data Parallel Programming

*Lispのデータ操作には大別すると5種類ある。

  1. プロセッサを選択し一連のオペレーションを実行するもの
  2. Connection Machine内のプロセッサ間のデータ移動をするもの
  3. ホストコンピュータとConnection Machine間のデータ転送をするもの
  4. データを合成/加工するもの
  5. pvarの形を決定するもの

以下、それぞれに2づつ例を挙げてゆく

3.2 Processor Selection Operators

常に全プロセッサで計算をしたいとは限らないので、*Lispでは各々のプロセッサを指定して計算したりしなかったりできる。

デフォルトで*cold-bootした場合、全プロセッサは活性状態であるとのこと。

3.2.1 Processor Selection - Doing More by Doing Less

条件分岐のようにプロセッサ毎に特定の命令を実行したりしなかったりすることができて、例えば、CLのwhenのような*whenや、if!!が使える。

色々試してみる。

(*defvar data 4)

;; とりあえず全部4で埋める
(ppp DATA :end 20)
;>>> 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 
;==> NIL

;; self-address!!ではプロセッサの番号を取得できるが、
;; 番号の性質を判定して実行

(ppp (self-address!!) :end 20)
;>>> 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
;==>  NIL

(ppp (evenp!! (self-address!!)) :end 20)
;>>>T NIL T NIL T NIL T NIL T NIL T NIL T NIL T NIL T NIL T NIL 
;==> NIL

;; ==> 偶数番号のプロセッサはTを返していることがわかる


;; ちょっと応用
;; アドレスが偶数番号のプロセッサの値に3を加える

(*when (evenp!! (self-address!!))
  (*set data (+!! data 3)))

(ppp DATA :end 20)
;>>> 7 4 7 4 7 4 7 4 7 4 7 4 7 4 7 4 7 4 7 4 
;==> NIL

;; if!!
(ppp (if!! (oddp!! (self-address!!))
           (+!! data 3)
           (-!! data 3))
     :end 20)
;>>> 4 7 4 7 4 7 4 7 4 7 4 7 4 7 4 7 4 7 4 7
;==>  NIL

self-address!!に似たものとして、enumerate!!という数え上げの関数がある。

;; 0で埋める
(*defvar empty-pvar 0)

(ppp empty-pvar :end 20)
;>> 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
;==> NIL

;; 偶数番プロセッサで、enumerate!!を実行
(*when (evenp!! (self-address!!))
  (*set empty-pvar (enumerate!!)))

(ppp empty-pvar :end 20)
;>>> 0 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 0 9 0
;==> NIL

条件を満したところがenumerate!!の結果で埋まっていることが分かり、順に数え上げられている。

3.2.2 The Processor Selection Operators of *Lisp

*LispにはCLのwhen, unless, if, cond, case, ecaseに対応する述語に加えて、独自の

*allとwith-css-savedという述語が用意されているが詳細は解説しないとのことで、リファレンスを参照せよ、とのこと。

リファレンスもないので、とりあえず、どういうものかを試して探ってみたものの、良く分からず…。

*allは、定義を眺める限りでは、こんな定義。どうやら全プロセッサを選択した状態でなにかをする時に使うものらしい…。

with-css-savedは、currently selected setの状態を保持しつつボディ部を実行するものの様子。しかし、これも詳細不明…。

次回3.3章から再開です。