SRFI-2の紹介

(LISP Library 365参加エントリ)

SRFI-2はand-let*と呼ばれるマクロを提供する。例えば以下のようなコードを書いたことはないだろうか？

;; make upcase symbol of car part if it's symbol
(and (pair? o)
     (let ((a (car o)))
       (and (symbol? a)
         (let ((s (symbol->string a)))
           (cons (string->symbol (string-upcase s)) (cdr o))))))

andとletがネストして非常に読みにくい素敵コードだ。こんな不快深い階層のネストを解消してくれる構文がand-let*である。これを使うと上記のようなコードは以下のようにすっきりと書ける。

(and-let* (( (pair? o))
           (a (car o))
           ( (symbol? a) )
           (s (symbol->string a)))
  (cons (string->symbol (string-upcase s)) (cdr o)))

あまり変わらない？それはあなたの心が澱んでいる可能性が高いのでリフレッシュさせることをお勧めする。

オリジナルの実装はdefine-macroで作られているのでCLに移植するのも難しくないはずだ。実際既に作られている。

風車の中

ライデンにはオランダ最古(だったはず)の風車があるのだが、長年外から眺めるだけで中に入ったことはなかった。先日偶然にも開いていたので(もちろん有料だけど)、せっかくだと思い中に入ってみた。

とりあえず、写真

展望台(？)から臨むライデンの街並み(一眼レフとかだともう少しワイドに取れて様になった気はするが気にしないｗ)

展望台から取った風車部分。

今は使われていない粉引き(？)

その２

信じられるか？これ風車の中なんだぜ？

立派なもんだろう？

正直自分のアパートよりはるかに豪華で泣けるｗ

 さすがにキッチンは時代を感じさせる。

ちなみに、風車自体は1802年に建築されたものらしいく、結構オーナーが転々と(多分子孫だと思うけど)していた。内装はおそらく当時、もしくは最終所有者が手放した状態のままだと思われる。まぁ、さすがに電気と水道は近年のものだと思うけど。写真は一階部分の居住区で２階以降は博物館になっていた。まぁ、これ自体が博物館みたいなものだが。

大人４ユーロと多少高めな入場料ではあったが、割と満足できると思う。機会があればぜひその目で確かめてほしい。

Sagittarius Scheme 0.5.0 リリース

今回のリリースはマイナーバージョンアップデートリリースです。また、リポジトリ及びダウンロードの場所が変更されたので注意して下さい。ダウンロード

修正された不具合

• importがcond-expand内でR7RSが要求するように動かなかった不具合が修正されました
• Linux上でプロセスを継続的に起動するとクラッシュする不具合が修正されました

新たに追加された機能

• change-classが追加されました

改善点

• ライブラリファイルの拡張子を追加する-Sオプションが追加されました
• クラスがdirect-subclassesスロットを持つようになりました
• R7RSスタイルのSRFIライブラリ名がサポートされました
• コンパイラがいくつかの参照透過かつ末尾位置にない式を削除するようになりました

内部的な変更

• 完全なセルフホスティングになりました

よろしいならば戦争だ(マクロ編)

もう何度目の戦だか覚えてもいない。

CLOS周りで微妙なkludgeを使っているのが嫌になって、えいやっと書き換えてやれと思ったらバグを発見したという話。

再現コードとしては以下のようなの。

(import (rnrs))

