WORDLISTs for its implementation (not vtables).
Major differences to Pountain's model are:
SEARCH-WORDLIST instead of patching link fields.
METHODS).
VALUE TO 0> 2>R 2R@ 2R> COMPILE,
WORDLIST SEARCH-WORDLIST DEFINITIONS SET-CURRENT GET-ORDER SET-ORDER
PREVIOUS
64 C/L) of it:
: LIT, ( x) POSTPONE LITERAL ; : >SIZE ( ta - n) CELL+ @ ; 0 VALUE SELF : SELF+ ( n - a) SELF + ; : SEND ( a xt) SELF >R SWAP TO SELF EXECUTE R> TO SELF ; VARIABLE CLS ( contains ta) : SIZE^ ( - aa) CLS @ ?DUP 0= ABORT" scope?" CELL+ ; : MFIND ( ta ca u - xt n) 2>R BEGIN DUP WHILE DUP @ 2R@ ROT SEARCH-WORDLIST ?DUP IF ROT DROP 2R> 2DROP EXIT THEN CELL+ CELL+ @ REPEAT -1 ABORT" can't?" ; : SEND' ( a ta "m ") BL WORD COUNT MFIND 0< STATE @ AND IF SWAP LIT, LIT, POSTPONE SEND ELSE SEND THEN ; : SUPER ( "m ") SIZE^ CELL+ @ BL WORD COUNT MFIND 0> IF EXECUTE ELSE COMPILE, THEN ; IMMEDIATE : DEFS ( n "f ") CREATE SIZE^ @ , SIZE^ +! IMMEDIATE DOES> @ STATE @ IF LIT, POSTPONE SELF+ ELSE SELF+ THEN ; : METHODS ( ta) DUP CLS ! @ DUP SET-CURRENT >R GET-ORDER R> SWAP 1+ SET-ORDER ; ( ALSO CONTEXT !) : CLASS ( "c ") CREATE HERE 0 , 0 , 0 , WORDLIST OVER ! METHODS ; : SUBCLASS ( ta "c ") CLASS SIZE^ OVER >SIZE OVER ! CELL+ ! ; : END ( ) SIZE^ DROP PREVIOUS DEFINITIONS 0 CLS ! ; : NEW ( ta "name ") CREATE DUP , >SIZE ALLOT IMMEDIATE DOES> DUP CELL+ SWAP @ SEND' ;
taoa"c ""f ""m "SELF, SELF+ and SEND' are easily replaced
by code words for a particular implementation. For example, in F/X and PoFo on the Macintosh,
I used a register for SELF.
1 CELLS CONSTANT CELL CLASS BUTTON CELL DEFS TEXT CELL DEFS LEN CELL DEFS X CELL DEFS Y : DRAW ( ) X @ Y @ AT-XY TEXT @ LEN @ TYPE ; : INIT ( ca u) 0 X ! 0 Y ! LEN ! TEXT ! ; END : BOLD 27 EMIT ." [1m" ; : NORMAL 27 EMIT ." [0m" ; BUTTON SUBCLASS BOLD-BUTTON : DRAW ( ) BOLD SUPER DRAW NORMAL ; END BUTTON NEW FOO S" thin foo" FOO INIT PAGE FOO DRAW BOLD-BUTTON NEW BAR S" fat bar" BAR INIT 1 BAR Y ! BAR DRAW
: VAR 1 CELLS DEFS ;would be a nice add-on. But there's more. We may nest objects within others:
: IV ( ta "name ") DUP >SIZE DEFS , DOES> 2@ SELF+ SWAP SEND' ;It is used thusly:
CLASS Foo Button IV btn1 Button IV btn2 ENDWe could also embed references to other objects, with
: REF ( ta "name ") VAR , DOES> 2@ SELF+ @ SWAP SEND' ;This allows us to say
CLASS Link 0 DEFS 'next Link REF next ENDwhere the
'next definition is used as a way to store addresses
into the reference field. Arrayed instance variables are left as an exercise
for the reader (I always wanted to say that sometime).
Also, for special cases, one might want to factor NEW into
: INSTANCE ( ta) DUP , >SIZE ALLOT DOES> DUP CELL+ SWAP @ SEND' ; : NEW ( ta "name ") CREATE INSTANCE IMMEDIATE ;thus providing a way of creating instances at runtime.
>SIZE).
So HYPE weighs only 23 now. Plus it doesn't require 0> anymore. Is this getting silly yet? :-)
: LIT, ( x) POSTPONE LITERAL ; 0 VALUE SELF : SELF+ ( n - a) SELF + ; : SEND ( a xt) SELF >R SWAP TO SELF EXECUTE R> TO SELF ; VARIABLE CLS ( contains ta -> |size|wid|super|) : SIZE^ ( - aa) CLS @ ?DUP 0= ABORT" scope?" ; : MFIND ( ta ca u - xt n) 2>R BEGIN DUP WHILE CELL+ DUP @ 2R@ ROT SEARCH-WORDLIST ?DUP IF ROT DROP 2R> 2DROP EXIT THEN CELL+ @ REPEAT -1 ABORT" can't?" ; : SEND' ( a ta "m ") BL WORD COUNT MFIND 0< STATE @ AND IF SWAP LIT, LIT, POSTPONE SEND ELSE SEND THEN ; : SUPER ( "m ") SIZE^ CELL+ CELL+ @ BL WORD COUNT MFIND 0< IF COMPILE, ELSE EXECUTE THEN ; IMMEDIATE : DEFS ( n "f ") CREATE SIZE^ @ , SIZE^ +! IMMEDIATE DOES> @ STATE @ IF LIT, POSTPONE SELF+ ELSE SELF+ THEN ; : METHODS ( ta) DUP CLS ! CELL+ @ DUP SET-CURRENT >R GET-ORDER R> SWAP 1+ SET-ORDER ; ( ALSO CONTEXT !) : CLASS ( "c ") CREATE HERE 0 , 0 , 0 , WORDLIST OVER CELL+ ! METHODS ; : SUBCLASS ( ta "c ") CLASS SIZE^ OVER @ OVER ! CELL+ CELL+ ! ; : END ( ) SIZE^ DROP PREVIOUS DEFINITIONS 0 CLS ! ; : NEW ( ta "name ") CREATE DUP , @ ALLOT IMMEDIATE DOES> DUP CELL+ SWAP @ SEND' ;