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 (fm a)
-  (define-macro (a b)
+;;   (define-macro (a b)
-    (display b)
+;;     (display b)
-    (newline)))
+;;     (newline)
+;;     "boo"))
 
-(display "f-define-macro: ")
+;; (display "f-define-macro: ")
-(fm 'dinges)
+;; (fm 'dinges)
-(a c)
+;; (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)
+     )
 
-
+(display "calling when")
-(define-macro (m a)
-  `(define-macro ;;(,a)
-     (,a b)
-     (display "b")
-     (display b) ;; todo
-     (newline)))
-
-(display "define-macro: ")
-(m dinges)
 (newline)
-(display "running dinges: ")
+(display (when 3 4 5))
-(dinges c)
 (newline)
-
+'dun
-(newline)
-3

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

@@ -51,9 +51,8 @@
   ;; (newline)
   `(define-macro (,macro-name . args)
      (,transformer (cons ',macro-name args)
-                   (lambda (x) x)
+                             (lambda (x) x)
-                   eq?)
+                             eq?)
-     ;;"blaat"
      ))
 
 ;; (define-macro (mes:define-syntax form expander)
@@ -83,7 +82,7 @@
 
 (mes:define-syntax syntax-rules
   (let ()
-   ;;begin
+    ;;begin
 
     (define name? symbol?)
 
@@ -103,7 +102,7 @@
 
     (lambda (exp r c)
 
-      (define %input (r '%input))     ;Gensym these, if you like.
+      (define %input (r '%input))      ;Gensym these, if you like.
       (define %compare (r '%compare))
       (define %rename (r '%rename))
       (define %tail (r '%tail))
@@ -158,7 +157,7 @@
       (define (process-segment-match input pattern)
         (let ((conjuncts (process-match '(car l) pattern)))
           (if (null? conjuncts)
-              `((list? ,input))                        ;+++
+              `((list? ,input))        ;+++
               `((let loop ((l ,input))
                   (or (null? l)
                       (and (pair? l)
@@ -176,7 +175,7 @@
               ((segment-pattern? pattern)
                (process-pattern (car pattern)
                                 %temp
-                                (lambda (x)        ;temp is free in x
+                                (lambda (x) ;temp is free in x
                                   (mapit (if (eq? %temp x)
                                              path ;+++
                                              `(map (lambda (,%temp) ,x)
@@ -207,11 +206,11 @@
                                                  (+ rank 1)
                                                  env))
                             (gen (if (equal? (list x) vars)
-                                     x        ;+++
+                                     x ;+++
                                      `(map (lambda ,vars ,x)
                                            ,@vars))))
                        (if (null? (cddr template))
-                           gen                ;+++
+                           gen         ;+++
                            `(append ,gen ,(process-template (cddr template)
                                                             rank env)))))))
               ((pair? template)
@@ -257,7 +256,7 @@
               (#t ;;else
                free)))
 
-      c ;ignored
+      c                                ;ignored
 
       (display "HELLO")
       (newline)