1; -*- scheme -*-
2;
3
4; (define macro
5;   (macro-set-code!
6;    (make-macro)
7;    (lambda (*macro-form*)
8;	 (display "; macro: *macro-form*=") (print *macro-form*)
9;	 (display "; macro: code=") (print `(lambda ( ,(cadr *macro-form*) ) ,@(cddr *macro-form*)))
10; 	 `(macro-set-code!
11; 	   (make-macro)
12; 	   (lambda ( ,(cadr *macro-form*) ) ,@(cddr *macro-form*))))))
13
14(define macro
15  (make-macro
16   (lambda (**macroform**)
17	 `(make-macro (lambda ( ,(cadr **macroform**) )
18					,@(cddr **macroform**))))))
19
20
21(define define-macro
22  (macro
23   f
24   (let ((formal (cadr f)) (body (cddr f)))
25	 (let ((name (car formal))
26		   (args (cdr formal)))
27;	   (display "name=") (print name)
28;	   (display "args=") (print args)
29;	   (display "formal=") (print formal)
30;	   (display "body=") (print body)
31
32;	   (display "macro=")
33;	   (print
34;		`(define ,name
35;		   (macro params (apply (lambda ,args ,@body) (cdr params)))))
36
37	   (eval
38		`(define ,name
39		   (macro params (apply (lambda ,args ,@body) (cdr params))))
40		(the-env))
41
42
43;	   (display "function=")
44;	   (print
45;		(if (pair? args)
46;		  `(macro-set-func! ,name (eval '(lambda ,args (,name ,@args))
47;										(the-env)))
48;		  `(macro-set-func! ,name (eval '(lambda ,args (apply ,name ,args))
49;										(the-env)))))
50
51;	   (eval
52;		(if (pair? args)
53;		  `(macro-set-func! ,name (eval '(lambda ,args (,name ,@args))
54;										(the-env)))
55;		  `(macro-set-func! ,name (eval '(lambda ,args (apply ,name ,args))
56;										(the-env))))
57;		(the-env))
58
59	   #t
60	   ))))
61
62
63
64