2013/12/06

STkのMOP

Metaobject Protocol(MOP) Advent Calendar 2013参加エントリ (12/7分)

SchemeからTkが使えるという(Tcl/TkのTcl部分をSchemeで置き換えた)、 STkというScheme処理系があった。 Gaucheが大きな影響を受けた処理系のひとつだ。

TinyCLOSベースのオブジェクトシステムを持っていて、 Tkウィジェットが自然にオブジェクトシステムに統合されている。 (このオブジェクトシステムをSTklosと称していた。後に作者のEric Gallesioは STkを完全に書き直してstklosという処理系を作る。)

例えば以下の、フレームを作って配置する簡単なtclスクリプト：

frame .f
button .f.b1 -text "Button1" -command { puts "clicked!" }
pack .f.b1
pack .f

STkだとこんな感じになる:

(require "Tk-classes")
(define f (make <frame>))
(define b (make <button> :parent f :text "Button1"
                         :command (lambda () (display "clicked!\n"))))
(pack b)
(pack f)

この例だと少し冗長になってるけど、実際にコード書くときは以下のような点でむしろ簡潔になった。

Tkにもともと備わってるオブジェクトをカスタマイズしたり、複数のウィジェットをまとめて扱いたい時に継承やcompsitingなどで書けて、新たなウィジェットも組み込みウィジェットと同様のインタフェースで扱える。
Tkではcanvasに描かれた図形オブジェクトやメニューアイテム等、通常のオブジェクトと微妙に異なるインタフェースを持つオブジェクトがあるのだけれど、それらもSTkレベルでは通常のウィジェットと全く同じように扱える。
ウィジェットの階層がTcl/Tkのように名前に密に結びつけられていないので再利用しやすい。

で、これをどうやって実装しているんだろうとソースを覗いてみたら、 MOPが使われていたわけだ。

基本的な発想は、Tkのクラスを定義する時に、Tkのプロパティに対応するスロットを :allocation :tk-virtual でマークしておく。

;; from STklos/Tk/Basics.stklos
(define-class <Tk-simple-widget> (<Tk-widget>)
  ((background           :accessor     background   
                         :init-keyword :background   
                         :allocation   :tk-virtual)
   (border-width         :accessor     border-width 
                         :init-keyword :border-width
                         :tk-name      bd     
                         :allocation   :tk-virtual)
   (cursor               :accessor     cursor
                         :init-keyword :cursor  
                         :allocation   :tk-virtual)
   (highlight-background :accessor     highlight-background  
                         :init-keyword :highlight-background
                         :tk-name      highlightback
                         :allocation   :tk-virtual)
   (highlight-color      :accessor     highlight-color  
                         :init-keyword :highlight-color
                         :tk-name      highlightcolor
                         :allocation   :tk-virtual)
   (highlight-thickness  :accessor     highlight-thickness  
                         :init-keyword :highlight-thickness
                         :tk-name      highlightthick
                         :allocation   :tk-virtual)
   (relief               :accessor     relief   
                         :init-keyword :relief       
                         :allocation   :tk-virtual)
   (take-focus           :accessor     take-focus
                         :init-keyword :take-focus
                         :tk-name      takefocus
                         :allocation   :tk-virtual)))

で、メタクラスの compute-get-n-set でスロットオプションをチェックして、スロットのアクセサを、Tkへの問い合わせ/プロパティ変更コマンドへとマップしている。 (canvas itemやmenu itemなどTkのインタフェースにいくつかバリエーションがあるので、<With-Tk-virtual-slots-metaclass> で大元のcompute-get-n-set をオーバライドして、バリエーションの方は compute-tk-virtual-get-n-set というメソッドで処理している。)

;; from STklos/Tk/Tk-meta.stklos
(define-class <With-Tk-virtual-slots-metaclass> (<class>)
  ())

