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