oop.htm

strongForth: a strongly typed dialect of Forth implemented in ANS Forth.

  :MEMBER . ( JOURNAL -- )
    DUP . CR ." Edition " .EDITION ;
ENDCLASS</pre>
<p>Let's now create an object of each of these four classes. The two classes 
at the bottom of the class hierarchy (<kbd>BOOK</kbd> and <kbd>JOURNAL</kbd>) 
inherit all public and protected members from their common parent 
<kbd>PAPER-MEDIUM</kbd> and their grandparent <kbd>MEDIUM</kbd>.</p>
<pre><u>" No name" NEW MEDIUM CONSTANT MEDIUM1</u>  OK
<u>MEDIUM1 .</u> No name ($0.00) OK
<u>" White paper" 1 NEW PAPER-MEDIUM CONSTANT PAPER1</u>  OK
<u>PAPER1 .</u> White paper ($0.00)
1 pages OK
<u>" Starting Forth" 348 NEW BOOK CONSTANT BOOK1</u>  OK
<u>BOOK1 .</u> &lt;null> - Starting Forth ($0.00)
348 pages OK
<u>" Scientific American" 114 3 2008 NEW JOURNAL CONSTANT JOURNAL1</u>  OK
<u>JOURNAL1 .</u> Scientific American ($0.00)
114 pages
Edition 3/2008  OK
<u>" Leo Brodie" BOOK1 SET-AUTHOR</u>  OK
<u>1999 BOOK1 SET-PRICE</u>  OK
<u>BOOK1 .</u> Leo Brodie - Starting Forth ($19.99)
348 pages OK
<u>BOOK1 PAGES .</u> 348  OK
<u>BOOK1 GET-AUTHOR .</u> Leo Brodie  OK
<u>BOOK1 SALE</u>  OK
<u>BOOK1 GET-PRICE .</u> 1599  OK
<u>BOOK1 .PRICE</u> 15.99 OK
<u>799 JOURNAL1 SET-PRICE</u>  OK
<u>JOURNAL1 PAGES .</u> 114  OK
<u>JOURNAL1 GET-PRICE .</u> 799  OK
<u>JOURNAL1 SALE</u>  OK
<u>JOURNAL1 .</u> Scientific American ($1.00)
114 pages
Edition 3/2008  OK</pre>
<p>The polymophism of the words <kbd>.</kbd> and <kbd>SALE</kbd> is simply 
implemented by overloading. Since this is one of StrongForth's basic features, 
no special treatment for object oriented programming is required. A different 
version of <kbd>.</kbd> is included 
in each of the four classes. However, <kbd>.</kbd> for a derived class generally 
uses the version defined for the respective parent class. For example, the 
member word <kbd>.</kbd> of class <kbd>BOOK</kbd> first displays the author 
followed by a dash and then executes <kbd>.</kbd>. Which version of <kbd>.</kbd> 
is this? The compiler sees an item of data type <kbd>BOOK</kbd> on the compiler 
data type heap. Searching the dictionary, the first match it finds is the 
member word <kbd>.</kbd> of <kbd>BOOK</kbd>'s parent class 
<kbd>PAPER-MEDIUM</kbd>. As a result, <kbd>.</kbd> for objects of class 
<kbd>BOOK</kbd> displays the author, the title, the price and the number of 
pages. <kbd>SALE</kbd>, on the other hand, is defined in <kbd>MEDIUM</kbd> and 
redefined in <kbd>JOURNAL</kbd>. This means that executing <kbd>SALE</kbd> for 
objects of the classes <kbd>MEDIUM</kbd>, <kbd>PAPER-MEDIUM</kbd> and 
<kbd>BOOK</kbd> causes a 20% price reduction, while <kbd>SALE</kbd> for 
objects of the class <kbd>JOURNAL</kbd> causes the price to be reduced to $1.00, 
no matter what the previous price was.</p>
<p>Based on the class hierarchy defined in the previous section, let's now try to 
implement a word that advertises the sellout of a given medium:</p>
<pre><u>: SELLOUT ( MEDIUM -- )</u>
<u>  ." Save money now!" CR DUP . CR DUP SALE</u>
<u>  ." Now for only $" .PRICE ." !" ;</u>  OK
<u>1999 BOOK1 SET-PRICE</u>  OK
<u>BOOK1 .</u> Leo Brodie - Starting Forth ($19.99)
348 pages OK
<u>799 JOURNAL1 SET-PRICE</u>  OK
<u>JOURNAL1 .</u> Scientific American ($7.99)
114 pages
Edition 3/2008  OK
<u>BOOK1 SELLOUT</u> Save money now!
Starting Forth ($19.99)
Now for only $15.99! OK
<u>JOURNAL1 SELLOUT</u> Save money now!
Scientific American ($7.99)
Now for only $6.39! OK</pre>
<p>Well, this did not work as intended. A 20% price reduction is granted for the 
book, but <kbd>SELLOUT</kbd> does not display the author and the number of pages. 
From the display of the journal, the number of pages and the edition is missing. 
Even worse, the reduced price is not correct. <kbd>SELLOUT</kbd> grants 20% for 
the journal, even though class <kbd>JOURNAL</kbd> has its own version of 
<kbd>SALE</kbd> that reduces the price to $1.00. What happened? When <kbd>.</kbd> 
and <kbd>SALE</kbd> are compiled into <kbd>SELLOUT</kbd>, the compiler sees an 
item of data type <kbd>MEDIUM</kbd> on the compiler data type heap and thus 
selects <kbd>MEDIUM</kbd>'s versions of the two member words. <kbd>.</kbd> and 
<kbd>SALE</kbd> are statically bound to <kbd>MEDIUM</kbd> by the compiler. To 
resolve this problem, they have to be made <em>virtual</em> members of the class 
hierarchy. Virtual members are bound dynamically at runtime, i. e., the versions 
of <kbd>.</kbd> and <kbd>SALE</kbd> to be executed depend on the actual class of 
the object.</p>
<p>The data type of an object can be determined at runtime, because each object 
contains a pointer to the virtual member table of its class. The memory image of 
a virtual member table looks like this:</p>
<table border=1 cellpadding=3 width=25%>
 <tr>
  <td align=center>object size</td>
 </tr>
 <tr>
  <td align=center>virtual member table size</td>
 </tr>
 <tr>
  <td align=center><br>tokens of virtual members<br><br></td>
 </tr>
