home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / tests / macro8.tst < prev    next >
Encoding:
Text File  |  1996-04-15  |  1.7 KB  |  103 lines
  1.  
  2. ;; testen der macrofunktionen kapitel 8
  3. ;; ------------------------------------
  4.  
  5.  
  6. ;; 8.1
  7. ;macro-function | defmacro
  8.  
  9.  
  10. (and (macro-function 'push) T)
  11. T
  12.  
  13. (and (macro-function 'member) T)
  14. NIL
  15.  
  16. (defmacro arithmetic-if (test neg-form zero-form pos-form)
  17.           (let ((var (gensym)))
  18.                `(let ((,var ,test))
  19.                      (cond ((< ,var 0) ,neg-form)
  20.                            ((= ,var 0) ,zero-form)
  21.                            (T ,pos-form)))))
  22. arithmetic-if
  23.  
  24.  
  25. (and (macro-function 'arithmetic-if) T)
  26. T
  27.  
  28. (setf x 8)
  29. 8
  30.  
  31. (arithmetic-if (- x 4)(- x)(LIST "ZERO") x)
  32. 8
  33.  
  34.  
  35. (setf x 4)
  36. 4
  37.  
  38. (arithmetic-if (- x 4)(- x)(LIST "ZERO")x)
  39. ("ZERO")
  40.  
  41.  
  42. (setf x 3)
  43. 3
  44.  
  45. (arithmetic-if (- x 4)(- x)(LIST "ZERO")x)
  46. -3
  47.  
  48.  
  49.  
  50. (defmacro arithmetic-if (test neg-form &optional zero-form pos-form)
  51.           (let ((var (gensym)))
  52.                `(let ((,var ,test))
  53.                      (cond ((< ,var 0) ,neg-form)
  54.                            ((= ,var 0) ,zero-form)
  55.                            (T ,pos-form)))))
  56. arithmetic-if
  57.  
  58.  
  59. (setf x 8)
  60. 8
  61.  
  62. (arithmetic-if (- x 4)(- x))
  63. nil
  64.  
  65.  
  66. (setf x 4)
  67. 4
  68.  
  69. (arithmetic-if (- x 4)(- x))
  70. NIL
  71.  
  72.  
  73. (setf x 3)
  74. 3
  75.  
  76. (arithmetic-if (- x 4)(- x))
  77. -3
  78.  
  79. (defmacro halibut ((mouth eye1 eye2)
  80.                    ((fin1 length1)(fin2 length2))
  81.                    tail)
  82.         `(list ,mouth ,eye1 ,eye2 ,fin1 ,length1 ,fin2 ,length2 ,tail))
  83. halibut
  84.  
  85. (setf m 'red-mouth
  86.       eyes '(left-eye . right-eye)
  87.       f1 '(1 2 3 4 5)
  88.       f2 '(6 7 8 9 0)
  89.       my-favorite-tail '(list of all parts of tail))
  90. (list of all parts of tail)
  91.  
  92.  
  93.  
  94. (halibut (m (car eyes)(cdr eyes))
  95.          ((f1 (length f1))(f2 (length f2)))
  96.          my-favorite-tail)
  97. (RED-MOUTH LEFT-EYE RIGHT-EYE (1 2 3 4 5) 5 (6 7 8 9 0) 5
  98. (LIST OF ALL PARTS OF TAIL))
  99.  
  100. ;; 8.2
  101. ; macroexpand | macroexpand-1
  102.  
  103.