6.24.5.3 mini-oof.fs Implementation

遅延結び付け(late binding)を備えたオブジェクト指向システムは通常、 「vtable」アプローチを使用します。 つまり、 各オブジェクトの最初の変数はテーブルへのポインタであり、 テーブルには関数ポインタとしてメソッドが含まれています。 vtable には他の情報も含まれる場合があります。

まず、 セレクターを宣言しましょう:

: method ( m v "name" -- m' v ) Create  over , swap cell+ swap
  DOES> ( ... o -- ... ) @ over @ + @ execute ;

セレクターの宣言中、 セレクターの数とインスタンス変数は(アドレス単位で)スタック上にあります。 method はセレクターを 1 つ作成し、 セレクター番号をインクリメントします。 セレクターを実行するには、 オブジェクトを取得し、 vtable ポインターを取得し、 オフセットを追加して、 そこに保存されているメソッド xt を実行します。 実行時、 各セレクターは、 スタック・パラメーターのTOSとして、 セレクターを呼び出すオブジェクトを受け取り、 パラメーター(オブジェクトを含む)を変更せずに、 適切なメソッドに渡します。

いまや、 インスタンス変数も宣言しなければなりません

: var ( m v size "name" -- m v' ) Create  over , +
  DOES> ( o -- addr ) @ + ;

同様に、 ワードには現在のオフセットを書き込んで作成されます。 インスタンス変数はさまざまなサイズ(セル、 浮動小数点数、 2倍長整数、 char)にすることができるため、 そのサイズを取得してオフセットに追加します。 マシンにアライメント制限がある場合は、 変数の前に適切な aligned または faligned を配置して、 変数のオフセットを調整します。 それが size がスタックのTOSにある理由です。

開始点(基底オブジェクト)と、 いくつかの糖衣構文も必要です:

Create object  1 cells , 2 cells ,
: class ( class -- class selectors vars ) dup 2@ ;

継承の場合、 新しい派生クラスが宣言されるときに、 親オブジェクトの vtable をコピーする必要があります。 これにより、 親クラスのすべてのメソッドが提供されますが、 それらはオーバーライドすることもできます。

: end-class  ( class selectors vars "name" -- )
  Create  here >r , dup , 2 cells ?DO ['] noop , 1 cells +LOOP
  cell+ dup cell+ r> rot @ 2 cells /string move ;

最初の行は、 noop で初期化された vtable を作成します。 2 行目は継承メカニズムで、 親 vtable から xt 達をコピーします。

新しいメソッドを定義する方法がまだありませんね。 ここで定義しましょう:

: defines ( xt class "name" -- ) ' >body @ + ! ;

新しいオブジェクトを割り当てるためのワードも必要です:

: new ( class -- o )  here over @ allot swap over ! ;

派生クラスが親オブジェクトのメソッドにアクセスしたい場合があります。 Mini-OOF でこれを実現するには 2 つの方法があります: 1 つ目は名前付きのワードを使用する方法で、 2 つ目は親オブジェクトの vtable を検索する方法です。

: :: ( class "name" -- ) ' >body @ + @ compile, ;

混乱しないためには良い例に勝るものはないので、 以下に例を示します。 まず、 テキストとその位置を格納するテキスト・オブジェクト(button と呼ばれます)を宣言しましょう:

object class
  cell var text
  cell var len
  cell var x
  cell var y
  method init
  method draw
end-class button

次に、 draw と init の 2 つのメソッドを実装します:

:noname ( o -- )
 >r r@ x @ r@ y @ at-xy  r@ text @ r> len @ type ;
 button defines draw
:noname ( addr u o -- )
 >r 0 r@ x ! 0 r@ y ! r@ len ! r> text ! ;
 button defines init

継承のデモンストレーションとして、 新しいデータや新しいセレクターを持たない、 クラス bold-button を定義します:

button class
end-class bold-button

: bold   27 emit ." [1m" ;
: normal 27 emit ." [0m" ;

クラス bold-button には button とは異なる draw メソッドがありますが、 新しいメソッドは button の draw メソッドに関して定義されています:

:noname bold [ button :: draw ] normal ; bold-button defines draw

最後に、 2 つのオブジェクトを作成し、セレクターを適用します:

button new Constant foo
s" thin foo" foo init
page
foo draw
bold-button new Constant bar
s" fat bar" bar init
1 bar y !
bar draw