Object oriented system with late binding typically use a "vtable"-approach: the first variable in each object is a pointer to a table, which contains the methods as function pointers. This vtable may contain some other informations, too.
So first, let's declare methods:
: method ( m v -- m' v ) Create over , swap cell+ swap DOES> ( ... o -- ... ) over + execute ;
During method declaration, the number of methods and instance
variables is on the stack (in address units).
one method and increments the method number. To execute a method, it
takes the object, fetches the vtable pointer, adds the offset, and
executes the xt stored there. Each method takes the object it is
invoked from as top of stack parameter. The method itself should
consume that object.
Now, we also have to declare instance variables
: var ( m v size -- m v' ) Create over , + DOES> ( o -- addr ) + ;
Same as above, a word is created with the current offset. Instance
variables can have different sizes (cells, floats, doubles, chars), so
all we do is take the size and add it to the offset. If your machine
has alignment restrictions, put the proper
faligned before the variable, it will adjust the variable
offset. That's why it is on the top of stack.
We need a starting point (the empty object) and some syntactic sugar:
Create object 1 cells , 2 cells , : class ( class -- class methods vars ) dup 2 ;
Now, for inheritance, the vtable of the parent object has to be copied, when a new, derived class is declared. This gives all the methods of the parent class, which can be overridden, though.
: end-class ( class methods vars -- ) Create here >r , dup , 2 cells ?DO ['] noop , 1 cells +LOOP cell+ dup cell+ r> rot 2 cells /string move ;
The first line creates the vtable, initialized with
noops. The second line is the inheritance mechanism, it
copies the xts from the parent vtable.
We still have no way to define new methods, let's do that now:
: defines ( xt class -- ) ' >body + ! ;
To allocate a new object, we need a word, too:
: new ( class -- o ) here over allot swap over ! ;
And sometimes derived classes want to access the method of the parent object. There are two ways to achieve this with this OOF: first, you could use named words, and second, you could look up the vtable of the parent object.
: :: ( class "name" -- ) ' >body + compile, ;
Nothing can be more confusing than a good example, so here is
one. First let's declare a text object (further called
button), that stores text and position:
object class cell var text cell var len cell var x cell var y method init method draw end-class button
Now, implement the two methods,
: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
For inheritance, we define a class
bold-button, with no
new data and no new methods.
button class end-class bold-button : bold 27 emit ." [1m" ; : normal 27 emit ." [0m" ; :noname bold [ button :: draw ] normal ; bold-button defines draw
And finally, some code to demonstrate how to create objects and apply methods:
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
Go to the first, previous, next, last section, table of contents.