home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / snobol / aisnobol / test.sno < prev    next >
Text File  |  1987-10-10  |  18KB  |  819 lines
  1. *
  2. * To run this test program:
  3. *     a)  have copies of TEST, SNOCORE.INC, and SNOLIB.INC
  4. *         under your default directory.
  5. *     b)  type
  6. *         SNOBOL4 TEST
  7. *
  8. *
  9. * Tests of single-argument numerical functions
  10. *     SNOLISPIST
  11. *
  12. -INCLUDE 'SNOCORE.INC'
  13. *
  14. * PAWS = *?( |'' |'Press ENTER to continue.'
  15. *+     |'' IN()    |(COLLECT() * 5 ' bytes available' |'') |'' )
  16.  PAWS = *?( |'' )
  17.  DEXP('PAUSE() = EVAL(PAWS)')
  18. *
  19.  ||''
  20.  ?( |'Single-argument numerical functions' |'' )
  21.  |'Incidentally uses MAPC, DEXP with LAMBDA, and EVALCODE'
  22.  |''
  23.  MAPC(DEXP('LAMBDA(EXPR) = '
  24. +          '|("     " EVALCODE( |EXPR))' ),
  25. +     'ABS(-15.9999)' ~
  26. +     'SIGN(0 - 4444.4444)' ~
  27. +     'ADD1(-1)' ~
  28. +     'SUB1(14456.9765)' ~
  29. +     'FLOAT(13 + 15 + 17)' ~
  30. +     'DFLOAT(17 - 15 - 13)' ~
  31. +     'FIX(P...I.)' ~
  32. +     'MINUS(LN...10.)' ~
  33. +     'ROUND(-8.5)' ~ NIL)
  34. *
  35.  PAUSE()
  36. *
  37. *
  38. * Tests of binary numerical functions
  39. *     SNOLISPIST
  40. *
  41. *
  42.  ||''
  43.  |'Binary numerical functions'
  44.  |''
  45.  MAPC(DEXP('LAMBDA(EXPR) = '
  46. +          '|("    " EVALCODE( |EXPR))' ),
  47. +     'ADD(P...I.,LN...10.)' ~
  48. +     'SUB(P...I.,LN...10.)' ~
  49. +     'MULT(P...I.,LN...10.)' ~
  50. +     'DIV(P...I.,LN...10.)' ~
  51. +     'MAX(1,-1)' ~
  52. +     'MIN(1,-1)' ~
  53. +     'REMAINDER(-44444444.,119)' ~ NIL)
  54. *
  55.  PAUSE()
  56. *
  57. *
  58. * Tests of list-argument numerical functions
  59. *     SNOLISPIST
  60. *
  61.  ||''
  62.  |'List-argument numerical functions'
  63.  |''
  64.  |'Incidentally uses MAPCAR, LREVERSE, and READ'
  65.  |''
  66.  ARGUMENT.LIST =
  67. +     MAPCAR(.DFLOAT,
  68. +        LREVERSE(
  69. +             #'(1 1 2 -3 5 8 -13 21)' ))
  70.  ?( |'Here is the argument list: ' |'' )
  71.  |ARGUMENT.LIST
  72. *
  73.  PAUSE()
  74. *
  75.  MAPC(DEXP('LAMBDA(FUNCTION) = '
  76. +          '|("     " APPLY( |FUNCTION, ARGUMENT.LIST))' ),
  77. +     .PLUS ~
  78. +     .DIFFERENCE ~
  79. +     .TIMES ~
  80. +     .QUOTIENT ~
  81. +     NIL)
  82. *
  83.  PAUSE()
  84. *
  85. *
  86. * Tests of extended numerical functions
  87. *     SNOLISPIST
  88. *
  89. *
  90.  |''
  91.  |'Extended numerical functions'
  92.  |''
  93.  ?( |'Testing FLOOR' |'' )
  94.  AL = #'(-10.9 -7.9 -6.01 -0.00001 0.00001 6.01 7.9 10.9)'
  95.  |'Argument list = '
  96.  ?( |("     "   !AL) |'' )
  97.  |MAPCAR(.FLOOR,AL)
  98. *
  99.  PAUSE()
  100. *
  101.  |''
  102.  ?( |'Testing CEIL' |'' )
  103.  |'Argument list = '
  104.  ?( |("     "   !AL) |'' )
  105.  |MAPCAR(.CEIL,AL)
  106. *
  107.  PAUSE()
  108. *
  109.  |''
  110.  ?( |'Testing SQRT by inverse mapping' |'' )
  111.  AL = #'(1 10 100 1000. 10000. 100000. 1000000. 10000000.)'
  112.  |'Argument list = '
  113.  ?( |("     "   !AL) |'' )
  114.  |MAPCAR(DEXP('LAMBDA(A) = ROUND(A * A)'),
  115. +     MAPCAR(.SQRT,AL))
  116. *
  117.  PAUSE()
  118. *
  119.  |''
  120.  |'Testing trigonometric and inverse trigonometric functions'
  121.  ?( |('     by inverse mapping') |'' )
  122.  AL = #( '(5 15 25 35 45 55 65 75 85 95 105 115 125 '
  123. +     '135 145 155 165 175 185 195 205 215 225 235 245 '
  124. +     '255 265 275 285 295 305 315 325 335 345 355)' )
  125.  |'Argument list = '
  126.  ?( |("     "   !AL) |'' )
  127.  ?( |'SIN and ASIN' |'' )
  128.  |MAPCAR(.ROUND,
  129. +     MAPCAR(.DEG,
  130. +        MAPCAR(.ASIN,
  131. +             MAPCAR(.SIN,
  132. +                  MAPCAR(.RAD,AL)))))
  133. *
  134.  PAUSE()
  135. *
  136.  ?( |'COS and ACOS' |'' )
  137.  |MAPCAR(.ROUND,
  138. +     MAPCAR(.DEG,
  139. +        MAPCAR(.ACOS,
  140. +             MAPCAR(.COS,
  141. +                  MAPCAR(.RAD,AL)))))
  142. *
  143.  PAUSE()
  144. *
  145.  ?( |'TAN and ATAN' |'' )
  146.  |MAPCAR(.ROUND,
  147. +     MAPCAR(.DEG,
  148. +        MAPCAR(.ATAN,
  149. +             MAPCAR(.TAN,
  150. +                  MAPCAR(.RAD,AL)))))
  151. *
  152.  PAUSE()
  153. *
  154.  |''
  155.  |'Logarithms to the base 2 of the first 30 powers of 2'
  156.  |''
  157.  I = 0 ; AL  = NIL  ; TWP = 1
  158. TWO.LOOP
  159.       I = LT(I,30) I + 1      :F(TWO.LOOP.END)
  160.       TWP = 2. * TWP
  161.       AL = TWP ~ AL      :(TWO.LOOP)
  162. TWO.LOOP.END
  163.       AL =  LREVERSE(AL)
  164. *
  165.  |MAPCAR(DEXP('LAMBDA(Z) = ROUND(LOG(Z,2))'), AL)
  166. *
  167.  PAUSE()
  168. *
  169.  |''
  170.  ?( |'The first 10 powers of e' |'' )
  171.  |MAPCAR(DEXP('LAMBDA(Z) = RAISE(NAT...BASE.,Z)' ),
  172. +     #'(1 2 3 4 5 6 7 8 9 10)' )
  173. *
  174.  PAUSE()
  175. *
  176.  |''
  177.  ?( |'The first 10 negative powers of e' |'' )
  178.  |MAPCAR(DEXP('LAMBDA(X) = RAISE(NAT...BASE., -X)' ),
  179. +     #'(1 2 3 4 5 6 7 8 9 10)' )
  180. *
  181.  PAUSE()
  182. *
  183. *
  184. * Test program for all compound CAR/CDR
  185. * functions in SNOLISPIST
  186. *
  187.  MNMNM = #'(1 2 3 4)'
  188. *
  189. * Build a reasonably hairy list
  190. *
  191.  LKLKL = #'((((\MNMNM) \MNMNM) \MNMNM) \MNMNM)'
  192.  MNMNM = #'(\LKLKL \LKLKL \LKLKL \LKLKL)'
  193.  LKLKL = LCOPY(MNMNM)
  194. *
  195.  ||''
  196.  |('LKLKL = ' !LKLKL)
  197.  |''
  198.  MAPC(DEXP('LAMBDA(S) = '
  199. +          '|EVAL( |(  "C" S "R(LKLKL)" ))' ),
  200. +     #('(A D AA AD DA DD '
  201. +       ' AAA AAD ADA DAA '
  202. +       ' ADD DAD DDA DDD '
  203. +       ' AAAA AAAD AADA ADAA DAAA '
  204. +       ' AADD ADAD DAAD ADDA DADA DDAA '
  205. +       ' ADDD DADD DDAD DDDA DDDD)' ))
  206. *
  207.  PAUSE()
  208. *
  209. *
  210. * SNOLISPIST I/O test program
  211. *
  212.      A = 'C' ; B = 'L' ; C = 'R'
  213. *
  214.      (|(11 % 'C.A') |'Centered.' ||'')
  215.      (|(11 % 'L.B') |'Left justified.'  ||'')
  216.      (|(11 % 'R.C') |'Right justified.'  ||'')
  217.   L = #'(A CENTERED LIST)'
  218. *
  219.   (|(72 % 'C.L') |'A centered list.' ||'')
  220. *
  221.  (|'Test of indentation via % operator.' |'')
  222.  ?( |'Outline Level I' |'' )
  223.  ?( |(5 % ' '   'Outline Level I.A') |'' )
  224.  ?( |(10 % ' '   'Outline Level I.A.1') |'' )
  225.  ?( |(15 % ' '   'Outline Level I.A.1.a') ||'' )
  226. *
  227.  PAUSE()
  228. *
  229.  |'Input test:   Should print echo of next input line.'
  230.  |''
  231.  |IN()
  232. *
  233.  PAUSE()
  234. *
  235. *
  236. * Tests of recursively defined list processing functIons
  237. *   SNOLISPIST
  238. *
  239. *
  240.  ||''
  241.  |'Recursively defined list processing functions'
  242.  |''
  243.  ?( |'Test LCOPY' |'' )
  244.  ORIGINAL = #'((O . R) (I . G) (I . N) (A . L))'
  245.  COPY = LCOPY(ORIGINAL)
  246.  |'Here is the original:'
  247.  ?( |(62 % 'C.ORIGINAL') |'' )
  248.  |'Here is the copy:'
  249.  ?( |(62 % 'C.COPY') |'' )
  250.  |'Are they EQU?'
  251.  ?( |("     "   ~EQU(COPY,ORIGINAL) 'No.') |'' )
  252.  |'Are they EQUAL?'
  253.  ?( |("     "   EQUAL(COPY,ORIGINAL) 'Yes.') |'' )
  254. *
  255.  PAUSE()
  256. *
  257.  ?( |'Test SUBST' |'' )
  258.  TEST.LIST = #'(1 (2) (3 . 4) ((5 . 6) 7) 1 2 3 4 5 6 7)'
  259.  SUBST.LIST = #'(S I X)'
  260.  |'Here is the original list:'
  261.  ?( |(62 % 'C.TEST.LIST') |'' )
  262.  ?( |'Here is the target sublist:  6' |'' )
  263.  |'Here is the result:'
  264.  ?( |(62 % 'C.SUBST(TEST.LIST,6,SUBST.LIST)' ) |'' )
  265. *
  266.  PAUSE()
  267. *
  268.  ?( |'Test REMOVE' |'' )
  269.  TEST.LIST = #'(A (B (C . D) E (F . G)) H A I R)'
  270.  REM.LIST = #'(C . D)'
  271.  |'Here is the test list:'
  272.  ?( |(62 % 'C.TEST.LIST') |'' )
  273.  |'Here is the list to be removed:'
  274.  ?( |(62 % 'C.REM.LIST') |'' )
  275.  |'Here is the result:'
  276.  ?( |(62 % 'C.REMOVE(TEST.LIST,REM.LIST)' ) |'' )
  277. *
  278.  PAUSE()
  279. *
  280.  ?( |'Test FIND' |'' )
  281.  TEST.LIST = #'(H A Y ((N . E) (E . D) (L . E)) S T A C K)'
  282.  FIND.LIST = #'(E . D)'
  283.  |'Here is the test list:'
  284.  ?( |(62 % 'C.TEST.LIST') |'' )
  285.  |'Here is the list to be found:'
  286.  ?( |(62 % 'C.FIND.LIST') |'' )
  287.  |'Here is the result:'
  288.  ?( |(62 % 'C.FIND(FIND.LIST,TEST.LIST)' ) |'' )
  289. *
  290.  PAUSE()
  291. *
  292. * Tests of miscellaneous list processing functions
  293. *     SNOLISPIST
  294. *
  295.  ||''
  296.  |'Miscellaneous list processing functions'
  297.  |''
  298.  ?( |'Test EXPLODE and READLIST by inverse mapping' |'' )
  299.  |MAPCAR(.READLIST,
  300. +     MAPCAR(.EXPLODE,
  301. +        #'(1 AARDVARK (SUB LIST) (C (O (MPLEX))))' ))
  302. *
  303.  PAUSE()
  304. *
  305.  |''
  306.  ?( |'Test LENGTH' |'' )
  307.  |MAPLIST(.LENGTH,
  308. +     EXPLODE('abcdefghijklmnopqrstuvwxyz'))
  309. *
  310.  PAUSE()
  311. *
  312.  |''
  313.  |'Test SETL (SET indirectly)'
  314.  |''
  315.  DEFINE('PLACE(CH)A')    :(PLACE.END)
  316. PLACE
  317. +     &ALPHABET CH @A
  318.       PLACE = A     :(RETURN)
  319. PLACE.END
  320. *
  321.  DEFINE('INTERLEAVE(L1,L2)LL')      :(INTERLEAVE.END)
  322. INTERLEAVE
  323. +     LL = NIL
  324. INTERLEAVE1
  325. +     LL = POP( .L2) ~ POP( .L1) ~ LL
  326. +        :S(INTERLEAVE1)
  327.       INTERLEAVE = LREVERSE(LL)    :(RETURN)
  328. INTERLEAVE.END
  329. *
  330.       AA =  EXPLODE('abcdefghijklmnopqrstuvwxyz')
  331.       VV =  MAPCAR(.PLACE,AA)
  332.       SETL(INTERLEAVE(AA,VV))
  333.       MAPC(DEXP('LAMBDA(Z) = '
  334. +          '?|(Z " = " VALUE(Z))' ),  AA)
  335. *
  336.  PAUSE()
  337. *
  338. *
  339. *  Tests of set functions on lists
  340. *     SNOLISPIST
  341. *
  342. *
  343.  ||''
  344.  |'Set functions'
  345.  |''
  346.  EVEN  = #'(2 4 6 8 10 12 14 16 18 20)'
  347.  ODD   = #'(1 3 5 7 9 11 13 15 17 19)'
  348.  PRIME = #'(2 3 5 7 11 13 17 19)'
  349.  FIBONACCI = #'(1 1 2 3 5 8 13)'
  350.  UNIVERSE = UNION(EVEN,ODD)
  351.  NON.PRIME = EXCLUDE(UNIVERSE,PRIME)
  352.  EVEN.PRIME = INTERSECT(EVEN,PRIME)
  353.  PRIME.FIBO = INTERSECT(PRIME,FIBONACCI)
  354.  ODD.FIBO = INTERSECT(ODD,FIBONACCI)
  355.  PRIME.OR.FIBO = UNION(PRIME,FIBONACCI)
  356.  NEITHER.PRIME.NOR.FIBO = EXCLUDE(UNIVERSE,PRIME.OR.FIBO)
  357. *
  358.  MAPC(DEXP('LAMBDA(NAME) = |$|( |"" NAME )' ),
  359. +     #( '(EVEN ODD PRIME FIBONACCI UNIVERSE NON.PRIME '
  360. +          'EVEN.PRIME PRIME.FIBO ODD.FIBO PRIME.OR.FIBO '
  361. +          'NEITHER.PRIME.NOR.FIBO)' ))
  362. *
  363.  PAUSE()
  364. *
  365. *
  366. *  Tests of some functions for adding to a list
  367. *     SNOLISPIST
  368. *
  369. *
  370.  ||''
  371.  |'Functions which add elements to lists'
  372.  |''
  373.  LIST1 = EXPLODE('APPEND')
  374.  LIST2 = EXPLODE('NCONC')
  375.  LIST3 = EXPLODE('SNOC')
  376.  LIST4 = EXPLODE('INSERT')
  377. *
  378.  EXTRA.LIST = EXPLODE('EXTRA')
  379.  EXTRA.ATOM = CONCAT(EXTRA.LIST)
  380. *
  381.  ||''
  382.  ?( |'Test APPEND' |'' )
  383.  |(62 % 'C.APPEND(LIST1 ~ EXTRA.LIST ~ NIL)' )
  384. *
  385.  PAUSE()
  386. *
  387.  ?( |'Test NCONC' |'' )
  388.  |(62 % 'C.NCONC(LIST2 ~ EXTRA.LIST ~ NIL)' )
  389. *
  390.  PAUSE()
  391. *
  392.  ?( |'Test SNOC' |'' )
  393.  |(62 % 'C.SNOC(LIST3,EXTRA.ATOM)' )
  394. *
  395.  PAUSE()
  396. *
  397.  ?( |'Test INSERT' |'' )
  398.  |(62 % 'C.INSERT("R",LIST4)'  )
  399.  |''
  400.  |(62 % 'C.INSERT(EXTRA.ATOM,LIST4)' )
  401. *
  402.  PAUSE()
  403. *
  404. * Tests of replacement functions
  405. *     SNOLISPIST
  406. *
  407. *
  408.  ||''
  409.  |'Replacement functions'
  410.  |''
  411.  LST = READ(
  412. +     '(NOW IS THE TIME FOR ALL GOOD MEN '
  413. +     'TO COME TO THE AID OF THEIR PARTY)' )
  414.  |''
  415.  |'The test list is'
  416.  ?( |(62 % 'C.LST') |'' )
  417. *
  418.  PAUSE()
  419. *
  420.  ?( |'Reverse the CDR' |'' )
  421.  RPLACD(LST,LREVERSE(CDR(LST)))
  422.  ?( |(62 % 'C.LST') |'' )
  423. *
  424.  PAUSE()
  425. *
  426.  ?( |'Put it back like it was' |'' )
  427.  RPLACD(LST,LREVERSE(CDR(LST)))
  428.  ?( |(62 % 'C.LST') |'' )
  429. *
  430.  PAUSE()
  431. *
  432.  ?( |'Use RPLACA to change the first five words' |'' )
  433.  RPLACA(LST,'Now')
  434.  RPLACA(CDR(LST),'is')
  435.  RPLACA(CDDR(LST),'the')
  436.  RPLACA(CDDDR(LST),'time')
  437.  RPLACA(CDDDDR(LST),'for')
  438.  ?( |(62 % 'C.LST') |'' )
  439. *
  440.  PAUSE()
  441. *
  442.  ?( |'Change the last five words using RPLACN' |'' )
  443.  RPLACN(LST,-1,'party?')
  444.  RPLACN(LST,-2,'their')
  445.  RPLACN(LST,-3,'of')
  446.  RPLACN(LST,-4,'aid')
  447.  RPLACN(LST,-5,'the')
  448.  ?( |(62 % 'C.LST') |'' )
  449. *
  450.  PAUSE()
  451. *
  452.  |'Restore the original list; then reverse each '
  453.  ?( |("     "   'word, starting with the last.') |'' )
  454.  LST = READ(
  455. +     '(NOW IS THE TIME FOR ALL GOOD MEN '
  456. +     'TO COME TO THE AID OF THEIR PARTY)' )
  457.  |''
  458.  |'The test list is'
  459.  ?( |(62 % 'C.LST') |'' )
  460. *
  461.  PAUSE()
  462. *
  463.        N = LENGTH(LST)
  464.        I = 0
  465. LUPE
  466.        I = LT(I,N) I + 1       :F(LUPE.END)
  467.        K = -I
  468.        RPLACN(LST,K,REVERSE(CAR(NTH(LST,K))))
  469.        PRINT(LST)         :(LUPE)
  470. LUPE.END
  471. +     PAUSE()
  472. *
  473. *
  474. * Tests of sublist functions
  475. *     SNOLISPIST
  476. *
  477. *
  478.  ||''
  479.  |'Sublist functions'
  480.  |''
  481.  LST = READ(
  482. +     '(NEVER TRY TO GIVE NECESSARY AND SUFFICIENT '
  483. +     'CONDITIONS FOR ANYTHING -- Linsky)' )
  484.  |''
  485.  |'The test list is'
  486.  PRINT(LST)
  487.  PAUSE()
  488. *
  489.  |'The last element is'
  490.  PRINT(LAST(LST))
  491. *
  492.   PAUSE()
  493. *
  494.  ?( |'Here is a vertical listing, using NTH' |'' )
  495.       N = LENGTH(LST)
  496.       I = 0
  497. LOOP
  498. +     I = LT(I,N) I + 1       :F(LOOP.END)
  499.       PRINT(CAR(NTH(LST,I)))       :(LOOP)
  500. LOOP.END      PAUSE()
  501. *
  502.  |''
  503.  |'The first 8 elements are'
  504.  PRINT(PRELIST(LST,8))
  505.  PAUSE()
  506. *
  507.  |'The tail starting with element 4 is'
  508.  PRINT(SUFLIST(LST,3))
  509.  PAUSE()
  510. *
  511.  |'The sublist consisting of elements 4 through 8 is'
  512.  PRINT(PRELIST(SUFLIST(LST,3),5))
  513.  PAUSE()
  514. *
  515.  |'The RAC is'
  516.  PRINT(RAC(LST))
  517.  |'The RDC is'
  518.  PRINT(RDC(LST))
  519.  PAUSE()
  520. *
  521. *
  522. * Tests of list searching functions
  523. *      SNOLISPIST
  524. *
  525. *
  526.  ||''
  527.  |'Searching functions'
  528.  |''
  529.  ALIST = READ(
  530. +      '((1 BUN) '
  531. +      '(2 SHOE) '
  532. +      '(3 TREE) '
  533. +      '(4 DOOR BORE SHORE CORE) '
  534. +      '(5 HIVE JIVE) '
  535. +      '(6 SEX) '
  536. +      '(7 HEAVEN) '
  537. +      '(8 WAIT) '
  538. +      '(9 RESIGN) '
  539. +      '(10 WHEN?) )' )
  540. *
  541.  |'The test list is'
  542.  PRINT(ALIST)
  543.  PAUSE()
  544. *
  545.  ?( |'NIL followed-by beat poetry' |'' )
  546.  PRINT(ASSOC(95,ALIST))
  547.  PRINT(ASSOC(6,ALIST))
  548.  PRINT(ASSOC(9,ALIST))
  549.  PRINT(ASSOC(5,ALIST))
  550.  PRINT(ASSOC(10,ALIST))
  551. *
  552.  PAUSE()
  553. *
  554.  MESS = #'(47 ABC XYZ BUN WAIT 5 7 1 3)'
  555.  |''
  556.  |'The list of targets for ASSOCL is'
  557.  |''
  558.  |'LTRACE is also tested here.'
  559.  |''
  560.  PRINT(MESS)
  561.  PAUSE()
  562. *
  563.  LTRACE(2, .ASSOCL ~ NIL) ; &TRACE = 10000
  564.  PRINT(ASSOCL(MESS,ALIST))
  565.  LTRACE(0, .ASSOCL ~ NIL) ; &TRACE = 0
  566.  PAUSE()
  567. *
  568.  |'Here is the tail of MESS starting with BUN'
  569.  PRINT(MEMBER('BUN',MESS))
  570.  PAUSE()
  571. *
  572.  MEMQ('WAIT',MESS) ?|'This line should appear'
  573.  MEMQ('INCLINE',ALIST) ?|'This line should NOT appear'
  574. *
  575.  PAUSE()
  576. *
  577. * Tests of mapping functions
  578. *     SNOLISPIST
  579. *
  580. *
  581.  ||''
  582.  |'Mapping functions'
  583.  |''
  584.  ?( |'Unimaginative MAP test' |'' )
  585.  MAP(.PRINT,#'(A B C D 11 22 33 44 (5 . 5))' )
  586. *
  587.  PAUSE()
  588. *
  589.  ?( |'Unimaginative MAPC test' |'' )
  590.  MAPC(.PRINT,
  591. +     READ(
  592. +         '(Now is the time for all good men '
  593. +         'to come to the aid of their party)' ))
  594. *
  595.  PAUSE()
  596. *
  597.  ?( |'Unimaginative MAPLIST test' |'' )
  598.  PRINT(MAPLIST(.LENGTH,
  599. +     #'(10 9 8 7 6 5 4 pi 3 e 2 1 0 BLAST OFF!    i)' ))
  600. *
  601.  PAUSE()
  602. *
  603.  ?( |'MAPCON test -- What will happen???' |'' )
  604.  PRINT(MAPCON(.EXPLODE,
  605. +     #'(EVERY GOOD BOY DOES FINE)' ))
  606. *
  607.  PAUSE()
  608. *
  609.  ?( |'MAPCAN test -- What wlll happen?????' |'' )
  610.  PRINT(MAPCAN(.EXPLODE,
  611. +     #'(CINNAMON PERSIMMON SIMIAN)' ))
  612.  PAUSE()
  613. *
  614.  |'EVERY test (correct answer = NIL)'
  615.  PRINT(EVERY(.NUMBERP,
  616. +     #'(5 4 3 2 1 0 X)' ))
  617. *
  618.  PAUSE()
  619. *
  620.  |'EVLIS test'
  621.  |'Correct answer is (1 2 3 (LIST VALUE))'
  622.  SETL( #'(A 1 B 2 C 3 D (LIST VALUE))' )
  623.  PRINT(EVLIS(#'(A B C D)' ))
  624. *
  625.  PAUSE()
  626. *
  627.  |'SOME test (correct answer = NIL)'
  628.  PRINT(SOME(.ZEROP,
  629. +     #'(19 9 8 3 6 4 2 \P...I. \LN...10. 66 666 -1)' ))
  630. *
  631.  PAUSE()
  632. *
  633.  |'SUBSET test (should print only negative numbers)'
  634.  PRINT(SUBSET(.NEGP,
  635. +     #'(0 0 0 -1 -2 9 8 6.3 \-P...I. \LN...10. -5)' ))
  636. *
  637.  PAUSE()
  638. *
  639. *
  640. * Tests of non-numerical Predicates
  641. *     SNOLISPIST
  642. *
  643.       LLST = #'(A (SMALL (TEST (LIST))))'
  644.  ||''
  645.  |'A series of Ts'
  646.  |''
  647.  MAPC(DEXP('LAMBDA(EXPR) = |("      " !EVALCODE( |EXPR))' ),
  648. +     '/T' ~
  649. +     'NULLP(NIL)' ~
  650. +     'NOTP(NIL)' ~
  651. +     'ATOMP(13.965)' ~
  652. +     'NUMBERP(-13.965)' ~
  653. +     'EQP(13,"13.000000")' ~
  654. +     'EQUALP(LLST,LCOPY(LLST))' ~
  655. +     NIL)
  656. *
  657.  PAUSE()
  658. *
  659.  ||''
  660.  |'A series of NILs'
  661.  |''
  662.  LLST = #'(TWEEDLE (DEE . DUM))'
  663.  MAPC(DEXP('LAMBDA(EXPR) = |("    " !EVALCODE( |EXPR))' ),
  664. +    'NULLP(14 ~ NIL)' ~
  665. +    'NOTP(1 ~ 1)' ~
  666. +    'ATOMP(1 ~ 2 ~ 3 ~ NIL)' ~
  667. +    'NUMBERP("LINDA")' ~
  668. +    'EQP(LLST,LCOPY(LLST))' ~
  669. +    NIL)
  670. *
  671.  PAUSE()
  672. *
  673. *
  674. * Tests of numerical predicates
  675. *    SNOLISPIST
  676. *
  677. *
  678.  ||''
  679.  |'Alternating series of Ts and NILs'
  680.  |''
  681.  ?( |'Testing NEGP' |'' )
  682.  |MAPCAR(.NEGP,
  683. +    #'(-1 2 -3.0 4 -5.00 6.00 -7.7 8.8 -8.999 10.101010)')
  684. *
  685.  PAUSE()
  686. *
  687.  ?( |'Testing ZEROP' |'' )
  688.  |MAPCAR(.ZEROP,
  689. +    #'(0 14 0. -41 0.0 29 -0.0 2.99 00000 99999.)')
  690. *
  691.  PAUSE()
  692. *
  693.  ?( |'Testing LESSP' |'' )
  694.  |LESSP( #'( \-P...I. 0.00 0.01 10000000.)' )
  695.  |LESSP( #'( \-LN...10. 0.00 1.01 1.000000)' )
  696. *
  697.  PAUSE()
  698. *
  699.  |'Testing GREATERP.'
  700.  |''
  701.  |GREATERP( #'( \P...I. 3.1 -4  -19.84)' )
  702.  |GREATERP( #'( 6 16 7 17    14.82   )' )
  703. *
  704.  PAUSE()
  705. *
  706. *
  707. * Tests of the property-list functions
  708. *    SNOLISPIST
  709. *
  710. *
  711.  ||''
  712.  |'Property list functions'
  713.  |''
  714. *
  715. *
  716.  MAPC(DEXP('LAMBDA(XPR) = '
  717. +     '|("      " !EVAL( |( |"" XPR )))' ),
  718. +     'PUT(.DOG,"NUMBER.OF.LEGS",4)' ~
  719. +     'GET(.DOG,"NUMBER.OF.LEGS")' ~ 'PAUSE()' ~
  720. +     'REMPROP(.DOG,"NUMBER.OF.LEGS")' ~
  721. +     'GET(.DOG,"NUMBER.OF.LEGS")' ~ 'PAUSE()' ~
  722. +     'PUTL(#"(DOG CAT HORSE)","NUMBER.OF.LEGS",4)' ~
  723. +     'GET(.DOG,"NUMBER.OF.LEGS")' ~
  724. +     'GET(.CAT,"NUMBER.OF.LEGS")' ~
  725. +     'GET(.HORSE,"NUMBER.OF.LEGS")' ~
  726. +     'GET(.ARMADILLO,"NUMBER.OF.LEGS")' ~ 'PAUSE()' ~
  727. +     'PUTPROP(.DOG,3,"LEGS")' ~
  728. +     'PUTPROP(.DOG,2,"LEGS")' ~
  729. +     'PUTPROP(.DOG,1,"LEGS")' ~
  730. +     'PUTPROP(.DOG,1,"HEAD")' ~
  731. +     'GETL(.DOG,#"(LEGS HEAD)")' ~
  732. +     'GETL(.DOG,#"(HEAD)")' ~ 'PAUSE()' ~
  733. +     'ADDPROP(.DOG,3,"LEGS")' ~
  734. +     'GET(.DOG,"LEGS")' ~
  735. +     'ADDPROP(.DOG,"ANOMALY","LEGS")' ~
  736. +     'GET(.DOG,"LEGS")' ~ 'PAUSE()' ~
  737. +     'DEFPROP(.FISH,0,"LEGS")' ~
  738. +     'GETL(.FISH,#"(EYES ARMS TEETH LEGS)")' ~
  739. +     NIL )
  740. *
  741.  PAUSE()
  742. *
  743. *
  744.  |''
  745.  ?( |'Empty all property stacks' |'' )
  746.  ?( |'DOG -- "LEGS"' |'' )
  747. *
  748. LOOP1 TEMP = GETPROP( .DOG, 'LEGS' )
  749.       ?( PRINT(TEMP) DIFFER(TEMP,NIL) )     :S(LOOP1)
  750.  |''
  751.  PAUSE()
  752.  ?( |'DOG -- "NUMBER.OF.LEGS"' |'' )
  753. LOOP2   TEMP = GETPROP( .DOG, 'NUMBER.OF.LEGS' )
  754.         ?( PRINT(TEMP) DIFFER(TEMP,NIL) )     :S(LOOP2)
  755.  |''
  756.  PAUSE()
  757.  ?( |'DOG -- "HEAD"' |'' )
  758. LOOP3   TEMP = GETPROP( .DOG, 'HEAD' )
  759.         ?( PRINT(TEMP) DIFFER(TEMP,NIL) )       :S(LOOP3)
  760.  |''
  761.  PAUSE()
  762.  |'CAT -- "NUMBER.OF.LEGS"'
  763. LOOP4   TEMP = GETPROP( .CAT, 'NUMBER.OF.LEGS' )
  764.         ?( PRINT(TEMP) DIFFER(TEMP,NIL) )     :S(LOOP4)
  765.  |''
  766.  PAUSE()
  767.  ?( |'FISH -- "LEGS"' |'' )
  768. LOOP5 TEMP = GETPROP( .FISH, 'LEGS' )
  769.       ?( PRINT(TEMP) DIFFER(TEMP,NIL) )      :S(LOOP5)
  770.  |''
  771.  PAUSE()
  772.  ?( |'HORSE -- "NUMBER.OF.LEGS"' |''   )
  773. LOOP6 TEMP = GETPROP( .HORSE, 'NUMBER.OF.LEGS' )
  774.       ?( PRINT(TEMP) DIFFER(TEMP,NIL) )      :S(LOOP6)
  775. *
  776.  PAUSE()
  777. *
  778.  ||''
  779.  ?( |'A combined test of CLA, CAL, and SORT' |'' )
  780.  ?( |'Should print ABDENWSSREBA' |'' )
  781.  L = CLA(EXPLODE('BADNEWSBEARS'))
  782.  SORT.(L,7,12,'LGE')
  783.  SORT.(L,1,6,'LLE')
  784.  |READLIST(CAL(L))
  785. *
  786.  PAUSE()
  787. *
  788.  ||''
  789.  |'A further test of SORT/CAL/CLA:'
  790.  |'Make anagrams out of some six-letter names by'
  791.  |'alphabetizing their letters.'
  792.  |''
  793.  MAPC(
  794. + DEXP(
  795. +   'LAMBDA(X) = '
  796. +    'PRINT('
  797. +     'CONCAT('
  798. +      'CAL('
  799. +       'SORT.(CLA(EXPLODE(X)),1,6,.LLE) )))' ),
  800. +         ('MARVIN' ~
  801. +         'PACMAN' ~
  802. +         'LOLITA' ~
  803. +         'MERLIN' ~
  804. +         'ELIJAH' ~
  805. +         'SHAFTO' ~
  806. +         'SYLVIA' ~
  807. +         'ITALIA' ~
  808. +         'GEORGE' ~
  809. +         'GIMPEL' ~
  810. +         'BACKUS' ~ NIL) )
  811. *
  812.  PAUSE()
  813. *
  814.  ||''
  815.  |'TDUMP test:  Should print suitable error message.'
  816.  |''
  817.  |(72 % 'C.a=b+c?')
  818. END
  819.