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

Diff of /gcl/tests/macro8.tst

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

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

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

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