File:
[gforth] /
gforth /
oofsampl.fs
Revision
1.1:
download - view:
text,
annotated -
select for diffs
Thu Sep 19 22:17:36 1996 UTC (27 years, 7 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>