Return to objexamp.fs CVS log

Up to [gforth] / gforth

added objexamp.fs

    1: \ examples and tests for objects.fs
    2: 
    3: \ written by Anton Ertl 1996, 1997
    4: \ public domain
    5: 
    6: cr object heap-new print
    7: 
    8: object class
    9: 
   10: :noname ( object -- )
   11:     drop ." undefined" ;
   12: overrides print
   13: end-class nothing
   14: 
   15: nothing heap-new constant undefined
   16: 
   17: cr undefined print
   18: 
   19: \ instance variables and this
   20: object class
   21:     cell% inst-var n
   22: m: ( object -- )
   23:    0 n ! ;m
   24: overrides construct
   25: m: ( object -- )
   26:     n @ . ;m
   27: overrides print
   28: m: ( object -- )
   29:     1 n +! ;m
   30: method inc
   31: end-class counter
   32: 
   33: counter heap-new constant counter1
   34: 
   35: cr
   36: counter1 print
   37: counter1 inc
   38: counter1 print
   39: counter1 inc
   40: counter1 inc
   41: counter1 inc
   42: counter1 print
   43: counter1 print
   44: 
   45: \ examples of static binding
   46: 
   47: cr undefined bind object print
   48: : object-print ( object -- )
   49:     [bind] object print ;
   50: 
   51: cr undefined object-print
   52: 
   53: \ interface
   54: 
   55: \ sorry, a meaningful example would be too long
   56: 
   57: interface
   58: selector add ( n object -- )
   59: selector val ( object -- n )
   60: end-interface foobar
   61: 
   62: counter class
   63:     foobar implementation
   64: 
   65: m: ( object -- )
   66:     this [parent] inc
   67:     n @ 10 mod 0=
   68:     if
   69: 	." xcounter " this object-print ." made another ten" cr
   70:     then
   71: ;m overrides inc
   72:     
   73: m: ( n object -- )
   74:     0 do
   75: 	this inc
   76:     loop
   77: ;m overrides add
   78: 
   79: m: ( object -- n )
   80:     n @
   81: ;m overrides val
   82: 
   83: end-class xcounter
   84: 
   85: object class
   86:     foobar implementation
   87: 
   88:     cell% inst-var n
   89: 
   90: m: ( n object -- )
   91:     n !
   92: ;m overrides construct
   93: 
   94: m: ( object -- )
   95:     n @ .
   96: ;m overrides print
   97: 
   98: m: ( n object -- )
   99:     n +!
  100: ;m overrides add
  101: 
  102: protected
  103: 
  104: create protected1
  105: 
  106: protected
  107: 
  108: create protected2
  109: 
  110: cr order
  111: 
  112: public
  113: 
  114: create public1
  115: 
  116: cr order
  117: 
  118: \ we leave val undefined
  119: end-class int
  120: 
  121: \ a perhaps more sensible class structure would be to have int as
  122: \ superclass of counter, but that would not exercise interfaces
  123: 
  124: xcounter dict-new constant x
  125: create y 3 int dict-new drop \ same as "3 int dict-new constant y"
  126: 
  127: cr
  128: y print cr
  129: 20 x add
  130: 20 y add
  131: x val .
  132: \ y val . \ undefined
  133: y print
  134: cr
  135: int push-order
  136: order cr
  137: words cr
  138: int drop-order
  139: order
  140: cr
  141: 
  142: object class
  143:     foobar implementation
  144: 
  145:     inst-value N
  146: 
  147:     m: ( n object -- )
  148:         this [parent] construct \ currently does nothing, but who knows
  149:         [to-inst] N
  150:     ;m overrides construct
  151: 
  152:     m: ( object -- )
  153:         N .
  154:     ;m overrides print
  155: 
  156:     m: ( object -- n )
  157:         N
  158:     ;m overrides val
  159: end-class const-int
  160: 
  161: 5 const-int heap-new constant five
  162: five print
  163: five val 1+ . cr
  164: .s cr
  165: