File:  [gforth] / gforth / oofsampl.fs
Revision 1.1: download - view: text, annotated - select for diffs
Thu Sep 19 22:17:36 1996 UTC (23 years, 2 months ago) by pazsan
Branches: MAIN
CVS tags: v0-7-0, v0-6-2, v0-6-1, v0-6-0, v0-5-0, v0-4-0, v0-3-0, v0-2-1, v0-2-0, HEAD
Steps to make 0.2.0 dist-ready.

    1: \ oof.fs	Object Oriented FORTH
    2: \ 		This file is (c) 1996 by Bernd Paysan
    3: \			e-mail: paysan@informatik.tu-muenchen.de
    4: \
    5: \		Please copy and share this program, modify it for your system
    6: \		and improve it as you like. But don't remove this notice.
    7: \
    8: \		Thank you.
    9: \
   10: 
   11: \ Data structures: data                                28nov93py
   12: 
   13: : place ( addr1 n addr2 -- )
   14:     over >r rot over 1+ r> move c! ;
   15: 
   16: : i!  postpone ! ; immediate
   17: : i@  postpone @ ; immediate
   18: 
   19: object class data       \ abstract data class
   20:         cell var ref  \ reference counter
   21:         method !        method @        method .
   22:         method null     method atom?    method #
   23: how:    : atom? ( -- flag )  true ;
   24:         : #     ( -- n )     0 ;
   25:         : null  ( -- addr )  new ;
   26: class;
   27: 
   28: \ Data structures: int                                 30apr93py
   29: 
   30: data class int
   31:         cell var value
   32: how:    : !     value i! ;
   33:         : @     value i@ ;
   34:         : .     @ 0 .r ;
   35:         : init  ( data -- )  ! ;
   36:         : dispose  -1 ref +!
   37:           ref i@ 0> 0= IF  super dispose  THEN ;
   38:         : null  0 new ;
   39: class;
   40: 
   41: 
   42: 
   43: \ Data structures: list                                17nov93py
   44: 
   45: 0 Value nil
   46: 
   47: data class lists
   48:         data ptr first  data ptr next
   49:         method empty?   method ?
   50: how:    : null  nil ;
   51:         : atom? false ;
   52: class;
   53: 
   54: lists class nil-class
   55: 
   56: how:    : empty? true ;
   57:         : dispose ;
   58:         : .  ." ()" ;
   59: class;
   60: 
   61: nil-class : (nil                (nil self TO nil
   62: nil (nil bind first             nil (nil bind next
   63: 
   64:     
   65: \ Data structures: list                                12mar94py
   66: 
   67: lists class linked
   68: how:    : empty? false ;
   69:         : #      next # 1+ ;
   70:         : ?      first . ;
   71:         : @      first @ ;
   72:         : !      first ! ;
   73:         : init ( first next -- )
   74:                  dup >o 1 ref +! o> bind next
   75: 		 dup >o 1 ref +! o> bind first ;
   76:         : .      self >o  [char] (
   77:                  BEGIN  emit ? next atom? next self o> >o
   78:                         IF ."  . " data . o> ." )" EXIT THEN bl
   79:                         empty?  UNTIL  o> drop ." )" ;
   80:         : dispose  -1 ref +!  ref i@ 0> 0=
   81:           IF   first dispose  next dispose  super dispose  THEN ;
   82: class;
   83:       
   84: \ Data structures: string                              04dec93py
   85: 
   86: int class string
   87: how:    : !     ( addr count -- )
   88:                 value i@ over 1+ resize throw value i!
   89:                 value i@ place ;
   90:         : @     ( -- addr count )  value i@ count ;
   91:         : .     @ type ;
   92:         : init  ( addr count -- )
   93:           dup 1+ allocate throw value i! value i@ place ;
   94:         : null  S" " new ;
   95:         : dispose ref i@ 1- 0> 0=
   96:           IF  value i@ free throw  THEN  super dispose ;
   97: class;
   98: 
   99: \ Data sturctures: pointer                             17nov93py
  100: 
  101: data class pointer
  102:         data ptr container
  103:         method ptr!
  104: how:    : !     container ! ;
  105:         : @     container @ ;
  106:         : .     container . ;
  107:         : #     container # ;
  108:         : init  ( data -- )  dup >o 1 ref +! o> bind container ;
  109:         : ptr!  ( data -- )  container dispose  init ;
  110:         : dispose  -1 ref +!  ref i@ 0> 0=
  111:           IF  container dispose super dispose  THEN ;
  112:         : null  nil new ;
  113: class;
  114: 
  115: \ Data sturctures: array                               30apr93py
  116: 
  117: data class array
  118:         data [] container
  119:         cell var range
  120: how:    : !     container ! ;
  121:         : @     container @ ;
  122:         : .     [char] [
  123:                 # 0 ?DO emit I container . [char] , LOOP drop ." ]" ;
  124:         : init  ( data n -- )  range i!  bind container ;
  125:         : dispose  -1 ref +!  ref i@ 0> 0=
  126:           IF  # 0 ?DO  I container dispose  LOOP
  127:               super dispose  THEN ;
  128:         : null  nil 0 new ;
  129:         : #     range i@ ;
  130:         : atom? false ;
  131: class;
  132: 
  133: \ Data structure utilities                             17nov93py
  134: 
  135: : cons  linked new ;
  136: : list  nil cons ;
  137: : car   >o lists first self o> ;
  138: : cdr   >o lists next  self o> ;
  139: : print >o data . o> ;
  140: : ddrop >o data dispose o> ;
  141: : make-string string new ;
  142: : $"    state @ IF  postpone S" postpone make-string exit  THEN
  143:   [char] " parse make-string ;       immediate
  144: 
  145: \ Examples
  146: 
  147: $" This" $" is" $" a" list cons $" example" $" list" list cons list cons cons
  148: cr dup print
  149: cr dup car print
  150: cr dup cdr cdr car print
  151: pointer : list1
  152: cr list1 .
  153: 
  154: 1 2 3  3 int new[] 3 array : lotus
  155: cr lotus .
  156: cr 2 lotus @ .
  157: cr 0 lotus @ .
  158: cr 5 1 lotus ! lotus .
  159: 
  160: \ Interface test
  161: 
  162: interface bla
  163: method fasel
  164: method blubber
  165: method Hu
  166: how:
  167: : fasel ." Bla Fasel" Hu ;
  168: : blubber ." urps urps" Hu fasel ;
  169: interface;
  170: 
  171: object class test
  172: bla
  173: method .
  174: how:
  175: : Hu ." ! " ;
  176: : . fasel ;
  177: class;
  178: 
  179: test : test1
  180: cr test1 fasel
  181: cr test1 blubber
  182: cr test1 .
  183: cr test1 self >o bla blubber o>
  184: 
  185: \ This should output the following lines:
  186: \
  187: \ (This (is a) (example list))
  188: \ This
  189: \ (example list)
  190: \ (This (is a) (example list))
  191: \ [1,2,3]
  192: \ 3 
  193: \ 1 
  194: \ [1,5,3]
  195: \ Bla Fasel! 
  196: \ urps urps! Bla Fasel!
  197: \ Bla Fasel! 
  198: \ urps urps! Bla Fasel!
  199: 

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