diff --git a/GNUmakefile b/GNUmakefile index 0db8d0d3..17275ef0 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -47,3 +47,6 @@ run: all syntax: all cat scm.mes syntax.mes | ./mes + +macro: all + cat macro.mes | ./mes diff --git a/macro.mes b/macro.mes new file mode 100644 index 00000000..0e884e04 --- /dev/null +++ b/macro.mes @@ -0,0 +1,38 @@ + +;; (define (run x) +;; (define (test? y) (display "testing:") (display y) (newline) (eq? x y)) +;; (test? 3) +;; ) + +;; (display "(run 3):") +;; (display (run 3)) +;; (newline) +;; (display "(run 4):") +;; (display (run 4)) +;; (newline) + +(define (fm a) + (define-macro (a b) + (display b) + (newline))) + +(display "f-define-macro...") +(fm 'dinges) +(a c) +(newline) + + +(define-macro (m a) + `(define-macro (,a) ;;;(,a b) b: todo + (display "b") ;; (display b) ;; todo + (newline))) + +(display "define-macro...") +(m dinges) + +(display "running dinges...") +(dinges) +(newline) + +(newline) +3 diff --git a/mes.c b/mes.c index bcef80a0..bf52ae2f 100644 --- a/mes.c +++ b/mes.c @@ -346,8 +346,20 @@ eval_ (scm *e, scm *a) else if (car (e) == &scm_symbol_cond) return evcon (cdr (e), a); #if MACROS - else if ((macro = assq (car (e), cdr (assq (&scm_macro, a)))) != &scm_f) + else if (eq_p (car (e), &scm_symbol_define_macro) == &scm_t) + return define_macro (e, a); + else if ((macro = assq (car (e), cdr (assq (&scm_macro, a)))) != &scm_f) { +#if DEBUG + printf ("GOTTA MACRO! name="); + display (car (e)); + printf (" body="); + display (cdr (macro)); + printf (" args="); + display (cdr (e)); + puts (""); +#endif return eval (apply_env_ (cdr (macro), cdr (e), a), a); + } #endif // MACROS return apply_env (car (e), evlis (cdr (e), a), a); } @@ -1178,13 +1190,14 @@ define_macro (scm *x, scm *a) display (aa); puts (""); #endif + scm *macros = assq (&scm_macro, a); + scm *macro; if (atom_p (cadr (x)) != &scm_f) - return cons (&scm_macro, - cons (cons (cadr (x), eval (caddr (x), a)), - cdr (assq (&scm_macro, a)))); - return cons (&scm_macro, - cons (cons (caadr(x), make_lambda (cdadr (x), cddr (x))), - cdr (assq (&scm_macro, a)))); + macro = cons (cadr (x), eval (caddr (x), a)); + else + macro = cons (caadr(x), make_lambda (cdadr (x), cddr (x))); + set_cdr_x (macros, cons (macro, cdr (macros))); + return a; } scm *