</table>
<p>Both the object size and the virtual member table size are stored in address 
units. Each virtual member word has a place for its execution token in the virtual 
member table. When a virtual member is executed for an object, the corresponding 
token is taken from the virtual member table of its class, requiring an index 
operation and one additional level of indirection. Executing a virtual member is 
thus similar to executing a deferred word.</p>
<pre>VIRTUAL name ( ... class -- ... )</pre>
<p>used between <kbd>CLASS</kbd> and <kbd>BODY</kbd> defines a virtual member for 
the actual class and for all inherited classes. The actual semantics are then 
assigned in the body of a class with</p>
<pre>:NONAME ( ... class -- ... ) ... ; IS name</pre>
<p>The complete virtual member table of a class is passed to the class's children. 
This means, as long as the semantics of a virtual member are not reassigned with 
<kbd>IS name</kbd> in the body of a class, the semantics assigned by its parent 
remains unchanged. It is even possible 
to define a virtual member and postpone assigning the semantics to one or more of 
the derived classes. Such a virtual member is called a <em>pure virtual member</em> 
An attempt to execute a pure virtual member results in an exception being thrown, 
because the virtual member table is initialized with the tokens of the word 
<kbd>PURE-VIRTUAL</kbd>. This word does nothing else but throwing this exception.</p>
<p>The last input parameter of a virtual member always needs to be an object of the 
respective class. This object is required in order to locate the virtual member table 
and to get the token of the virtual member that has been assigned to the class the 
object belongs to. Invoking a virtual member with a null object on the stack will 
almost certainly cause a crash. On the other hand, a non-virtual member may be 
invoked with a null object on the stack, as long as no data members are being 
accessed based on the null object. It is even possible to defined non-virtual 
members that do not expect an object of its class as the last input parameter.</p>
<p>With this knowledge about virtual members and dynamic binding, let's redefine 
the <kbd>MEDIUM</kbd> class hierarchy. Both <kbd>.</kbd> and <kbd>SALE</kbd> 
become virtual members:</p>
<pre>CLASS MEDIUM
  VIRTUAL . ( MEDIUM -- )
  VIRTUAL SALE ( MEDIUM -- )
