Syntax highlighter

2014-01-24

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に移植するのも難しくないはずだ。実際既に作られている

2014-01-20

風車の中

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

とりあえず、写真
展望台(?)から臨むライデンの街並み(一眼レフとかだともう少しワイドに取れて様になった気はするが気にしないw)

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

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

その2

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

立派なもんだろう?

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

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

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

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

2014-01-17

Sagittarius Scheme 0.5.0 リリース

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

修正された不具合
  • importがcond-expand内でR7RSが要求するように動かなかった不具合が修正されました
  • Linux上でプロセスを継続的に起動するとクラッシュする不具合が修正されました
新たに追加された機能
  • change-classが追加されました
改善点
  • ライブラリファイルの拡張子を追加する-Sオプションが追加されました
  • クラスがdirect-subclassesスロットを持つようになりました
  • R7RSスタイルのSRFIライブラリ名がサポートされました
  • コンパイラがいくつかの参照透過かつ末尾位置にない式を削除するようになりました
内部的な変更
  • 完全なセルフホスティングになりました

2014-01-16

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

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

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はテンプレート変数に変換されるんだけど、これに変換されるとコンパイラがうまいこと局所変数を参照できないという問題だったりする。

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

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

2014-01-15

日本語 vs English

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

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

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

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

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

2014-01-14

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))

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

2014-01-12

SBCLのPCLを読む

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

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にする気がする。

2014-01-11

Scheme処理系の選び方

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

目的別

【SICP用】

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

【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が使える。
(自分の処理系の宣伝w)

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

RacketのPLT、ChickenのEgg等

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

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

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

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の宣伝w)

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

2014-01-10

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

実は役に立たないことが判明してしまった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バイト読み取ってビットで適当にやればいいのか。無くてもいいかな?ちょっと考えるか・・・

2014-01-02

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-1srfi-5などのサポートしているSRFIを入れていますが、library識別子は処理系が持っているライブラリを探して、存在するかしないかをチェック可能です。

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

2014-01-01

謹賀新年

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

時候の挨拶ここまで。

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

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

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

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

こんなところかなぁ。

2013-12-30

それでも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用に考えていた題ともいうw
*2ここでは高校数学を対象としている。

2013-12-28

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ともに同名のクラスが既にあった場合クラスの再定義プロセスが走るみたいだが、これどうしたものかな。

2013-12-24

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ライブラリはその辺が面倒であまり使ってなかったりする・・・)

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

2013-12-20

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ライブラリが廃止されました

2013-12-17

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ではサポートしていないので明示的に追加してやる必要があります。

さて肝はできたので後はお化粧です。 このままではinnercall-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実際に使ったことはないですw
*2どうやら予定通りには動かないようです。勘違いでした。参照
*3make-methodを使わなければ0.4.11でも動作するはず。

2013-12-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-readdefine-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大したものじゃないって言ったじゃないですかw
*7体感には個人差があります。単なる宣伝です。

2013-12-10

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これが言いたかっただけw

2013-12-05

