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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>