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

明日使える総称関数(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紹介部分が予定したよりかなり長くなってしまったので分割しました。

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がある。

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

以下は適当な情報
ソースはsitelib/rfc/sshディレクトリ以下。あまりの汚さに精神汚染を起こしても当方は責任を取らない(多分未来の自分に対する警告・・・)。これを実装するために以下の機能及びライブラリが追加された。

• (binary data)ライブラリ(自分で言うのもなんだけど、すごく便利ｗ)
• DSA鍵署名及び検証

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

マクロバグリターンズ

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

問題となるのは以下のようなコード。

(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が意味的に違うってのを構文の情報なしにどう知ればいいんだ？

セルフホスティング

現状でも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インストラクションで構成されるが、吐き出すインストラクションはターゲットが必要とするものになるといった寸法である。多少回りくどいなぁとは思うが、仕組み上回避不可っぽいので諦めるしかないだろう。

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

コンパイラマクロ

実は材料は最初からあったんだけど、気が向かなかったのと必要に迫られるほどタイトな性能を要求してなかったので放置してたものの一つ。っが、気が向いたのでえいや！っと作ることにした。まぁ、気が向いた理由は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の方が設計が難しい気がしないでもない・・・

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

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.

DBM用インターフェース

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

個人的には Sagittarius に欲しいライブラリは gdbm とかかな。 リレーショナルデータベースはちょっとしたスクリプトには豪華すぎる。 sqlite があるから気軽な用途にも使えるんだろうけど私は SQL とかようわからんし。
— (32) 齊藤敦志 (@SaitoAtsushi) October 18, 2013

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呼ばなくてもいいので便利である。

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)のドキュメントが追加されました

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

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

とりあえずこんな感じで使える。

(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とか誰か書いてくれないかなぁ・・・)。後はテストとドキュメントの整備か。 テストとか使用感の関係でひょっとしたら次のバージョンでは明文化しないかもしれないが・・・リリース来週だし・・・

書庫と圧縮ライブラリ

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

一つ前の記事で書いたけど、パッケージシステムがあるといいよなぁと思い始めたのでその準備段階として書庫と圧縮展開ライブラリの増強をすることにした。とりあえず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とかもあったな。多分サポートされないけど・・・(^^;

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.

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

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

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

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

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

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

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.

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

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

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

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

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

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

パッケージとか

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

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

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

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

訛り

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

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

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

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

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

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.

TLSライブラリのバグ

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

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

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

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

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

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行以下くらいなので、こういうのがサクッと作れる位には下地になるライブラリが揃っているということになる。多分に偏りがあるというか、一転集中型で揃っているだけだが・・・

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をつける必要があります。

速度改善

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

Scheme で CRC 計算の件について、いくつかの処理系で動かして時間を計ってみた。 表の数値は 200MB のデータを対象にしたときにかかった時間。 CRC32 改は値を 16bit ずつに分けて計算するバージョン。 pic.twitter.com/COhgUkOYWv
— (32) 齊藤敦志 (@SaitoAtsushi) August 16, 2013

問題は結果のほうである。後ろから数えた方が早い位置にいる。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が処理時間の半分を占めているのでそこの改善がほぼダイレクトに効くのだが、どうやら効かせ方が足りないらしい。

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のシグナル/スロットで監視
• これ、便利なんだけど、スロット内で他のシグナルを起動するようなことすると意味不明のバグになる
• 既に悩んだ
• しかも、どれがシグナルを送るのか今一わからなかったりするしｗ

ふと思ったのだが、この手法(リモートREPL)で行けば他のモバイルで動かすのも簡単にいけるのではないかと妄想。

以下はTODO

• 起動ポートを設定可能にしたい
• 既に準備はしてある
• 実行履歴があると便利だと思う
• 外部に出す？
• 実機で動かしてみたい
• Blackberry Worldに登録

仕事で山ほどBB7(一つ前のモデル郡の総称)の実機を使ってるのに、BB10の実機はない現実。ここではまだ売ってないので買うという選択肢もないという(まだ北米だけか？もう欧州でも売ってる？買うつもりはないんだけどｗ)。ストレステストみたいなことはしてないので、Boehm GCがまともに動いてるのかは微妙なんだけど(多分動いてると思う)、気になってるのはシミュレータと実機ではCPUが違うこと。実機はARMなんだよね。CPU依存の部分は特に変更なかったと思うから大丈夫だとは思うけど・・・


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

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?

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.

引数の上限

引数の上限を超えるとどうなるだろうと以下の記事を読んで気になった。

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はどうして動いているのかは分からない。

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.

Bignumの速度改善(調査編)

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

これで @tk_riple さんの第二次VS SBCL Bignum戦争開幕？
— llibra (@l_libra) July 5, 2013

期待されているなぁ・・・相手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時間だけ気にすることにする。

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

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.

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

ほしいライブラリ

ちょっと開発意欲が低下気味な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で音が鳴ったら適当にシェルからメールがチェックできたりして便利かもとか考えていたりはする。まぁ、これは必要に迫られていないので妄想すらないが・・・

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)に追加されました

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にあるけど消すかも・・・)