(define-method compute-get-n-set ((class <With-Tk-virtual-slots-metaclass>) slot)
  (if (memv (slot-definition-allocation slot) '(:tk-virtual :pseudo))
      [let ((tk-name (make-keyword (get-keyword :tk-name (cdr slot) (car slot)))))
        (compute-tk-virtual-get-n-set class tk-name)]
      [next-method]))

(define-class <Tk-metaclass> (<With-Tk-virtual-slots-metaclass>)
  ())

(define-method compute-tk-virtual-get-n-set ((class <Tk-metaclass>) tk-name)
  (list
   (lambda (o)   ((slot-ref o 'Id) 'cget tk-name))
   (lambda (o v) ([slot-ref o 'Id] 'configure tk-name v))))

わかってしまえば素直な実装なのだけれど、このコードを読んだ時は目から鱗だった。

各ウィジェットのプロパティの共通部分はベースクラスにまとめて多重継承で具体的なウィジェットを定義するなど、他にも参考にしたテクニックは多い。

また、Tk側でウィジェットを破棄すると、対応するSTklosのオブジェクトを <Destroyed-object> にchange classするのもCLOSっぽいテクニックでおもしろい。 (change classの無いOOシステムだと、破棄されたウィジェットはフラグか何かを立てておくことになるけれど、それだとインスタンスに使われているメモリは以降使われない無駄メモリとなる。change classするとインスタンスのメモリレイアウト自体が変更されたクラスのものになる。 <Destroyed-object> はスロットを持たないので、インスタンスが「縮む」ことになる。)

★ ★ ★

ところで上で、「複数のウィジェットをまとめて扱いたい時にcompsiting」と書いたけれど、複数のオブジェクトをあたかもひとつのオブジェクトであるかのように見せるのにもMOPが使われている。これについては時間があれば別エントリで書いてみる。

この記事を読んでSTkを試してみたくなった人へ。STkの最終リリースはSTk-4.0.1で、検索すれば出てくるだろう。1998年のコードなので今コンパイルすると warningがいっぱい出るが、ビルドはできる。ただし、Linuxでは一ヶ所 configure に修正が必要だった。多分当時のautoconfのバグで、当時はたまたま通っていたのだろう。

*** Tcl/configure.orig  Sat Jan  3 02:46:25 1998
--- Tcl/configure       Fri Dec  6 01:16:21 2013
***************
*** 3219,3225 ****
        # results, and the version is kept in special file).
      
        if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
!           system=MP-RAS-`awk '{print $3}' /etc/.relid'`
        fi
        if test "`uname -s`" = "AIX" ; then
            system=AIX-`uname -v`.`uname -r`
--- 3219,3225 ----
        # results, and the version is kept in special file).
      
        if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
!           system=MP-RAS-`awk '{print $3}' /etc/.relid`
        fi
        if test "`uname -s`" = "AIX" ; then
            system=AIX-`uname -v`.`uname -r`

Tags: Programming, Gauche, CLOS, STk

Comments (0)

2013/12/03

#permalink

gauche.recordとMOP

(Metaobject Protocol(MOP) Advent Calendar 2013参加エントリ)

自分はもともとクラスベースオブジェクト指向よりはクロージャによる抽象化を好むこともあって、 MOPをバリバリ使って新しいオブジェクトシステムを実験する、みたいなことはあまりやらない。

なのでMOPの使いどころは主に「もともとのシステムからはちょっぴり外れた仕様を実現したい」というケースだ。今回もそういう、ちょっとした小技で仕様の違いを吸収した話。

＊＊＊

さて、C言語の構造体にあたるものは、Schemeではレコードという。 Gaucheのレコード型はsrfi-99 (SRFI:99) で定義されたものの拡張で、 gauche.record モジュールをuseすると使える。

例えばこれが、フィールドx, y, zを持つpoint型の定義。

(define-record-type point #t #t
  x y z)

コンストラクタやアクセサは自動的に定義される (必要なら名前をカスタマイズすることもできる)。

gosh> (define p (make-point 1 2 3))
p
gosh> p
#<point 0x2976de0>
gosh> (point? p)
#t
gosh> (point-x p)
1
gosh> (point-z p)
3

デフォルトではフィールドはimmutableだが、mutableなフィールドを定義することもできる。

さて、Gaucheにはもともと、複数のフィールド(スロット)を持つ構造的なデータを定義する方法として、組み込みのクラスシステムがある。であれば、レコード型もクラスにマップするのが素直だろう。実際、レコード型 point は Gaucheのクラスに束縛されている。

gosh> (describe point)
#<class point> is an instance of class <record-meta>
slots:
  field-specs: #((immutable x) (immutable y) (immutable z))
  name      : point
  cpl       : (#<class point> #<class <record>> #<class <object>> #<class 
  direct-supers: (#<class <record>> #<class <object>>)
  accessors : ((x . #<slot-accessor point.x proc>) (y . #<slot-accessor po
  slots     : ((x :immutable #t :index 0) (y :immutable #t :index 1) (z :i
  direct-slots: ((x :immutable #t :index 0) (y :immutable #t :index 1) (z :i
  num-instance-slots: 3
  direct-subclasses: (#<class mutable-point>)
  direct-methods: ()
  initargs  : (:name point :field-specs #((immutable x) (immutable y) (imm
  defined-modules: ()
  redefined : #f
  category  : scheme

pointのインスタンスもGaucheのインスタンスとして使える。

gosh> (~ p 'x)
1
gosh> (slot-ref p 'y)
2

ただ、レコード定義をそのままクラス定義に置き換えると、ちと困ったことが起きる。継承がある場合だ。

srfi-99レコードは単一継承を許している。例えば上記 point を継承して colored-point を定義できる。

(define-record-type (colored-point point) #t #t
  r g b)

gosh> (define cp (make-colored-point 1 2 3 0.5 0.5 0.9))
cp
gosh> (describe cp)
#<colored-point 0x2a89bc0> is an instance of class colored-point
slots:
  r         : 0.5
  g         : 0.5
  b         : 0.9
  x         : 1
  y         : 2
  z         : 3

ここで、サブクラスに、親クラスのフィールドと同名のフィールドを定義したらどうなるか。Gaucheのクラスでは、CLOSと同様に、同名のフィールドはマージされる。親と子がともにfooという名前のスロットを定義していたら、インスタンスには foo用のスロットはひとつしか定義されない。 (このことを利用して、子クラスで親クラスのスロットオプションをオーバライドできる。)

レコード型では、親レコードの構造を保ったまま、子レコードのスロットが追加される。次の例を参照。

(define-record-type (colored-point2 point) #t #t
  c m y k)

yというスロット名が重複しているが、親のyと子のyは区別される。スロット名でアクセスすると子クラスのスロットしか見えないが、アクセサを使えば親クラスのスロットにもアクセスできる。

gosh> (define cp (make-colored-point2 1 2 3 0.5 0.5 0.8 0.1))
cp
gosh> (~ cp 'y)
0.8
gosh> (colored-point2-y cp)
0.8
gosh> (point-y cp)
2

マクロで define-record-type から define-class に変換する時にぶつかる名前をリネームしてやって… というふうにも出来るが、名前の管理が煩わしい。MOPならわずかのコードでこの変更が書ける。

継承関係から、クラスclassのインスタンスが持つべきスロットを計算するメソッドがcompute-slotsだ。組み込みのクラスではここで重複スロット名をチェックしている。レコード型については、スロット名をチェックせずに単純に先祖のクラスのスロットを足してゆけば良い。

(define-method compute-slots ((class <record-meta>))
  (fold (^[c r] (append (slot-ref c'direct-slots) r))
        '() (reverse (slot-ref class'cpl))))

クラスの継承リストをreverseしているのは、子クラスのスロットの方が定義で先に来るようにするためだ。こうすると、Gaucheインスタンスとしてスロット名でアクセスした場合に、子クラスのスロットが優先される。

定義中ではクラスのスロットの順番を入れ替えたが、インスタンス中のスロットの配置は親クラスの方を先に持ってきたい。なぜならcolored-point2のインスタンスをpointとしてアクセスした場合には親クラスの構造が見えて欲しいからだ。そのため、スロットアクセサを計算する compute-get-n-set メソッドをオーバライドする。

(define-method compute-get-n-set ((class <record-meta>) slot)
  (next-method)
  (let1 s
      (compute-slot-accessor class slot (slot-definition-option slot :index))
    (if (slot-definition-option slot :immutable #f)
      `(,(^o (slot-ref-using-accessor o s))
        ,(^[o v] (errorf "slot ~a of ~a is immutable"
                         (slot-definition-name slot) o))
        ,(^o (slot-bound-using-accessor? o s)))
      s)))

:index オプションはインスタンス先頭からのスロットのオフセット。レコード型を生成する make-rtd 手続き中で計算される。

compute-slot-accessor にこのオフセットを渡すことで、このスロットへのアクセス＝インスタンスの該当オフセットにあるメモリの読み書き、という動作になる。

(slot-definition-option slot :immutable #f) 以下の部分は immutableなスロットを実現するトリックで、セッター手続きが呼ばれた場合にエラーを投げる。

gauche.recordのソースは他にも色々やっているが、効率のためになるべくインライン展開されるようにごちゃごちゃ工夫しているだけで、レコード型からクラスへのadaptationの本質はこのMOP部分だけだ。

Tags: Programming, Gauche, MOP, CLOS, gauche.record

Comments (0)

2013/11/24

#permalink

二値画像の回転 (どう書く? のお題)

朝飯前にネットをぶらついていたら見かけたので、ちょい前のやつだけどやってみた。

第2回オフラインリアルタイムどう書くの参考問題

正方形の二値画像を時計回りに回転する。
画像フォーマットは、x:d　のようになっており、x が画像の一辺の長さ（常に正方形）、d は16進表記の画像データ。

回転自体は性能を考えなければ、データをリストのリストで持っておけば1行だ。どっちかというと入出力に行数を取られる。

昔、X11R3が出た頃に、バイトで作っていたアプリでワークステーション上でグラフを描く必要があったのだけれど、当時テキストを回転させて表示するAPIが無かったので、 Y軸のキャプションはビットマップに描画して90度回転させていた。素直に1ビットづつ処理してたら遅かったのでビット演算を使ってごにょごにょした覚えがかすかにあるけど、もう忘れたなあ。

https://gist.github.com/7632084

Tags: Programming, Gauche

Comments (0)

2013/11/16

#permalink

ピアノレッスン111回目

Kapustin: Concerto Etude Op40-1
- 四分音符=92で始めたら破綻したので88で仕切り直し。タッチが違うと戸惑うってことはまだちゃんと頭に入ってないな。
Ravel: Ondine
- スローで通し。一応曲の全体像が分かるような感じにはなってきたような。

Tag: Piano

Comments (0)

2013/11/11

#permalink

HHKB + Synergy

HHKB Pro2をLinuxマシンにつないでて、 Synergyを使ってWindowsマシンおよびMacを操作してるんだけれど、MacのCommandキーをどう入れたら良いのかわからず不便していた。しかしさすがにその不便さが「設定を調べる面倒くささ」を上回ってきたので何とかすることに。

設定の組み合わせが色々あるから望む組み合わせを見つけるのが面倒なんだな。結果だけメモ。

前提として、Emacs遣いのためAltを多用するので、HHKB Pro2のAltと◇はもともと入れ替えている (Dip SW 5 を ON)
デフォルトのキーボードモード (SW1,SW2ともにOFF) だと、左◇は「無変換」、右◇は「変換」キーになってるようだ (1.の設定があるので実際のキーは左Altと右Alt)。キーボードモードをLite Ext.(SW1=OFF, SW2=ON)にすると、これらがSuperキーになる。
Synergyのconfigで「server(Linux)のsuper」を、「client(Mac)のmeta」にマッピング。この書き方の順番が結構紛らわしい。
```
section: screens
  scherzo:
  toccata:
  etude:
    meta = super
end
```
scherzoがLinux、toccataがWindows、etudeがMac。
Ubuntu UnityのデフォルトではSuperキーを押すとdashが立ち上がるが、このキーの認識はsynergysより手前でインターセプトされるようで、 MacでCommandを使う度にLinux側で画面がちらちらするのが煩わしい。そこでUnityの方のバインディングを変えておく (Super+Tabにした。)

Tag: Computer

Comments (0)

More entries ...

Island Life

About

最近のエントリ

最近のコメント

最近のリリース

書いたり訳したりした本

2013/12/06

STkのMOP

2013/12/03

gauche.recordとMOP

2013/11/24

二値画像の回転 (どう書く? のお題)

2013/11/16

ピアノレッスン111回目

2013/11/11

HHKB + Synergy