Annotation of gforth/oofsampl.fs, revision 1.1

1.1     ! pazsan      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>