How should include work?

There was a post which asked the behaviour of the include syntax in R7RS. This is the post;

Dybvig's paper about syntax-case, I'm unsure abouttherequirements
of R7RS regarding the use of `include' within macros:

(define-syntax m
   (syntax-rules ()
     ((_) (lambda (a) (include "some/file.sch")))))

where the file "some/file.sch" contains, say,

(+ a 1)

Is the symbol `a' in "some/file.sch" supposed to match the
lambda's argument?

[Scheme-reports] file inclusion (section 4.1.7 of draft 9)

Then R7RS draft 9 says like this;

Both include and include-ci take one or more names expressed as string literals, apply an implementation-specifi c algorithm to find corresponding files, read the contents of the files in the specified order as if by repeated applications of read, and e ffectively replace the include or include-ci expression with a begin expression containing what was read from the files.

So in R7RS include reads from the specified file with read without any syntax information. So, in above case it shouldn't refer the lambda's argument.

Now, John Cowan responded a lot of implementation could see the variable a. Well, yes, this is odd. However I think I know why (only R6RS implementation wise).

Following is the (naive) implementation of the include with R6RS syntax-case

(import (rnrs))
(define-syntax include
  (lambda (x)
    (define (do-include k name)
      (call-with-input-file name
        (lambda (in)
          (do ((e (read in) (read in)) (r '() (cons (datum->syntax k e) r)))
              ((eof-object? e) (reverse r))))))
    (syntax-case x ()
      ((k name)
       (string? (syntax->datum #'name))
       (with-syntax (((expr ...) (do-include #'k (syntax->datum #'name))))
         #'(begin expr ...))))))

The point in R6RS is that syntax-case must always return syntax object so with this implementation, the included expressions wrapped (or converted) by syntax object so that a contains some syntactic information to refer the lambda's argument. (Unfortunately, Sagittarius raises an error with unbound variable. Well, I know it's a bug...)

Then we need to come back to what R7RS says. Yes, it actually doesn't specify but read the file content by read and replace it. Thus, both behaviours can be valid as my understanding.

Now, my big problem is that I need to fix the macro's bug... I thought it could see it but it didn't...

FFIとcallback

最近FFI周りばかり弄っている気がする。取り立てて必要というわけではないのだが、バグが目に付くというか、一貫性の無さが気に入らないというかそんな感じ。

っで、ふとcallbackの実装がメモリ使用量的に嬉しくないことに気づいた。

現状の実装ではcallbackは作られるとSagittariusの静的領域に保存される。これは「呼び出したC関数内でcallback関数が保存された後にGCが走ってcallbackは回収されちゃったけどCから呼び出されちゃった、てへっ♪」って言うのを防ぐためだったりする。FFIで開いた共有オブジェクト内のことはGCは気にしてくれないし、ついでにそこに渡されるcallbackはlibffiが割り付けたメモリなのでそもそもGCはたどることすらできない。

まぁ、callbackなんてそんなに使わないからいいかと言えばいいのだが、たとえばうっかり100万回回るループの中で10個ずつ作成しました！なんてことが起きる可能性が無いわけではない。実際、書く方としてはわざわざ開放してやるなんてことをしたくはないだろう。(推奨してはいないが・・・)

ただ、そうするとどうにかして自動で開放してやる仕組みが必要になるのだが、 どこか見知らぬアドレスに格納されたGC管理外メモリのことなんて知る由もないわけで、いい案どころか無理ゲーな感じが否めない。

なにかしら、適当な落としどころがほしい感じである。

FFIの可変長引数

必要がないのでサボっていたのだがGTKのバインディングをまじめに考えるなら必要になることがわかったのでちょっと頑張って実装してみた。

こんな感じで使える

(import (rnrs) (sagittarius ffi))

(define libc (open-shared-library "msvcrt.dll" #t))

(define snprintf (c-function libc int _snprintf (char* ___)))

(let ((buf (make-bytevector 10)))
  (snprintf buf 10"%d:%s\n" 100 "test")
  (print (utf8->string buf)))

(snprintf) ;; error

まだ実装が適当(与えられる引数の制限が多い)なのと、libffiのバージョンによっては正式にサポートされていないので警告文が出たりする(ぱっとソース見た感じだと特殊な処理が必要なアーキテクチャの方が少ないみたいだし、メジャーどころは要らなさそうなので、デフォルトで警告を出す必要は無いかもしれないが・・・)。

libffiで可変長の引数を扱うのは結構泥臭くて、呼び出し側は全ての引数を把握していないといけないのと、*残り*みたいな引数型はないのでffi_storageを引数個確保しておく必要がある。この制約のせいで通常の関数とは違って多少オーバーヘッドがかかるようになってしまった。

通常はC関数オブジェクトの作成時に必要な領域(引数型情報の配列)を確保しているのだが、可変長の場合は呼び出しごとに作成する必要がある。利便性を取るか速度を取るかといった感じである(ベンチマークとってないのでどれくらい性能に影響を与えるかは分かっていなかったりするが)。

あと、コールバックは可変長に対応していなかったりする。今のところ必要な場面が思いつかないのと、可変長引数を受け付けるコールバックを見たことがないというのが理由。まぁ、単なる手抜きである。

MOP improvement(?)

On Sagittarius,  MOP was not totally compatible with Tiny CLOS's MOP. That's because of my laziness. However I have noticed that once I use non builtin generic class, then it's not possible to use method qualifiers. This is not good to me. So I have improved some stuff.

The problem was that it was only implemented in C code and not in Scheme code so once I used custom generic class then it won't check those qualifiers. So I have removed builtin compute-applicable-method and moved to Scheme. Then implemented all required procedures and duplicated the logic in Scheme. (I actually don't want to do this but so far I couldn't find any better way.)

Now, I can do something like this;

(import (rnrs) (clos user) (clos core) (srfi :1))
 
(define-class <my-generic> (<generic>) ())
(define-generic foo :class <my-generic>)

(define-method compute-applicable-methods ((gf <my-generic>) args)
  (let ((m* (generic-methods gf)))
    (let-values (((supported others)
                  (partition (lambda (m) 
                               (memq (method-qualifier m)
                                     '(:before :after :around :primary)))
                             m*)))
      (for-each (lambda (m) (remove-method gf m)) others)
      (let ((methods (call-next-method)))
        (for-each (lambda (m) (add-method gf m)) others)
        (append others methods)))))

(define-class <human> ()())
(define-class <businessman> (<human>) ())
(define-method foo :append ((h <human>))
  (print "something else")
  (call-next-method))

(define-method foo :around ((h <human>))
  (print "human around before")
  (call-next-method)
  (print "human around after"))

(define-method foo :before ((h <human>))
  (print "human before"))
(define-method foo :before ((b <businessman>))
  (print "businessman before"))
 
(define-method foo ((h <human>))
  (print "human body"))
(define-method foo ((b <businessman>))
  (print "businessman body"))
 
(foo (make <businessman>))
#|
something else
human around before
businessman before
human before
businessman body
human around after
|#

I have no idea what I'm doing in above code!! Well, default implementation of method qualifier refuses non supported keywords so first remove other keywords from generic function then compute builtin qualifiers and adds the removed ones. At last append the non supported qualifier methods in front of the computed ones. The result is the other qualifier one is called first then the rest. If you put this append after the around method then all methods need to call call-next-method otherwise it won't reach there.

I have no idea if I will use this or not but at least I have something if I want to change the behaviour!

総称関数の:beforeとか

ほぼ初めて実用でこの辺の機能を使おうとしてふと不満に思ったこと。

SagittariusのCLOSはXeroxのTiny CLOSの動作を基本にして作られていて、:beforeとかもその動作を元にしている(たぶんこれは以前にも書いた気がする)。っで、ふとそれだとまずいというか、嬉しくないなぁというパターンが出てきて、ちょっと動作のおさらいをしている。

とりあえずは、以下のコード

(import (rnrs) 
        (rename (clos user)
                (define-class %define-class)
                (define-method %define-method))
        (srfi :0))

(define-generic foo)
(define (print . args) (for-each display args) (newline))
(cond-expand
 (mosh
  (define-syntax define-class
    (syntax-rules ()
      ((_ name parents (slots ...))
       (%define-class name parents slots ...))))
  (define-syntax define-method
    (syntax-rules (:before :after :around)
      ((_ name :before (specifiers ...) body ...)
       (%define-method name 'before (specifiers ...) body ...))
      ((_ name :after (specifiers ...) body ...)
       (%define-method name 'after (specifiers ...) body ...))
      ((_ name :around (specifiers ...) body ...)
       (%define-method name 'around (specifiers ...) body ...))
      ((_ name (specifiers ...) body ...)
       (%define-method name (specifiers ...) body ...)))))
 (sagittarius
  (define-syntax define-class (identifier-syntax %define-class))
  (define-syntax define-method (identifier-syntax %define-method))))

(define-class <human> ()())
(define-class <businessman> (<human>) ())
(define-method foo :before ((h <human>)) 
  (print "human before"))
(define-method foo :before ((b <businessman>)) 
  (print "businessman before"))

(define-method foo ((h <human>)) 
  (print "human body"))
(define-method foo ((b <businessman>)) 
  (print "businessman body"))

(foo (make <businessman>))
#|
businessman before
human before
businessman body
|#

まじめに書いてないのでまともに動きはしないのだが、Moshとの互換レイヤが入っている。気になるのは出力結果。動作を合わせてあるので現状は同じ出力を返すのだが、「human before」はcall-next-methodがあった場合にのみに出力されてほしい気がする。というか、そうじゃないと綺麗に書けないコードを書いていて、もにょっている感じ。

本家のCLではどうなっているのかもついでに試してみた(これも以前試したっけ？)

(defclass human () ())
(defclass businessmane (human) ())

(defmethod foo :before ((h human)) (print "before human"))
(defmethod foo :before ((h businessmane)) (print "before businessmane"))

(defmethod foo ((h human)) (print "body human"))
(defmethod foo ((h businessmane)) (print "body businessmane"))

(foo (make-instance 'businessmane))
#|
"before businessmane"
"before human"
"body businessmane"
|#

あぁ、本家もそうなのか。そうなると逸脱するのも微妙だなぁ・・・

CLOS based GUI library

Most of the script I have written so far is command line script and I didn't feel any inconvenience with it. However, sometimes I felt like if there is GUI to do it, it might make my life easier.

So I have decided to write a GUI library using FFI binding (currently working only Windows or Cygwin). There is a huge problem that is I have never written it before so I have no idea what is the best way to do it. After couple of days, I decided to use CLOS based method (named by me :-P).

It's not done yet but the code looks like this;

(import (clos user) (turquoise))

(let ((w (make <frame> :name "Sample" :width 200 :height 200))
      (b (make <button> :name "ok" :x-point 37 :y-point 50)))
  (add! w b)
  (add! b (lambda (action) (print action)))
  (show w))

The library (turquoise) is the GUI library. This piece of code just shows a window contains a button which prints action argument to standard output when it's pressed. The basic idea is using class as a component representation the same as other modern libraries and show thoese classes to users so that they can extend it easily.

I'm not sure if I should make add-component! or add-action-listner! instead of using generic method add!. If you have opinions about it, please let me know.

公用語が英語な会社

この記事が書かれたきっかけ

1. 自分の会社が最近オランダ人を雇っていないと気づく
2. これって募集要項が英語だからじゃね？
3. そういえば公用語を英語にするって表明した会社があったなぁ
4. 募集要項を英語のみにすれば必然的に英語ができるかつ優秀なやつがくるんじゃね？

という流れで、どれくらいの企業が日本人向けの募集要項を英語で出しているのか調べてみた。(ちなみに、自分が今勤めている会社はオランダ語の募集要項は無い。ってか、サイトにオランダ語の選択肢すらない。いいのか、それで？)

楽天とユニクロは有名だけど、他にどこがあるんだろうとまず調査。以下のNaverのページに載っていた公用語を英語にすると発表した企業に限定(昇進に英語必須とか含めると大変だったのでｗ)

楽天とユニクロ以外に「社内英語公用語」を発表している企業様まとめ 

っで以下が結果。

【日本語で募集】
楽天、ユニクロ、日産、SHARP、 日本硝子

【英語で募集】
SMK

SMKはロケールで変わるのかもしれないが、トップページがSMK Japan in Englishに飛ばされたので。日本語ページを見ると日本語の募集要項が載っていた。その他の企業は基本トップページが日本語だった、ひょっとしたら英語ページは英語なのかもしれない。

別に何ということもないのだが、個人的には企業がどれくらい公用語英語をまじめに実践しているかということを外からしる一つの指標になるのではないだろうかと思ったり。もちろん実情は知りようがないし、面接は英語で行われるとかも調べていないが・・・

ついでに、企業がまじめに英語を公用語にしているということは、「英語は話せて当たり前、その上で何ができるの？」というスタンスでいると思うので、「英語話せます」だけでは採用されないということだと思ったりもしている。というか、意思疎通の手段としているわけだからそこを言及すること自体そもそもおかしいわな。

Sagittarius 0.4.5 リリース

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

修正された不具合

• define-c-structがアライメントを無視したサイズの構造体を作る不具合が修正されました
• この修正によって(sagittarius ffi)がより正確なアライメントを計算するようになりました
• parameterizeが値を正しく復元しない不具合が修正されました
• (/ 1 -0.0)が+inf.0を返す不具合が修正されました
• sashの-Iオプションがエラーを投げる不具合が修正されました

改善点

• キャッシュファイルがマルチプロセス環境でより安全になりました
• これによりmake -j nでのビルドが可能です
• parameterのメモリ使用量が少なくなりました

新たに追加された機能

• eql sepecializerが組み込みになりました
• open-shared-libraryが共有ライブラリが見つからなかった際にエラーを投げるオプショナル引数を受け付けるようになりました
• generate-secret-keyでDES3の秘密鍵を生成する際に8及び16バイトの鍵を受け付けるようになりました
• lock-port!及びunlock-port!が追加されました(明文化はされていません)
• call-with-port-lockが(util port)に追加されました(明文化はされていません)

新たに追加されたドキュメント

• (dbi)及び(odbc)のドキュメントが追加されました

Should let-syntax family make a scope?

On R7RS ML, there was a discussion for this topic and I'm wondering about it.

On current draft of R7RS, it says 'The let-syntax and letrec-syntax binding constructs are anologous to let and letrec' so I would say it should make a scope. However the reference implementation, Chibi Scheme, doesn't.

Following quote is from the ML:

Please try to keep a grip on the fact that R7RS-small `let-syntax`, like the R5RS version, is a scope rather than being spliced into the surrounding scope. See ticket #48 and WG1Ballot2Results.

From http://lists.scheme-reports.org/pipermail/scheme-reports/2013-May/003439.html

However, seeing this issue from Chibi Scheme, it's not making a scope intentionally.

The reason I'm wondering about it is actually I don't want to make a scope for neither let-syntax nor letrec-syntax. Current compiler checks the mode and switches the path. Well, it's not heavy operation so it won't improve much performance if I remove it (just a tiny bit). However it does make a big change to write some memory efficient code.

Let's say you want to write sort of following code:

#!r6rs
(library (foo)
    (export command1 command2)
    (import (rnrs))
  (letrec-syntax ((define-command
                    (syntax-rules ()
                      ((_ name body ...)
                       (define name (lambda () body ...))))))
    (define-command command1 (display 'command1) (newline))
    (define-command command2 (display 'command2) (newline))))

This only works when you put #!r6rs annotation on the library defined file (I'm talking about Sagittarius). So, if you want to make some keyword argument or so, then you need to remove the annotation and make define-command global binding.

You might say, "as long as you don't export define-command, then it won't harm your code.", well sort of yes. The problem is acutally on cache file. If you define global macros, then cache file must contain it since we can access it without exporting, using with-library macro. (I know it's a back door stuff, but it's sometimes convenient!) However, if we use let-syntax then cache file won't have it because all local macros are already expanded.

On Sagittarius, if you really don't want to export internal macro you need to write it like above in R6RS mode. Then you don't have any chance to use keyword features.

Should I follow Chibi's behaviour or what R7RS (implicitly) says?

パラメタ

面白いというか、目の付け所が鋭いバグ報告が届いた。(面倒なバグとも言う・・・)

具体的な再現コードは以下のようになる。

(import (rnrs) (srfi :39))
(define x (make-parameter 3 (lambda (x) (+ x 3))))
(print (x))
(parameterize ((x 4)) (print (x)))
(print (x))
#|
6
7
9
|#

SRFI-39的にもR7RS的にも最後の9は6じゃないといけない。原因はすぐに分かったんだけど、問題はどう解決するかという部分。

ちなみに、原因はparameterizeとparameterの実装にある。parameterizeはdynamic-windを使って実装されているのだが、afterのthunkが値をセットしなおす際に保存された値が変換されるという悲しいことがおきる(この場合は6が保存されて、6をセットする際に9に変換される)。 まぁ、解決方法は簡単で、after thunkで保存された値をセットする際に、変換を行わなければいい。

言うは易し、行うは難しの典型である。なぜか、そんなAPIが無いからだ。現状ではパラメタはYpsilonの実装を移植したものを使っている。この実装ではパラメタは単なるlambdaである。つまり、その中身にアクセスする方法などないということだ。(もちろん、同様の問題がYpsilonでも発生する。ちなみにChezでも起きた。意外とこのバグはいろんな実装で穴になっているっぽい。)

とりあえずぱっと思いつく解決方法は2つ。

1. パラメタ作成時に直接値を設定できる手続きを作って一緒に保存する
2. せっかくobject-applyがあるんだし、CLOSで実装してしまう

1の方法だと使用するメモリの量が不安になる、単純計算でパラメタ作成にかかるメモリコストが倍になる。
2の方法だとパラメタを呼び出すときのオーバヘッドが気になる。なんだかんだで総称関数の呼び出しは現状では重たい。

さて、どうしようかな。

eql specializer

This article is continued from the previous one (in Japanese).

Sagittarius has the library to do eql specializer however it was a bit limited if I wanted to use it from C level. So I wanted it builtin, yes I made it :)

Basically almost nothing is changed to use just it became a bit convenient. So you can write it like this (without (sagittarius mop eql) library);

(import (clos user))
(define-method fact ((n (eql 0))) 1)
(define-method fact ((n )) (* n (fact (- n 1))))
(fact 10) ;; -> 3628800

Now you don't have to define a generic procedure before defining methods.

Current implementation is simply ported from the old library so it might not be so efficient. (Well, it's written in C now so it should be faster than before!)


Ah, I thought I wanted to write more but guess not :(