BODY
  ALSO PROTECTED DEFINITIONS
  NULL STRING MEMBER TITLE
  NULL UNSIGNED MEMBER PRICE \ in cent
  FORTH DEFINITIONS PROTECTED
  :MEMBER MEDIUM ( CADDRESS -> CHARACTER UNSIGNED MEDIUM -- 4 TH )
    >THIS NEW STRING TITLE ! 0 PRICE ! THIS ;
  :MEMBER SET-PRICE ( UNSIGNED MEDIUM -- )
    PRICE ! ;
  :MEMBER GET-PRICE ( MEDIUM -- UNSIGNED )
    PRICE @ ;
  :NONAME ( MEDIUM -- )
    >THIS PRICE @ 8 10 */ PRICE ! ; IS SALE
  :MEMBER .PRICE ( MEDIUM -- )
    PRICE @ 100 /MOD 0 .R [CHAR] . . S>D <# # # #> TYPE ;
  :NONAME ( MEDIUM -- )
    >THIS TITLE @ . ." ($" .PRICE ." )" ; IS .
ENDCLASS

CLASS PAPER-MEDIUM
BODY
  ALSO PROTECTED DEFINITIONS
  NULL UNSIGNED MEMBER #PAGES
  FORTH DEFINITIONS PROTECTED
  :MEMBER PAPER-MEDIUM ( CADDRESS -> CHARACTER UNSIGNED UNSIGNED 
       PAPER-MEDIUM -- 5 TH )
    >THIS #PAGES ! MEDIUM ;
  :MEMBER PAGES ( PAPER-MEDIUM -- UNSIGNED )
    #PAGES @ ;
  :NONAME ( PAPER-MEDIUM -- )
    DUP [PARENT] . CR PAGES . ." pages" ; IS .
ENDCLASS

CLASS BOOK
BODY
  ALSO PROTECTED DEFINITIONS
  NULL STRING MEMBER AUTHOR
  FORTH DEFINITIONS PROTECTED
  :MEMBER BOOK ( CADDRESS -> CHARACTER UNSIGNED UNSIGNED BOOK -- 5 TH )
    >THIS NULL STRING AUTHOR ! PAPER-MEDIUM ;
  :MEMBER SET-AUTHOR ( CADDRESS -> CHARACTER UNSIGNED BOOK -- )
    >THIS NEW STRING AUTHOR ! ;
  :MEMBER GET-AUTHOR ( BOOK -- STRING )
    AUTHOR @ ;
  :NONAME ( BOOK -- )
    DUP GET-AUTHOR . ." - " [PARENT] . ; IS .
ENDCLASS

