1(import "test")
2;;;
3;;; Chapter 8: Macros
4;;;
5
6($ap 1 "Macros")
7
8;;;------------------------------------------------------------
9($test `(list ,(+ 1 2) 4) (list 3 4) equal)
10($test (let ((name 'a)) `(list name ,name ',name)) (list name a (quote a)) equal)
11($test `(a ,(+ 1 2) ,@(create-list 3 'x) b) (a 3 x x x b) equal)
12($test `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))
13 ((foo 7) . cons) equal)
14($test `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)
15 (a `(b ,(+ 1 2) ,(foo 4 d) e) f) equal)
16($test (let ((name1 'x)
17       (name2 'y))
18   `(a `(b ,,name1 ,',name2 d) e))
19 (a `(b ,x ,'y d) e) equal)
20
21;;;------------------------------------------------------------
22;;; [defining operator]
23;;;
24;;;  (defmacro macro-name lambda-list form*) --> <symbol>
25;;;------------------------------------------------------------
26($test (defmacro my-caar (x) (list 'car (list 'car x))) my-caar)
27($test (my-caar '((a b) (c d))) a)
28($test (my-caar '(((a b) (c d)) ((e f) (g h)))) (a b) equal)
29;;;
30($eval (defmacro my-first (x) `(car ,x)))
31($eval (defmacro my-first2 (x) `(my-first ,x)))
32($test (my-first '(1 2)) 1 eql)
33($test (my-first2 '(1 2)) 1 eql)
34;;;
35($error (defmacro) <program-error>)
36($error (defmacro foo) <program-error>)
37;;;
38($error (defmacro foo 2 . 3) <error>)
39;;; toplevel
40($error1 (+ (defmacro foo (x))) <error>)
41;;; macro-name
42($error (defmacro #2a((a b) (c d)) ()) <domain-error>)
43($error (defmacro #\a ()) <domain-error>)
44($error (defmacro 1234()) <domain-error>)
45($error (defmacro 123456789 ()) <domain-error>)
46($error (defmacro 1.234 ()) <domain-error>)
47($error (defmacro "abc" ()) <domain-error>)
48($error (defmacro #(a b c) ()) <domain-error>)
49($error (defmacro (x y) ()) <domain-error>)
50;;; lambda-list
51($eval (defmacro foo (x) y))
52($error (foo 1) <unbound-variable>)
53
54;;;
55($eval (defmacro foo (x &rest y) `(list ,x ,@y)))
56($test (foo 1) (1) equal)
57($test (foo 1 2) (1 2) equal)
58($test (foo 1 2 3) (1 2 3) equal)
59($argc foo 1 0 1)
60($error (foo 1 . 2) <error>)
61;;;
62($eval (defmacro foo (x y) `(list ,x ,y)))
63($test (foo 1 2) (1 2) equal)
64($argc foo 2 0 0)
65($error (foo 1 2 . 3) <error>)
66
67;;; end of file
68
69