mes.c: another macro clue-bat in apply. now macro.mes equals guile -s macro.mes.

macro.mes

@@ -11,30 +11,77 @@
 ;; (display (run 4))
 ;; (newline)
 
-(define (fm a)
-  (define-macro (a b)
-    (display b)
-    (newline)))
+;; (define (fm a)
+;;   (define-macro (a b)
+;;     (display b)
+;;     (newline)
+;;     "boo"))
 
-(display "f-define-macro: ")
-(fm 'dinges)
-(a c)
+;; (display "f-define-macro: ")
+;; (fm 'dinges)
+;; (a c)
+;; (newline)
+
+
+;; (define-macro (m a)
+;;   `(define-macro (,a b)
+;;      (display "b")
+;;      (display b)
+;;      (newline)))
+
+;; (display "define-macro: ")
+;; (m dinges)
+;; (newline)
+;; (display "running dinges: ")
+;; (dinges c)
+;; (newline)
+
+
+(define-macro (d-s n t)
+  ;; (display "D-S: ")
+  ;; (display `(define-macro (,n . a)
+  ;;             (,t (cons ',n a))))
+  ;; (newline)
+  `(define-macro (,n . args)
+     ;; (display "CALLING: t: ")
+     ;; (display ,t)
+     ;; (display " args: ")
+     ;; (display (cons ',n a))
+     ;; (newline)
+     ;; (display "HALLO: ==>")
+     ;; (display (,t (cons ',n a)))
+     ;; ;; (display "HALLO: ==>")
+     ;; ;; (display (,t (cons ',n a)))
+     ;; (newline)
+     (,t (cons ',n args))
+     )
+  )
+
+(d-s s-r
+     (lambda (. n-a)
+       (display "YEAH:")
+       (display n-a)
+       (newline)
+       '(lambda (. i) ;;(i r c)
+          (display "transformers")
+          (newline)
+          ''tee-hee-hee
+          )
+       ;; (define (foo) (display "Footje") (newline) 'f-f-f)
+       ;; foo
+       ;;"blaat"
+       )
+     ;;(let ())
+     )
+
+(display "calling s-r")
 (newline)
+(d-s when
+     (s-r 0 1 2)
+     )
 
-
-(define-macro (m a)
-  `(define-macro ;;(,a)
-     (,a b)
-     (display "b")
-     (display b) ;; todo
-     (newline)))
-
-(display "define-macro: ")
-(m dinges)
+(display "calling when")
 (newline)
-(display "running dinges: ")
-(dinges c)
+(display (when 3 4 5))
 (newline)
-
-(newline)
-3
+'dun

mes.c

@@ -273,6 +273,9 @@ apply_env_ (scm *fn, scm *x, scm *a)
   printf (" x=");
   display (x);
   puts ("");
+#endif
+#if MACROS
+  scm *macro;
 #endif
   if (atom_p (fn) != &scm_f)
     {
@@ -288,6 +291,30 @@ apply_env_ (scm *fn, scm *x, scm *a)
     return begin_env (cddr (fn), pairlis (cadr (fn), x, a));
   else if (car (fn) == &scm_label)
     return apply_env (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a));
+#if MACROS
+  else if ((macro = assq (car (fn), cdr (assq (&scm_macro, a)))) != &scm_f) {
+#if DEBUG
+    printf ("APPLY GOTTA MACRO! name=");
+    display (car (fn));
+    printf (" body=");
+    display (cdr (macro));
+    printf (" args=");
+    display (cdr (fn));
+    puts ("");
+#endif
+    scm *r = apply_env (cdr (macro), cdr (fn), a);
+#if DEBUG
+    printf ("APPLY MACRO GOT: ==> ");
+    display (r);
+    puts ("");
+#endif
+    return apply_env (r, x, a);
+    //return eval_ (cons (r, x), a);
+    //return apply_env_ (eval (cdr (macro), a), x, a);
+    //return eval (apply_env_ (cdr (macro), x, a), a);
+    //return eval (apply_env_ (eval (cdr (macro), a), x, a), a);
+  }
+#endif // MACROS
   return &scm_unspecified;
 }
 
@@ -831,7 +858,8 @@ display_helper (scm *x, bool cont, char *sep, bool quote)
   }
   else if (atom_p (x) == &scm_t) printf ("%s", x->name);
 
-  return &scm_unspecified;
+  //return &scm_unspecified;
+  return x; // FIXME: eval helper for macros
 }
 
 // READ

syntax.mes

@@ -53,7 +53,6 @@
      (,transformer (cons ',macro-name args)
                              (lambda (x) x)
                              eq?)
-     ;;"blaat"
      ))
 
 ;; (define-macro (mes:define-syntax form expander)