CLASS JOURNAL
BODY
  ALSO PROTECTED DEFINITIONS
  NULL UNSIGNED MEMBER YEAR
  NULL UNSIGNED MEMBER MONTH
  FORTH DEFINITIONS PROTECTED
  :MEMBER JOURNAL ( CADDRESS -> CHARACTER UNSIGNED UNSIGNED UNSIGNED 
     UNSIGNED JOURNAL -- 7 TH )
    >THIS YEAR ! MONTH ! PAPER-MEDIUM ;
  :NONAME ( JOURNAL -- )
    100 SWAP PRICE ! ; IS SALE
  :MEMBER .EDITION ( JOURNAL -- )
    DUP MONTH @ 0 .R [CHAR] / . YEAR @ . ;
  :NONAME ( JOURNAL -- )
    DUP [PARENT] . CR ." Edition " .EDITION ; IS .
ENDCLASS</pre>
<p>The virtual member table is built (or extended) between <kbd>CLASS</kbd> and 
<kbd>BODY</kbd>, where an item of data type <kbd>VTABLE-SIZE</kbd> is 
kept on the stack to count the number of address units allocated for the virtual 
member table. Between <kbd>BODY</kbd> and <kbd>ENDCLASS</kbd>, an item of data 
type <kbd>OBJ-SIZE</kbd> counts number of address units occupied by objects of 
the class. Now let's try <kbd>SELLOUT</kbd> again:</p>
<pre><u>: SELLOUT ( MEDIUM -- )</u>
<u>  ." Save money now!" CR DUP . CR DUP SALE</u>
<u>  ." Now for only $" .PRICE ." !" ;</u>  OK
<u>" Starting Forth" 348 NEW BOOK CONSTANT BOOK1</u>  OK
<u>" Leo Brodie" BOOK1 SET-AUTHOR</u>  OK
<u>1999 BOOK1 SET-PRICE</u>  OK
<u>BOOK1 .</u> Leo Brodie - Starting Forth ($19.99)
348 pages OK
<u>BOOK1 SELLOUT</u> Save money now!
Leo Brodie - Starting Forth ($19.99)
348 pages
Now for only $15.99! OK
<u>" Scientific American" 114 3 2008 NEW JOURNAL CONSTANT JOURNAL1</u>  OK
<u>799 JOURNAL1 SET-PRICE</u>  OK
<u>JOURNAL1 .</u> Scientific American ($7.99)
114 pages
Edition 3/2008  OK
<u>JOURNAL1 SELLOUT</u> Save money now!
Scientific American ($7.99)
114 pages
Edition 3/2008
Now for only $1.00! OK</pre>
<p>Okay, now it works fine. Both <kbd>.</kbd> and <kbd>SALE</kbd> used in 
<kbd>SELLOUT</kbd> are bound dynamically to their actual objects. Instead 
of statically being bound by the compiler to an object of class 
<kbd>MEDIUM</kbd>, the two words are bound to the object <kbd>SELLOUT</kbd> 
receives from the stack at runtime.</p>
<p>But you also have to change the definitions of <kbd>.</kbd> for 
classes <kbd>PAPER-MEDIUM</kbd>, <kbd>BOOK</kbd> and <kbd>JOURNAL</kbd>. 
Instead of just writing <kbd>.</kbd> to compile the version of <kbd>.</kbd> 
from the respective parent class, you now have to write 
<kbd>[PARENT] .</kbd> in order to accomplish the same thing as before. 
<kbd>[PARENT]</kbd> is an immediate word that 
compiles a virtual member bound <em>statically</em> to the version of the 
parent class. If you just write <kbd>.</kbd>, the compiler uses dynamic 
binding, which results in <kbd>.</kbd> executing itself and thus causing an 
endless recursion. But in this case, you want 
to explicitly compile the token of the parent's version of <kbd>.</kbd>. 
Generally, <kbd>[PARENT]</kbd> is useful whenever the semantics of 
a virtual member word that is defined in the parent class is to be somehow 
extended in the child class. This definitely applies to <kbd>.</kbd>. 
On the other hand, the original version of <kbd>SALE</kbd>, which is 
defined in class <kbd>MEDIUM</kbd>, is not being extended. The version of 
<kbd>SALE</kbd> in class <kbd>JOURNAL</kbd> has its own semantic. If