/[gcl]/gcl/tests/tprint.tst
ViewVC logotype

Diff of /gcl/tests/tprint.tst

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Thu Dec 20 20:29:54 2001 UTC revision 1.2 by camm, Sun Feb 3 18:44:08 2002 UTC
# Line 0  Line 1 
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    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26