home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / tests / readtable.tst < prev    next >
Encoding:
Text File  |  1996-04-15  |  11.0 KB  |  589 lines
  1. ;*******************************************************************************
  2. ;*      Rosenmueller  tel.340 Testquelle READTABLE.que    23.03.1988
  3.        *
  4. ;*******************************************************************************
  5.  
  6. (prin1-to-string (setq *readtable* (copy-readtable nil)))
  7. "#<SYSTEM::%TYPE-READTABLE #<SYSTEM::%TYPE-SIMPLE-VECTOR SYSTEM::%TYPE-UNSIGNED-WORD-POINTER
  8.  00000000 00000000 00000000 00000000 00040001 00000004 00040004 00000000
  9.  00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000
  10.  00010004 011E0075 00010001 02250001 00A50395 0C010401 14010535 00010B41
  11.  06010601 06010601 06010601 06010601 06010601 00850701 08010001 00010001
  12.  0D010061 12010E01 00011501 00010001 00010001 00010001 00010001 0F010001
  13.  00010001 13011101 00010001 00010001 00011001 00010001 00010902 00010001
  14.  0D010055 12010E01 00011501 00010001 00010001 00010001 00010001 0F010001
  15.  00010001 13011101 00010001 00010001 00011001 00C50001 00B50A03 00010001>
  16. NIL>"
  17.  
  18. (setq $ 23)
  19. 23
  20.  
  21. (defun single-dollar-reader (stream char)
  22.        (declare (ignore stream))
  23.        (intern (string char)))
  24. SINGLE-DOLLAR-READER
  25.  
  26. (set-macro-character #\$ #'single-dollar-reader)
  27. T
  28.  
  29. $
  30. 23
  31.  
  32. 45
  33. 45
  34.                                         ; => 23 => 45
  35. (prin1-to-string (get-macro-character #\$))
  36. "#<SYSTEM::%TYPE-CLOSURE SINGLE-DOLLAR-READER
  37. NIL
  38. NIL
  39. (LAMBDA (STREAM CHAR) (DECLARE (IGNORE STREAM)) (INTERN (STRING CHAR)))>"
  40.  
  41.  
  42. (progn (setq *readtable* (copy-readtable nil)) t)
  43. t
  44.  
  45. (sys::rt-bitmask-char #\" )
  46. 117
  47.  
  48. (sys::rt-bitmask-char #\( )
  49. 917
  50.  
  51. (sys::rt-bitmask-char #\) )
  52. 165
  53.  
  54. (sys::rt-bitmask-char #\\ )
  55. 2306
  56.  
  57. (sys::rt-bitmask-char #\x )
  58. 4097
  59.  
  60. (sys::rt-bitmask-char #\y )
  61. 1
  62.  
  63. (set-syntax-from-char #\" #\( )
  64. T
  65.  
  66. (sys::rt-bitmask-char #\" )
  67. 917
  68.  
  69. (sys::rt-bitmask-char #\( )
  70. 917
  71.  
  72. (sys::rt-bitmask-char #\) )
  73. 165
  74.  
  75. (sys::rt-bitmask-char #\\ )
  76. 2306
  77.                 ; *readtable* nil
  78.                                         ; *readtable* cl-standard
  79. (progn (setq doppelquote-liston-readtable (copy-readtable)) t)
  80. t
  81.  
  82. (sys::rt-bitmask-char #\" doppelquote-liston-readtable )
  83. 917
  84.  
  85. (sys::rt-bitmask-char #\( doppelquote-liston-readtable )
  86. 917
  87.  
  88. (sys::rt-bitmask-char #\) doppelquote-liston-readtable )
  89. 165
  90.  
  91. (sys::rt-bitmask-char #\\ doppelquote-liston-readtable )
  92. 2306
  93.  
  94. '"1 2 3)
  95. (1 2 3)
  96.  
  97. (set-syntax-from-char #\" #\\ )
  98. T
  99.  
  100. (sys::rt-bitmask-char #\" )
  101. 2306
  102.  
  103. (sys::rt-bitmask-char #\( )
  104. 917
  105.  
  106. (sys::rt-bitmask-char #\) )
  107. 165
  108.  
  109. (sys::rt-bitmask-char #\\ )
  110. 2306
  111.  
  112. (progn (setq doppelquote-backslash-readtable (copy-readtable)) t)
  113. T
  114.  
  115. (sys::rt-bitmask-char #\" doppelquote-backslash-readtable )
  116. 2306
  117.  
  118. (sys::rt-bitmask-char #\\ doppelquote-backslash-readtable )
  119. 2306
  120.  
  121. (sys::rt-bitmask-char #\( doppelquote-backslash-readtable )
  122. 917
  123.  
  124. (sys::rt-bitmask-char #\) doppelquote-backslash-readtable )
  125. 165
  126.  
  127. #"<
  128. #\<
  129.  
  130. (progn (setq 2.-doppelquote-backslash-readtable
  131.                         (copy-readtable doppelquote-backslash-readtable)) t)
  132. t
  133.  
  134. (sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
  135. 2306
  136.  
  137. (sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
  138. 2306
  139.  
  140. (sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
  141. 917
  142.  
  143. (sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
  144. 165
  145.  
  146. (progn (setq 2.-doppelquote-liston-readtable
  147.                         (copy-readtable doppelquote-liston-readtable)) t)
  148. t
  149.  
  150. (sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
  151. 917
  152.  
  153. (sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
  154. 917
  155.  
  156. (sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
  157. 165
  158.  
  159. (sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
  160. 2306
  161.  
  162. (progn (setq cl-standard-readtable
  163.                         (copy-readtable nil))
  164.        (setq *readtable* cl-standard-readtable) t)
  165. t
  166.  
  167. (sys::rt-bitmask-char #\" cl-standard-readtable )
  168. 117
  169.  
  170. (sys::rt-bitmask-char #\( cl-standard-readtable )
  171. 917
  172.  
  173. (sys::rt-bitmask-char #\) cl-standard-readtable )
  174. 165
  175.  
  176. (sys::rt-bitmask-char #\\ cl-standard-readtable )
  177. 2306
  178.  
  179. (sys::rt-bitmask-char #\" )
  180. 117
  181.  
  182. (sys::rt-bitmask-char #\( )
  183. 917
  184.  
  185. (sys::rt-bitmask-char #\) )
  186. 165
  187.  
  188. (sys::rt-bitmask-char #\\ )
  189. 2306
  190.  
  191. "1234"
  192. "1234"
  193.  
  194. (progn (setq *readtable* 2.-doppelquote-liston-readtable) t)
  195. t
  196.  
  197. (sys::rt-bitmask-char #\" )
  198. 917
  199.  
  200. (sys::rt-bitmask-char #\( )
  201. 917
  202.  
  203. (sys::rt-bitmask-char #\) )
  204. 165
  205.  
  206. (sys::rt-bitmask-char #\\ )
  207. 2306
  208.  
  209. '"1 2 3)
  210. (1 2 3)
  211.  
  212. (progn (setq *readtable* doppelquote-backslash-readtable) t)
  213. T
  214.  
  215. (sys::rt-bitmask-char #\" )
  216. 2306
  217.  
  218. (sys::rt-bitmask-char #\( )
  219. 917
  220.  
  221. (sys::rt-bitmask-char #\) )
  222. 165
  223.  
  224. (sys::rt-bitmask-char #\\ )
  225. 2306
  226.  
  227. #"<
  228. #\<
  229.  
  230. (readtablep 2.-doppelquote-backslash-readtable )
  231. T
  232.  
  233. (readtablep 1)
  234. NIL
  235.  
  236.  
  237. (set-syntax-from-char #\" #\" 2.-doppelquote-backslash-readtable )
  238. T
  239.  
  240. (sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
  241. 117
  242.  
  243. (sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
  244. 2306
  245.  
  246. (sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
  247. 917
  248.  
  249. (sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
  250. 165
  251.  
  252.  
  253. (set-syntax-from-char #\) #\( 2.-doppelquote-backslash-readtable )
  254. T
  255.  
  256. (sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
  257. 117
  258.  
  259. (sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
  260. 2306
  261.  
  262. (sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
  263. 917
  264.  
  265. (sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
  266. 917
  267.  
  268.  
  269. (set-syntax-from-char #\( #\) 2.-doppelquote-backslash-readtable )
  270. T
  271.  
  272. (sys::rt-bitmask-char #\" 2.-doppelquote-backslash-readtable )
  273. 117
  274.  
  275. (sys::rt-bitmask-char #\\ 2.-doppelquote-backslash-readtable )
  276. 2306
  277.  
  278. (sys::rt-bitmask-char #\( 2.-doppelquote-backslash-readtable )
  279. 165
  280.  
  281. (sys::rt-bitmask-char #\) 2.-doppelquote-backslash-readtable )
  282. 917
  283.  
  284.  
  285. (set-syntax-from-char #\( #\( 2.-doppelquote-liston-readtable
  286.                               2.-doppelquote-backslash-readtable )
  287. T
  288.  
  289. (sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
  290. 917
  291.  
  292. (sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
  293. 165
  294.  
  295. (sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
  296. 165
  297.  
  298. (sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
  299. 2306
  300.  
  301.  
  302. (set-syntax-from-char #\) #\) 2.-doppelquote-liston-readtable
  303.                               2.-doppelquote-backslash-readtable )
  304. T
  305.  
  306. (sys::rt-bitmask-char #\" 2.-doppelquote-liston-readtable )
  307. 917
  308.  
  309. (sys::rt-bitmask-char #\( 2.-doppelquote-liston-readtable )
  310. 165
  311.  
  312. (sys::rt-bitmask-char #\) 2.-doppelquote-liston-readtable )
  313. 917
  314.  
  315. (sys::rt-bitmask-char #\\ 2.-doppelquote-liston-readtable )
  316. 2306
  317.  
  318.  
  319. (progn (setq *readtable* 2.-doppelquote-backslash-readtable ) t)
  320. t
  321.  
  322. )sys::rt-bitmask-char #\( (
  323. 165
  324.  
  325. )sys::rt-bitmask-char #\) (
  326. 917
  327.  
  328. )sys::rt-bitmask-char #\\ (
  329. 2306
  330.  
  331. "1234"
  332. "1234"
  333.  
  334. ')1 2 3(
  335. (1 2 3)
  336.  
  337. )progn )setq *readtable* 2.-doppelquote-liston-readtable ( t(
  338. t
  339.  
  340.  
  341. )sys::rt-bitmask-char #\( (
  342. 165
  343.  
  344. )sys::rt-bitmask-char #\) (
  345. 917
  346.  
  347. )sys::rt-bitmask-char #\\ (
  348. 2306
  349.  
  350. '"1234(
  351. (1234)
  352.  
  353. ')1 2 3(
  354. (1 2 3)
  355.                 ; ) muesste listen-anfang-sein
  356. )progn )setq *readtable* )copy-readtable nil(( t(
  357. t
  358.  
  359. (sys::rt-bitmask-char #\" )
  360. 117
  361.  
  362. (sys::rt-bitmask-char #\( )
  363. 917
  364.  
  365. (sys::rt-bitmask-char #\) )
  366. 165
  367.  
  368. (sys::rt-bitmask-char #\\ )
  369. 2306
  370.  
  371. (sys::rt-bitmask-char #\x )
  372. 4097
  373.  
  374. (sys::rt-bitmask-char #\y )
  375. 1
  376.  
  377.  
  378. (make-dispatch-macro-character #\x)
  379. T
  380.  
  381. (sys::rt-bitmask-char #\x )
  382. 4109
  383.  
  384. (sys::rt-bitmask-char #\y )
  385. 1
  386.  
  387. (defun d1 (a b c) (princ "1.dmacro"))
  388. D1
  389.  
  390. (d1 1 2 3)
  391. "1.dmacro"
  392.  
  393. (set-dispatch-macro-character #\x #\. #'d1)
  394. T
  395.  
  396. (sys::rt-bitmask-char #\x )
  397. 4109
  398.  
  399. (prin1-to-string (get-dispatch-macro-character #\x #\.))
  400. "#<SYSTEM::%TYPE-CLOSURE D1
  401. NIL
  402. NIL
  403. (LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
  404.  
  405. (multiple-value-list (read-from-string "123x.45"))
  406. (   123 3)
  407.  
  408. (multiple-value-list (read-from-string "123x.45" t nil :start 3))
  409. (   "1.dmacro" 5)
  410.  
  411. (multiple-value-list (read-from-string "123x.45" t nil :start 5))
  412. (45 7)
  413.  
  414.  
  415. (make-dispatch-macro-character #\y)
  416. T
  417.  
  418. (s\Ys::rt-bitmask-char #\x )
  419. 4109
  420.  
  421. (s\Ys::rt-bitmask-char #\y )
  422. 13
  423.  
  424. (defun d2 (a b c) (princ "2.dmacro"))
  425. D2
  426.  
  427. (d2 1 2 3)
  428. "2.dmacro"
  429.  
  430. (set-dispatch-macro-character #\y #\, #'d2)
  431. T
  432.  
  433. (s\Ys::rt-bitmask-char #\x )
  434. 4109
  435.  
  436. (s\Ys::rt-bitmask-char #\y )
  437. 13
  438.  
  439. (prin1-to-string (get-dispatch-macro-character #\x #\.))
  440. "#<SYSTEM::%TYPE-CLOSURE D1
  441. NIL
  442. NIL
  443. (LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
  444.  
  445. (prin1-to-string (get-dispatch-macro-character #\y #\,))
  446. "#<SYSTEM::%TYPE-CLOSURE D2
  447. NIL
  448. NIL
  449. (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
  450.  
  451. (multiple-value-list (read-from-string "123y,45"))
  452. (   123 3)
  453.  
  454. (multiple-value-list (read-from-string "123y,45" t nil :start 3))
  455. (   "2.dmacro" 5)
  456.  
  457. (multiple-value-list (read-from-string "123y,45" t nil :start 5))
  458. (45 7)
  459.  
  460. (set-dispatch-macro-character #\x #\. #'d2)
  461. T
  462.  
  463. (s\Ys::rt-bitmask-char #\x )
  464. 4109
  465.  
  466. (s\Ys::rt-bitmask-char #\y )
  467. 13
  468.  
  469. (prin1-to-string (get-dispatch-macro-character #\y #\,))
  470. "#<SYSTEM::%TYPE-CLOSURE D2
  471. NIL
  472. NIL
  473. (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
  474.  
  475. (prin1-to-string (get-dispatch-macro-character #\x #\.))
  476. "#<SYSTEM::%TYPE-CLOSURE D2
  477. NIL
  478. NIL
  479. (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
  480.  
  481. (multiple-value-list (read-from-string "123x.45"))
  482. (   123 3)
  483.  
  484. (multiple-value-list (read-from-string "123x.45" t nil :start 3))
  485. (   "2.dmacro" 5)
  486.  
  487. (multiple-value-list (read-from-string "123x.45" t nil :start 5))
  488. (45 7)
  489.  
  490. (set-dispatch-macro-character #\y #\. #'d1)
  491. T
  492.  
  493. (s\Ys::rt-bitmask-char #\x )
  494. 4109
  495.  
  496. (s\Ys::rt-bitmask-char #\y )
  497. 13
  498.  
  499. (prin1-to-string (get-dispatch-macro-character #\x #\.))
  500. "#<SYSTEM::%TYPE-CLOSURE D2
  501. NIL
  502. NIL
  503. (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
  504.  
  505. (prin1-to-string (get-dispatch-macro-character #\y #\,))
  506. "#<SYSTEM::%TYPE-CLOSURE D2
  507. NIL
  508. NIL
  509. (LAMBDA (A B C) (PRINC \"2.dmacro\"))>"
  510.  
  511. (prin1-to-string (get-dispatch-macro-character #\y #\.))
  512. "#<SYSTEM::%TYPE-CLOSURE D1
  513. NIL
  514. NIL
  515. (LAMBDA (A B C) (PRINC \"1.dmacro\"))>"
  516.  
  517. (multiple-value-list (read-from-string "123y.45"))
  518. (   123 3)
  519.  
  520. (multiple-value-list (read-from-string "123y.45" t nil :start 3))
  521. (   "1.dmacro" 5)
  522.  
  523. (multiple-value-list (read-from-string "123y.45" t nil :start 5))
  524. (45 7)
  525.  
  526. (multiple-value-list (read-from-string "123y,45"))
  527. (   123 3)
  528.  
  529. (multiple-value-list (read-from-string "123y,45" t nil :start 3))
  530. (   "2.dmacro" 5)
  531.  
  532. (multiple-value-list (read-from-string "123y,45" t nil :start 5))
  533. (45 7)
  534.  
  535. (progn (setq *readtable* (cop\Y-readtable nil nil)) t)
  536. t
  537.  
  538. (sys::rt-bitmask-char #\x )
  539. 4097
  540.  
  541. (sys::rt-bitmask-char #\y )
  542. 1
  543.  
  544. (get-dispatch-macro-character #\x #\.)
  545. ERROR
  546.  
  547. (get-dispatch-macro-character #\y #\,)
  548. ERROR
  549.  
  550. (get-dispatch-macro-character #\y #\.)
  551. ERROR
  552.  
  553. (defun |#{-reader| (stream char arg)
  554.   (declare (ignore char arg))
  555.   (mapcon #'(lambda (x)
  556.               (mapcar #'(lambda (y)(list (car x) y))(cdr x)))
  557.           (read-delimited-list #\} stream)))
  558. |#{|-|reader|
  559.  
  560. (set-dispatch-macro-character #\# #\{ #'|#{-reader|)
  561. T
  562.  
  563. ;;      (set-macro-character #\} (get-macro-character #\)) nil))
  564. ;;      geht bei uns nicht !
  565. ;;      dafuer :
  566. (set-syntax-from-char #\} #\) )
  567. ;;      nicht notwendig, da superklammer
  568. (progn
  569. (setq read-st (make-string-input-stream "#{p q z a} #{a b c d}")) t)
  570. T
  571.  
  572. (read read-st)
  573. ((P Q) (P Z) (P A) (Q Z) (Q A) (Z A))
  574.  
  575. (read read-st)
  576. ((A B) (A C) (A D) (B C) (B D) (C D))
  577.  
  578. (progn (setq *readtable* (copy-readtable nil nil))
  579.        (makunbound 'doppelquote-liston-readtable)
  580.        (makunbound 'doppelquote-backslash-readtable)
  581.        (makunbound '2.-doppelquote-liston-readtable)
  582.        (makunbound '2.-doppelquote-backslash-readtable)
  583.        (makunbound 'cl-standard-readtable)
  584.        (makunbound 'read-st)
  585.        (makunbound '$)
  586. t)
  587. T
  588.  
  589.