明日使える総称関数(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 真面目にやるならメソッドのソートや受け取った引数の型を調べてメソッドの選別をする必要がありますが、この例では簡便にするために省いています。

2013-12-02

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

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

実は今日が誕生日の筆者です。適当に何かを送りつけてくれたり、お祝いの言葉をもらえたりすると喜ぶかもしれません。

さて、MOPと言えばCLOSがまず浮かぶのではないでしょうか。Metaobject Protocolなのでオブジェクトのクラス定義の方をさすのかもしれないのですが、CLOSといえば総称関数が便利です。そこで今回は「明日使える総称関数」と題しまして、qualifierを便利に使いつつMOP的にも満足いくようにしてみたいと思います。

とりあえず前提としてコードは拙作Sagittarius Scheme(0.4.11)で動作確認しています。またGaucheはメソッドのqualifierをサポートしていないので移植は(現状では)不可能ですが、本稿で紹介するqualifierはCLにも同様のものがあるので、そちらへの移植は難しくないかと思います。

まずはメソッドqualifierのおさらいをしましょう。Sagittariusではデフォルトで:primary, :before, :afterそして:aroundの4つのqualifierを実装しています。特に何も指定しない場合は:primaryが暗黙のうちに使用されます。イメージをつかむために簡単な例を見てみます。
(import (rnrs) (clos user))
(define-method print :around args
  (display "around:before") (newline)
  (call-next-method)
  (display "around:after") (newline))

(define-method print :before args
  (display ":before") (display args) (newline))
(define-method print :after args
  (display ":after") (display args) (newline))

(define-method print args (call-next-method))
(print 'a 'b 'c)
#|
around:before
:before(a b c)
abc
:after(a b c)
around:after
|#
:aroundは一番外側を包み、call-next-methodが呼ばれた際のみに続くメソッドチェインを起動します。また、チェイン全体の戻り値は:aroundメソッドが返した値になります。
:beforeはメソッド本体が呼ばれる手前で呼び出されます。戻り値は捨てられます。
:primaryはメソッド本体です。:aroundが上書きしない限りこのメソッドの戻り値がメソッドチェインの全体の戻り値として使用されます。
:afterはメソッド本体が呼ばれた直後に呼ばれます。:before同様戻り値は捨てられます。
ちなみに、この動作はCLでも同様です。

では、これが使えると何が嬉しいのでしょう?

例えば、 DB接続を考えて見ます。DBの実装によってクエリ発行などは別にする必要があるけど、コネクションが生きているかチェックするのは共通でやりたい、なんてこと考えたことありませんか?素直に考えれば、以下のようになるでしょう。
;; super class method
(define-method select ((c <connection>) query)
  (check-connection c))

;; Database dependent layer
(define-method select ((c <oracle-connection) query)
  (call-next-method)
  (oracle-select c query))
DBの種類が増えた場合でもcall-next-methodを呼べば共通の処理はしてくれるという寸法です。でも毎回書くのはだるいですよね?そこでメソッドqualifierです。この場合なら事前処理に:beforeを使って以下のように書くことができます。
;; super class method
;; implementation limitation. Sagittarius needs primary method
(define-method select ((c <connection>) query))
(define-method select :before ((c <connection>) query)
  (check-connection c))

;; Database dependent layer
(define-method select ((c <oracle-connection) query)
  (oracle-select c query))
これでDBの実装が増えてもselectメソッドではコネクションが生きているかを自動で判別してくれます。(もちろん、check-connectionがエラーを投げなければ意味はありませんが・・・)

もう一例見てみましょう。JavaでAspectJを使っている方なら馴染み深いと思いますが、既存のメソッドの前後に事前と事後処理を入れたい場合というのがあるかと思います。例えばあるメソッドがエンティティの状態を変更します、ユーザーはその状態の変化を捉えて何かしらの通知を行うというのを考えて見ます。以下は簡単なコード例です。
;; pseudo method
;; This is in somewhere the library so users can't
;; change.
;; do something useful and return the new entity
(define (fire-event entity event) 'new-entity)

;; wrap it with qualifier
;; just stub to call original
(define-method fire-event args (call-next-method))

(define-method fire-event :around args
  ;; check args length and get the entity's state
  (print args)
  ;;
  (let ((r (call-next-method)))
    ;; check the result of the entity and notify
    (print r)
    r))
#|
(fire-event 'entity 'event)
;;> (entity event)
;;> new-entity
;;=> new-entity
|#
この例では:aroundが実際のメソッドを呼び出していますが、引数が不正であったりする場合は呼ばないことも可能です。Lisp:よくある正解で上げられているToo dynamicはこの機能を使えば実現できそうです*1

次回*2はMOPを使って総称関数にユーザー定義のqualifierを足してみます。

*1コンパイラが手続きの呼び出しをインライン展開している場合等全てに対応できるわけではありません。
*2紹介部分が予定したよりかなり長くなってしまったので分割しました。

2013-11-30

SSHクライアントを実装したった

そろそろ(自分のために)要るなぁと思っていたので「えいや!」と作った。と書くとちょっと自分がすごいことしてる感じが出るが、要するにRFCに書かれていることを地道に実装しただけである。ちなみに全ての要求はまだ満たしていない。

以下のように使える。
(import (rfc ssh))

(define transport (make-client-ssh-transport "localhost" "22"))
(define user "guest1")
(define pass "pass1")

(ssh-authenticate transport +ssh-auth-method-password+ user pass)
(let-values (((status response) (ssh-execute-command transport "ls -l")))
  (print (utf8->string response)))
ssh-execute-commandはコマンドの戻り値と出力を受け取る。出力はバイナリなので適当に変換する必要がある。他にもShellを起動したりチャンネルを自前で開いたりするAPIがある。

まだまだおもちゃ程度の処理しかできない(ので、しばらくはドキュメントに載らないw)。そして、本当にほしいのはSFTPだったりするので次はsubsystemセッションの確立とSFTPの実装かね。

以下は適当な情報
ソースはsitelib/rfc/sshディレクトリ以下。あまりの汚さに精神汚染を起こしても当方は責任を取らない(多分未来の自分に対する警告・・・)。これを実装するために以下の機能及びライブラリが追加された。
  • (binary data)ライブラリ(自分で言うのもなんだけど、すごく便利w)
  • DSA鍵署名及び検証

2013-11-20

Binary data structure read/write library

Currently I'm implementing SSH (for now client only) on Sagittarius and have noticed it would be convenient to have a library which handles binary data structure read/write. So I've written (binary data) library. (not sure if the name should be '(binary structure)' or '(binary io)', or something else).

Here is the simple example;
;; The definition is from RFC 4250-4254
;; atom datum
(define-simple-datum-define define-ssh-type read-message write-message)
(define-ssh-type <name-list> (<ssh-type>)
  names '()
  (lambda (in)
    (let* ((len (get-unpack in "!L"))
           (names (get-bytevector-n in len)))
      (string-split (utf8->string names) #/,/)))
  (lambda (out names)
    (let ((names (string->utf8 (string-join names ","))))
      (put-bytevector out (pack "!L" (bytevector-length names)))
      (put-bytevector out names)))
  :parent-metaclass <ssh-type-meta>)

;; composite data
(define-composite-data-define define-ssh-message read-message write-message)
(define-ssh-message <ssh-msg-keyinit> (<ssh-message>)
  ((type   :byte +ssh-msg-kexinit+)
   (cookie (:byte 16)) ;; array of byte
   (kex-algorithms <name-list>)
   (server-host-key-algorithms <name-list>)
   (encryption-algorithms-client-to-server <name-list>)
   (encryption-algorithms-server-to-client <name-list>)
   (mac-algorithms-client-to-server <name-list>)
   (mac-algorithms-server-to-client <name-list>)
   (compression-algorithms-client-to-server <name-list> (name-list "none"))
   (compression-algorithms-server-to-client <name-list> (name-list "none"))
   (language-client-to-server <name-list> (name-list))
   (language-server-to-client <name-list> (name-list))
   (first-kex-packat-follows :boolean #f)
   (reserved :uint32 0)))
So the idea of the library is that structured data are either simple datum or composite of simple datum. Thus if we define how to read/write the simple datum, then composite data's read/write are already decided. This might not be always true but as far as I know most of the case.

BTW, I think the naming of the macro is ugly so if you have a better suggestion it's very welcome :)

2013-11-19

マクロバグリターンズ

えらく久しぶりに発見した気分ではある。二つあって、一つは(とりあえずやっつけで)片付けたのだが、もう一つに苦戦している。

問題となるのは以下のようなコード。
(import (rnrs))
(define-syntax renaming-test
  (syntax-rules ()
    ((_ var val)
     (begin
       (define dummy val)
       (define (var) dummy)))))
(define dummy #f)
(renaming-test a 'a)
(print (a))
(print dummy)
まぁ、見れば分かるとおり、最後のdummyは#fを返してほしいのだがaを返してくるというバグである。要するにリネームが上手いこといっていないのである。

現状ではリネームは展開時にのみ行われているのだが、パターンのコンパイル時にどこにも束縛されていない識別子はリネームしてしまっていいのではないか?という気がしている。上記の例なら、パターン変数であるvarとval、束縛されている_、begin及びdefineはリネームするとまずいのだが、残り(dummy)はリネームしてもマクロ外にもれることはないわけなのだから(むしろ漏れるとまずい)。ちょっとそんな感じでやってみるかね。 あぁ、だめだ。それだと以下のようなパターンで困る。
(let ((dummy #f)
      (hoge #t))
  (define (print . args) (for-each display args) (newline))
  (let-syntax
      ((renaming-test (lambda (x)
                        (syntax-case x ()
                          ((_ var val)
                           #'(begin
                               (define dummy val)
                               (define (var) dummy)
                               (display hoge) (newline)))))))
    (renaming-test a 'a))
  (print (a))
  (print dummy))
これだと、dummyはリネームされてほしいけど、hogeは変更されたくない。ただ、このパターンってマクロが構文を知ってないとどうしようもないような。違うかな?dummyとhogeが意味的に違うってのを構文の情報なしにどう知ればいいんだ?

2013-11-15

セルフホスティング

現状でもSagittariusはほぼセルフホスティングしているのだが、もう少し発展させたものにしたいなぁと思ってきたのと、微妙な問題点に気づいたのでメモ。

0.4.11までは(実は0.4.11は試験的に違うが)Schemeで書かれたVM上でコンパイラをコンパイルしてCのコードを生成していたのだが、これだとVMのコードを変更するたびにC側とScheme側の両方を変更しなければならなくて正直面倒だった。そこで、とりあえずの下地として、コンパイルされたコードをCに変換するライブラリを0.4.11では導入した。

とまぁ、Sagittariusが変なことをしていない処理系だったらこれで話は終わるんだけど、実は変なことをしている処理系なのでここで話が終わらないことに気づいたのだ。SagittariusのコンパイラはVMが使用するフレームのワード数を知っていて(VMから取るんだけど)、コンパイル時に余計な環境の束縛を行わないようにしている(多分以前そうしたっていう記事書いた)。これが問題になる。ちょっといい例が思いつかなかったので微妙な例だが、こんなの。
(disasm (lambda (x)
          (let ((y (get x z))) 
            (print (let ((w (get y z)))
                     (get w (let ((e (get x)))
                              (get e x))))))))
;; size: 40
;;    0: FRAME 6
;;    2: LREF_PUSH(0)
;;    3: GREF_PUSH #<identifier z#user (0x80501990)>; z
;;    5: GREF_CALL(2) #<identifier get#user (x805019d8)>; (get x z)
;;    7: PUSH
;;    8: FRAME 6
;;   10: LREF_PUSH(1)
;;   11: GREF_PUSH #<identifier z#user (0x805018b8)>; z
;;   13: GREF_CALL(2) #<identifier get#user (0x80501900)>; (get y z)
;;   15: PUSH
;;   16: FRAME 18
;;   18: LREF_PUSH(2)
;;   19: FRAME 4
;;   21: LREF_PUSH(0)
;;   22: GREF_CALL(1) #<identifier get#user (0x80501810)>; (get x)
;;   24: PUSH
;;   25: FRAME 5
;;   27: LREF_PUSH(10) <-- !!! this !!!
;;   28: LREF_PUSH(0)
;;   29: GREF_CALL(2) #<identifier get#user (0x805017b0)>; (get e x)
;;   31: LEAVE(1)
;;   32: PUSH
;;   33: GREF_CALL(2) #<identifier get#user (0x80501870)>; (get w (let ((e (get x))) (get ...
;;   35: LEAVE(1)
;;   36: PUSH
;;   37: GREF_TAIL_CALL(1) #<identifier print#user (0x80501948)>; (print (let ((w (get y z))) (g ...
;;   39: RET
普通ならLREF_PUSH(10)というのはスタックに詰まれた変数の10番目をスタックに積むという意味なのだが、この場合は途中にあるフレームを考慮したら10番目になった変数の参照を意味している。なんでこんな風になっているかと言えば、まぁ歴史的理由が大きいのだが、Sagittariusには一つ外側の環境という概念が存在しないからである(その方がパフォーマンス的に有利だったから)。VMのスタックはプッシュとポップ以外では基本変更されないので、そこを(個人的には)上手く使った(と思っている)トリックである。

では、普通のセルフホスティングでは何が嬉しくないかといえば、コンパイラやビルトインライブラリにこういったケースが無いとは言い切れないため、先に計算されたオフセットがずれる可能性があるからである。となれば、解決策は一つで、ホストはまずターゲットコンパイラAをコンパイルしてそのコンパイラでもう一回コンパイルするというものだろう。Aは一つ前のVMインストラクションで構成されるが、吐き出すインストラクションはターゲットが必要とするものになるといった寸法である。多少回りくどいなぁとは思うが、仕組み上回避不可っぽいので諦めるしかないだろう。

とりあえず、メモとして記録。

2013-11-07

コンパイラマクロ

実は材料は最初からあったんだけど、気が向かなかったのと必要に迫られるほどタイトな性能を要求してなかったので放置してたものの一つ。っが、気が向いたのでえいや!っと作ることにした。まぁ、気が向いた理由は2chでRacketとChickenはあるという話を見たからなのだが・・・

とりあえず、以下の様に使える。
(import (rnrs) (core inline))
;; map is defined in (core base)
(define-inliner map (core base)
  ((_ p arg)
   (let ((proc p))
     (let loop ((l arg) (r '()))
       (if (null? l)
           (reverse! r)
           (loop (cdr l) (cons (proc (car l)) r)))))))
手続き名とそれが定義されているライブラリを指定し、実際の展開部分はsyntax-rulesのようなパターンマッチで記述する。っで、比較のためにある版とない版のコンパイル結果がこれ。
;; あり
(disasm (lambda (x) (map values '(1 2 3 4 5))))
;; size: 26
;;    0: GREF_PUSH #<identifier user#values x80414678>; values
;;    2: CONST_PUSH (1 2 3 4 5)
;;    4: CONST_PUSH ()
;;    6: LREF(2)
;;    7: BNNULL 5                  ; (if (null? l) (reverse! r) (lo ...
;;    9: LREF_PUSH(3)
;;   10: GREF_TAIL_CALL(1) #<identifier reverse!#user x804146d8>; (reverse! r)
;;   12: RET
;;   13: LREF_CDR_PUSH(2)
;;   14: FRAME 4
;;   16: LREF_CAR_PUSH(2)
;;   17: LREF(1)
;;   18: CALL(1)
;;   19: PUSH
;;   20: LREF(3)
;;   21: CONS_PUSH
;;   22: SHIFTJ(2 2)
;;   23: JUMP -18
;;   25: RET

;; なし
;; size: 7
;;    0: GREF_PUSH #<identifier values#user x802ba300>; values
;;    2: CONST_PUSH (1 2 3 4 5)
;;    4: GREF_TAIL_CALL(2) #<identifier map#user x802ba330>; (map values '(1 2 3 4 5))
;;    6: RET
インライン展開されていることが分かる。実際に効果があるか、といわれるとなくは無いがベンチマークレベルで多用しないと目に見えないレベル、の効果だったりする。

これだと高階関数を使用する手続きのインライン展開にしか使えず、定数畳込みはできない。実はもう一段低レベルのマクロがあってdefine-inlinerはそれのラッパーなのだけど、外に見えるようにはしていない。理由は今一APIが気に入らないからだったりする。低レベルのAPIの方が設計が難しい気がしないでもない・・・

2013-10-28

How to write portable code on R7RS

There was a discussion (or rather question about) 'cond-expand'. I was also wondering about 'cond-expand' why it has 'library' form even though it can't help to write portable script (not a library).

Since draft 8 (or 9?), R7RS dropped 'import' syntax from (scheme base) which means users can't write the code like following;
(import (scheme base) (scheme write))

(cond-expand
 ((library (srfi :1))
  (import (srfi :1)))
 ((library (srfi 1))
  (import (srfi 1))))

(define (print . args) (for-each display args) (newline))
(print (iota 10 1))
Interestingly, this works most of the R7RS implementation (well, I only know Chibi and Sagittarius :-P) and Gauche (probably next release supports R7RS). However it's still not portable since the *correct* behaviour should be an error.

Then what is the proper way to make this portable? The answer is simple, just write the stub library like this;
;; somewhere load path whare your favourite implementation can search.
(define-library (srfi-1)
  (export iota)
  (cond-expand
   ((library (srfi :1))
    (import (srfi :1)))
   ((library (srfi 1))
    (import (srfi 1)))
   (else
    ;; To make code absolutely portable
    ;; you need 'begin' :)
    (begin (define iota ...))
    ))
 )
For me, it's inconvenient so I will probably not write strictly portable code on R7RS. Even WG1 member is asking to implement it the way how Chibi is doing now (not sure if this is about what I'm talking about though);
> As far as I can tell, there is no way in a program to use cond-expand to
> control what libraries get imported.

That appears to be correct. I consider that an oversight on the WG's part.
Chibi actually supports this, and I would urge you to support it too.
(from http://lists.scheme-reports.org/pipermail/scheme-reports/2013-October/003802.html)
Even though it's inconvenient, however, R7RS at least provides a way to write portable library which R6RS doesn't. For this perspective, it's not so bad (well, still I don't understand why it dropped 'import' and asking to go non-standard way even if it would be de-facto. If they think it's an oversight then they should put it on errata).

2013-10-24

Port position for transcoded port

I'm planing to support port-position and set-port-position! for transcoded textual ports and checked some major R6RS implementation how they act. The result was rather interesting.

First of all, I write the implementations I checked and its result. (I don't put Sagittarius because it's obviously not supporting it yet :-P)

Petite Chez 8.4
#t
#t
3
�
Larceny 0.9.7
#t
#t
1

Error: no handler for exception #<record &compound-condition>
Compound condition has these components:
#<record &assertion>
#<record &who>
    who : set-port-position!
#<record &message>
    message : "position not obtained from port-position"
#<record &irritants>
    irritants : (#<INPUT PORT test.txt> 2)

Terminating program execution.
Mosh 0.2.7
#f
#f
Ypsilon 0.9.6-update3
#t
#t
3
�
Racket 5.2.1
#t
#t
3
�
The test code;
(import (rnrs))

(call-with-input-file "test.txt"
  (lambda (p)
    (display (port-has-port-position? p)) (newline)
    (display (port-has-set-port-position!? p)) (newline)
    (when (port-has-port-position? p)
      (get-char p)
      (display (port-position p)) (newline)
      (set-port-position! p 2)
      (display (get-char p)) (newline))))
#|
test.txt (UTF-8)
あいうえおかきくけこ
|#
Mosh doesn't support the port-position so test was skipped.Except Larceny, the other implementations simply set the position of underlying binary port. So it returned the invalid character. On the other hand, Larceny is checking the position of textual port and if it mismatches then raises an error. (although, if I change the setting position to 0, then it reads an invalid character, so seems not really working.)

I'm not sure which is the expected behaviour but at least the way Chez, Ypsilon and Racket are doing is easy enough to implement.

2013-10-23

DBM用インターフェース

こんな意見をいただいた。


GDBMは外部ライブラリが必要なのでWindows対応しづらいという点から直接のサポートは別の方法を取るとして、とりあえずインターフェースを作った。APIはGauche互換(というかほぼ流用)で、こんな感じで使える。
(import (rnrs) (dbm) (clos user))

(define-constant +dumb-db-file+ "dumb.db")

(define dumb-class (dbm-type->class 'dumb))

(let ((dumb-dbm (dbm-open dumb-class :path +dumb-db-file+
                          :key-convert #t :value-convert #t)))
  (dbm-put! dumb-dbm 'key1 #t)
  (dbm-get dumb-dbm 'key1)
  (dbm-close dumb-dbm))
Sagittarius本体でサポートするのはPythonのdbm.dumbに影響を受けた(dbm dumb)。ひょっとしたらGaucheのfsdbmみたいなのも入れるかもしれないが、当面は予定がない(訳:自分が使わない)

どうでもいい情報としては、DBMが開いてるかとかのチェックをCLOSの:beforeでやってること辺りか。わざわざcall-next-method呼ばなくてもいいので便利である。

2013-10-18

Enbug

Even though 0.4.10 has just been released today I found a critical (caused SEGV) bug.... ;-(

The code is like this;
(import (rnrs))
(define save #f)
(let* ([p (make-custom-binary-input/output-port
    "custom in"
    (lambda (bv start end)
      (bytevector-u8-set! bv start 7)
      (set! save bv)
      1)
    (lambda (bv start end)
      1)
    #f #f #f)])
  (put-u8 p 10)
  (flush-output-port p)
  (get-u8 p)
  (close-port p))
(print "SEGV!!")
(print save)
I've never seen such use case however SEGV is worse than unexpected result (it is unexpected but you know...).  I know exactly why this happens and how to resolve this. The reason why I'm writing this is making this for my admonition.

The reason why this happens is because it's using stack allocated bytevector for *invalid* performance optimisation. I was so eager to make Sagittarius uses less memory so did this. However once C code calls Scheme code then there are always possibilities that the passed value would be saved out side of the scope. This is the typical case.

I just need to say this to myself, DON'T BE LESS CONSIDERED!!!

Sagittarius Scheme 0.4.10 リリース

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

修正された不具合
  •  set-port-position!がファイルポートに対して正しく動作しない不具合が修正されました
  • (- 0 )が常に負の整数を返す不具合が修正されました
  • (least-fixnum)が返す値をリーダーが巨大数読む不具合が修正されました
  • -8388609が8388607として読まれる不具合が修正されました
  • bitwise-xorに負数を与えると不正な結果を返す不具合が修正されました
  • (bitwise-arithmetic-shift 0 65)が巨大数の0を返す不具合が修正されました
  • bitwise-arithmetic-shift-rightに64ビット環境で巨大な32ビットに収まらない値を渡した際に不正な値を返す不具合が修正されました
  • fxdiv0-and-mod0が特定の値に対して不正な値を返す不具合が修正されました
  • fxbit-set?がR6RSの正誤表にある動作をするように修正されました
  • open-inflating-input-portに小さなバッファを指定して展開を行うとエラーが投げられる不具合が修正されました
  • file-executable?がWindows環境でSEGVを起こす不具合が修正されました
  • file-stat-atime、 file-stat-ctime及びfile-stat-mtimeがWindows環境でPOSIX時間のナノ秒を返さない不具合が修正されました
  • copy-directory*がトップディレクトリにあるファイルを正しく処理しない不具合が修正されました
  • url-server&pathが返すパスの先頭に//がつけられている不具合が修正されました
改善点
  • メモリ使用量が少なくなりました
  • ビルドプロセス時のBoehm GC及びlibffi探索に可能であればpkg-configを使用するようになりました
  • RSA鍵の比較が可能になりました
  • RSA鍵のimport-public-key及びimport-private-keyがバイトベクタを受け付けるようになりました
  • parse-pemにユーザがオブジェクトの構築を指定可能にする:builderキーワードが追加されました
  • with-argsマクロにオプショナル変数を指定した際に、リストにない引数が渡されてもエラーを投げずにその変数にパックするようになりました
新たに追加された機能
  • file->bytevectorが(util file)に追加されました
  • ジェネリックな書庫ライブラリ(archive)が追加されました
  • Zipファイルを操作するライブラリ(archive core zip)が追加されました
  • TARファイルを操作するライブラリ(archive core tar)が追加されました
  • GZIPライブラリ(rfc gzip)が追加されました
新たに追加されたドキュメント
  • (getopt)のドキュメントが追加されました

2013-10-11

ジェネリックな書庫ライブラリ

一つ前の投稿のやつだけど、早速作ってみた。どうせ作るような気がしたので、なら早い方がいいだろうというだけの理由。

とりあえずこんな感じで使える。
(import (rnrs)
        (srfi :26)
        (archive))

;; for this example it's tar
(define-constant file "test.tar")
(when (file-exists? file)
  (delete-file file))

;; use tar. for zip then 'zip.
(define type 'tar)

(call-with-output-file file
  (lambda (out)
    (call-with-archive-output type out
      (lambda (zip-out)
        (append-entry! zip-out (create-entry zip-out "test.scm"))
        (append-entry! zip-out (create-entry zip-out "test-lib/bar.scm")))))
  :transcoder #f)
        

(call-with-input-file file
  (lambda (in)
    (call-with-archive-input type in
      (lambda (zip-in)
        (do ((e (next-entry! zip-in) (next-entry! zip-in)))
            ((not e) #t)
          (print (archive-entry-name e))
          (unless (string=? "test.scm" (archive-entry-name e))
            (print (utf8->string 
                    (call-with-bytevector-output-port
                     (cut extract-entry e <>)))))))))
  :transcoder #f)
書庫を作る際は現在のところファイル名を受け付けるが、展開する際はポートに吐き出すようになっている。これは、書庫のフォーマットによって必要な情報が異なるので。実際に使い出して必要そうなら多分キーワード引数で指定するとかするようにするかもしれない。当面要りそうなのは展開部分なので、とりあえずといった感じ。next-entry!が末尾に来た際に#fを返すべきかEOFを返す返すべきかは悩みどころではあるが、#fの方が後々楽じゃないかなぁとは思っている。まぁ、好みだろう。

仕組みはDBIと似ていて、書庫のタイプごとに(archive $type)ライブラリが定義されている。現状ではtarとzipのみ(RARとかLZHとか誰か書いてくれないかなぁ・・・)。後はテストとドキュメントの整備か。 テストとか使用感の関係でひょっとしたら次のバージョンでは明文化しないかもしれないが・・・リリース来週だし・・・

2013-10-10

書庫と圧縮ライブラリ

日本語で書くとちょっとかっこいいw

一つ前の記事で書いたけど、パッケージシステムがあるといいよなぁと思い始めたのでその準備段階として書庫と圧縮展開ライブラリの増強をすることにした。とりあえずzip、tarとgzipを追加。それぞれ、(archive core zip)、(archive core tar)と(rfc gzip)という感じになっている。書庫ライブラリにcoreと付いているのはこの上にジェネリックなインターフェースを構築してやろうかなぁと目論んでいるため。っが、書いてて要らないかもと思っていたりもしているので、実装されるかは目下のところ微妙(多分する)。

とりあえず、以下は簡単な使い方。
まずはtarとgzip
(import (rnrs)
        (srfi :26)
        (archive core tar)
        (rfc gzip))

(define-constant gzip-file "test.tar.gz")
(when (file-exists? gzip-file)
  (delete-file gzip-file))

;; archive and compress
(call-with-output-file gzip-file
  (lambda (out)
    (let ((h (make-gzip-header-from-file gzip-file :comment "comment")))
      (call-with-port (open-gzip-output-port out :header h)
        (lambda (gout)
          (append-file gout "test.scm")
          (append-file gout "dir/test.zip")))))
  :transcoder #f)

;; expand
(call-with-input-file gzip-file
  (lambda (in)
    (call-with-port (open-gzip-input-port in)
      (cut extract-all-files <> :overwrite #t)))
  :transcoder #f)
gzipな出力ポートを開いてそこに追加していくという方式でtar.gzができる。tarはシーケンシャルアクセスなので割りと直感的な操作でかなり楽に行ける。make-gzip-header-from-fileは特に呼ばなくてもよくて、その際はheaderキーワードを削除すればよい。指定しない場合はzlibのウィンドウビット16以上(31を使用)のオプションを利用して空のGZIPヘッダが付くようになる。

tarは現状のところUSTARフォーマットのみをサポートしているので、ファイル名は最大で255バイトまでになる。(prefixフィールドを使用している。コマンドでも展開できるから正しいよね、多分。)

次はzip
(import (rnrs)
        (srfi :26)
        (archive core zip))

(define-constant zip-file "test.zip")
(when (file-exists? zip-file)
  (delete-file zip-file))

;; archive
(call-with-output-file zip-file
  (lambda (out)
    (let ((centrals (map (cut append-file out <>)
                         '("test.scm" "dir/test.zip"))))
      (append-central-directory out centrals)))
  :transcoder #f)

;; expand
(call-with-input-file zip-file
  (cut extract-all-files <> :overwrite #t)
  :transcoder #f)
zipはランダムアクセス可能という特性があるのだが、それを可能にしているのは末尾に付いた情報なので、ファイルを追加するたびに生成される情報を保持して最後に足してやる必要がある。tarとの違いを意識しなくてもいいようにジェネリックなインターフェースを作って操作を統一したいというのがあるので、多分作られる。

 あとRAR辺りを作ったら何でも来いになる感じがある。あぁ、LZHとかもあったな。多分サポートされないけど・・・(^^;

2013-10-06

Archive APIs

I'm thinking to make a package system for Sagittarius. For this, I first need archive APIs such as zip and tar. To make things easy for later, I want interface and implementation separated like DBI.

I'm more like go and getter type so making flexible interface from the beginning is not my strong point. So I've checking the other archive library implementations. So far, I've found Java's ZipInputStream/ZipOutputStream seems fine. So current idea would be like this;

;; Interface
(define-class <archive-entry> ()
  ;; might need more
  ((name)
   (size)
   (type)))
;; might not needed
(define-class <archive-input> ()
   ((port)))

(define-class <archive-output> ()
   ((port)))
;; for input
(define-generic next-entry) ;; get entry
;; this should be default method implementation
;; so that subclass can extend.
(define (read-contents input entry)
  ;; returns bytevector read from port.
  ...)

;; for output
(define-generic add-entry) 
If it's possible then it's better to dispatch port type however right now the only way to make custom port is R6RS way and it's always makes the same class object which can't be used for CLOS method dispatcher.

Right now, I need only expander so first try to implement both tar and zip expander I guess.

2013-09-30

省メモリ計画(スタック編)

自分でも次があるとは予想していなかったw

ふとシャワーを浴びながら気づいたのだが、Sagittariusではほぼ全てのSchemeオブジェクトがヒープに作られる。しかし、多くのオブジェクトは使用後すぐに不必要になりGCを待つことになる。これはパフォーマンス的にはメモリ使用量的にも嬉しくない。

なぜこのような作りになっているかと言えば、単なる手抜きである。しかし、初期化用のC APIを用意してやればいいような気がしてきた。全てのオブジェクトに対して用意するのは手間だが、とりあえず頻繁に使用されるかつ使用後すぐに破棄されるようなものだけに絞ってやればそこそこ成果が出るのではないかと思っている。

では何が上記の条件を満たすようなものなのか?実は既にいくつか候補があって、トランスコーダ、ポート、ハッシュテーブル辺りがとりあえずのやってみると効果がありそうなものとなっている。なぜか?ポートはキャッシュを読み込む際に問答無用で作られるので、たとえば(rnrs)を読み込むと20個以上のオブジェクトが作られることになる。トランスコーダはUTF8からUTF32に変換する際に作られているうえに、この処理はreadで常に起きている。ハッシュテーブルはいたるところで共有オブジェクト等の保持に使われていて、たとえば1つのキャッシュファイルの読み込みに2つ使用されるなどかなり使われている。

とりあえず実装してみて効果があれば順次足していくという方向で行くことにする。

2013-09-28

Why Sagittarius?

While ago, I saw a comment on Reddit which said 'why Sagittarius?'. At that time, I've just thought 'why not?' and 'then why Racket or other implementations?'. Now I still don't have that much reason but at least there should be a good reason to be chosen! So trying to convince people who are looking for a good reason to switch or start trying new Scheme implementation.

N reasons why you should use Sagittarius.

1. Multiplatform
Sagittarius is supported on number of platforms, such as Windows, Cygwin, Linux, QNX, FreeBSD*1 and Mac OS X. A lot of implementations don't have native Windows binary support. So if you need to run Scheme on Windows, then this is one of your choice!

2. Architecture independent FFI support
Sagittarius is using libffi for its FFI so most of platforms can use FFI.

3. MIT license
GPL or LGPL is not suitable for a lot of situation (say Racket is LGPL).

4. Short term release cycle
Currently Sagittarius is being released once a month so if you find a bug, you would get the fixed version next month.

5. Both R6RS and R7RS are supported
As far as I know, Sagittarius is the only implementation which supports both R6RS and R7RS (currently).

6. Reader macro and replaceable reader
If you don't like S-expression but like Scheme or want to use some of libraries written in Scheme (or Sagittarius' builtin libraries), this would be your choice!

You will probably find more reasons once you start using it. So why don't you give it a shot?

*1: Current FreeBSD ports has Boehm GC 7.1 however this version doesn't work on it. 7.2 or later needs to be installed manually.

2013-09-24

省メモリ計画(ポート編)

多分ポート以外にはないと思うけど・・・あってもコーデックくらいかね、次・・・

SagittariusはCで書かれているのだがポート周りはカスタムポートとかの兼ね合いから可能な限り柔軟にしようと思いオブジェクト指向風に書かれている。単に構造体が自身を操作するための関数ポインタを持っているだけだが。

先日ポート位置の不具合を直した際に4つほど関数ポインタを足したのだが、 現状のポートのサイズが不安なことになってきた。現在のHEADでポートのサイズは72バイト(32ビット環境)。単なるオブジェクトとしてはちとデカイ気がする。しかも、これは実装部分を除いた共通インターフェースだけなので、実際には100バイトを超えてくる。(バイナリポートが88バイトと一番でかい・・・)。

これがC++ならクラスが持つメンバー関数のサイズなんて気にしなくてもいいのだが、そこはないものねだりになる。そこで、とりあえず何かいい案はないかなぁと考えたのだが、ポートの構造体に仮想テーブル的なポインタを持たせて実際の操作用関数は静的領域に確保してしまうというのはどうだろうか?問題になるのは関数へのアクセス部分になるが、マクロにするか、関数呼び出しにしてしまうか悩んでいる。マクロにすると仮想テーブルを外に出さないといけないが、関数呼び出しにしてしまうとパフォーマンスが心配になる。

とりあえず書いてみてから悩むことにする。

2013-09-23

パッケージとか

Sagittariusは自分が仕事で使うために書き始めた処理系なのだが、ありがたいことにいろんな方からバグ報告をいただいたりパッチをいただいたりしてきた。宣伝とか名前を広める系の活動が苦手で、数回comp.lang.schemeに投稿したのを除けばほとんど何もしていないし、自分でも「自分が最大のユーザー」であればいいかとか思ってて特に気にしていなかった。

ところがここ数日(本当に2,3日)でArch LinuxのAUR(Arch linux User Repository)に乗ったり、Mac OS XのHomebrewに乗りそうだったりと、4年前(公開したのは2年半前)には想像もしていなかったことが起きた。どちらの環境も持っていないので(Arch Linuxはインストールに挫折した・・・)、その意味でもありがたいことだ。

こうして本格的に自分以外の人の手によって広まっていくのを(広まってない?)目の当たりにしていると、雛が巣立っていくような感覚を覚えて嬉しいような寂しいような感じである。もちろん自分が最大のユーザーであることは多分変わらないだろうし(譲る気もないw)、開発自体を誰かに譲るとかも考えていないのだが・・・

そういえば、開発者MLってないの?って聞かれたのだが、あった方がいいのだろうか?登録者自分だけっていうことになりそうな雰囲気ありまくりだし、作ったことすらないのでどうすればいいのかさえ知らないけどw

2013-09-13

訛り

(元ネタ Island Life - 訛りとか)
本題とは関係ない部分でなんとなく引っかかっていたのがなんとなく分かった気がしたのでつらつらと書いてみることにした。

オランダでは英語はほぼ全ての人にとって第二外国語であるといえる。もちろんイギリス人もいるし、アメリカ人やカナダ人、オーストラリア人だって住んでいるので例外もままある。そうすると、まぁ大抵の人がしゃべる英語は訛っているわけだ。

もちろん個人差はあるし、中にはすごく綺麗(典型的)な英国訛りでしゃべる人もいれば、がちがちのインディアン訛りで何言ってるのか理解するのに苦労するなんて人もいる。(インド人を例にあげたのに特に理由はない。別にスペインでもフランスでもいい。ロマンス系言語訛りはひどく聞きづらいし。)

僕の職場はかなり多国籍で東は日本(俺だよ!)から西はカナダや南米とまぁ多種多用である(最近は中東出身の同僚が増えてきた感もあるが。) 会社自体はそんなに大きくないので、人は少ないのだが、これだけ種類があるとまぁ慣れる。自分の英語の発音がどれほど訛っているのかというのは実に知りようがなくて(だれも指摘しないし)、少なくとも意思疎通は問題なくできるレベルではあると思う。ただ、確実にいえるのは、いい悪いは別にして、昔と思うと発音が大分変わったなぁということ。Tomatoがトメイトからトマートになったとか、そんなレベルではあるが。

本題に絡みそうなところに無理やり戻すと、北米(特にアメリカ)出身の人は特に訛りや別名に対して非寛容であるというのが経験から学んだこと。たとえば、aubergineとかcourgetteはほぼ通じない。ついでに同じwaterでも「ウォータ」では通じない(飛行機内で通じなかった経験あり)。個人的にPGが対象にしているのはおそらく米国内のみの話じゃないかなぁと思ったりはする。あの国ほどに言語に非寛容な国は後フランスぐらいしか知らん。

2013-09-08

SRFI 110

Today the SRFI 110 will be the final state (according to the latest ML topic). So for the celebration, I have supported it on Sagittarius.

Basically I have only added compatible layer to the reference implementation and run some scripts. There is one exception which is not satisfying requirement. That is, again the same as previous curly-infix SRFI, hash-bang directive. I don't have any intention to support these SRFIs in core Sagittarius so it's always uses reader macro or replaceable reader. So to use this SRFI on Sagittarius, it must look like this;
;; #!sweet for compatibility
#!sweet
#!reader=sweet

define factorial(n)
  if {n <= 1}
     1
     {n * factorial{n - 1}}

print(factorial(10))

define a 4

define g(x y)
  {x * y}

let <* x sqrt(a) *>
! g {x + 1} {x - 1}
It might not be a big issue as usual.

The good thing about this SRFI is that it can be used in real world. If you are familiar with Python or Ruby which I don't know much about, this might be a good alternative. So the next step for this would be an Emacs lisp to support this :)

Well, again (the same as SRFI 105) I don't think I use this SRFI but it's always good to have choices for users.

2013-08-28

TLSライブラリのバグ

WebSocketをTLSで使うためにSNIがサポートされてないといけないという話からバグを発見。元々は、wssでアクセスするとフリーズするという話だったのだが、これSNIが問題ではなく単にバグを踏んでいただけだったという話。

問題はTLSのレコードが複数のハンドシェイクメッセージを持つことが可能であることに起因する。現状の実装では1レコード1メッセージを期待していて、複数のメッセージが乗っていた場合2レコード目以降を捨ててしまうというバグである。(単にRFCの読みが甘かったという話でもある。)

これ結構大きめな問題で、設計からやり直しかねぇと思いながら15分くらい考えたらなんとなく隙間を縫っていけそうな解決案が思い浮んだのでメモ。現状レコードで運ばれてきたメッセージはとりあえず一度に全部取得し、その後先頭バイトを見てメッセージの振り分けをしている。ここで、アプリケーションメッセージ以外のメッセージは取得した内容をバイナリポートに変換して扱いやすくしている。

問題になるのは、変換したポートが空になるまで読んでいないことなのだ。1メッセージ読んだ後に1バイト先を見てやりEOFでないならセッションオブジェクトにでも保存しておけば次に読むのはメッセージであるということが分かるのでソケットにアクセスしにいって無限に待つということもなくなるのではないか、という案。レコードを読む部分の処理とセッションオブジェクトの変更のみで残りの部分は特に問題なくいける気がする。

とりあえず、明日試してみることにする。 しかし、原因を追究するためにRFCを読み直したり、パケットログを取ったりといろいろやったが、ほぼ空回りというのが自分らしいというか・・・

2013-08-27

SchemeでJSON-RPC

SchemeでRAM over Httpだとさすがに誰得すぎるというのがあったので、まだ需要がありそうなJSON-RPCにw (どちらも仕事で使っているという点は一緒)

最近自社プロダクトでJSON-RPCを使っている外部インターフェースがあることに気づいた。ついでにその機能をテストする必要も出てきて、毎回SoapUIで作られたテスト用のスクリプトを数個走らせるのはたるいので、えいやっと作った。最新のHEADに入ってる。

JSON-RPC自体は仕様がネットで公開されているので、それを参照してもらうとして、実際にSagittarius上で使うと以下のような感じになる。
(import (rpc json) (rpc transport http))

(define request (make-json-request 'someMethod :params #((p1 . 1) (p2 . 2)))

(let-values (((status header response)
       (rpc-http-request "http://somewhere.com/jsonrpc-service" request)))
  (json-response-result response))
たったこれだけ!

JSON-RPC自体は非常に簡単な仕様なので、JSONを読み書きできるライブラリがあれば実装可能。 HTTPはSRFI-106で頑張ればいけるので、その気になればそこそこポータブルな実装でもいけるかもしれない(やる気はない)。

実装した際に一応気にしたのは、トランスポートとメッセージは可能な限り分離するということ。これは(今のところ予定はないが)他のRPC(Message PackとかXML-RPCとか)をサポートする際に自分が楽をしたいため。ただ、現状どちらの実装も一個しかないので上手いこと分離できてるかは多少不安。ついでに、JSONの読み書きに使っているChicken Schemeからの移植JSONライブラリはベクタをマップとして扱うので多少使い勝手が悪い部分もある(主にレスポンスデータの探索等)。まぁmatchが使えたり、メモリ気にしなくていいなら手間がかかる程度ではあるが・・・

実際のコードは実に合計で500行以下くらいなので、こういうのがサクッと作れる位には下地になるライブラリが揃っているということになる。多分に偏りがあるというか、一転集中型で揃っているだけだが・・・

2013-08-23

Sagittarius 0.4.8 リリース

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

修正された不具合
  • bytevector-u8-set!が負のインデックスを受付けかつデータを破壊する不具合が修正されました
  • マクロ展開でlambdaが未束縛エラーになる不具合が修正されました
  • cond-expandがネストした条件を処理できない不具合が修正されました
  • bitwise-ior、bitwise-xor及びbitwise-andが0引数を受け付けない不具合が修正されました
  • write-emv-tlvが長さバイトを正しくエンコードしない不具合が修正されました
改善点
  • bitwise-ior、bitwise-xor、bitwise-and、fxior、fxxor及びfxandのパフォーマンスが改善されました
新たに追加された機能
  • bytevector-split-at*及びbytevector-splicesが(util bytevector)に追加されました
  • SRFI-106がサポートされました
  • CMACライブラリ(rfc cmac)が追加されました
  • c-variableマクロが(sagittarius ffi)に追加されました
  • QNX (BlackBerry 10)環境でのビルドがサポートされました(x86のみ)
  • socket-sendto及びsocket-recvfromが(sagittarius socket)に追加されました
非互換な変更
  • let-syntax及びletrec-syntaxの既定の振る舞いがR6RSのものになりました。R5RS/R7RSの振る舞いにするには#!r7rsをつける必要があります。

2013-08-17

速度改善

Pure SchemeでCRC32のベンチマークを取った方がいて、ありがたいことにSagittariusも結果に入っていた。


問題は結果のほうである。後ろから数えた方が早い位置にいる。Sagittariusは最速を目指しているわけではないのだが、(明示してないけど)高速であることも売りにしている。幸いにもソースは公開されていらしたのでプロファイルを取って速度改善に望むことにした。

Fixnumは30ビット幅しかないので(32ビット環境)CRCテーブルの要素ほぼ全てはBignumになると思っていい。これは避けようがないので放置。ざっとソースを見ると(当たり前だが)ビット演算が多用されているので実装を眺める。Fixnum-Bignumの組み合わせの場合にFixnumをBignumに変換してBignum同士で演算するようにしていたので、とりあえずこいつのメモリ割り当てをやめるようにする(ちょこっと改善された)。

次にプロファイルを取る。するとbitwise-xorやたら遅い。実装もまぁ、そりゃ遅いわという感じだったので、ゴリゴリ書き直し。(15%くらい改善)。次いで気になったのでbytevector-u8-refがやたらサンプリングされていた。こんなの単なる配列アクセスだからどれだけ呼ばれてもそんなにあるわけ無いだろうと思ったら実装があほなことをしていたので直す(微々たる改善)。

とりあえず、この段階で既存のものと比較してみた。結果は以下。
$ sash crc.scm

;;  (crc32 data)
;;  121.992214 real    124.3640 user    6.130000 sys

$ ./build/sash.exe crc.scm

;;  (crc32 data)
;;  100.720778 real    101.5090 user    3.6040000915527344 sys
うむむ、まだ遅い。bitwise-xorが処理時間の半分を占めているのでそこの改善がほぼダイレクトに効くのだが、どうやら効かせ方が足りないらしい。

2013-08-01

Boehm GCとQNXとBB10と

いろいろ動くようになってきたので多少のメモを含めて。

BB10(Blackberry 10)上でSagittariusを動かせないだろうかというのはそれこそ発売当初くらいから考えていたりする(2月か?)。BB10はQNXをベース(というかOSはQNX)にしたデバイスなのでPOSIX準拠(なはず)。POSIXをサポートしてるんだし、いけるだろう程度にしか考えてなかったのだが、Boehm GCが鬼門であった。

Twitterでも呟いたのだが、Boehm GCの環境依存コードはよく言えば歴史を感じさせる継ぎ足しっぷり、悪く言えば全くもって嫌気がするレベルのコードである。QNX自体は結構歴史あるUNIX系OS(らしい)ので当然サポートされてるだろうなぁ、なんてあまっちょろいことを考えていたのだが、世の中そううまくいくわけはなかった。がっつりパッチを書きました。幸いだったのは、FreeBSD依存のコードとか、OpenBSD依存のコードが結構流用できたので最低限サポートしなければならない部分だけ書けばよかった点かな。最新のHEADはQNX用のBoehm GCのパッチが入ってたりする。できに自身はないので、本家に取り込んでもらおうということは考えていない。

元々はSagittariusのC APIを使って実装しようと思ったんだけど、RIMが提供するIDEでの設定が分からなかったのでbarファイルにsashごと全部放り込んでリモートREPLを立ち上げるというかなり強引な手を使って実現してたりする。ソケット通信なのでセキュリティ等々をもう少し考えないとまずいのだが(俺々証明書作ってTLSで通信するか?)、まぁそれはもう少し後にする。GUIのデザインは正直苦手なのと今一Widgetの融通が利かないのとで多少異常に満足のいかないものになっているのも愛嬌だろう・・・

とりあえず、実装詳細的なもの。
  • sashプロセスが立ち上がってもREPLサーバは立ち上がっていない
    • 回避するためにサーバが立ち上がったらマークファイル作るようにした
  • (exit)を実行するとプロセスごと死ぬ問題
    • 死んだことを検地して再起動を促すように
  • Qt側のソケットとプロセスの状態をQtのシグナル/スロットで監視
    • これ、便利なんだけど、スロット内で他のシグナルを起動するようなことすると意味不明のバグになる
      • 既に悩んだ
      • しかも、どれがシグナルを送るのか今一わからなかったりするしw
ふと思ったのだが、この手法(リモートREPL)で行けば他のモバイルで動かすのも簡単にいけるのではないかと妄想。

以下はTODO
  • 起動ポートを設定可能にしたい
    • 既に準備はしてある
  • 実行履歴があると便利だと思う
    • 外部に出す?
  • 実機で動かしてみたい
  • Blackberry Worldに登録
仕事で山ほどBB7(一つ前のモデル郡の総称)の実機を使ってるのに、BB10の実機はない現実。ここではまだ売ってないので買うという選択肢もないという(まだ北米だけか?もう欧州でも売ってる?買うつもりはないんだけどw)。ストレステストみたいなことはしてないので、Boehm GCがまともに動いてるのかは微妙なんだけど(多分動いてると思う)、気になってるのはシミュレータと実機ではCPUが違うこと。実機はARMなんだよね。CPU依存の部分は特に変更なかったと思うから大丈夫だとは思うけど・・・


ということで、だれかBB10ください(違

2013-07-29

Porting to BB10

A lot of Scheme implementations are ported to mobile device such as Gambit (iPhone), Mosh(Android), Gauche(iPhone, developing state though). Well, I'm feeling like it's time for me to ride the wave! Unfortunately, I have no developing environment neither iPhone nor Android but Blackberry. So I've so far decided to do with BB10 environment.

First of all, I needed to build Sagittarius on BB10 environment. This wasn't so difficult actually, I just needed to provide proper CMake tool chain configuration and some patches for Boehm GC (which only makes compiler satisfied currently though).

After that, I was trying to use Sagittarius as a library so that the application only needs to do eval and outputs the result. However this wasn't easy for me to handle standard I/Os. On BB10 environment, as far as I know, it is impossible to redirect keyboard input and standard output to GUI panels. So I thought I needed to create custom port to handle these things but I was too lazy to do it. So I've decided to use remote REPL which is already in library.

The basic idea I'm trying to do is really simple. Put all Sagittarius component into bar (Blackbarry ARchive, I guess) file and run the remote REPL as a child process. So what I need to implement is only send user input and receive the result. Then I'm facing a problem that for some reason sash is not executable. So I wrapped with shell which add permission of execution then run it. Now I've got core dump.

What am I missing?

2013-07-18

Why I think macro is necessary for programming language!

DRUNKEN ARTICLE CAUTION: the article might not make any sense!

Macro, that is the last resort for all programmers. Macro, it's a sweet temptation. Macro...

Well, if you are familiar with macros and doing job with Java (or any other languages don't have macro), you must be really frustrated like me. I was thinking why I've got so irritated without macros and got a conclusion.

I assume all programmers want to write clean, fast and maintainable code without any inconsistency. Suppose you are a Java programmer and need to write really similar code multiple times and all of the classes are not the same region. In this case, I would create an abstract class or utility class to put all common process in. However I think it's ugly because the abstract class is not the behaviour of the derived class and utility class is not object oriented. Then what is the cleanest and consist way to resolve it? Copy&Paste? I have yet no solution.

If I'm using C++ then I could use template for that situation. It allow me to write common process without creating super class and inject dependency. If I can use Lisp for this situation, this is, I think, the best situation to use macro to avoid code duplication or writing ugly code.

What makes macro so powerful? Well, after writing this I felt I'm so stupid to write such obvious question. If you have written any code, then you must know how powerful modifying source code before it's compiled is. You can feel you became a god or so (not really). So far, I only know the language which allows you to do such free things is only Lisp. It has macro, read macro, reflection, aspect oriented and so on. (Well, even though I listed some other stuff but I'll focus on only macro.) Which other language can make own *syntax* within its language specification?

I know it has also some crappy things like it doesn't allow me to do much things within the specification (Scheme), not so portable between implementations (CL, Scheme) and all. And I think each language needed to decide not to have all *nice to have* features. So everything is trade off but if that's so, I would rather go more comfortable one and to me comfortable means freedom. More precisely, the language which can extend itself if I needed.

Yes, as I expect there is no conclusion nor sense in this article. Don't write something in drunk.

2013-07-16

引数の上限

引数の上限を超えるとどうなるだろうと以下の記事を読んで気になった。
Chibi schemeの多値は単に多値オブジェクトで、call-with-values等で明示的に受け取らないと悲しいことになる。もっともChibi schemeのような実装にも、多値の長さに制限がないというメリットがある。nmoshは多値の長さ(= 事実上手続き引数の個数制限)が100程度に制限されている。現状のSchemeではこの制限をクエリする良い方法が無い。

引数個数制限はご無体な気もするが、Cの呼び出し規約のように関数呼び出しをスタック経由で行う規約は基本的にヒープサイズ制限よりもスタック長制限が先に来る。常識的に考えて固定arityの引数が100を越えることは無いので、可変arityの手続きの呼び出し規約をスタック渡しとオブジェクト渡しに分けるのは効果的かもしれない。
[scheme][nmosh] Unspecifiedの数とarity - .mjtの日記復帰計画
まぁスタックサイズに限界はあるわけだし、SEGVのが普通かなぁと思いつつ、以下のスクリプトを用意。
(import (rnrs) (only (srfi :1) iota))

(define-syntax apply-100000-values
  (lambda (x)
    (syntax-case x ()
      ((k)
       (with-syntax (((v ...) (datum->syntax #'k (iota 100000))))
         #'(list v ...))))))

(apply-100000-values)
(display 'ok) (newline)
以下はGauche用
(define-macro (apply-100000-values)
  `(list ,@(iota 100000)))
(apply-100000-values)
(apply-100000-values)
(print 'ok)
でっ、結果。(Chezはiotaを自前実装した。Chibiは低レベルマクロの使い方が分からないので割愛。)

Chez - ok
Gauche - SEGV
Mosh - ok
Sagittarius - 返ってこない(マクロの展開が終わらなかった)
Ypsilon - ok

意外だなぁと思ったのはMoshで、以前valuesに10000以上の個数をapplyするとSEGVるというバグを報告している経験からこけるものだと思っていた。(スタックを壊してる可能性があるので、他の操作をしたら予期しない場所でこける可能性はあるが。)

Chez及びYpsilonはどうして動いているのかは分からない。

2013-07-14

Why does this call/cc go into infinite loop?

I've found interesting call/cc stuff in Chaton's Gauche room (this)

The code is this one;
(let ((x 0) (cc '())) 
  (set! x (+ x (call/cc (lambda (c) (set! cc c) (c 1)))))
  (if (< x 4) (cc 2) x))
As far as I investigate, Chez, Chicken, Mosh, Sagittarius and Ypsilon went infinite loop. Chibi and Gauche returned 5. Well I'm not a guy from continuation world so I can't say which is correct. However if the call/cc is located to left hand side, then it won't be infinite loop.
;; This returns 5
(let ((x 0) (cc '())) 
  (set! x (+ (call/cc (lambda (c) (set! cc c) (c 1))) x))
  (if (< x 4) (cc 2) x))
It seems the order of evaluation so I can probably get the answer.

I don't know about other implementations but Sagittarius so following guess is based on its call/cc implementation.

On Sagittarius, continuation is stack and it contains return address. So call/cc captures arguments and return address. Following is the image;
#first one
before call/cc
 +----------+
 |   cont   |
 +----------+ <- captured
 |   pc(+)  |
 +----------+
 |    x=1   | *1
 +----------+
 | pc(set!) |
 +----------+

#second one
before call/cc           after call/cc
 +----------+             +----------+
 |   cont   |             |    x     |   
 +----------+ <- captured +----------+
 |   pc(+)  |             |   c(1)   |
 +----------+             +----------+
 | pc(set!) |             |   pc(+)  |
 +----------+             +----------+
                          | pc(set!) |
                          +----------+

NOTE: pc is return address, cont is call/cc's argument. 
      Stack is growing upwards.
Well it's already obvious but I will describe just in case.The point is *1. The first one, the x is not a box means it's mere value (in this case 1). Then call/cc will capture the stack with the value. So the second call of (cc 2) will always be addition of 1 and 2. Thus it will never be greater than 4. On the other hand, the second case, stack doesn't have x yet so that VM will always compute what is inside of the box (x). Then (cc 2) will always compute the value of x and 2.

I think implementations caused infinite loop are using the similar method to implement call/cc as Sagittarius and Chibi and Gauche use something different. And again, I'm not the those guys from continuation world, so can't say which is correct or not but as my understanding both can be correct and this case is sort of edge case of call/cc.

2013-07-08

Bignumの速度改善(調査編)

SBCLがGMPを使うようになったらしく、こんなツイートをもらった。

期待されているなぁ・・・相手GMPだけど・・・

期待されると応えようともがく性分なので、とりあえず現状でどれくらいGMPと差があるのか適当にテストしてみることにした。GMPと言えばMoshが使っているのでここと比較。なぜか?機械語吐き出すSBCLと戦う前に同じバイトコードなScheme処理系のMoshを倒さないとオーバーヘッドの部分で確実に負けることが確定しているから。

テストコードは以下(ここのPython用のをSchemeに移植):
(import (rnrs) (time))

(define (factorial n stop)
  (let loop ((n n) (o 1))
    (if (> n stop)
        (loop (- n 1) (* o n))
        o)))

(define (choose n k)
  (/ (factorial n k) (factorial (- n k) 0)))

(time (choose 50000 50))
#|
;; Mosh用timeライブラリ
;; time.scm
(library (time) (export time) (import (mosh)))
|#
以下が結果。
% time sash test.scm

;;  (choose 50000 50)
;;  6.536399841308594 real    11.13800 user    1.669000 sys
sash test.scm  11.17s user 1.76s system 194% cpu 6.661 total

% time mosh --loadpath=. test.scm

;;1.4351999759674072 real 1.264 user 0.172 sys
mosh --loadpath=. test.scm  1.28s user 0.20s system 99% cpu 1.482 total
まぁ、分かってはいたのだがここまで差があるのか・・・
SagittariusはBoehmGCがGC用スレッドを持ってるからRealとUser時間が倍違うのか?とりあえずReal時間だけ気にすることにする。

このベンチだと単純に乗算だけなんだけど、とりあえずそこからか・・・先は長そうである・・・

2013-07-05

Loop macro for Scheme

The inspiration came from this article's comment: 10.times - Island Life

I'm not a CL user but I sometimes think CL's loop macro is really convenient if I want to write something really small. (I don't think I want to write big stuff with it. It's too complicated to me.) So why don't I write something looks like it?

Here is that something. It doesn't cover whole loop macro but some.
#!r6rs
(import (except (rnrs) for-each map) (only (srfi :1) iota for-each map))

(define-syntax %loop
  (syntax-rules (:for :in :do :repeat :collect)
    ((_ (vars ...) (body ...) op :for var :in l rest ...)
     (%loop ((var l) vars ...) (body ...) op rest ...))
    ((_ (vars ...) (body ...) op :repeat n rest ...)
     (%loop ((tmp (iota n)) vars ...) (body ...) op rest ...))
    ((_ (vars ...) (body ...) op :do expr rest ...)
     (%loop (vars ...) (expr body ...) for-each rest ...))
    ((_ (vars ...) (body ...) op :collect expr rest ...)
     (%loop (vars ...) (expr body ...) map rest ...))
    ;; last
    ;; do trivial case first
    ((_ () (body ...) op)
     ;; infinite loop
     (do () (#f) body ...))
    ((_ ((var init) ...) (body ...) op)
     (op (lambda (var ...) body ...) init ...))))

(define-syntax loop
  (syntax-rules ()
    ((_ clause ...)
     (%loop () () #f clause ...))))

#|
(loop :for i :in '(1 2 3 10) 
      :for j :in '(4 5 6)
      :do (begin (display i) (display j) (newline)))

(loop :repeat 10 :do (begin (display 'ok) (newline)))

(display
 (loop :for i :in '(1 2 3 10) 
       :for j :in '(4 5 6)
       :collect (+ i j))) (newline)
;; (loop :do (begin (display 'ok) (newline)))
|#
I'm not sure if this is useful or not and I don't want to go deep inside of the crucial loop macro specification either, though :-)

NOTE: I've tested above code Racket (plt-r6rs), Mosh, Ypsilon and Sagittarius but Ypsilon raises an exception when the given list length are not the same.

2013-06-26

TLSとFTPと

FTPライブラリを書いてたらTLSにバグが混入しているのを発見。しかも、0.4.4から紛れ込んでいたものだったという切ないものだった。まぁ、TLS周りはテストを書いていないので発見しようが無かったという話ではあるのだが、あんまり使わないんだなぁ自分でも・・・テスト大事だよ!(どうテスト書こう、テスト用にサードパーティの何かを入れるのは嫌だが、セキュリティ周りのテストを自家製だけで書くのはまずいし、さてさて・・・)

まぁ、原因はSRFI-6の挙動をポートから取り出してもポートを空にしないように直した際のバグなのだが、何しろ3ヶ月前のこととあまり直接的な原因ではないこともあいまって最初はどこが悪いのかさっぱり分からんかったりした。っで、どう見つけたか?もうね、ローラー作戦ですよ。0.4.3までソースを巻き戻してどこで起きるかというのを一個ずつ潰していくという何とも地味な作戦。0.4.3から0.4.4の間ではBignumのパフォーマンス改善してたのでそこかなと当たりをつけてたらまんまと外れたという、思い込みもよくないという話。

原因が分かれば直すのは簡単で、さくっと直してFTPの実装を再開。データコネクション周りが実は面倒だということが発覚して、どうしようというのが現在直面している課題。

問題になるのはアクティブモードなのだが、クライアント側がサーバソケットを作ってFTPサーバからの接続を待つ必要があるのだが、現状のソケットライブラリでサーバソケットを作るとgetsocketnameで取れるアドレスがループバックアドレス(0.0.0.0)になってしまう。じゃあと思ってAI_PASSIVEを外してやると今度は127.0.0.1が取れるのだが、これって他のサーバとやり取りできないよなぁという感じでごにょごにょしている。(どうでもいいのだが、socket-nameというAPIがあるんだけど、こいつが非常に紛らわしくなっているので変更してやろうと思っていたりする。) 普通にNICに割り付けられたIPアドレスを取る方法ってないのだろうか?

どうでもいいのだが、職場のFTPはFTPSは受け付けていないという事実が分かって驚愕している・・・SFTPじゃないとだめなのかよ・・・orz

2013-06-23

ほしいライブラリ

ちょっと開発意欲が低下気味な6月、ほしいものはあるんだけどモチベーションが高まらないというなんともだめな感じである。

とりあえず、何がほしいかをメモっておいて後で頑張ろうという先送り作戦を展開してみんとす。といっても、今のところは2つしかないんだけどね。

【Lexer】
CのヘッダをパースしてFFIのバインディングを吐き出すような何かを作ろうとしているんだけど、Packratという強力なパーサジェネレータはあるくせにLexerは毎回手書きという切ない状態にある。 ということで、Packratで使えるLexerを生成する何かしらがほしい。妄想的に以下のように書けると嬉しいかもしれない。
(define generator
  (lexer
    (D #("0-9"))    ;; vector indicates a charset?
    (L #("a-zA-Z_"))
    ...
    ("/*" comment)  ;; here comment is a procedure takes one argument which is a port?
    ("auto" 'AUTO)  ;; returns token kind?
    ...
    ((/ "[" "<:") '#\[)
    ...))
細かいことは全然考えてないのだけど、とりあえずこんな感じでルールを書いたら適当にLexerを作ってくれる何かしらな感じ。RacketにLexerジェネレータなライブラリがあるから参考にしようかと考えている。(Pure Schemeな実装があったら是非教えてほしいなぁ)

【FTP】
仕事でちょいちょいFTPでwarを上げてJBossにデプロイなんてことがあるんだけど、現状でMavenをSchemeで叩いているのだから出来上がったwarもSchemeで上げてしまえたら一手間減るよなぁと考えている。FTPなんて実装はどこにでもあるわけだし移植するだけなんだけど割りと億劫になっているのと、APIをどうしようとか、TLSなソケットも使えるようにしてFTPSもサポートしないと使い物にならんとか考えていて手が動いていない状態。まぁ、なんとなく構想ができてきている段階ではあるので、テスト用の環境をでっち上げて作るだけではあるのだが・・・

個人的にはIMAPとかあるとiPhoneで音が鳴ったら適当にシェルからメールがチェックできたりして便利かもとか考えていたりはする。まぁ、これは必要に迫られていないので妄想すらないが・・・

2013-06-14

Sagittarius 0.4.6リリース

Sagittarius Scheme 0.4.6がリリースされました。今回のリリースはメンテナンスリリースです。ダウンロード

修正された不具合
  •  parameterize内でcall/ccを使うとパラメタの値が正しく復帰しない不具合が修正されました
  • パラメタの束縛を変更しても変更が反映されない不具合が修正されました
  • define-libraryで(scheme base)をインポートしないとcond-expandが使えない不具合が修正されました
  • define-classが他のライブラリに依存している不具合が修正されました
  • #x800000がマイナスの値を返す不具合が修正されました
  • (sagittarius mop validator)のobservevrがエラーを投げる不具合が修正されました
  • 組込み総称関数がSEGVを起こす不具合が修正されました
  • current-jiffyが正確な整数を返さない不具合が修正されました
  • ((and and))がREPL上でSEGVを起こす不具合が修正されました
  • datum->syntaxが正しく構文オブジェクトを作成しない不具合が修正されました
  • importがexcept句を無視する不具合が修正されました
  • 組込み総称関数が:primary以外のqualifierを持てない不具合が修正されました
  • list-sortが第一引数をチェックしない不具合が修正されました
  • make-bytevectorの第一引数にマイナスの値を渡すとSEGVを起こす不具合が修正されました
  • (clos user)をprefixインポートした際にunbound variable例外が投げられる不具合が修正されました
改善点
  • define-c-structが局所的に扱えるようになりました
  • FFIがwchar_t*を扱えるようになりました
  • c-functionが可変長引数を扱えるようになりました
  • MOPがより柔軟になりました
  • コンパイラが使用されていないインストラクションを生成しないようになりました
新たに追加された機能
  • object->pointer及びpointer->objectが(sagittarius ffi)に追加されました

2013-06-10

CLライクな未定義シンボルハンドリング

正直あってもあまり使いどころは無いのだが、面白いことに使えるかなと思い実装してみた。

仕組みはいたって簡単で、総称関数unbound-variableを追加して、VMが未定義シンボルを検出したらそれを呼び出すだけ。デフォルトでは普通に&undefinedを投げるんだけど、たとえばこんなメソッドを追加してやるとCLっぽく動くようになる。

(import (rnrs)
        (sagittarius debug)
        (sagittarius vm)
        (clos user))

(define-method unbound-variable ((name <symbol>) lib)
  (format (current-error-port) "**** unbound variable ~s~%" name)
  (format (current-error-port)
          "use-value   :r1 Input a value to be used instead of ~s~%" name)
  (format (current-error-port)
          "store-value :r2 Input a new value for ~s~%" name)
  (format (current-error-port)
          "abort       :r3 Abort (raise unbound variable error)~%")
  (let loop ()
    (format (current-error-port) "break >")
    (case (read)
      ((:r1) 
       (format (current-error-port) "Use instead of ~a:" name)
       (read))
      ((:r2)
       (format (current-error-port) "New ~a:" name)
       (let ((e (read)))
         (%insert-binding lib name e)
         e))
      ((:r3) (call-next-method))
      (else (newline (current-error-port)) (loop)))))

(print test)
(print test)
(print test)
正直、これがうれしいかといわれると、微妙なところではあるが。使いどころは無いんだけど、REPL上でデバッグするときに便利だろうか?(ただ、あんまり何も考えてないので、この中で例外投げたらどうなるとか全く気にしてなかったりする・・・HEADにあるけど消すかも・・・)