Annotation of gforth/objexamp.fs, revision 1.2
1.1 anton 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:
1.2 ! anton 85:
1.1 anton 86: object class
87: foobar implementation
88:
89: cell% inst-var n
90:
91: m: ( n object -- )
92: n !
93: ;m overrides construct
94:
95: m: ( object -- )
96: n @ .
97: ;m overrides print
98:
99: m: ( n object -- )
100: n +!
101: ;m overrides add
102:
103: protected
104:
105: create protected1
106:
107: protected
108:
109: create protected2
110:
111: cr order
112:
113: public
114:
115: create public1
116:
117: cr order
118:
119: \ we leave val undefined
120: end-class int
121:
122: \ a perhaps more sensible class structure would be to have int as
123: \ superclass of counter, but that would not exercise interfaces
124:
125: xcounter dict-new constant x
126: create y 3 int dict-new drop \ same as "3 int dict-new constant y"
127:
128: cr
129: y print cr
130: 20 x add
131: 20 y add
132: x val .
133: \ y val . \ undefined
134: y print
135: cr
136: int push-order
137: order cr
138: words cr
139: int drop-order
140: order
141: cr
142:
1.2 ! anton 143: \ test override of inherited interface selector
! 144: xcounter class
! 145:
! 146: m: ( object -- n )
! 147: this [parent] val 2*
! 148: ;m overrides val
! 149:
! 150: end-class ycounter
! 151:
! 152: ycounter dict-new constant z
! 153: cr
! 154: z print cr
! 155: z val . cr
! 156: z inc
! 157: z val . cr
! 158:
! 159: \ test inst-value
1.1 anton 160: object class
161: foobar implementation
162:
163: inst-value N
164:
165: m: ( n object -- )
166: this [parent] construct \ currently does nothing, but who knows
167: [to-inst] N
168: ;m overrides construct
169:
170: m: ( object -- )
171: N .
172: ;m overrides print
173:
174: m: ( object -- n )
175: N
176: ;m overrides val
177: end-class const-int
178:
179: 5 const-int heap-new constant five
180: five print
181: five val 1+ . cr
182: .s cr
183:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>