1 |
|
;****************************************************************************** |
2 |
|
;* ROSENMUELLER TPRINT.QUE * |
3 |
|
;****************************************************************************** |
4 |
|
|
5 |
|
;;** displace zu displac0 umbenannt, weil paket gedruckt wird 22.08.1990 |
6 |
|
**;; |
7 |
|
|
8 |
|
(write-to-string |
9 |
|
'(let ((a a1) |
10 |
|
(b b1)) |
11 |
|
1 2 |
12 |
|
(3 4) |
13 |
|
(5 6) |
14 |
|
7 8) :pretty t) |
15 |
|
"(LET ((A A1) |
16 |
|
(B B1)) |
17 |
|
1 2 |
18 |
|
(3 4) |
19 |
|
(5 6) |
20 |
|
7 8)" |
21 |
|
|
22 |
|
(write-to-string |
23 |
|
'(prog (1 2) |
24 |
|
(3 4) |
25 |
|
a (5 6) |
26 |
|
(8 9) |
27 |
|
x (zzz)) :pretty t) |
28 |
|
"(PROG (1 2) |
29 |
|
(3 4) |
30 |
|
A (5 6) |
31 |
|
(8 9) |
32 |
|
X (ZZZ))" |
33 |
|
|
34 |
|
(write-to-string |
35 |
|
'(do ((l '(1 2 3) |
36 |
|
(cdr l))) |
37 |
|
((null l) |
38 |
|
(print 'a1) |
39 |
|
(print 'a2)) |
40 |
|
(print l)) :pretty t) |
41 |
|
"(DO ((L '(1 2 3) |
42 |
|
(CDR L))) |
43 |
|
((NULL L) |
44 |
|
(PRINT 'A1) |
45 |
|
(PRINT 'A2)) |
46 |
|
(PRINT L))" |
47 |
|
|
48 |
|
(setq *print-level* nil *print-length* nil *print-pretty* t) |
49 |
|
T |
50 |
|
|
51 |
|
(WRITE-TO-STRING |
52 |
|
'(123 |
53 |
|
"das ist der 1. string laenger als 80 zeichen aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" |
54 |
|
456 |
55 |
|
"das ist der 2. bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" |
56 |
|
789) |
57 |
|
) |
58 |
|
"(123 \"das ist der 1. string laenger als 80 zeichen aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\" |
59 |
|
|
60 |
|
456 |
61 |
|
\"das ist der 2. bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\" |
62 |
|
|
63 |
|
789)" |
64 |
|
|
65 |
|
(setq tarray |
66 |
|
#4a((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20)) |
67 |
|
((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40)) |
68 |
|
((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))) |
69 |
|
(((61 62 63 64 65)(66 67 68 69 70)(11 12 13 14 15)(16 17 18 19 20)) |
70 |
|
((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40)) |
71 |
|
((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))) |
72 |
|
)) |
73 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
74 |
|
25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 |
75 |
|
49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 |
76 |
|
12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)( |
77 |
|
36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 |
78 |
|
60)))) |
79 |
|
|
80 |
|
(setq tal |
81 |
|
'((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20)) |
82 |
|
((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40)) |
83 |
|
((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))) |
84 |
|
(((61 62 63 64 65)(66 67 68 69 70)(11 12 13 14 15)(16 17 18 19 20)) |
85 |
|
((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40)) |
86 |
|
((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60))) |
87 |
|
)) |
88 |
|
((((1 2 3 4 5) |
89 |
|
(6 7 8 9 10) |
90 |
|
(11 12 13 14 15) |
91 |
|
(16 17 18 19 20)) |
92 |
|
((21 22 23 24 25) |
93 |
|
(26 27 28 29 30) |
94 |
|
(31 32 33 34 35) |
95 |
|
(36 37 38 39 40)) |
96 |
|
((41 42 43 44 45) |
97 |
|
(46 47 48 49 50) |
98 |
|
(51 52 53 54 55) |
99 |
|
(56 57 58 59 60))) |
100 |
|
(((61 62 63 64 65) |
101 |
|
(66 67 68 69 70) |
102 |
|
(11 12 13 14 15) |
103 |
|
(16 17 18 19 20)) |
104 |
|
((21 22 23 24 25) |
105 |
|
(26 27 28 29 30) |
106 |
|
(31 32 33 34 35) |
107 |
|
(36 37 38 39 40)) |
108 |
|
((41 42 43 44 45) |
109 |
|
(46 47 48 49 50) |
110 |
|
(51 52 53 54 55) |
111 |
|
(56 57 58 59 60)))) |
112 |
|
|
113 |
|
(setq tlist (list 'a 'b 'c tarray)) |
114 |
|
(A B C |
115 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
116 |
|
25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
117 |
|
48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
118 |
|
11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 |
119 |
|
34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 |
120 |
|
57 58 59 60))))) |
121 |
|
|
122 |
|
(setq *print-length* 6) |
123 |
|
6 |
124 |
|
|
125 |
|
tarray |
126 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)( |
127 |
|
26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 |
128 |
|
50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 |
129 |
|
13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 |
130 |
|
37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))) |
131 |
|
|
132 |
|
(WRITE-TO-STRING tal) |
133 |
|
"((((1 2 3 4 5) |
134 |
|
(6 7 8 9 10) |
135 |
|
(11 12 13 14 15) |
136 |
|
(16 17 18 19 20)) |
137 |
|
((21 22 23 24 25) |
138 |
|
(26 27 28 29 30) |
139 |
|
(31 32 33 34 35) |
140 |
|
(36 37 38 39 40)) |
141 |
|
((41 42 43 44 45) |
142 |
|
(46 47 48 49 50) |
143 |
|
(51 52 53 54 55) |
144 |
|
(56 57 58 59 60))) |
145 |
|
(((61 62 63 64 65) |
146 |
|
(66 67 68 69 70) |
147 |
|
(11 12 13 14 15) |
148 |
|
(16 17 18 19 20)) |
149 |
|
((21 22 23 24 25) |
150 |
|
(26 27 28 29 30) |
151 |
|
(31 32 33 34 35) |
152 |
|
(36 37 38 39 40)) |
153 |
|
((41 42 43 44 45) |
154 |
|
(46 47 48 49 50) |
155 |
|
(51 52 53 54 55) |
156 |
|
(56 57 58 59 60))))" |
157 |
|
|
158 |
|
(setq *print-length* 5) |
159 |
|
5 |
160 |
|
|
161 |
|
tarray |
162 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)( |
163 |
|
26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 |
164 |
|
50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 |
165 |
|
13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 |
166 |
|
37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))) |
167 |
|
|
168 |
|
(WRITE-TO-STRING tal) |
169 |
|
"((((1 2 3 4 5) |
170 |
|
(6 7 8 9 10) |
171 |
|
(11 12 13 14 15) |
172 |
|
(16 17 18 19 20)) |
173 |
|
((21 22 23 24 25) |
174 |
|
(26 27 28 29 30) |
175 |
|
(31 32 33 34 35) |
176 |
|
(36 37 38 39 40)) |
177 |
|
((41 42 43 44 45) |
178 |
|
(46 47 48 49 50) |
179 |
|
(51 52 53 54 55) |
180 |
|
(56 57 58 59 60))) |
181 |
|
(((61 62 63 64 65) |
182 |
|
(66 67 68 69 70) |
183 |
|
(11 12 13 14 15) |
184 |
|
(16 17 18 19 20)) |
185 |
|
((21 22 23 24 25) |
186 |
|
(26 27 28 29 30) |
187 |
|
(31 32 33 34 35) |
188 |
|
(36 37 38 39 40)) |
189 |
|
((41 42 43 44 45) |
190 |
|
(46 47 48 49 50) |
191 |
|
(51 52 53 54 55) |
192 |
|
(56 57 58 59 60))))" |
193 |
|
|
194 |
|
(setq *print-length* 4) |
195 |
|
4 |
196 |
|
|
197 |
|
(WRITE-TO-STRING tarray) |
198 |
|
"#4A((((1 2 3 4 ...)(6 7 8 9 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)( |
199 |
|
26 27 28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 |
200 |
|
49 ...)(51 52 53 54 ...)(56 57 58 59 ...)))(((61 62 63 64 ...)(66 67 68 69 ...)( |
201 |
|
11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)(26 27 28 29 ...)(31 32 33 |
202 |
|
34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 49 ...)(51 52 53 54 ...)(56 |
203 |
|
57 58 59 ...))))" |
204 |
|
;;"#4A((((1 2 3 4 ...)(6 7 8 9 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 |
205 |
|
;;24 ...)(26 27 28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)( |
206 |
|
;;46 47 48 49 ...)(51 52 53 54 ...)(56 57 58 59 ...)))(((61 62 63 64 ...)(66 67 |
207 |
|
;;68 69 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)(26 27 28 29 ...)( |
208 |
|
;;31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 49 ...)(51 52 53 |
209 |
|
;;54 ...)(56 57 58 59 ...))))" |
210 |
|
|
211 |
|
(WRITE-TO-STRING tal) |
212 |
|
"((((1 2 3 4 ...) |
213 |
|
(6 7 8 9 ...) |
214 |
|
(11 12 13 14 ...) |
215 |
|
(16 17 18 19 ...)) |
216 |
|
((21 22 23 24 ...) |
217 |
|
(26 27 28 29 ...) |
218 |
|
(31 32 33 34 ...) |
219 |
|
(36 37 38 39 ...)) |
220 |
|
((41 42 43 44 ...) |
221 |
|
(46 47 48 49 ...) |
222 |
|
(51 52 53 54 ...) |
223 |
|
(56 57 58 59 ...))) |
224 |
|
(((61 62 63 64 ...) |
225 |
|
(66 67 68 69 ...) |
226 |
|
(11 12 13 14 ...) |
227 |
|
(16 17 18 19 ...)) |
228 |
|
((21 22 23 24 ...) |
229 |
|
(26 27 28 29 ...) |
230 |
|
(31 32 33 34 ...) |
231 |
|
(36 37 38 39 ...)) |
232 |
|
((41 42 43 44 ...) |
233 |
|
(46 47 48 49 ...) |
234 |
|
(51 52 53 54 ...) |
235 |
|
(56 57 58 59 ...))))" |
236 |
|
|
237 |
|
(setq *print-length* 3) |
238 |
|
3 |
239 |
|
|
240 |
|
(WRITE-TO-STRING tarray) |
241 |
|
"#4A((((1 2 3 ...)(6 7 8 ...)(11 12 13 ...)...)((21 22 23 ...)(26 27 28 ...)(31 |
242 |
|
32 33 ...)...)((41 42 43 ...)(46 47 48 ...)(51 52 53 ...)...))(((61 62 63 ...)( |
243 |
|
66 67 68 ...)(11 12 13 ...)...)((21 22 23 ...)(26 27 28 ...)(31 32 33 ...)...)(( |
244 |
|
41 42 43 ...)(46 47 48 ...)(51 52 53 ...)...)))" |
245 |
|
|
246 |
|
(WRITE-TO-STRING tal) |
247 |
|
"((((1 2 3 ...) |
248 |
|
(6 7 8 ...) |
249 |
|
(11 12 13 ...) ...) |
250 |
|
((21 22 23 ...) |
251 |
|
(26 27 28 ...) |
252 |
|
(31 32 33 ...) ...) |
253 |
|
((41 42 43 ...) |
254 |
|
(46 47 48 ...) |
255 |
|
(51 52 53 ...) ...)) |
256 |
|
(((61 62 63 ...) |
257 |
|
(66 67 68 ...) |
258 |
|
(11 12 13 ...) ...) |
259 |
|
((21 22 23 ...) |
260 |
|
(26 27 28 ...) |
261 |
|
(31 32 33 ...) ...) |
262 |
|
((41 42 43 ...) |
263 |
|
(46 47 48 ...) |
264 |
|
(51 52 53 ...) ...)))" |
265 |
|
|
266 |
|
(setq *print-length* 2) |
267 |
|
2 |
268 |
|
|
269 |
|
(WRITE-TO-STRING tarray) |
270 |
|
"#4A((((1 2 ...)(6 7 ...)...)((21 22 ...)(26 27 ...)...)...)(((61 62 ...)(66 67 ...)...)(( |
271 |
|
21 22 ...)(26 27 ...)...)...))" |
272 |
|
|
273 |
|
(WRITE-TO-STRING tal) |
274 |
|
"((((1 2 ...) |
275 |
|
(6 7 ...) ...) |
276 |
|
((21 22 ...) |
277 |
|
(26 27 ...) ...) ...) |
278 |
|
(((61 62 ...) |
279 |
|
(66 67 ...) ...) |
280 |
|
((21 22 ...) |
281 |
|
(26 27 ...) ...) ...))" |
282 |
|
|
283 |
|
(setq *print-length* 1) |
284 |
|
1 |
285 |
|
|
286 |
|
(WRITE-TO-STRING tarray) |
287 |
|
"#4A((((1 ...)...)...)...)" |
288 |
|
|
289 |
|
(WRITE-TO-STRING tal) |
290 |
|
"((((1 ...) |
291 |
|
...) |
292 |
|
...) |
293 |
|
...)" |
294 |
|
;;"((((1 ...) ...) ...) ...)" |
295 |
|
|
296 |
|
(setq *print-length* 0) |
297 |
|
0 |
298 |
|
|
299 |
|
(WRITE-TO-STRING tarray) |
300 |
|
"#4A(...)" |
301 |
|
|
302 |
|
(WRITE-TO-STRING tal) |
303 |
|
"(...)" |
304 |
|
|
305 |
|
;***1 |
306 |
|
|
307 |
|
(setq *print-length* 6) |
308 |
|
6 |
309 |
|
|
310 |
|
tarray |
311 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)( |
312 |
|
26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 |
313 |
|
50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 |
314 |
|
13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 |
315 |
|
37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))) |
316 |
|
|
317 |
|
(WRITE-TO-STRING tal) |
318 |
|
"((((1 2 3 4 5) |
319 |
|
(6 7 8 9 10) |
320 |
|
(11 12 13 14 15) |
321 |
|
(16 17 18 19 20)) |
322 |
|
((21 22 23 24 25) |
323 |
|
(26 27 28 29 30) |
324 |
|
(31 32 33 34 35) |
325 |
|
(36 37 38 39 40)) |
326 |
|
((41 42 43 44 45) |
327 |
|
(46 47 48 49 50) |
328 |
|
(51 52 53 54 55) |
329 |
|
(56 57 58 59 60))) |
330 |
|
(((61 62 63 64 65) |
331 |
|
(66 67 68 69 70) |
332 |
|
(11 12 13 14 15) |
333 |
|
(16 17 18 19 20)) |
334 |
|
((21 22 23 24 25) |
335 |
|
(26 27 28 29 30) |
336 |
|
(31 32 33 34 35) |
337 |
|
(36 37 38 39 40)) |
338 |
|
((41 42 43 44 45) |
339 |
|
(46 47 48 49 50) |
340 |
|
(51 52 53 54 55) |
341 |
|
(56 57 58 59 60))))" |
342 |
|
|
343 |
|
(setq *print-level* 5) |
344 |
|
5 |
345 |
|
|
346 |
|
tarray |
347 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)( |
348 |
|
26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 |
349 |
|
50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 |
350 |
|
13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 |
351 |
|
37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))) |
352 |
|
|
353 |
|
(WRITE-TO-STRING tal) |
354 |
|
"((((1 2 3 4 5) |
355 |
|
(6 7 8 9 10) |
356 |
|
(11 12 13 14 15) |
357 |
|
(16 17 18 19 20)) |
358 |
|
((21 22 23 24 25) |
359 |
|
(26 27 28 29 30) |
360 |
|
(31 32 33 34 35) |
361 |
|
(36 37 38 39 40)) |
362 |
|
((41 42 43 44 45) |
363 |
|
(46 47 48 49 50) |
364 |
|
(51 52 53 54 55) |
365 |
|
(56 57 58 59 60))) |
366 |
|
(((61 62 63 64 65) |
367 |
|
(66 67 68 69 70) |
368 |
|
(11 12 13 14 15) |
369 |
|
(16 17 18 19 20)) |
370 |
|
((21 22 23 24 25) |
371 |
|
(26 27 28 29 30) |
372 |
|
(31 32 33 34 35) |
373 |
|
(36 37 38 39 40)) |
374 |
|
((41 42 43 44 45) |
375 |
|
(46 47 48 49 50) |
376 |
|
(51 52 53 54 55) |
377 |
|
(56 57 58 59 60))))" |
378 |
|
|
379 |
|
(setq *print-level* 4) |
380 |
|
4 |
381 |
|
|
382 |
|
tarray |
383 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)( |
384 |
|
26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 |
385 |
|
50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 |
386 |
|
13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 |
387 |
|
37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))) |
388 |
|
|
389 |
|
(WRITE-TO-STRING tal) |
390 |
|
"((((1 2 3 4 5) |
391 |
|
(6 7 8 9 10) |
392 |
|
(11 12 13 14 15) |
393 |
|
(16 17 18 19 20)) |
394 |
|
((21 22 23 24 25) |
395 |
|
(26 27 28 29 30) |
396 |
|
(31 32 33 34 35) |
397 |
|
(36 37 38 39 40)) |
398 |
|
((41 42 43 44 45) |
399 |
|
(46 47 48 49 50) |
400 |
|
(51 52 53 54 55) |
401 |
|
(56 57 58 59 60))) |
402 |
|
(((61 62 63 64 65) |
403 |
|
(66 67 68 69 70) |
404 |
|
(11 12 13 14 15) |
405 |
|
(16 17 18 19 20)) |
406 |
|
((21 22 23 24 25) |
407 |
|
(26 27 28 29 30) |
408 |
|
(31 32 33 34 35) |
409 |
|
(36 37 38 39 40)) |
410 |
|
((41 42 43 44 45) |
411 |
|
(46 47 48 49 50) |
412 |
|
(51 52 53 54 55) |
413 |
|
(56 57 58 59 60))))" |
414 |
|
|
415 |
|
(setq *print-level* 3) |
416 |
|
3 |
417 |
|
|
418 |
|
(WRITE-TO-STRING tarray) |
419 |
|
"#4A(((# # # #)(# # # #)(# # # #))((# # # #)(# # # #)(# # # #)))" |
420 |
|
|
421 |
|
(WRITE-TO-STRING tal) |
422 |
|
"(((# |
423 |
|
# |
424 |
|
# |
425 |
|
#) |
426 |
|
(# |
427 |
|
# |
428 |
|
# |
429 |
|
#) |
430 |
|
(# |
431 |
|
# |
432 |
|
# |
433 |
|
#)) |
434 |
|
((# |
435 |
|
# |
436 |
|
# |
437 |
|
#) |
438 |
|
(# |
439 |
|
# |
440 |
|
# |
441 |
|
#) |
442 |
|
(# |
443 |
|
# |
444 |
|
# |
445 |
|
#)))" |
446 |
|
|
447 |
|
(setq *print-level* 2) |
448 |
|
2 |
449 |
|
|
450 |
|
(WRITE-TO-STRING tarray) |
451 |
|
"#4A((# # #)(# # #))" |
452 |
|
|
453 |
|
(WRITE-TO-STRING tal) |
454 |
|
"((# |
455 |
|
# |
456 |
|
#) |
457 |
|
(# |
458 |
|
# |
459 |
|
#))" |
460 |
|
|
461 |
|
(setq *print-level* 1) |
462 |
|
1 |
463 |
|
|
464 |
|
(WRITE-TO-STRING tarray) |
465 |
|
"#4A(# #)" |
466 |
|
|
467 |
|
(WRITE-TO-STRING tal) |
468 |
|
"(# |
469 |
|
#)" |
470 |
|
|
471 |
|
(setq *print-level* 0) |
472 |
|
0 |
473 |
|
|
474 |
|
(WRITE-TO-STRING tarray) |
475 |
|
"#4A#" |
476 |
|
|
477 |
|
(WRITE-TO-STRING tal) |
478 |
|
"#" |
479 |
|
|
480 |
|
(setq *print-level* 6) |
481 |
|
6 |
482 |
|
|
483 |
|
tarray |
484 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)( |
485 |
|
26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 |
486 |
|
50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)(11 12 |
487 |
|
13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 35)(36 |
488 |
|
37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))) |
489 |
|
|
490 |
|
(WRITE-TO-STRING tal) |
491 |
|
"((((1 2 3 4 5) |
492 |
|
(6 7 8 9 10) |
493 |
|
(11 12 13 14 15) |
494 |
|
(16 17 18 19 20)) |
495 |
|
((21 22 23 24 25) |
496 |
|
(26 27 28 29 30) |
497 |
|
(31 32 33 34 35) |
498 |
|
(36 37 38 39 40)) |
499 |
|
((41 42 43 44 45) |
500 |
|
(46 47 48 49 50) |
501 |
|
(51 52 53 54 55) |
502 |
|
(56 57 58 59 60))) |
503 |
|
(((61 62 63 64 65) |
504 |
|
(66 67 68 69 70) |
505 |
|
(11 12 13 14 15) |
506 |
|
(16 17 18 19 20)) |
507 |
|
((21 22 23 24 25) |
508 |
|
(26 27 28 29 30) |
509 |
|
(31 32 33 34 35) |
510 |
|
(36 37 38 39 40)) |
511 |
|
((41 42 43 44 45) |
512 |
|
(46 47 48 49 50) |
513 |
|
(51 52 53 54 55) |
514 |
|
(56 57 58 59 60))))" |
515 |
|
|
516 |
|
(setq *print-length* 6) |
517 |
|
6 |
518 |
|
|
519 |
|
(WRITE-TO-STRING tlist) |
520 |
|
"(A B C |
521 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
522 |
|
25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
523 |
|
48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
524 |
|
11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 |
525 |
|
35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 |
526 |
|
58 59 60)))))" |
527 |
|
;;"(A B C |
528 |
|
;; #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
529 |
|
;; 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
530 |
|
;; 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
531 |
|
;; 11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 |
532 |
|
;; 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 |
533 |
|
;; 57 58 59 60)))))" |
534 |
|
|
535 |
|
(setq *print-length* 5) |
536 |
|
5 |
537 |
|
|
538 |
|
(WRITE-TO-STRING tlist) |
539 |
|
"(A B C |
540 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
541 |
|
25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
542 |
|
48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
543 |
|
11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 |
544 |
|
35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 |
545 |
|
58 59 60)))))" |
546 |
|
;;"(A B C |
547 |
|
;; #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
548 |
|
;; 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
549 |
|
;; 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
550 |
|
;; 11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 |
551 |
|
;; 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 |
552 |
|
;; 57 58 59 60)))))" |
553 |
|
|
554 |
|
(setq *print-length* 4) |
555 |
|
4 |
556 |
|
|
557 |
|
(WRITE-TO-STRING tlist) |
558 |
|
"(A B C |
559 |
|
#4A((((1 2 3 4 ...)(6 7 8 9 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 |
560 |
|
24 ...)(26 27 28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)( |
561 |
|
46 47 48 49 ...)(51 52 53 54 ...)(56 57 58 59 ...)))(((61 62 63 64 ...)(66 67 |
562 |
|
68 69 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)(26 27 28 29 ...)( |
563 |
|
31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 49 ...)(51 52 |
564 |
|
53 54 ...)(56 57 58 59 ...)))))" |
565 |
|
;;"(A B C #4A((((1 2 3 4 ...)(6 7 8 9 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 |
566 |
|
;; 22 23 24 ...)(26 27 28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 |
567 |
|
;; 44 ...)(46 47 48 49 ...)(51 52 53 54 ...)(56 57 58 59 ...)))(((61 62 63 64 ...)( |
568 |
|
;; 66 67 68 69 ...)(11 12 13 14 ...)(16 17 18 19 ...))((21 22 23 24 ...)(26 27 |
569 |
|
;; 28 29 ...)(31 32 33 34 ...)(36 37 38 39 ...))((41 42 43 44 ...)(46 47 48 49 ...)( |
570 |
|
;; 51 52 53 54 ...)(56 57 58 59 ...)))))" |
571 |
|
|
572 |
|
(setq *print-length* 3) |
573 |
|
3 |
574 |
|
|
575 |
|
(WRITE-TO-STRING tlist) |
576 |
|
"(A B C ...)" |
577 |
|
|
578 |
|
|
579 |
|
(setq *print-length* 2) |
580 |
|
2 |
581 |
|
|
582 |
|
(WRITE-TO-STRING tlist) |
583 |
|
"(A B ...)" |
584 |
|
|
585 |
|
|
586 |
|
(setq *print-length* 1) |
587 |
|
1 |
588 |
|
|
589 |
|
(WRITE-TO-STRING tlist) |
590 |
|
"(A ...)" |
591 |
|
|
592 |
|
|
593 |
|
(setq *print-length* 0) |
594 |
|
0 |
595 |
|
|
596 |
|
(WRITE-TO-STRING tlist) |
597 |
|
"(...)" |
598 |
|
|
599 |
|
(setq *print-length* 6) |
600 |
|
6 |
601 |
|
|
602 |
|
(WRITE-TO-STRING tlist) |
603 |
|
"(A B C |
604 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
605 |
|
25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
606 |
|
48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
607 |
|
11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 |
608 |
|
35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 |
609 |
|
58 59 60)))))" |
610 |
|
;;"(A B C |
611 |
|
;; #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
612 |
|
;; 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
613 |
|
;; 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
614 |
|
;; 11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 |
615 |
|
;; 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 |
616 |
|
;; 57 58 59 60)))))" |
617 |
|
|
618 |
|
(setq *print-level* 5) |
619 |
|
5 |
620 |
|
|
621 |
|
(WRITE-TO-STRING tlist) |
622 |
|
"(A B C |
623 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
624 |
|
25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
625 |
|
48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
626 |
|
11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 |
627 |
|
35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 |
628 |
|
58 59 60)))))" |
629 |
|
;;"(A B C |
630 |
|
;; #4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
631 |
|
;; 25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
632 |
|
;; 48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
633 |
|
;; 11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 |
634 |
|
;; 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 |
635 |
|
;; 57 58 59 60)))))" |
636 |
|
|
637 |
|
(setq *print-level* 4) |
638 |
|
4 |
639 |
|
|
640 |
|
(WRITE-TO-STRING tlist) |
641 |
|
"(A B C #4A(((# # # #)(# # # #)(# # # #))((# # # #)(# # # #)(# # # |
642 |
|
#))))" |
643 |
|
|
644 |
|
(setq *print-level* 3) |
645 |
|
3 |
646 |
|
|
647 |
|
(WRITE-TO-STRING tlist) |
648 |
|
"(A B C #4A((# # #)(# # #)))" |
649 |
|
|
650 |
|
|
651 |
|
(setq *print-level* 2) |
652 |
|
2 |
653 |
|
|
654 |
|
(WRITE-TO-STRING tlist) |
655 |
|
"(A B C #4A(# #))" |
656 |
|
|
657 |
|
(setq *print-level* 1) |
658 |
|
1 |
659 |
|
|
660 |
|
(WRITE-TO-STRING tlist) |
661 |
|
"(A B C #4A#)" |
662 |
|
|
663 |
|
(setq *print-level* 0) |
664 |
|
0 |
665 |
|
|
666 |
|
(WRITE-TO-STRING tlist) |
667 |
|
"#" |
668 |
|
|
669 |
|
(setq *print-level* 6) |
670 |
|
6 |
671 |
|
|
672 |
|
(WRITE-TO-STRING tlist) |
673 |
|
"(A B C |
674 |
|
#4A((((1 2 3 4 5)(6 7 8 9 10)(11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 |
675 |
|
25)(26 27 28 29 30)(31 32 33 34 35)(36 37 38 39 40))((41 42 43 44 45)(46 47 |
676 |
|
48 49 50)(51 52 53 54 55)(56 57 58 59 60)))(((61 62 63 64 65)(66 67 68 69 70)( |
677 |
|
11 12 13 14 15)(16 17 18 19 20))((21 22 23 24 25)(26 27 28 29 30)(31 32 33 34 |
678 |
|
35)(36 37 38 39 40))((41 42 43 44 45)(46 47 48 49 50)(51 52 53 54 55)(56 57 |
679 |
|
58 59 60)))))" |
680 |
|
|
681 |
|
;***2 |
682 |
|
|
683 |
|
(setq *print-pretty* t) |
684 |
|
t |
685 |
|
|
686 |
|
(setq *print-length* 10.) |
687 |
|
10 |
688 |
|
|
689 |
|
(setq *print-level* 3.) |
690 |
|
3 |
691 |
|
|
692 |
|
(setq *print-circle* nil) |
693 |
|
NIL |
694 |
|
|
695 |
|
(setq a '(10 11 12)) |
696 |
|
(10 11 12) |
697 |
|
|
698 |
|
(WRITE-TO-STRING (rplacd (cdr a) a)) |
699 |
|
"(11 10 11 10 11 10 11 10 11 10 ...)" |
700 |
|
|
701 |
|
(setq b '(10 11 12)) |
702 |
|
(10 11 12) |
703 |
|
|
704 |
|
(WRITE-TO-STRING (rplaca (cddr b) b)) |
705 |
|
"((10 11 |
706 |
|
(10 11 |
707 |
|
#)))" |
708 |
|
|
709 |
|
(setq c '(10 11 12 13)) |
710 |
|
(10 11 12 13) |
711 |
|
|
712 |
|
(WRITE-TO-STRING (rplacd (cddr c) (cdr c))) |
713 |
|
"(12 11 12 11 12 11 12 11 12 11 ...)" |
714 |
|
|
715 |
|
(WRITE-TO-STRING (setq d (list 'a 'b a 'c b c 'a ))) |
716 |
|
"(A B |
717 |
|
(10 11 10 11 10 11 10 11 10 11 ...) |
718 |
|
C |
719 |
|
(10 11 |
720 |
|
(10 11 |
721 |
|
#)) |
722 |
|
(10 11 12 11 12 11 12 11 12 11 ...) |
723 |
|
A)" |
724 |
|
|
725 |
|
(setq *print-length* nil) |
726 |
|
NIL |
727 |
|
|
728 |
|
(setq *print-level* nil) |
729 |
|
NIL |
730 |
|
|
731 |
|
(setq *print-circle* t) |
732 |
|
T |
733 |
|
|
734 |
|
(setq a '(10 11 12)) |
735 |
|
(10 11 12) |
736 |
|
|
737 |
|
(WRITE-TO-STRING (rplacd (cdr a) a)) |
738 |
|
"#2=(11 10 . #2#)" |
739 |
|
|
740 |
|
(setq b '(10 11 12)) |
741 |
|
(10 11 12) |
742 |
|
|
743 |
|
(WRITE-TO-STRING (rplaca (cddr b) b)) |
744 |
|
"(#1=(10 11 |
745 |
|
#1#))" |
746 |
|
;;"(#1=(10 11 |
747 |
|
;; #1#))" |
748 |
|
|
749 |
|
(setq c '(10 11 12 13)) |
750 |
|
(10 11 12 13) |
751 |
|
|
752 |
|
(WRITE-TO-STRING (rplacd (cddr c) (cdr c))) |
753 |
|
"#2=(12 11 . #2#)" |
754 |
|
|
755 |
|
(WRITE-TO-STRING (setq d (list 'a 'b a 'c b c 'a ))) |
756 |
|
"(A B |
757 |
|
#3=(10 11 . #3#) |
758 |
|
C |
759 |
|
#6=(10 11 |
760 |
|
#6#) |
761 |
|
(10 . #8=( 11 12 . #8#)) |
762 |
|
A)" |
763 |
|
;;"(A B |
764 |
|
;; #3=(10 11 . #3#) |
765 |
|
;; C |
766 |
|
;; #6=(10 11 |
767 |
|
;; #6#) |
768 |
|
;; (10 . #8=( 11 12 . #8#)) |
769 |
|
;; A)" |
770 |
|
|
771 |
|
(setq *print-circle* nil) |
772 |
|
NIL |
773 |
|
|
774 |
|
;***3 |
775 |
|
|
776 |
|
(setq sys::*pprint-max-indentation* 5) |
777 |
|
5 |
778 |
|
|
779 |
|
; (a b c ) ==> (a b c) |
780 |
|
(WRITE-TO-STRING '(a b c)) |
781 |
|
"(A B C)" |
782 |
|
|
783 |
|
; (aaaaaaaaaaa.. bbbbbbb.. cccc..) lang |
784 |
|
; ==> (aaaaa... bbbbb.. |
785 |
|
; ccc...) |
786 |
|
(WRITE-TO-STRING '(aaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb |
787 |
|
cc |
788 |
|
bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb dd |
789 |
|
cccccccccccccccccccccccccccccccccccccccccccccc eeeeeee)) |
790 |
|
"(AAAAAAAAA BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB CC |
791 |
|
BBBBBBBBBBBBBBBBBBBBBBBBBBBBBB DD |
792 |
|
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC EEEEEEE)" |
793 |
|
|
794 |
|
; ((a)(b)(c)) ==> ((a) (b) (c)) |
795 |
|
(WRITE-TO-STRING '((a) (b) (c))) |
796 |
|
"((A) |
797 |
|
(B) |
798 |
|
(C))" |
799 |
|
|
800 |
|
; ((aaaa..) (bbbb..) (cccc..)) lang |
801 |
|
; ==> ((aaaa....) |
802 |
|
; (bbbb...) |
803 |
|
; (ccc..)) |
804 |
|
(WRITE-TO-STRING '((aaaaaaaaaaaaaaaaaaaaaaaaaa) |
805 |
|
(bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb) |
806 |
|
(ccccccccccccccccccccc) |
807 |
|
(dddddddddddddddddddddddddddddddddd))) |
808 |
|
"((AAAAAAAAAAAAAAAAAAAAAAAAAA) |
809 |
|
(BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB) |
810 |
|
(CCCCCCCCCCCCCCCCCCCCC) |
811 |
|
(DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD))" |
812 |
|
|
813 |
|
; (abcde (a)(b)(c)) ==> (abcde (a) (b) (c)) |
814 |
|
(WRITE-TO-STRING '(abcde (a)(b)(c))) |
815 |
|
"(ABCDE (A) |
816 |
|
(B) |
817 |
|
(C))" |
818 |
|
|
819 |
|
; (abcde (aaaaaa..) (bbb..) ...) lang |
820 |
|
; ==> (abcde (aaaa....) |
821 |
|
; (bbbb...) |
822 |
|
; (ccc.......)) |
823 |
|
(WRITE-TO-STRING '(abcde (aaaaaaaaaaaaaaaaaaaaaaaaaaaaa) (bbbbbbbbbbbbbbbbbbbbb) |
824 |
|
(cccccccccccccccccccccccccccccccc) |
825 |
|
(dddddddddddddddddddddddddddddddddddddd))) |
826 |
|
"(ABCDE (AAAAAAAAAAAAAAAAAAAAAAAAAAAAA) |
827 |
|
(BBBBBBBBBBBBBBBBBBBBB) |
828 |
|
(CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC) |
829 |
|
(DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD))" |
830 |
|
|
831 |
|
; (form1 form2 ...) eine Zeile |
832 |
|
; ==> (form1 form2 ...) |
833 |
|
(WRITE-TO-STRING '((a 1 2) (b 1 2) (c 1 2))) |
834 |
|
"((A 1 2) |
835 |
|
(B 1 2) |
836 |
|
(C 1 2))" |
837 |
|
|
838 |
|
; (form1 form2 ...) lang |
839 |
|
; ==> (form1 |
840 |
|
; form2 ...) |
841 |
|
(WRITE-TO-STRING '((aaaaaaaaaa 1111111111 2222222222) |
842 |
|
(bbbbbbbbbb 1111111111 2222222222) |
843 |
|
(cccccccccc 1111111111 2222222222))) |
844 |
|
"((AAAAAAAAAA 1111111111 2222222222) |
845 |
|
(BBBBBBBBBB 1111111111 2222222222) |
846 |
|
(CCCCCCCCCC 1111111111 2222222222))" |
847 |
|
|
848 |
|
; (atom form1 form2 ....) |
849 |
|
; ==> (atom form1 |
850 |
|
; form2..) |
851 |
|
(WRITE-TO-STRING '(abcde (a 1 2) (b 1 2))) |
852 |
|
"(ABCDE (A 1 2) |
853 |
|
(B 1 2))" |
854 |
|
|
855 |
|
(WRITE-TO-STRING '(abcde (aaaaaaaaaaaaaaaaa 111111111111 22222222222) |
856 |
|
(bbbbbbbbbbbbbbbbb 111111111111 22222222222) |
857 |
|
(ccccccccccccccccc 111111111111 22222222222))) |
858 |
|
"(ABCDE (AAAAAAAAAAAAAAAAA 111111111111 22222222222) |
859 |
|
(BBBBBBBBBBBBBBBBB 111111111111 22222222222) |
860 |
|
(CCCCCCCCCCCCCCCCC 111111111111 22222222222))" |
861 |
|
|
862 |
|
; (prog form1 form2 atom form3 ...) |
863 |
|
; ==> (prog form1 |
864 |
|
; form2 |
865 |
|
; atom form3 ..) |
866 |
|
;; 16.8.1990 ab hier alle progs ausgetauscht, da alte am zeilenende zwei space? |
867 |
|
(WRITE-TO-STRING '(prog (a 1 2) (b 1 2) at (c 1 2) (d 1 2))) |
868 |
|
"(PROG (A 1 2) |
869 |
|
(B 1 2) |
870 |
|
AT (C 1 2) |
871 |
|
(D 1 2))" |
872 |
|
|
873 |
|
(WRITE-TO-STRING '(prog (a 1 2) (b 1 2) atommarke (c 1 2) (d 1 2))) |
874 |
|
"(PROG (A 1 2) |
875 |
|
(B 1 2) |
876 |
|
ATOMMARKE |
877 |
|
(C 1 2) |
878 |
|
(D 1 2))" |
879 |
|
|
880 |
|
(WRITE-TO-STRING '(tagbody (a) (b) at (c) (d))) |
881 |
|
"(TAGBODY |
882 |
|
(A) |
883 |
|
(B) |
884 |
|
AT (C) |
885 |
|
(D))" |
886 |
|
;;"(TAGBODY (A) |
887 |
|
;; (B) ........) |
888 |
|
|
889 |
|
; (form1 atom1 atom2 form2..) |
890 |
|
; ==> (form1 |
891 |
|
; atom1 atom2 |
892 |
|
; form2..) |
893 |
|
(WRITE-TO-STRING '((a 1 2) at1 at2 (b 1 2) (c 1 2))) |
894 |
|
"((A 1 2) |
895 |
|
AT1 AT2 |
896 |
|
(B 1 2) |
897 |
|
(C 1 2))" |
898 |
|
|
899 |
|
(WRITE-TO-STRING '((aaaaaaaaaaaa 11111111111 22222222222) atom1 atom2 |
900 |
|
(bbbbbbbbbbbb 11111111111 222222222222) |
901 |
|
(ccccc 1111 2222 3333))) |
902 |
|
"((AAAAAAAAAAAA 11111111111 22222222222) |
903 |
|
ATOM1 ATOM2 |
904 |
|
(BBBBBBBBBBBB 11111111111 222222222222) |
905 |
|
(CCCCC 1111 2222 3333))" |
906 |
|
|
907 |
|
; (atom1 atom2 atom3 .. ) lang |
908 |
|
; ==> (atom1 atom2 .. |
909 |
|
; atomn..) |
910 |
|
(WRITE-TO-STRING '(aaaaaaaaaaaaaaaa b ccccccccccccccccc dddddd eeeeeeeeeeeeeeee |
911 |
|
|
912 |
|
ffffffffffffffffffffffffffffffffffffffff ggg hhhh iiiii |
913 |
|
jjjjjjjjjjjjjjjjjj k l m n ooooooooooooooo)) |
914 |
|
"(AAAAAAAAAAAAAAAA B CCCCCCCCCCCCCCCCC DDDDDD EEEEEEEEEEEEEEEE |
915 |
|
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF GGG HHHH IIIII |
916 |
|
JJJJJJJJJJJJJJJJJJ K L M N OOOOOOOOOOOOOOO)" |
917 |
|
|
918 |
|
; Test der Sonderfunktionen |
919 |
|
;; ab hier alle gequoteten objekte mit terpri ! |
920 |
|
(WRITE-TO-STRING '(a '1 b)) |
921 |
|
"(A '1 B)" |
922 |
|
|
923 |
|
(WRITE-TO-STRING '(a `'b c)) |
924 |
|
"(A `'B |
925 |
|
C)" |
926 |
|
|
927 |
|
(WRITE-TO-STRING '(a '''''''''b c)) |
928 |
|
"(A '''''''''B |
929 |
|
C)" |
930 |
|
|
931 |
|
(WRITE-TO-STRING '(a b 'c d)) |
932 |
|
"(A B 'C D)" |
933 |
|
|
934 |
|
(WRITE-TO-STRING '(aaaaaaaaaa bbbbbbbbbbbb 'c |
935 |
|
ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd)) |
936 |
|
"(AAAAAAAAAA BBBBBBBBBBBB 'C |
937 |
|
DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD)" |
938 |
|
|
939 |
|
(WRITE-TO-STRING '(a (b) 'c d)) |
940 |
|
"(A (B) |
941 |
|
'C D)" |
942 |
|
|
943 |
|
(WRITE-TO-STRING '(aaaaaaaaaa (bbbbbbbbbbbb) 'c |
944 |
|
dddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd)) |
945 |
|
"(AAAAAAAAAA (BBBBBBBBBBBB) |
946 |
|
'C DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD)" |
947 |
|
|
948 |
|
(WRITE-TO-STRING '(a #'b c)) |
949 |
|
"(A #'B |
950 |
|
C)" |
951 |
|
;;"(A #'B C)" |
952 |
|
|
953 |
|
(WRITE-TO-STRING '(a `b c)) |
954 |
|
"(A `B |
955 |
|
C)" |
956 |
|
;;"(A `B C)" |
957 |
|
|
958 |
|
(WRITE-TO-STRING '(a ,b c)) |
959 |
|
"(A ,B |
960 |
|
C)" |
961 |
|
;;"(A ,B C)" |
962 |
|
|
963 |
|
(WRITE-TO-STRING '(a ,@b c)) |
964 |
|
"(A ,@B |
965 |
|
C)" |
966 |
|
;;"(A ,@B C)" |
967 |
|
|
968 |
|
(WRITE-TO-STRING '(a ,.b c)) |
969 |
|
"(A ,.B |
970 |
|
C)" |
971 |
|
;;"(A ,.B C)" |
972 |
|
|
973 |
|
(WRITE-TO-STRING '(displac0 (liste1)(liste2))) |
974 |
|
"(displac0 (LISTE1) |
975 |
|
(LISTE2))" |
976 |
|
|
977 |
|
(WRITE-TO-STRING |
978 |
|
'(lambda (form vare lenv benv) |
979 |
|
(progn (mapcon '(lambda (x) |
980 |
|
(if (typep 'list x) |
981 |
|
(compile-exp x vare |
982 |
|
lenv benv) |
983 |
|
'((lbl ,(cdr(assoc x |
984 |
|
lenv )))))))))) |
985 |
|
"(LAMBDA (FORM VARE LENV BENV) |
986 |
|
(PROGN (MAPCON '(LAMBDA (X) |
987 |
|
(IF (TYPEP 'LIST X) |
988 |
|
(COMPILE-EXP X VARE LENV BENV) |
989 |
|
'((LBL ,(CDR (ASSOC X LENV)))))))))" |
990 |
|
|
991 |
|
(WRITE-TO-STRING |
992 |
|
'(lambda () |
993 |
|
((c) nil "12345678901234567890123456789012"))) |
994 |
|
"(LAMBDA NIL |
995 |
|
((C) |
996 |
|
NIL \"12345678901234567890123456789012\"))" |
997 |
|
|
998 |
|
(WRITE-TO-STRING '(lambda () |
999 |
|
((cccccccccccccccccccccccccccccccccccccccccccc) nil |
1000 |
|
"12345678901234567890123456789012"))) |
1001 |
|
"(LAMBDA NIL |
1002 |
|
((CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC) |
1003 |
|
NIL \"12345678901234567890123456789012\"))" |
1004 |
|
|
1005 |
|
(WRITE-TO-STRING '(defun ed-search-all |
1006 |
|
(cl) |
1007 |
|
(cond ((null (consp cl)) nil) |
1008 |
|
((ed-search cl) t) |
1009 |
|
(t nil)))) |
1010 |
|
"(DEFUN ED-SEARCH-ALL |
1011 |
|
(CL) |
1012 |
|
(COND ((NULL (CONSP CL)) |
1013 |
|
NIL) |
1014 |
|
((ED-SEARCH CL) |
1015 |
|
T) |
1016 |
|
(T NIL)))" |
1017 |
|
|
1018 |
|
(WRITE-TO-STRING '(defun ed-search-all |
1019 |
|
(cl) |
1020 |
|
(cond ((null (consp ccccccccclllllllllll)) nil) |
1021 |
|
((ed-search ccccccccclllllllllll) t) |
1022 |
|
(t nil)))) |
1023 |
|
"(DEFUN ED-SEARCH-ALL |
1024 |
|
(CL) |
1025 |
|
(COND ((NULL (CONSP CCCCCCCCCLLLLLLLLLLL)) |
1026 |
|
NIL) |
1027 |
|
((ED-SEARCH CCCCCCCCCLLLLLLLLLLL) |
1028 |
|
T) |
1029 |
|
(T NIL)))" |
1030 |
|
|
1031 |
|
(WRITE-TO-STRING '(a b c |
1032 |
|
(d) |
1033 |
|
'e f g h i )) |
1034 |
|
"(A B C |
1035 |
|
(D) |
1036 |
|
'E F G H I)" |
1037 |
|
|
1038 |
|
(WRITE-TO-STRING '(aaaaaaaaaaa bbbbbbbbbb cccccccccc |
1039 |
|
(dddddddddd) |
1040 |
|
'eeeeeeeeee fffffffffff gggggggggg hhhhhhhhhh iiiiiiiiii )) |
1041 |
|
"(AAAAAAAAAAA BBBBBBBBBB CCCCCCCCCC |
1042 |
|
(DDDDDDDDDD) |
1043 |
|
'EEEEEEEEEE FFFFFFFFFFF GGGGGGGGGG HHHHHHHHHH IIIIIIIIII)" |
1044 |
|
|
1045 |
|
(WRITE-TO-STRING '(DEFMACRO DEFSTRUCT |
1046 |
|
(LET ((TYPE (CAR TYPE-OPTIONS)) (OPTIONS (CDR TYPE-OPTIONS))) |
1047 |
|
(LET ((DEFSTRUCT-TYPE (ANY-KNOWN-TYPE OPTIONS))) |
1048 |
|
`(PROGN 'COMPILE |
1049 |
|
(PUT ',TYPE |
1050 |
|
(MAKE-DEFSTRUCT-DESCRIPTION NAME |
1051 |
|
(LET ((I (1- (DEFSTRUCT-TYPE-DESCRIPTION-OVERHEAD ( |
1052 |
|
GET ',DEFSTRUCT-TYPE |
1053 |
|
'DEFSTRUCT-TYPE-DESCRIPTION))))))))))))) |
1054 |
|
"(DEFMACRO DEFSTRUCT |
1055 |
|
(LET ((TYPE (CAR TYPE-OPTIONS)) |
1056 |
|
(OPTIONS (CDR TYPE-OPTIONS))) |
1057 |
|
(LET ((DEFSTRUCT-TYPE (ANY-KNOWN-TYPE OPTIONS))) |
1058 |
|
`(PROGN 'COMPILE |
1059 |
|
(PUT ',TYPE |
1060 |
|
(MAKE-DEFSTRUCT-DESCRIPTION NAME |
1061 |
|
(LET ((I (1- |
1062 |
|
(DEFSTRUCT-TYPE-DESCRIPTION-OVERHEAD |
1063 |
|
(GET ',DEFSTRUCT-TYPE |
1064 |
|
'DEFSTRUCT-TYPE-DESCRIPTION))))))))))))" |
1065 |
|
|
1066 |
|
(WRITE-TO-STRING '(SETQ (COND ((SETQ (CATCH (MAPCAN '(LAMBDA (SPEC) |
1067 |
|
|
1068 |
|
(CASE (T (COND ((SETQ (COND ((MINUSP SPEC)))))))))))))))) |
1069 |
|
"(SETQ (COND ((SETQ (CATCH (MAPCAN '(LAMBDA (SPEC) |
1070 |
|
(CASE (T (COND ((SETQ (COND ((MINUSP |
1071 |
|
SPEC)))))))))))))))" |
1072 |
|
|
1073 |
|
(WRITE-TO-STRING '((SETQ (CATCH (MAPCAN '(LAMBDA (SPEC) |
1074 |
|
(CASE (T (COND ((COND (EVENT1 (COND ((AND (EQCAR INPU |
1075 |
|
)))))))))))))))) |
1076 |
|
"((SETQ (CATCH (MAPCAN '(LAMBDA (SPEC) |
1077 |
|
(CASE (T (COND ((COND (EVENT1 (COND ((AND (EQCAR |
1078 |
|
INPU)))))))))))))))" |
1079 |
|
(WRITE-TO-STRING '(case a |
1080 |
|
(otto (aaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbb) |
1081 |
|
(ccccccccccccccccccccc ddddddddddddddddddddddddddddddddddddd)) |
1082 |
|
(:otto (aaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb) |
1083 |
|
(ccccccccccccccccccccccccc ddddddddddddddddddddddddd)) |
1084 |
|
(12 (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbbbb) |
1085 |
|
(ccccccccccccccccccccccccccccccccc ddddddddddddddddddddddddddd)) |
1086 |
|
(#\n (aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb) |
1087 |
|
(ccccccccccccccccccccccccccccccccccccccc ddddddddddddddddddddddd)))) |
1088 |
|
"(CASE A |
1089 |
|
(OTTO (AAAAAAAAAAAAAAAAAAAAAAAAAAAAA BBBBBBBBBBBBBBBBBBBBBB) |
1090 |
|
(CCCCCCCCCCCCCCCCCCCCC DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD)) |
1091 |
|
(:OTTO (AAAAAAAAAAAAAAAAAAAAAA BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB) |
1092 |
|
(CCCCCCCCCCCCCCCCCCCCCCCCC DDDDDDDDDDDDDDDDDDDDDDDDD)) |
1093 |
|
(12 (AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA BBBBBBBBBBBBBBBBBBBBBBBBBBB) |
1094 |
|
(CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DDDDDDDDDDDDDDDDDDDDDDDDDDD)) |
1095 |
|
(#\\n (AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA BBBBBBBBBBBBBBBBBBBBBBBBB) |
1096 |
|
(CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DDDDDDDDDDDDDDDDDDDDDDD)))" |
1097 |
|
|
1098 |
|
(WRITE-TO-STRING '(DEFMACRO DEFSTRUCT-TYPE-DESCRIPTION-OVERHEAD (A_STRUCTURE) |
1099 |
|
|
1100 |
|
(LET ((TYPE (QUOTE DEFSTRUCT-TYPE-DESCRIPTION)) (SLOT-NAME (QUOTE OVERHEAD))) |
1101 |
|
|
1102 |
|
(EVAL (DEFSTRUCT-TYPE-DESCRIPTION-REF |
1103 |
|
(GET (QUOTE LIST) (QUOTE DEFSTRUCT-TYPE-DESCRIPTION))))))) |
1104 |
|
"(DEFMACRO DEFSTRUCT-TYPE-DESCRIPTION-OVERHEAD |
1105 |
|
(A_STRUCTURE) |
1106 |
|
(LET ((TYPE 'DEFSTRUCT-TYPE-DESCRIPTION) |
1107 |
|
(SLOT-NAME 'OVERHEAD)) |
1108 |
|
(EVAL (DEFSTRUCT-TYPE-DESCRIPTION-REF (GET 'LIST |
1109 |
|
'DEFSTRUCT-TYPE-DESCRIPTION)))))" |
1110 |
|
|
1111 |
|
(WRITE-TO-STRING '(defmacro aaa |
1112 |
|
(let--eval--defstruct-type-description-ref |
1113 |
|
(get lista qdefstruct-type-description)))) |
1114 |
|
"(DEFMACRO AAA |
1115 |
|
(LET--EVAL--DEFSTRUCT-TYPE-DESCRIPTION-REF (GET LISTA |
1116 |
|
QDEFSTRUCT-TYPE-DESCRIPTION)))" |
1117 |
|
|
1118 |
|
(WRITE-TO-STRING |
1119 |
|
'(UN-MAC-EXPAND DM-DF KWOTE MOVD SP VIRGINFN OK EF EXPAND-MCALL |
1120 |
|
EXPANDMACROS IS-displac0 IS-MACRO MAC-EXPAND R-EXPANDMACROS |
1121 |
|
PUTPROPS1 *UNDIS *DIS COPY PUTPROPS *CHE *CL *CLE *TEST *UNBLOCK |
1122 |
|
CH |
1123 |
|
EDITCOMS EDREPLACE PRINTLEVEL NEQ *UNDO ABFRAGE ATOML CONS0 CONT |
1124 |
|
EDFIND1ST |
1125 |
|
EDITF )) |
1126 |
|
"(UN-MAC-EXPAND DM-DF KWOTE MOVD SP VIRGINFN OK EF EXPAND-MCALL EXPANDMACROS |
1127 |
|
IS-displac0 IS-MACRO MAC-EXPAND R-EXPANDMACROS PUTPROPS1 *UNDIS *DIS |
1128 |
|
COPY PUTPROPS *CHE *CL *CLE *TEST *UNBLOCK CH EDITCOMS EDREPLACE |
1129 |
|
PRINTLEVEL NEQ *UNDO ABFRAGE ATOML CONS0 CONT EDFIND1ST EDITF)" |
1130 |
|
|
1131 |
|
(WRITE-TO-STRING '(DEFUN MAKEFILE |
1132 |
|
(LET |
1133 |
|
(PRINT (displac0 (LIST 'PRINT (LIST 'QUOTE (LIST 'LAST 'UPDATE |
1134 |
|
(DATE-TIME)))) `(PRINT '(LAST UPDATE ,(DATE-TIME)))) (OR ECHO STREAM)) |
1135 |
|
(PRINT (displac0 (LIST 'PRINT (LIST 'QUOTE (LIST 'VERSION GENV))) |
1136 |
|
`(PRINT '(VERSION ,GENV))) (OR ECHO STREAM)) |
1137 |
|
(WHEN FNSV (PRINT (displac0 (LIST 'SETQ FNS (LIST 'QUOTE FNSV)) |
1138 |
|
`(SETQ ,FNS ',FNSV)) (OR ECHO STREAM))) |
1139 |
|
(WHEN VARSV (PRINT (displac0 (LIST 'SETQ VARS (LIST 'QUOTE VARSV)) |
1140 |
|
`(SETQ ,VARS ',VARSV)) (OR ECHO STREAM))) |
1141 |
|
(PRINT (displac0 (LIST 'SETQ COMS (LIST 'QUOTE COMSV)) `(SETQ |
1142 |
|
,COMS ',COMSV)) (OR ECHO STREAM)) |
1143 |
|
(PRINT (LIST 'SETQ GEN GENV) (OR ECHO STREAM)) ))) |
1144 |
|
"(DEFUN MAKEFILE |
1145 |
|
(LET (PRINT (displac0 (LIST 'PRINT |
1146 |
|
(LIST 'QUOTE |
1147 |
|
(LIST 'LAST 'UPDATE |
1148 |
|
(DATE-TIME)))) |
1149 |
|
`(PRINT '(LAST UPDATE |
1150 |
|
,(DATE-TIME)))) |
1151 |
|
(OR ECHO STREAM)) |
1152 |
|
(PRINT (displac0 (LIST 'PRINT |
1153 |
|
(LIST 'QUOTE |
1154 |
|
(LIST 'VERSION GENV))) |
1155 |
|
`(PRINT '(VERSION ,GENV))) |
1156 |
|
(OR ECHO STREAM)) |
1157 |
|
(WHEN FNSV |
1158 |
|
(PRINT (displac0 (LIST 'SETQ FNS |
1159 |
|
(LIST 'QUOTE FNSV)) |
1160 |
|
`(SETQ ,FNS |
1161 |
|
',FNSV)) |
1162 |
|
(OR ECHO STREAM))) |
1163 |
|
(WHEN VARSV |
1164 |
|
(PRINT (displac0 (LIST 'SETQ VARS |
1165 |
|
(LIST 'QUOTE VARSV)) |
1166 |
|
`(SETQ ,VARS |
1167 |
|
',VARSV)) |
1168 |
|
(OR ECHO STREAM))) |
1169 |
|
(PRINT (displac0 (LIST 'SETQ COMS |
1170 |
|
(LIST 'QUOTE COMSV)) |
1171 |
|
`(SETQ ,COMS |
1172 |
|
',COMSV)) |
1173 |
|
(OR ECHO STREAM)) |
1174 |
|
(PRINT (LIST 'SETQ GEN GENV) |
1175 |
|
(OR ECHO STREAM))))" |
1176 |
|
|
1177 |
|
(write-to-string '(DEFUN EVENT-SPEC |
1178 |
|
(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa ( |
1179 |
|
(NUMBERP |
1180 |
|
SPEC) |
1181 |
|
(SETQ |
1182 |
|
EVENT1 |
1183 |
|
(COND ( |
1184 |
|
(MINUSP |
1185 |
|
SPEC) |
1186 |
|
(NTH-BACK |
1187 |
|
HISTORY |
1188 |
|
(1- |
1189 |
|
SPEC))) |
1190 |
|
)))))) |
1191 |
|
"(DEFUN EVENT-SPEC |
1192 |
|
(AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA ( |
1193 |
|
(NUMBERP |
1194 |
|
SPEC) |
1195 |
|
(SETQ |
1196 |
|
EVENT1 |
1197 |
|
(COND ( |
1198 |
|
(MINUSP |
1199 |
|
SPEC) |
1200 |
|
(NTH-BACK |
1201 |
|
HISTORY |
1202 |
|
(1- |
1203 |
|
SPEC))))))))" |
1204 |
|
|
1205 |
|
(WRITE-TO-STRING '(DEFUN EVENT-SPEC |
1206 |
|
((LAMBDAxSETQxxCONDxxxSETQxxCATCHxxMAPCANxxxxxCASE (TxxCOND |
1207 |
|
(COND (EVENT1 |
1208 |
|
(COND (E (LIST EVENT1)) |
1209 |
|
((AND (CONSP INPU) ;!!! |
1210 |
|
(EQCAR INPU '&GROUP)) |
1211 |
|
(APPEND (CDR INPU) NIL)) ;!!! |
1212 |
|
(T))))))))) |
1213 |
|
"(DEFUN EVENT-SPEC |
1214 |
|
((LAMBDAXSETQXXCONDXXXSETQXXCATCHXXMAPCANXXXXXCASE (TXXCOND (COND |
1215 |
|
(EVENT1 |
1216 |
|
(COND |
1217 |
|
(E |
1218 |
|
(LIST |
1219 |
|
EVENT1)) |
1220 |
|
( |
1221 |
|
(AND |
1222 |
|
(CONSP |
1223 |
|
INPU) |
1224 |
|
(EQCAR |
1225 |
|
INPU |
1226 |
|
'&GROUP)) |
1227 |
|
(APPEND |
1228 |
|
(CDR |
1229 |
|
INPU) |
1230 |
|
NIL)) |
1231 |
|
(T))))))))" |
1232 |
|
(WRITE-TO-STRING |
1233 |
|
'(DEFUN EVENT-SPEC |
1234 |
|
((LAMBDA (EVENT V INPUT EVENT1 I E) |
1235 |
|
(SETQ INPUT |
1236 |
|
(COND ((SETQ INPUT |
1237 |
|
(CATCH 'TAG |
1238 |
|
(MAPCAN '(LAMBDA (SPEC) |
1239 |
|
(CASE SPEC |
1240 |
|
(T (COND ((NUMBERP SPEC) |
1241 |
|
(SETQ EVENT1 |
1242 |
|
(COND ((MINUSP SPEC) |
1243 |
|
(NTH-BACK HISTORY |
1244 |
|
(1- SPEC))))) |
1245 |
|
(COND (EVENT1 (COND ((AND (EQCAR INPU '&GROUP))))))) |
1246 |
|
(T (PRINTL-SP "illegale specification" SPEC 'IN L)))))) |
1247 |
|
L)))))))))) |
1248 |
|
"(DEFUN EVENT-SPEC |
1249 |
|
((LAMBDA (EVENT V INPUT EVENT1 I E) |
1250 |
|
(SETQ INPUT |
1251 |
|
(COND ((SETQ INPUT |
1252 |
|
(CATCH 'TAG |
1253 |
|
(MAPCAN '(LAMBDA (SPEC) |
1254 |
|
(CASE SPEC |
1255 |
|
(T (COND ( |
1256 |
|
(NUMBERP |
1257 |
|
SPEC) |
1258 |
|
(SETQ |
1259 |
|
EVENT1 |
1260 |
|
(COND ( |
1261 |
|
(MINUSP |
1262 |
|
SPEC) |
1263 |
|
(NTH-BACK |
1264 |
|
HISTORY |
1265 |
|
(1- |
1266 |
|
SPEC))))) |
1267 |
|
(COND |
1268 |
|
(EVENT1 |
1269 |
|
(COND ( |
1270 |
|
(AND |
1271 |
|
(EQCAR |
1272 |
|
INPU |
1273 |
|
'&GROUP))))))) |
1274 |
|
(T |
1275 |
|
(PRINTL-SP |
1276 |
|
\"illegale specification\" |
1277 |
|
SPEC 'IN L)))))) |
1278 |
|
L)))))))))" |
1279 |
|
|
1280 |
|
(WRITE-TO-STRING '(DEFUN EVENT-SPEC |
1281 |
|
(HISTORY &OPTIONAL L) |
1282 |
|
((LAMBDA (EVENT V INPUT EVENT1 I E) |
1283 |
|
(SETQ INPUT |
1284 |
|
(COND ((NULL L) |
1285 |
|
(CAR (CDR (CAR (CAR (CDDDR (CAR HISTORY))))))) |
1286 |
|
((SETQ INPUT |
1287 |
|
(CATCH 'TAG |
1288 |
|
(MAPCAN '(LAMBDA (SPEC) |
1289 |
|
(CASE SPEC |
1290 |
|
(V (SETQ V T) |
1291 |
|
(SETQ E NIL) |
1292 |
|
NIL) |
1293 |
|
(I (SETQ V NIL) |
1294 |
|
(SETQ E NIL)) |
1295 |
|
(E (SETQ E T) |
1296 |
|
(SETQ V NIL) |
1297 |
|
(SETQ I NIL)) |
1298 |
|
(T (COND ( |
1299 |
|
(NUMBERP |
1300 |
|
SPEC) |
1301 |
|
(SETQ |
1302 |
|
EVENT1 |
1303 |
|
(COND ( |
1304 |
|
(MINUSP |
1305 |
|
SPEC) |
1306 |
|
(NTH-BACK |
1307 |
|
HISTORY |
1308 |
|
(1- |
1309 |
|
SPEC))) |
1310 |
|
( |
1311 |
|
(ASSQ-HOLD |
1312 |
|
SPEC |
1313 |
|
HISTORY)))) |
1314 |
|
(COND |
1315 |
|
(EVENT1 |
1316 |
|
(SETQ |
1317 |
|
INPU |
1318 |
|
(CAR |
1319 |
|
(CDR |
1320 |
|
EVENT1))) |
1321 |
|
(COND |
1322 |
|
(V |
1323 |
|
(LIST |
1324 |
|
(CAR |
1325 |
|
(CDDR |
1326 |
|
EVENT1)))) |
1327 |
|
(E |
1328 |
|
(LIST |
1329 |
|
EVENT1)) |
1330 |
|
( |
1331 |
|
(AND |
1332 |
|
(CONSP |
1333 |
|
INPU) |
1334 |
|
(EQCAR |
1335 |
|
INPU |
1336 |
|
'&GROUP)) |
1337 |
|
(APPEND |
1338 |
|
(CDR |
1339 |
|
INPU) |
1340 |
|
NIL)) |
1341 |
|
(T |
1342 |
|
(LIST |
1343 |
|
INPU)))))) |
1344 |
|
(T |
1345 |
|
(PRINTL-SP |
1346 |
|
"illegale specification" |
1347 |
|
SPEC |
1348 |
|
'IN L) ))))))))))))))) |
1349 |
|
"(DEFUN EVENT-SPEC |
1350 |
|
(HISTORY &OPTIONAL L) |
1351 |
|
((LAMBDA (EVENT V INPUT EVENT1 I E) |
1352 |
|
(SETQ INPUT |
1353 |
|
(COND ((NULL L) |
1354 |
|
(CAR (CDR (CAR (CAR (CDDDR (CAR HISTORY))))))) |
1355 |
|
((SETQ INPUT |
1356 |
|
(CATCH 'TAG |
1357 |
|
(MAPCAN '(LAMBDA (SPEC) |
1358 |
|
(CASE SPEC |
1359 |
|
(V (SETQ V T) |
1360 |
|
(SETQ E NIL) |
1361 |
|
NIL) |
1362 |
|
(I (SETQ V NIL) |
1363 |
|
(SETQ E NIL)) |
1364 |
|
(E (SETQ E T) |
1365 |
|
(SETQ V NIL) |
1366 |
|
(SETQ I NIL)) |
1367 |
|
(T (COND ( |
1368 |
|
(NUMBERP |
1369 |
|
SPEC) |
1370 |
|
(SETQ |
1371 |
|
EVENT1 |
1372 |
|
(COND ( |
1373 |
|
(MINUSP |
1374 |
|
SPEC) |
1375 |
|
(NTH-BACK |
1376 |
|
HISTORY |
1377 |
|
(1- |
1378 |
|
SPEC))) |
1379 |
|
( |
1380 |
|
(ASSQ-HOLD |
1381 |
|
SPEC |
1382 |
|
HISTORY)))) |
1383 |
|
(COND |
1384 |
|
(EVENT1 |
1385 |
|
(SETQ |
1386 |
|
INPU |
1387 |
|
(CAR |
1388 |
|
(CDR |
1389 |
|
EVENT1))) |
1390 |
|
(COND |
1391 |
|
(V |
1392 |
|
(LIST |
1393 |
|
(CAR |
1394 |
|
(CDDR |
1395 |
|
EVENT1)))) |
1396 |
|
(E |
1397 |
|
(LIST |
1398 |
|
EVENT1)) |
1399 |
|
( |
1400 |
|
(AND |
1401 |
|
(CONSP |
1402 |
|
INPU) |
1403 |
|
(EQCAR |
1404 |
|
INPU |
1405 |
|
'&GROUP)) |
1406 |
|
(APPEND |
1407 |
|
(CDR |
1408 |
|
INPU) |
1409 |
|
NIL)) |
1410 |
|
(T |
1411 |
|
(LIST |
1412 |
|
INPU)))))) |
1413 |
|
(T |
1414 |
|
(PRINTL-SP |
1415 |
|
\"illegale specification\" |
1416 |
|
SPEC 'IN L)))))))))))))))" |
1417 |
|
|
1418 |
|
;***4 |
1419 |
|
|
1420 |
|
(WRITE-TO-STRING '(LAMBDA (PP-CALL &OPTIONAL ENV) |
1421 |
|
(LET ((SYMB (CADR PP-CALL))) |
1422 |
|
(IF (SYMBOLP SYMB) |
1423 |
|
(LIST 'PROGN |
1424 |
|
(IF (BOUNDP SYMB) |
1425 |
|
(LIST 'PPRINT SYMB)) |
1426 |
|
(IF (FBOUNDP SYMB) |
1427 |
|
(LET ((FUN (SYMBOL-FUNCTION SYMB))) |
1428 |
|
(COND ((EQ (SYSTEM::%GET-TYPE FUN) |
1429 |
|
SYSTEM::%TYPE-CLOSURE) |
1430 |
|
(LIST 'PPRINT |
1431 |
|
(LIST 'QUOTE |
1432 |
|
(LIST* 'DEFUN SYMB |
1433 |
|
(CDR (SYSTEM::%P-GET-CONTENT |
1434 |
|
(SYSTEM::%INDEX-LOCATION |
1435 |
|
FUN 3))))))) |
1436 |
|
((EQ (SYSTEM::%GET-TYPE FUN) |
1437 |
|
SYSTEM::%TYPE-CONS) |
1438 |
|
(LIST 'PPRINT |
1439 |
|
(LIST 'QUOTE |
1440 |
|
(LIST* 'DEFUN SYMB |
1441 |
|
(CDR FUN))))) |
1442 |
|
((EQ (SYSTEM::%GET-TYPE FUN) |
1443 |
|
SYSTEM::%TYPE-MACRO-FUNCTION) |
1444 |
|
(LET ((FUNLIS (SYSTEM::%SET-TYPE-POINTER |
1445 |
|
SYSTEM::%TYPE-CONS |
1446 |
|
FUN))) |
1447 |
|
(LIST 'PPRINT |
1448 |
|
(LIST 'QUOTE |
1449 |
|
(COND ((NULL (CDR FUNLIS)) |
1450 |
|
(CAR FUNLIS)) |
1451 |
|
(T (CADR FUNLIS)))))))))) |
1452 |
|
"ok"))))) |
1453 |
|
"(LAMBDA (PP-CALL &OPTIONAL ENV) |
1454 |
|
(LET ((SYMB (CADR PP-CALL))) |
1455 |
|
(IF (SYMBOLP SYMB) |
1456 |
|
(LIST 'PROGN |
1457 |
|
(IF (BOUNDP SYMB) |
1458 |
|
(LIST 'PPRINT SYMB)) |
1459 |
|
(IF (FBOUNDP SYMB) |
1460 |
|
(LET ((FUN (SYMBOL-FUNCTION SYMB))) |
1461 |
|
(COND ((EQ (SYSTEM::%GET-TYPE FUN) |
1462 |
|
SYSTEM::%TYPE-CLOSURE) |
1463 |
|
(LIST 'PPRINT |
1464 |
|
(LIST 'QUOTE |
1465 |
|
(LIST* 'DEFUN SYMB |
1466 |
|
(CDR |
1467 |
|
(SYSTEM::%P-GET-CONTENT |
1468 |
|
(SYSTEM::%INDEX-LOCATION |
1469 |
|
FUN 3))))))) |
1470 |
|
((EQ (SYSTEM::%GET-TYPE FUN) |
1471 |
|
SYSTEM::%TYPE-CONS) |
1472 |
|
(LIST 'PPRINT |
1473 |
|
(LIST 'QUOTE |
1474 |
|
(LIST* 'DEFUN SYMB |
1475 |
|
(CDR FUN))))) |
1476 |
|
((EQ (SYSTEM::%GET-TYPE FUN) |
1477 |
|
SYSTEM::%TYPE-MACRO-FUNCTION) |
1478 |
|
(LET ((FUNLIS (SYSTEM::%SET-TYPE-POINTER |
1479 |
|
SYSTEM::%TYPE-CONS |
1480 |
|
FUN))) |
1481 |
|
(LIST 'PPRINT |
1482 |
|
(LIST 'QUOTE |
1483 |
|
(COND ((NULL (CDR FUNLIS)) |
1484 |
|
(CAR FUNLIS)) |
1485 |
|
(T (CADR FUNLIS)))))))))) |
1486 |
|
\"ok\"))))" |
1487 |
|
|
1488 |
|
(WRITE-TO-STRING ' |
1489 |
|
(LAMBDA (PP-CALL &OPTIONAL ENV) |
1490 |
|
(LET ((SYMB (CADR PP-CALL))) |
1491 |
|
(IF (SYMBOLP SYMB) |
1492 |
|
(LIST 'PROGN |
1493 |
|
(IF (BOUNDP SYMB) |
1494 |
|
(LIST 'PPRINT SYMB)) |
1495 |
|
(IF (FBOUNDP SYMB) |
1496 |
|
(LET ((FUN (SYMBOL-FUNCTION SYMB))) |
1497 |
|
(COND ((EQ (SYSTEM::%GET-TYPE FUN) |
1498 |
|
SYSTEM::%TYPE-CLOSURE) |
1499 |
|
(LIST 'PPRINT |
1500 |
|
(LIST 'QUOTE |
1501 |
|
(LIST* 'DEFUN SYMB |
1502 |
|
(CDR (SYSTEM::%P-GET-CONTENT |
1503 |
|
(SYSTEM::%INDEX-LOCATION |
1504 |
|
FUN 3))))))) )))))))) |
1505 |
|
"(LAMBDA (PP-CALL &OPTIONAL ENV) |
1506 |
|
(LET ((SYMB (CADR PP-CALL))) |
1507 |
|
(IF (SYMBOLP SYMB) |
1508 |
|
(LIST 'PROGN |
1509 |
|
(IF (BOUNDP SYMB) |
1510 |
|
(LIST 'PPRINT SYMB)) |
1511 |
|
(IF (FBOUNDP SYMB) |
1512 |
|
(LET ((FUN (SYMBOL-FUNCTION SYMB))) |
1513 |
|
(COND ((EQ (SYSTEM::%GET-TYPE FUN) |
1514 |
|
SYSTEM::%TYPE-CLOSURE) |
1515 |
|
(LIST 'PPRINT |
1516 |
|
(LIST 'QUOTE |
1517 |
|
(LIST* 'DEFUN SYMB |
1518 |
|
(CDR |
1519 |
|
(SYSTEM::%P-GET-CONTENT |
1520 |
|
(SYSTEM::%INDEX-LOCATION |
1521 |
|
FUN 3))))))))))))))" |
1522 |
|
(WRITE-TO-STRING ' |
1523 |
|
(LAMBDA (PP-CALL &OPTIONAL ENV) |
1524 |
|
(LET (IF (LIST (IF (LET (COND ((LIST (LIST (LIST* (CDR (SYSTEM::%P-GET-CONTENT |
1525 |
|
(SYSTEM::%INDEX-LOCATION |
1526 |
|
FUN 3))))))) )))))))) |
1527 |
|
"(LAMBDA (PP-CALL &OPTIONAL ENV) |
1528 |
|
(LET (IF (LIST (IF (LET (COND ((LIST (LIST (LIST* (CDR |
1529 |
|
(SYSTEM::%P-GET-CONTENT |
1530 |
|
(SYSTEM::%INDEX-LOCATION |
1531 |
|
FUN 3))))))))))))))" |
1532 |
|
(WRITE-TO-STRING ' |
1533 |
|
(LAMBDA (PP-CALL &OPTIONAL ENV) |
1534 |
|
(letttttttttttttttttttttttttttttttttttttttttttttt (CDR (SYSTEM::%P-GET-CONTENT |
1535 |
|
(SYSTEM::%INDEX-LOCATION |
1536 |
|
FUN 3)))))) |
1537 |
|
"(LAMBDA (PP-CALL &OPTIONAL ENV) |
1538 |
|
(LETTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT (CDR |
1539 |
|
(SYSTEM::%P-GET-CONTENT |
1540 |
|
(SYSTEM::%INDEX-LOCATION |
1541 |
|
FUN 3)))))" |
1542 |
|
|
1543 |
|
(WRITE-TO-STRING ' |
1544 |
|
(lambdaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa (CDR (SYSTEM::%P-GET-CONTENT |
1545 |
|
(SYSTEM::%INDEX-LOCATION |
1546 |
|
FUN 3) )))) |
1547 |
|
"(LAMBDAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA (CDR |
1548 |
|
(SYSTEM::%P-GET-CONTENT |
1549 |
|
(SYSTEM::%INDEX-LOCATION |
1550 |
|
FUN 3))))" |
1551 |
|
|
1552 |
|
(WRITE-TO-STRING ' |
1553 |
|
(laaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa (SYSTEM::%P-GET-CONTENT |
1554 |
|
(SYSTEM::%INDEX-LOCATION |
1555 |
|
FUN 3) ))) |
1556 |
|
"(LAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA |
1557 |
|
(SYSTEM::%P-GET-CONTENT (SYSTEM::%INDEX-LOCATION FUN 3)))" |
1558 |
|
|
1559 |
|
(SETQ *PRINT-PRETTY* NIL) |
1560 |
|
NIL |
1561 |
|
|
1562 |
|
;***5 |
1563 |
|
|
1564 |
|
(defstruct name a b c d e) |
1565 |
|
NAME |
1566 |
|
|
1567 |
|
(progn (setq val '(name 1 2 3 4 5)) |
1568 |
|
(setq st (sys::%set-type-pointer sys::%type-named-structure val)) |
1569 |
|
T) |
1570 |
|
T |
1571 |
|
|
1572 |
|
(WRITE-TO-STRING st) |
1573 |
|
"#S(NAME A 1 B 2 C 3 D 4 E 5)" |
1574 |
|
|
1575 |
|
(defstruct (pcvar (:print-function print-pcvar)) id) |
1576 |
|
pcvar |
1577 |
|
|
1578 |
|
(defun print-pcvar (var str dep) |
1579 |
|
(format str "?~s" (pcvar-id var))) |
1580 |
|
print-pcvar |
1581 |
|
|
1582 |
|
(prin1-to-string (make-pcvar :id 'otto)) |
1583 |
|
"?OTTO" |
1584 |
|
|
1585 |
|
#|------------------------------------------------------------------------- |
1586 |
|
|
1587 |
|
-------------------------------------------------------------------------|# |
1588 |
|
|