(define-syntax aif
  (lambda (x)
    (syntax-case x ()
      ((aif expr then else)
       (with-syntax ((it (datum->syntax #'aif 'it)))
  #'(let ((it expr))
      (if it then else)))))))
(define-syntax wrap
  (syntax-rules ()
    ((_)
     (aif 'ok it #f))))


(wrap) ;; => error

(wrap)はokを返さないといけないんだけど、itがないって怒る。まぁ、原因も実は分かっていて、wrap内でitはテンプレート変数に変換されるんだけど、これに変換されるとコンパイラがうまいこと局所変数を参照できないという問題だったりする。

正直現在の実装は中身がぐちゃぐちゃになりすぎてて、何をやっているのかがコメントと記憶を頼りにするしかないのだが、このパターンは単純にもれている気がする。ただ、どうすればいいのかというのが今一分かっていない。例えば、上記の場合ならコンパイラが参照する環境に含まれる局所変数は識別子になっているので、識別子＋テンプレート変数の組み合わせを参照する際に何かすればいいような気がするが、これが何かを壊すのではないかという不安もあって、う～んといった感じである。

まぁ、一つ分かっているのは、これは多分明日のリリースには間に合わないということかｗ

日本語 vs English

先日一年ぶりくらいに日本語を話す機会があったのだが、その際に不思議な感覚を覚えたので書いて見る。はっきり言って個人の日記レベルである(ちょっと前にTwitterで流行ってたので使ってみるｗ)

不思議な感覚というのは、日本語を喋っているときに英単語を言おうとするとカタカナ発音に敢えて変換していたこと。敢えてというのは、無意識にカタカナの発音を検索してから発音していたという感じ。検索してること自体はなんか意識下にあったんだけど、検索する作業が無意識に発生していた。これ、逆のパターンのときの実はあって、英語話してるときに日本語の単語を言えといわれるとなんか片言みたいな発音になっていたりする。

言語別のコンテキストがはっきりと分かれてきたのかなぁと思わなくもない。が、そう入っても普段の頭の中は基本日本語だし、スイッチ入れ替えるのも特にストレス感じることなく行えるので、わざわざ検索しているという感覚がなんとなく奇妙で不思議だったりしたわけだ。

言語別のコンテキストといえば、混ぜるな危険ではないが、英語話してるときに日本語で考えていないし、逆も(というか逆はある意味当たり前だが)然りな感じである。その昔、後天的バイリンガル(という言葉が正しいかは知らない)は母語が複数ある人と比べると同じ言語でも使っている脳の位置が違うなんてのをテレビか雑誌で見た記憶があって、なんとなくそんな感じになってきたのかなぁと思ったりもした。

特にオチもなく終了。こういう現象に名前付いてないのかね？

SRFI-1の紹介

(LISP Library 365参加エントリ)

SRFI-1の紹介。このSRFIを使ってないSchemerはいないんじゃないかなぁと思われるくらい有名なSRFI。内容は便利なリスト操作手続きをまとめたもの。

今回は、便利だけどあまり日の目を見ない手続きに焦点を当てて紹介する。題はSRFIの目次に対応している。

Constructors

list-tabulate
iotaを知っている人は多いと思うが、list-tabulateも同様にリストを構築する手続き。以下のように使える。

(list-tabulate 5 values) ;; => (0 1 2 3 4)

第一引数にリストの要素数を受け取り、第二引数にリストのn番目の要素を構築する手続きを受け取る。上記の例だとiotaの方が短い記述でかけるが、数値以外の要素を作りたい場合には便利になる。

Miscellaneous

append-reverse
append-reverse!
見れば分かるような気がするが、(append (reverse lis) tail)のシノニム。後者reverse!を使うので、注意が必要。

(append-reverse (list 1 2 3) 4) ;; => (3 2 1 . 4)

Fold, unfold & map

append-map
append-map!
append-reverseと似たようなのだが、(apply append (map f lis1 ...))をするもの。リスト内リストを操作しつつフラットにするのに便利。

(append-map values '((1) (2) (3))) ;; => (1 2 3)

filter-map
(filter values (map f lis ...))をするもの。fが#fを返すような場合に返されるリスト内から#fを取り除く。

(filter-map (lambda (n) (and (number? n) n)) '(1 a 2 b 3 c)) ;; => (1 2 3)

注意が必要なのは、fの戻り値がリストの要素になるということ、なので以下のようなものは悲しい結果になる。

(filter-map even? '(1 2 3 4 5 6)) ;; => (#t #t #t)

Deletion

delete-duplicates
delete-duplicates!
リスト内から重複するリストを削除する。

(delete-duplicates '(a a b b c c)) ;; => (a b c)
(delete-duplicates '((a b) (c d) (a b) (e f) (c d)) equal?) ;; => ((a b) (c d) (e f))

ここに列挙したのは僕が便利だと思うものだけである。他にも便利そうな手続きがあるので気になったら眺めて使ってみるといいかもしれない。

SBCLのPCLを読む

クラス再定義を実装するべPCLを参考にすることにした。ので、真面目に全部を読むわけではなく、defclassから下に続く処理を読むだけ。また、断定系で書いてあるけど、動作確認までしてるわけではないので、全ての断定系には「と思う」を付与して読むこと。上から順番に何をしているか書いてるので、読み終わるころにはPCLのdefclassが何をしているのか分かる(と思う、補足して読むことｗ)。

defclass
単なるマクロ。一応defstructで定義されたものも裁けるようになってるらしい。展開後はload-defclassを呼ぶ式になる。

load-defclass
defclassは単なるマクロなので、マクロ内で何かをするか、展開結果がクラスを作ることは容易に想像できると思う。じゃあ、その下請けの関数は何か？という話。
2種類あって、単にコンパイラに知らせる用のものと、実際にensure-classを呼ぶreal-load-defclassがある。PCLをブートする再には前者を使って、ブート後は後者を使う。

ensure-class
ロックをかけて渡されたクラスの名前からクラスを検索、ensure-class-using-classを呼ぶ

ensure-class-using-class
メソッド。ensure-classでクラスが見つかった場合と見つからなかった場合の2種類が定義されている。
前者はfrob-ensure-class-argsを呼んで見つかったメタクラスが再定義されるクラスを同じならchange-classを呼ぶ、違えば呼ばない。その後、reinitialize-instanceを呼んでインスタンスを更新する。メタクラスが違った場合はどうなるんだろう？
後者は単に普通の定義。(以下では言及されない)

change-class
メソッド。いくつか定義されてるけど、基本的にはCPLを調べて変更可能かのチェックをしたのち%change-classを呼ぶだけ。

%change-class
古いインスタンスと新しいインスタンス、このケースでは元クラスと新クラス、を受け取ってメモリ割付、スロットとメタクラスの交換をした後、update-instance-for-different-classを呼ぶ。

update-instance-for-different-class
基本的には何もせずshared-initializeに処理を委譲

shared-initialize
メソッド。プライマリのメソッドは一個なんだけど、クラス用に:beforeと:afterが定義されてる。(それ以外にもあるが。) 中身は後で読む。っが、見た感じ、クラスのスロットを詰めてるだけに見える。まぁ、initializeからも呼ばれるメソッドなので、ある意味当たり前か。

reinitialize-instance
メソッド。 プライマリはcheck-initargs-1呼んで何かしらチェックした後、shared-initializeを呼ぶ。
クラス用の:beforeではダイレクトサブクラスを除去したのちスロットの除去をしてる。
:afterではmap-dependentにupdate-dependentを呼ぶ手続きを渡している。何するかは今一不明。多分依存関係の解決。

基本的にはほぼ全ての手続きがメソッドなので、頑張ればいろいろ手を加えられそう。Sagittariusに組み込む場合ここまでは要らないので、下請け手続きは単なるlambdaにする気がする。

Scheme処理系の選び方

世の中に星の数ほどSchemeの処理系はあれど、その選び方についてはあまり言及されていない気がするので、目的、環境別くらいの処理系の選び方を書いてみようと思う。僕の知っている処理系の話になるのでかなり限定されたものになることには目をつぶってほしい。また、基本リリースされているバージョンについてのみ言及なので、この処理系の開発版はサポートしているというのは割愛されている可能性があることにも注意してほしい。さらには、少なくともRnRS(R5RS以降)に準拠している処理系のみの言及であることも留意してほしい。

目的別

【SICP用】

 どれでもいいｗ 環境別辺りを参照して適当に選んでｗ

【R7RS準拠の処理系を使いたい】

現状でChibi SchemeとSagittariusのみがほぼ完全にサポートしている。
うわさに寄るとChicken Schemeもサポートしているらしいのだが、最新バージョン(4.8.0.5)ではされていなかった。
Gaucheは0.9.4でサポートされる予定。
Kawaが意欲的にサポートしているらしい。

【R6RS準拠の処理系を使いたい】

この辺参照。ただし、Biwa SchemeはR6RSのサポートが弱いので(syntax-caseとか)注意が必要。

【とにかく高速な処理系】

Vicare、Larcenyが機械語にコンパイルする(はず、未使用、未確認)
(ただし、VicareはLinuxじゃないと処理系自体がインストールできない)
RacketはJITがあるので特定の環境(x86等)では高速
ChickenはCへのトランスレータがあるのでCコンパイラの最適化による
Chezも商用版は機械語にコンパイルするらしい

LarcenyはCへのトランスレータもあるらしい

【FFIが使える処理系】

Chez、Chicken、Racket、Vicare、Mosh、Ypsilon、Sagittarius。そこそこ実用的な処理系はほぼ持っているはず。
Mosh、Ypsilonはx86、x64限定。SagittariusはlibFFIを使っているのでかなりのCPUでFFIが使える。
(自分の処理系の宣伝ｗ)

【ライブラリが豊富な処理系】

RacketのPLT、ChickenのEgg等

【ドキュメントが充実してる処理系】

Racket、Chicken、Gaucheはドキュメントが充実している。
Sagittariusもまぁまぁ。
(あまり他の処理系のドキュメントを参照しないのでこの項目は弱いｗ)

【いざというときに日本語で質問できる処理系】

Gauche、Mosh、Sagittarius、Ypsilon、Schluesselは開発者が日本人。
多分他にもあるがよく知らない。

環境別

【Windowsでインストーラ一発インストールしたい】

Chez、Racket、Sagittarius、YpsilonはWindows用のインストーラがある

【Mac OSで使いたい】

Chicken、Racket、Mosh、Chibi、Gauche、Sagittarius等結構ある、がBrewに登録されてるのはどれかは知らない。

【Linuxで使いたい】

自前でビルドすればほぼどれでもいけるんじゃね？(適当)

【JVMで使いたい】

Kawa一択 かと
SchluesselもJVMで動く

【開発環境が充実してる】

RacketがDr RacketというIDEを持っている
Emacsが使えるならschemeモード使えばいい気がする。
Gaucheならgauche-modeがある。(つかったことないけど便利らしい)

注意事項

Larceny、Mosh、Ypsilonはリリースが年単位で出ていないので、不具合の発見をしても修正される可能性が低め
ChezはCiscoに買収されてから更新が停まっている感じ


他にほしい項目とか、この処理系もお勧めだという突込み歓迎。


追記 2014年1月11日
Larcenyタイポ修正
Schluesselを追加
FFIの項目を多少追加(Sagittariusの宣伝ｗ)

追記 2014年1月13日
Chez Schemeの買収関連のリンクを追加

ビットフィールドがほしい

実は役に立たないことが判明してしまったMQTTの実装を書いてるのだが、仕様書を読んでいる段階からビットフィールドが(binary data)にあるといいなぁということを思っていた。なんとなく腹案もあって、こんな風に書けるといいかなぁというのが以下、

;; assume define-mqtt-type is defined as composite data
(define-mqtt-type <fixed-header> ()
  ((:bit-field :byte
     (type   :bits 4)
     (dup    :bits 1)
     (qos    :bits 2)
     (retain :bits 1))
   (remaining-length :length)))

うっかりスロット名とかぶるとまずいのでキーワードを使う必要がある（？）。

とりあえず現状ではデフォルトのデータ読み取りなどはないので(多分将来にわたって入れるつもりもない)、:byteが返す値は数値であることをチェックする必要がある。まぁ、しなくてもビット操作したさいに死ぬのでいいといえばいいのだが。いや、読み取った数値が合計ビット数より大きかった場合の処理はいるなぁ。後、読み取るビット数を明示して未使用ビットは暗黙に計算する方がスマートかな？もしくは暗黙に8の倍数を取るか？どっちも一長一短な感じはするなぁ。

この辺を入れだすと、じゃあユニオンもほしい状況が出てくるんじゃないのか？と思っていたりはするのだが、まぁそれは必要になったら考えるとする。

追記
よく考えればsimple datumの定義でなんとかできなくもない気がしてきたなぁ。1バイト読み取ってビットで適当にやればいいのか。無くてもいいかな？ちょっと考えるか・・・

SRFI-0の紹介

(LISP Library 365参加エントリ)

SRFIとはScheme Requests For Implementationの略。これがライブラリかどうかという議論は置いておくことにする。(8割はPure Schemeで実装可能なので、まぁOKということで。)

一応昇順に紹介していくつもりだが、そうすると最新のものは年の最後の方になるので、適当に「このSRFIが知りたい」とかのコメントなりメンションなり投げてもらえれば適宜対応する予定。

さて、一発目は0番目のSRFI、cond-expandの紹介。

これは何？
処理系毎の差異を吸収するためのマクロです。C言語で言えば#ifdefとかのプリプロセッサみたいなの。

どう使うの？
こんな感じで処理系とか、仕様とかを指定します。

;; want to use record
(cond-expand
  ;; or/and can be used to expand/narrow the condition
  ((or sagittarius r7rs)
    (import (scheme base)))
  (gauche
    (use gauche.record)))
  (else
    ;; define own record
   ))

実はこのSRFIはすでにR7RSに組み込まれています。また、R7RSではR6RS同様モジュールの定義がされたので、cond-expandにlibraryの識別子が入っています。オリジナルのSRFIではsyntax-rules内のキーワードにsrfi-1やsrfi-5などのサポートしているSRFIを入れていますが、library識別子は処理系が持っているライブラリを探して、存在するかしないかをチェック可能です。

さて、これで処理系の切り分けをしてみたくなりましたね？

謹賀新年

あけましておめでとうございます。旧年は大変お世話になりました、本年もよろしくお願いいたします。

時候の挨拶ここまで。

新年が始まると浮かれて何かしら決意したりするのが恒例なので今年も何かしら決意しようと思う。

私生活
2012年から言ってるけど、ギターの練習をもう少し真面目にやりたい。弾きたい曲が少ないのがモチベーションを上げれない理由かも。(弾きたいのは難易度高すぎてやる前からしり込みしてるってのもあるが・・・)
昨年末はちょっと忙しくてサボったけど、週1ではジムにいっていたのでこれを継続したい。(平日にいけれないのは痛いが、まぁ家トレで頑張るということで。)
オランダ語をいい加減話せるようにならないと、といい続けて早2年。まだ喋れない・・・今年は頑張る。

Sagittarius
BlackBerryで動くようになってたｗ
今年はライブラリの充実とMOP周りを頑張ろうかなぁと。まぁ、ここで言っても大抵年末までにはいろいろ予定が変わるので2014年開始2,3ヶ月の予定ということでｗ
月一リリースでやってるけど、どこまでこれを継続するか悩み中。個人的には小出しにしていけばいろいろ楽だと思ってるんだけど、大掛かりな変更をしづらいというのもあってどうしようかなぁと。
Google Codeから逃げた。ダウンロード機能があるから使っていたのでなくなるなら特に魅力ないし・・・移り先
長期というか、永遠の課題だけど、パフォーマンスの改善とデバッグ機能の強化。特にパフォーマンス。ちょいちょいベンチマークに使ってもらえるようになったけど、結果が散々なのでなんとかしたい。

その他
Lisp Library 365に参加したので、継続的に月３くらいでSRFIの紹介をする。(Sagittariusのライブラリを紹介してほしいという要望があれば応えますｗ)
R7RSとSRFI縛りで何かを作る過程を綴ってみたいなぁと思いつつ、こいつは未定(ネタ募集) 。

こんなところかなぁ。

それでもLispを使う - 2013年を振り返って

今年も残すところわずかになった。ここで一度一年を振り返ることにする。表題*1で謳っているLispとはSchemeのことである。SchemeがLispであるか否かという疑問については一切触れない。

Lispは万能ではない
プログラマであれば誰しも「Lispは神の言語」であるというジョークをしばしば目にすることがあるだろう。もしLispが神の言語であれば、それは万能のツールとなり多くのプログラマが救いを求めて使用しているだろうが、現実はそれとは大きく異なる。人工知能と深いかかわりがある、LispでLispを書いて実行することができる、そういった歴史的または稀有な言語の特徴を指して人が神の言語と呼ぶのであればそうなのかもしれない、しかし、現実の問題を解く際の最適解に常になり得るかといえばそんなことはない。どちらかといえばLispはLispが得意とする分野が限定的であるとさえいえる。

Lispは悟りを開くためのものでもない
Eric Raymondは「How To Become A Hacker」で次のように述べている；

LISP is worth learning for a different reason — the profound enlightenment experience you will have when you finally get it. That experience will make you a better programmer for the rest of your days, even if you never actually use LISP itself a lot.

しかしながら、Lispを使い始めて4年になるが悟りといったものを開けたと思ったことは一度たりともない。むしろ使えば使うほどに目の前に聳え立つ大きな壁のようなものがLispの限界を知らしめてくる、そんな気にさえなる。全く異なるパラダイムの言語を複数習得する過程で悟りが開けるのかもしれないが、それであればCとC++を学べば悟りを開けることになる。

プログラマは強力な言語を使うべきである
現実の問題は数学のそれとは違い公式があるわけではない*2。正しい答えというものも存在しないかもしれない。その際に使うツールは思考の疎外をしない柔軟でかつあらゆる局面に対して対応可能なものであるべきだ。プログラミング言語はそれぞれに得意とする分野があり、銀の弾などありはしない。であれば、最も手になじむものを複数個選び局面に合わせて使い分ける他に最適な手はないだろう。
私自身の問としては、Lispはどうか？ではなく、Sagittariusはどうか？にならざるを得ない。この一年で果たしてて最も手になじむツールになりえただろうか？答えはYesでもありNoでもある。Sagittariusはこの一年で大きく向上した。ライブラリも充実し、現実の問題に立ち向かえる程度には手になじむようになった。だがここはまだゴールではない。時としてそれがもつ制約や利便性の欠如によって思考が疎外されることがある。いかなる時でも最適解でありえるというのがゴールであれば、ゴールなどありはしないのかもしれない。

一年は長いようで短く、短いようで長い。Sagittariusが今年の初めにどのような姿をしていたのか思い出せない。来年もこの感じがまた味わえるような一年にするとしよう。

*1Lisp AC用に考えていた題ともいうｗ
*2ここでは高校数学を対象としている。

change-class

MOP ACに参加してしまったのでMOPサポートを手厚くしたいなぁという欲求が勝手に高まってきている。サポートしていない機能のもっとも大きなものとしてchange-classとクラスの再定義がある。個人的にどちらもあまり(サポートしてないのだから当然だが)使わない機能で今一どういうものかよく分かっていない。とりあえず、オリジナルのAMOPを当たってみることにした。

AMOPで使われているソースはclossette.lispと呼ばれるものらしく、ググって見るとまぁ簡単に見つかった。これとか。

っで、とりあえず、change-classの骸骨だけ作ってみたのが以下。

(import (rnrs) (clos user) (clos core)
        (sagittarius)
        (sagittarius control))

(define (slot-exists? obj slot)
  (slot-exists-using-class? (class-of obj) obj slot))

(define-method slot-exists-using-class? (class obj slot)
  (not (not (assq slot (class-slots class)))))

(define-method change-class ((old <object>) (new-class <class>) :rest initargs)
  (let ((new (allocate-instance new-class initargs)))
    (dolist (slot-name (map slot-definition-name (class-slots new-class)))
      (when (and (slot-exists? old slot-name)
                 (slot-bound? old slot-name))
        (slot-set! new slot-name (slot-ref old slot-name))))
    ;; TODO
    ;;(%swap-slots new old)
    ;;(%swap-class new old)
    (apply update-instance-for-different-class new old initargs)
    old))

(define-method update-instance-for-different-class
  ((old <object>) (new <object>) :rest initargs)
  (let ((added-slots (remove (lambda (slot-name)
                               (slot-exists? old slot-name))
                             (map slot-definition-name 
                                  (class-slots (class-of new))))))
    (apply shared-initialize new added-slots initargs)))

(define-method shared-initialize ((instance <object>) slot-names :rest all-keys)
  (dolist (slot (class-slots (class-of instance)))
    (let ((slot-name (slot-definition-name slot))
          (init-key   (slot-definition-option slot :init-keyword #f))
          (init-value (slot-definition-option slot :init-value #f))
          (init-thunk (slot-definition-option slot :init-thunk #f)))
      ;; init-keyword is the strongest
      (cond ((and init-key (get-keyword init-key all-keys #f))
             => (lambda (v) (slot-set! instance slot-name v)))
            ((and init-value (get-keyword init-value all-keys #f))
             => (lambda (v) (slot-set! instance slot-name v)))
            ((and init-thunk (get-keyword init-thunk all-keys #f))
             => (lambda (v) (slot-set! instance slot-name (v)))))))
  instance)

ほぼオリジナルのコピー。違いはオリジナルはrotatefでスロットとクラスも変更できるがSagittariusではそんなことできないので本体に何かしら手を入れる必要があるといった点と、shared-initializeが美しくない点か。(普通にinitialize呼び出せばいいじゃん、と思ったのだが、そうすると引数チェックとかがユーザーによって定義されていると嬉しくないのだろう。実際多分嬉しくない)

っで多分以下のように使える(予定)。

(define-class <member> ()
  ((name       :init-keyword :name)
   (occupation :init-keyword :occupation)))

(define-class <member2> ()
  ((first-name :init-keyword :first-name)
   (last-name  :init-keyword :last-name)
   (occupation :init-keyword :occupation)
   ))

(define m (make <member> :name "Takashi" :occupation "Programmer"))

(change-class m <member2> :last-name "Kato" :first-name "Takashi")

CLHSのchange-classにある例では明示的に呼んでいるのでこうあるべきなのだろう。

closseteではクラスの再定義は禁止してるみたいなんだけど、CL、Gaucheともに同名のクラスが既にあった場合クラスの再定義プロセスが走るみたいだが、これどうしたものかな。

XSDを扱いたい

仕事柄SOAPを頻繁に使う。現状ではSOAP-UIを使ってリクエストを投げているのだが、これがまどろっこしくなってきた。SchemeにはSXMLがあるので気合を入れれば何とでもなるのだが(大抵のことは気合を入れれば何とかなるが・・・)、せっかくなので何かしらフレームワーク的なものがあってもいいのではと思ってきた。

0.4.12から入った(binary data)ライブラリの便利さに驚いているので、同様な感じで定義一発でmarshalとunmarshalも可能になるといいかなぁと思っている。例えばこんな感じで定義して

;; Pseudo code
(define-define-xml-schema define-xml-type reader writer)
(define-xml-type <customer> ()
  ((name :type xs:string :element Name :min 1 :max 1)
   (birth-of-country :type xs:string :element BirthOfCountry :min 0 :max 1))
  :namespace "http://example.com"
  :element Customer)

こんな感じで使えるとか

(let ((x (call-with-input-file "sample.xml" reader))
  (writer x (current-output-port)))
#|
<Customer xmlns="http://example.com">
  <Name>read from sample.xml</Name>
</Customer>
|#

ぱっと思いついた感が強いな。

っで、この定義も手で書くのはあほらしいので、XSDをパースして適当に自動生成されるとうれしい気がする。(実際Githubに上げてるSOAPライブラリはその辺が面倒であまり使ってなかったりする・・・)

もう少し案を練ってから実装してみるか。

Sagittarius Scheme 0.4.12リリース

Sagittarius Scheme 0.4.12がリリースされました。今回のリリースはメンテナンスリリースです。

修正された不具合

• CLOSのメソッドを使用したマクロを定義するマクロがエラーになる不具合が修正されました
• bytevector->integerが負の整数に対して正しい値を返さない不具合が修正されました
• mod-inverseがランダムで正しい値を返さない不具合が修正されました
• Windows上でgetenvが正しく値を返さない不具合が修正されました
• get-output-bytevector及びextract-output-bytevectorがSEGVを起こす不具合が修正されました
• R6RSモードでエスケープされたシンボルを読み込むと&lexicalが投げられる不具合が修正されました
• CBCモードで作成された暗号器が初回以降の暗号/復号で正しいIVを使用しない不具合が修正されました
• (rfc mime)がマルチパートデータを正しく処理しない不具合が修正されました

改善点

• cipher-block-sizeが暗号器の名前でも使用可能になりました
• next-method?がメソッド内で使用可能になりました
• is-prime?が巨大数に対してLucas-Lehmer法を使用するようになりました
• スタックトレースが継続をまたいでも表示されるようになりました
• access-protected-resourceでマルチパートデータが使用可能になりました
• inflating-input-portが実際に使用したバイト数のみ元ポートの位置を進めるようになりました
• mime-compose-message-stringがバイナリデータを扱えるようになりました
• open-bytevector-output-portのextraction手続きがtranscoded-portで元ポートが閉じられた後でも使用可能になりました

新たに追加された機能

•  socket-recv!が追加されました
• (binary data)ライブラリが追加されました
• DSAの署名及び検証機能が追加されました
• bytevector->sinteger及びbytevector->uintegerが追加されました
• sinteger->bytevector及びuinteger->bytevectorが追加されました
• (rfc ssh)が追加されました(ドキュメントはまだありません)
• compute-getter-n-setterが追加されました
• slot-ref-using-class、slot-set-using-class!及びslot-bound-using-class?が追加されました

非互換な変更

• nullライブラリが廃止されました

Edge case?

I've just found an interesting behaviour of R6RS implementation about bytevector output port. First of all, look at this piece of code;

(import (rnrs))

(let*-values (((port extract) (open-bytevector-output-port))
              ((out) (transcoded-port port (native-transcoder))))
  (put-string out "hello")
  (display (extract)))

What do you think the (extract) should do? According to the R6RS spec of transcoded-port the port must be closed by special way so that other string operations can be done.

As a side effect, however, transcoded-port closes binary-port in a special way that allows the new textual port to continue to use the byte source or sink represented by binary-port, even though binary-port itself is closed and cannot be used by the input and output operations described in this chapter.
-- R6RS Standard libraries 8.2.6 Input and output ports

I know open-bytevector-output-port can take a transcoder as its optional argument, however I think there is needs that the created bytevector output port needs to be converted later for some reason or user wants to store first pure binary data then some text data.

Now I've tried what the implementations would return, the result was rather interesting. Followings are the tested implementations and its result;

[Implementations that raised an error]

• Larceny 0.97
• Racket 5.2.1
• Sagittarius 0.4.11
• Ypsilon 0.9.6-update3

[Implementations that returned a bytevector]

• Mosh 0.2.7
• Petite Chez Scheme 8.4

The majority is raising an error, but interestingly Chez Scheme which I think the reference implementation of R6RS returned a value. For me, it is convenient the latter behaviour and the specification (as far as I searched) doesn't specify how it should be. The above quotation is only specifying the input/output operation not extracting.

Hmmmm, what should I do?

Mooseのaugment/innerをMOPで

この記事はMetaobject Protocol(MOP) Advent Calendar 2013 17日目の記事として書かれました。

PerlにはMooseというMOPをサポートしたオブジェクト指向モジュールがあります*1。その中にaugment/innerという一風変わったメソッドモディファイアがあったのでこれをMOPで実現してみようと思います。

実装するためにはそれがいったいどのように動作するのかを知る必要があります。PerldocのMoose::Manual::MethodModifiersにaugment/innerの項目があるのでそちらを見てみましょう。

…

見ましたね？どうやら動作の肝はinner手続きが下位の実装を呼び出す点にありそうです。これは通常のMOPで実現されるメソッドチェインとは逆です。以下の図は通常とaugment/innerが要求するメソッドチェインを表したものです。

* as-xml is the method
* income-and-expenses is too long so now combined :)
+-------------------+                       +-----------------+                       +-------------------+
| as-xml (combined) | - call-next-method -> | as-xml (report) | - call-next-method -> | as-xml (document) |
+-------------------+                       +-----------------+                       +-------------------+

+-------------------+            +-----------------+            +-------------------+
| as-xml (document) | - inner -> | as-xml (report) | - inner -> | as-xml (combined) |
+-------------------+            +-----------------+            +-------------------+

既に答えは見えている気がしますが、肝はcompute-applicable-methodsです。以下が今回の肝になるコード片です。

(import (rnrs) (clos user) (clos core) (srfi :39))

(define-class <augment-generic> (<generic>) ())

(define *default-inner-value* (make-parameter ""))

(define-method compute-applicable-methods ((gf <augment-generic>) args)
  `(,@(reverse! (call-next-method))
    ;; add very bottom one
    ,(make-method (list <top>)
                  (lambda (call-next-method o) (*default-inner-value*)))))

5日目の記事では与えられたメソッドから特定のqualifierを取り除いて等の複雑なことをしましたが、今回は単に逆順にするだけです。最後にデフォルトの値を返すメソッドを追加しているのがトリックです。Gaucheの<bottom>のようなクラスがあればこのトリックは要らないのですが、*2Sagittariusではサポートしていないので明示的に追加してやる必要があります。

さて肝はできたので後はお化粧です。 このままではinnerをcall-next-methodとして呼ばなければならないのであまりaugment/innerっぽくありません。そこで以下のようにマクロを定義します。

(define-syntax define-augment
  (syntax-rules ()
    ((_ name)
     (define-generic name :class <augment-generic>))))

(define-syntax augment
  (lambda (x)
    (define (analyse args)
      (let loop ((ss args) (rs '()))
        (cond ((null? ss)          (values (reverse! rs) '() #f))
              ((not (pair? ss))    (values (reverse! rs) ss #f))
              ((keyword? (car ss)) (values (reverse! rs) (gensym) ss))
              (else (loop (cdr ss) (cons (car ss) rs))))))
    (define (build k generic qargs rest opts body)
      (define (parse-specializer s)
        (syntax-case s (eqv?)
          ((_ class) (identifier? #'class) #'class)
          ((_ (eqv? v)) #'(eql v))
          ((_ v) #'v)
          (_ #'<top>)))
      (define (->s d) (datum->syntax k d))
      (with-syntax (((specializers ...) (->s (map parse-specializer qargs)))
                    ((reqargs ...)
                     (->s (map (lambda (s) (if (pair? s) (car s) s)) qargs)))
                    (rest       (->s rest))
                    (option     (->s opts))
                    ((body ...) (->s body))
                    (generic    (->s generic))
                    (inner      (->s 'inner)))
        (with-syntax ((real-body (if opts
                                     #'(lambda (inner reqargs ... . rest)
                                         (apply (lambda option body ...) rest))
                                     #'(lambda (inner reqargs ... . rest)
                                         body ...))))
          #'(begin
              (add-method generic
                          (make-method
                           (list specializers ...)
                           real-body))
              generic))))
    (syntax-case x ()
      ((k ?generic ?args . ?body)
       (let-values (((qargs rest opt) (analyse #'?args)))
         (build #'k #'?generic qargs rest opt #'?body))))))

実際に使うには以下のようにします。

(define-class <document> () ())
(define-class <report>  (<document>) ())
(define-class <combine> (<report>) ())

(define-augment xml)
(augment xml ((o <document>))
  (string-append "<doc>" (inner) "</doc>"))

(augment xml ((o <report>))
  (string-append "<title>foo</title>"
                 "<summary>bar</summary>" 
                 "<body>"
                 (inner)
                 "</body>"))
(augment xml ((o <combine>)) "hello")

(xml (make <document>))
;; => <doc></doc>

(xml (make <report>))
;; => <doc><title>foo</title><summary>bar</summary><body></body></doc>

(xml (make <combine>))
;; => <doc><title>foo</title><summary>bar</summary><body>hello</body></doc>

上記のコードの動作には今週末にリリースされる予定の0.4.12が必要なので注意してください*3。ちゃんと下位実装の値がinner呼び出しの部分に埋め込まれているのが確認できます。

MOPを使えば一見処理系でサポートしないといけないような処理でもお手軽にサポートできる可能性を示せていれば幸いです。

*1実際に使ったことはないですｗ
*2どうやら予定通りには動かないようです。勘違いでした。参照
*3make-methodを使わなければ0.4.11でも動作するはず。

明日使える総称関数(3)

この記事はMetaobject Protocol(MOP) Advent Calendar 2013 11日目の記事として書かれました。

MOPはメタクラス上に構築されます。今回はそのクラスそのものを使って総称関数を使ってみます*1。

MOP ACのこれまでの記事を読まれた方なら既にご存知かと思いますが、 まずはメタクラスとはのおさらいです。MOPをMOP足らしめる大きな存在の一つとしてメタクラスがあります。例えばJavaであれば全てのクラスはjava.lang.Classのサブクラスになるといったように、CLOSでも大元のクラスがあります。CLならばstandard-class、Gauche及びSagittarius*2ならば<class>がデフォルトでクラスのメタクラスになります。ここでデフォルトでと言ったのは(CLOSベースの)MOPではこの階層を変更することができるからです。図で表すと以下のようになります。

+---------+            +-------+        +-----------------+
| <class> | <--------- | <top> | <<-+-- | builtin classes |
+----+----+            +-------+    |   +-----------------+
     ^                              |
     ^                              |   +----------+       +---------------+
     |                              +-- | <object> | <<+-- | <user-class1> |
     |                                  +----+-----+   |   +---------------+
     |                                       ^         |
     |                                       ^         |   +---------------+
     |                                       |         +-- | <user-class2> |
     |                          +------------+             +---------------+
     |                          |
+----+--------+       +---------+----------+
| <metaclass> | <---- | <meta-user-class1> |
+-------------+       +--------------------+

ASCII記号の関係上^及び<をインスタンス作成時に使用されるクラス、縦に並んだ^及び<<を継承関係として使っています。この図では<class>は独立した位置にありますが、実際のCLOSでは<object>のサブクラスになっています。つまり、CLOSのMOPにおいてはメタクラスも単なるオブジェクトに過ぎないということです。しかし、ここでは図を簡略にするため独立したものとして描いています。

CLOSではこのメタクラスのサブクラスを使ってオブジェクト構築の振る舞いをユーザがコントロールできるようにしています*3*4。

ではこれが「明日使える総称関数」とどう関係してくるのでしょうか？ここでは実際に使われている例を見ながらその便利さを体感していきます。拙作Sagittarius Schemeでは最近(binary data)というライブラリが追加されました*5。このライブラリではメタクラスを使用したバイナリデータの読み書きとCLOSでの抽象化を行っています。

実際のコードはユーザの負担を減らすためにマクロでコードの自動生成をしていますが、肝になる部分は以下です。ここではユーザが<；sample>という複合データクラスを:parent-metaclassキーワード引数に<sample-meta-parent>を指定したとします。*1*6

;; This meta class will be generated automatically
(define-class <sample-meta> (<sample-meta-parent>) ())

;; main class
;; suppose user didn't specify the parent class
(define-class <sample> ()
  ((a :init-keyword :a :init-value #f))
  :metaclass <sample-meta>)

;; binary reader
(define-method sample-read ((t <sample-meta>) in . ignore)
　　(let ((o (make t)) ;; !!! POINT !!!
    ;; read structured binary data and set it to the slot(s)
    o))

sample-readはdefine-composite-data-defineマクロに渡されたreaderパラメタです。実際にはマクロによって暗黙的に定義されるので、<sample-meta>はユーザに見えることはありません。

sample-readがこのように定義されてうれしい理由はなんでしょうか？一つの答えとして以下のように書くことができます。

(sample-read <sample> binary-input-port)
;; => instance of <sample>

コードの中でPOINTと書かれている部分がまさに肝です。CLOSではオブジェクトの構築はMOPを使っていると書きましたが、makeも例に漏れず総称関数を<class>で特殊化したものです。つまり、<class>を継承したクラスを渡してやればそのインスタンスを作ることができます。また、総称関数の引数型に指定すればそのクラスで特殊化することが可能です。

このライブラリの例では、バイナリという低レベルの操作をメタクラスによる総称関数のメソッドディスパッチでCLOSのインスタンスにマッピングするため、データの抽象度及びコードの可読性が格段にあがります*7。

今回紹介した例はCLやGaucheと他のCLOSベースのMOPでも応用可能です。贔屓の処理系で実際に動かしてみて理解を深めてみてはいかがでしょうか？

*1この記事が書かれた経緯。
*2Tiny CLOSベースなら恐らくどの処理系でも
*3参考例：Metaobjectでオブジェクト指向プログラミング
*4参考例：コンポジションに便利なpropagatedスロット
*5記事のサンプルコードと現在の実装では仕様が違うので注意
*6大したものじゃないって言ったじゃないですかｗ
*7体感には個人差があります。単なる宣伝です。

Windowsは悪なのか？

多くのハッカーと呼ばれる人、それを目指す人、はたまた凄腕ITエンジニアはWindowsではなくLinuxもしくはUNIXライクOSを使っているし、Windowsを良しとはしない傾向になる。How To Become A HackerでEric Raymondは以下のようにその理由を述べている。

Yes, there are other operating systems in the world besides Unix. But they're distributed in binary — you can't read the code, and you can't modify it. Trying to learn to hack on a Microsoft Windows machine or under any other closed-source system is like trying to learn to dance while wearing a body cast.

確かにそのとおりだ。WindowsはプロプライエタリなOSでそのソースを読むには莫大な金額のライセンス料をMicrosoftに支払ってソースコードを入手する以外にはない。では、LinuxやBSD系UNIXを使っている人たちはそのOSのコードを読むためにそれらを使っているのだろうか？いざというときソースを解析して問題を回避するのだろうか？

そのような統計を見たことはないので憶測でしかないのだが答えはNoではないだろうか？仮に多くの非Windowsユーザーがカーネルのソースコードを読むことはないとしたら、いったい何が彼らをそのOSを使うように仕向けたのだろう？

Windowsは良くも悪くも万人向けである。システムの根幹にかかわる部分に直接手を入れる手段はほぼない。全ての操作はGUIを使って行われる前提で設計されている。万人向けであるがゆえにプログラミングに関係するツールは初期状態では付随していなし、そのシェルはあまりにも貧弱だ。逆にUNIXライクOSでは全ての設定は単にファイルであることが多い。また、プログラマが必要とするツールの多くは初期状態で使用可能であることが多い。さらにOSのシステムコールはWindowsのそれに比べてはるかに簡潔であり、manでそれらの使い方を容易く調べることが可能である。

これだけ比べるとプログラマとしてはWindowsではない方が楽なのではないだろうか？ 既にある開発環境、整備されたドキュメント、簡潔なAPIどれを見てもWindowsにはない。彼らはWindowsから逃げたのではないだろうか？

それは悪いことではない。僕自身Windowsでの開発はCygwin上で行っている。可能な限り楽をしたいからだ。だが、SagittariusはWindowsでの動作も常に確認している。楽をしたいからだ。そして、僕以外の誰かが同じように楽ができることを願っているからだ。OSのインストールは楽ではない。また、量販店で買うコンピュータには基本Windowsが入っている。Windowsを諦めるということは楽ではない作業をしなければならないということだ。僕は心が弱い。目の前に高い壁と通り抜けられそうな茨の道があれば後者を選ぶ。楽がしたいからだ。

Windowsを諦めない*1。

*1これが言いたかっただけｗ

明日使える総称関数(2)

この記事はMetaobject Protocol(MOP) Advent Calendar 2013 5日目の記事として書かれました。

前回はビルトインでサポートされているqualifierの使い方を紹介しました。今回は自前のqualifierを作ってみましょう。問題になるのはSagittariusでは基本のqualifier以外のものはエラーになるという部分ですが、そこをMOPを使って何とかしてしまおうという算段です。

注意
前回の続きなのでタイトルは「明日使える総称関数(2)」となっていますが、このレベルだと明日使える保障はありません。また、使いどころを間違えると大変なことになる可能性があります。使用は自己責任でお願いします。

ここでは:collectというqualifierを導入することにしましょう。要求としてこのqualifierが付いたメソッドの戻り値をリストにパックするものとします。また話を簡単にするために、:primaryメソッドの戻り値は捨てられるものとします。では、コードを見てみましょう。

(import (rnrs) (clos user) (clos core) (srfi :1) (srfi :26))
(define-class <collect-qualifier-generic> (<generic>) ())
(define-method compute-applicable-methods ((gf <collect-qualifier-generic>)
                                           args)
  (let* ((methods (generic-methods gf))
         (appends (filter-map (lambda (m)
                                (and (eq? (method-qualifier m) :collect)
                                     m)) methods)))
    (for-each (cut remove-method gf <>) appends)
    (let ((r (call-next-method)))
      (for-each (cut add-method gf <>) appends)
      ;; make method which collects all result of methods which have
      ;; :collect qualifier
      (list (make <method>
              :generic gf
              :specializers (list)
              :lambda-list 'args
              :procedure (lambda (call-next-method . args)
                           ;; discards other result
                           (compute-apply-methods gf r args)
                           (map (lambda (m) 
                                  (compute-apply-methods gf (list m) args))
                                appends)))))))

(define-generic foo :class <collect-qualifier-generic>)
(define-method foo :collect ((a <symbol>)) 'symbol)
(define-method foo :collect (a) 'top)
(define-method foo ((a <symbol>)) (print a) 'b)

(print (foo 'a))
;;> a
;;=>(top symbol)

順番に見ていきましょう。

まず、:collect qualifierをサポートするための総称関数クラスをのサブクラスとして作ります。これにより、MOP用総称関数の一つであるcompute-applicable-methodsの特殊化を可能にします。
次にcompute-applicable-methodsを先ほど作ったクラスで特殊化します。処理の中身は以下のフローです。

1. 総称関数fooに登録されている全てのメソッドから:collect qualifierを持つものを除く
2. 親クラスの処理を呼び出し、戻り値を保存する
3. 取り除いたメソッドを戻す
4. 処理に使われるメソッドを作成する*1

#4で作られたメソッドは以下の処理を行います。

1. 上記#2で作られたメソッドチェインを実行する
2. :collect qualifierの付いたメソッドを全て実行する*2

上記の振る舞いを適用するために

(define-generic foo :class <collect-qualifier-generic>)

のように生成される総称関数のクラスを指定します。

たったこれだけです。Sagittariusではメソッドを作る構文がdefine-methodしかないので、フロー1の#4が多少煩雑な感じがしますが、やっていることは非常に単純です。

MOPとか、オブジェクト構築の振る舞いを変えるとか言われると非常に難しいことをしている気がしますが、たったこれだけで面白いことができるわけですから遊んでみない手はないでしょう。

*1 束縛されないのでspecializerを真面目に指定する必要はありません。
*2 真面目にやるならメソッドのソートや受け取った引数の型を調べてメソッドの選別をする必要がありますが、この例では簡便にするために省いています。