support define-macro inside eval (i.e., inside define-macro)

GNUmakefile

@@ -47,3 +47,6 @@ run: all
 
 syntax: all
 	cat scm.mes syntax.mes | ./mes
+
+macro: all
+	cat macro.mes | ./mes

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

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 *