\\   *** Samples for object oriented programming ***   15mar93py                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ Data structures: data                                28nov93py                                                                Memory also Forth                                                                                                               \needs debugging  include oof.scr                                                                                               debugging class data       \ abstract data class                        cell var ref  \ reference counter                       public: method !        method @        method .                        method null     method atom?    method #                how:    : atom? ( -- flag )  true ;                                     : #     ( -- n )     0 ;                                        : null  ( -- addr )  new ;                              class;                                                                                                                                                                          -->             \ Data structures: int                                 05dec99py                                                                data class int                                                          cell var value                                          how:    : !     value F ! ;                                             : @     value F @ ;                                             : .     @ 0 .r ;                                                : init  ( data -- )  ! ;                                        : dispose  -1 ref +!                                              ref F @ 0<= IF  super dispose  THEN ;                         : null  0 new ;                                         class;                                                                                                                                                                                                                                                                                                          -->             \ Data structures: list                                17nov93pyforward nil                                                     data class lists                                                public: data ptr first  data ptr next                                   method empty?   method ?                                how:    : null  nil ;                                                   : atom? false ;                                         class;                                                          | lists class nil-class                                         how:    : empty? true ;                                                 : dispose ;                                                     : .  ." ()" ;                                           class;                                                          | nil-class : (nil              (nil self Aconstant nil         nil (nil bind first             nil (nil bind next                                                              -->             \ Data structures: list                                12mar94pylists class linked                                              how:    : empty? false ;        : #      next # 1+ ;                    : ?      first . ;                                              : @      first @ ;                                              : !      first ! ;                                              : init ( first next -- )                                                 dup >o 1 ref +! o> bind next                                    dup >o 1 ref +! o> bind first ;                        : .      self >o  '(                                                     BEGIN  emit ?  next atom?  next self o> >o                             IF ."  . " data . o> ." )"  EXIT THEN bl                        empty?  UNTIL  o> drop ." )" ;                  : dispose  -1 ref +!  ref F @ 0> 0=                               IF first dispose  next dispose  super dispose THEN ;  class;                                          -->             \ Data structures: string                              04dec93py                                                                int class string                                                how:    : !     ( addr count -- )                                               value over 1+ SetHandleSize                                     value F @ place ;                                       : @     ( -- addr count )  value F @ count ;                    : .     @ type ;                                                : init  ( addr count -- )                                         dup 1+ value Handle! value F @ place ;                        : null  S" " new ;                                              : dispose  ref F @ 1- 0> 0=                                       IF  value HandleOff  THEN  super dispose  ;           class;                                                                                                                                                                          -->             \ Data sturctures: pointer                             17nov93py                                                                data class pointer                                              public: data ptr container                                              method ptr!                                             how:    : !     container ! ;                                           : @     container @ ;                                           : .     container . ;                                           : #     container # ;                                           : init  ( data -- )  dup >o 1 ref +! o> bind container ;        : ptr!  ( data -- )  container dispose  init ;                  : dispose  -1 ref +!  ref F @ 0> 0=                               IF  container dispose super dispose  THEN ;                   : null  nil new ;                                       class;                                                                                                          -->             \ Data sturctures: array                               25feb00py                                                                data class array                                                public: data [] container                                               cell var range                                          how:    : !     container ! ;                                           : @     container @ ;                                           : .     '[                                                              # 0 ?DO emit I container . ', LOOP drop ." ]" ;         : init  ( data n -- )  range F !  bind[] container ;            : dispose  -1 ref +!  ref F @ 0> 0=                               IF  dispose[] container  super dispose  THEN ;                : null  nil 0 new ;                                             : #     range F @ ;                                             : atom? false ;                                         class;                                          -->             \ Data structure utilities                             20jun98py                                                                : cons  linked new ;                                            : list  nil cons ;                                              : car   >o lists first self o> ;                                : cdr   >o lists next  self o> ;                                : print >o data . o> ;                                          : ddrop >o data dispose o> ;                                    : make-string string new ;                                      : $"    state @ IF  compile S" compile make-string exit  THEN           '" parse make-string ;       immediate                                                                                                                                                                                                                                                                                                                                  -->             \ Examples                                             16jul00py                                                                $" This" $" is" $" a" list cons $" example" $" list"            list cons list cons cons                                        cr dup print                                                    cr dup car print                                                cr dup cdr cdr car print                                        pointer : list1                                                 cr list1 .                                                                                                                      1 2 3  3 int new[] 3 array : lotus                              cr lotus .                                                      cr 2 lotus @ .                                                  cr 0 lotus @ .                                                  cr 5 1 lotus ! lotus .                                          toss Forth                                      -->             \ interface test                                       16jul00py                                                                interface bla                                                   method fasel                                                    method blubber                                                  method Hu                                                       how:                                                            : fasel ." Bla Fasel" Hu ;                                      : blubber ." urps urps" Hu fasel ;                              interface;                                                                                                                                                                                                                                                                                                                                                                                                                                      -->             \ interface test                                       16jul00py                                                                object class test                                               bla                                                             method .                                                        how:                                                            : Hu ." ! " ;                                                   : . fasel ;                                                     class;                                                                                                                          test : test1                                                    cr test1 fasel                                                  cr test1 blubber                                                cr test1 .