home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / tests / tprint.tst < prev    next >
Encoding:
Text File  |  1996-04-15  |  60.3 KB  |  1,589 lines
  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.  
  1589.