HYPE - a simple OOF implementation


Helge Horch
heho@gmx.de

May 1998
[URL: http://home.munich.netsurf.de/Helge.Horch/hype.html DATE: 06jan99]
NOTE: THIS WAS WORK IN PROGRESS FOR QUITEAWHILE. DON'T EXPECT TOO MUCH ANYMORE.

What?

This is a short description of HYPE, the author's implementation of object-oriented capabilities for Forth. They allow the programmer to define data and methods that act upon that data as a unit ("class").

Why now?

The recent thread on comp.lang.forth about different OOFs prompted me to revise my pet implementation. According to the categories Mike Hore has put forth, HYPE This makes HYPE a "type F" implementation.

Why at all?

I've been using HYPE (i.e. all its predecessors) for nearly nine years years now to my full satisfaction. HYPE originally grew from Dick Pountain's 1987 landmark book "Object-oriented Forth" [Academic Press]. I carried my implementation around to every Forth I used and modified it on the way. I wrote a small library of classes, e.g. classes for the Macintosh Toolbox, and experimented with MIDI classes.

Major differences to Pountain's model are:

  1. HYPE uses SEARCH-WORDLIST instead of patching link fields.
  2. Existing classes can be extended later (by using METHODS).
  3. Subclasses inherit instance variables, although they must be accessed with SUPER.
  4. Instance variables are public now (data hiding was of no great use to me in Forth anyway...)
  5. No extra object stack, which was synchronous with the return stack anyway.

What do I need?

The HYPE version below is intended for ANS-Forths. Beyond the CORE word set, it also requires

How much?

The code is herewith released into the public domain. If you really use and build upon it, I would be glad to hear of it. So here it is, all 24 lines (at 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' ;

This comprises the basic definitions I can't do without. Some quick explanations regarding the stack comments:
ta
the address of a class (formerly "type"), ta -> | wid | size | super-ta |
oa
the address of an object (instance), oa -> | ta | ... |
"c "
a class name follows the word
"f "
a field name (instance variable name) follows the word
"m "
an existing method name (selector) follows the word
Here's what I like about HYPE:

What does it look like?

Here is a HYPE version of Bernd Paysan's example, transcribed from his 12-line OOF:
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

Perhaps you'll agree that
: 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
END
We 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
END
where 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.

Now what?

Here are some open questions: Please direct comments, ideas and funky-ways-to-cut-HYPE-down-to-16-lines to me.

Appendix

12may98 NEWS FLASH: By staring at the code, I've managed to squeeze one more line out (>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' ;