Diff for /gforth/objects.fs between versions 1.16 and 1.19

version 1.16, 1999/07/08 09:46:42 version 1.19, 2000/09/23 15:06:01
Line 1 Line 1
 \ yet another Forth objects extension  \ yet another Forth objects extension
   
 \ written by Anton Ertl 1996-1999  \ written by Anton Ertl 1996-2000
 \ public domain; NO WARRANTY  \ public domain; NO WARRANTY
   
 \ This (in combination with compat/struct.fs) is in ANS Forth (with an  \ This (in combination with compat/struct.fs) is in ANS Forth (with an
Line 259  variable public-wordlist Line 259  variable public-wordlist
     then      then
     r> class-wordlist @ swap 1+ ;      r> class-wordlist @ swap 1+ ;
   
 : push-order ( class -- ) \ objects- objects  : class>order ( class -- ) \ objects- objects
     \g Add @var{class}'s wordlists to the head of the search-order.      \g Add @var{class}'s wordlists to the head of the search-order.
     >r get-order r> add-class-order set-order ;      >r get-order r> add-class-order set-order ;
   
   : push-order class>order ; \ old name
   
 : methods ( class -- ) \ objects- objects  : methods ( class -- ) \ objects- objects
     \g Makes @var{class} the current class. This is intended to be      \g Makes @var{class} the current class. This is intended to be
     \g used for defining methods to override selectors; you cannot      \g used for defining methods to override selectors; you cannot
     \g define new fields or selectors.      \g define new fields or selectors.
     dup current-interface ! push-order ;      dup current-interface ! class>order ;
   
 : class ( parent-class -- align offset ) \ objects- objects  : class ( parent-class -- align offset ) \ objects- objects
     \g Start a new class definition as a child of      \g Start a new class definition as a child of
Line 291  variable public-wordlist Line 293  variable public-wordlist
     until      until
     drop ;      drop ;
   
 : drop-order ( class -- ) \ objects- objects  : class-previous ( class -- ) \ objects- objects
     \g Drop @var{class}'s wordlists from the search order. No      \g Drop @var{class}'s wordlists from the search order. No
     \g checking is made whether @var{class}'s wordlists are actually      \g checking is made whether @var{class}'s wordlists are actually
     \g on the search order.      \g on the search order.
     >r get-order r> remove-class-order set-order ;      >r get-order r> remove-class-order set-order ;
   
   : drop-order class-previous ; \ old name
   
 : end-methods ( -- ) \ objects- objects  : end-methods ( -- ) \ objects- objects
     \g Switch back from defining methods of a class to normal mode      \g Switch back from defining methods of a class to normal mode
     \g (currently this just restores the old search order).      \g (currently this just restores the old search order).
     current-interface @ drop-order ;      current-interface @ class-previous ;
   
 : end-class-noname ( align offset -- class ) \ objects- objects  : end-class-noname ( align offset -- class ) \ objects- objects
     \g End a class definition. The resulting class is @var{class}.      \g End a class definition. The resulting class is @var{class}.
Line 481  current-interface 1 cells save-mem curre Line 485  current-interface 1 cells save-mem curre
 0 current-interface @ class-parent !  0 current-interface @ class-parent !
 wordlist current-interface @ class-wordlist !  wordlist current-interface @ class-wordlist !
 object%  object%
 current-interface @ push-order  current-interface @ class>order
   
 ' drop ( object -- )  ' drop ( object -- )
 method construct ( ... object -- ) \ objects- objects  method construct ( ... object -- ) \ objects- objects
Line 494  method print ( object -- ) \ objects- ob Line 498  method print ( object -- ) \ objects- ob
 \g Print the object. The method for the class @var{object} prints  \g Print the object. The method for the class @var{object} prints
 \g the address of the object and the address of its class.  \g the address of the object and the address of its class.
   
   selector equal ( object1 object2 -- flag )
   
 end-class object ( -- class ) \ objects- objects  end-class object ( -- class ) \ objects- objects
 \g the ancestor of all classes.  \g the ancestor of all classes.
   

Removed from v.1.16  
changed lines
  Added in v.1.19


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>