Allow expanding interpreted macro from within another

scheme/cyclone/macros.sld

@@ -58,6 +58,11 @@
                 rename
                 compare?))
             (else
+              (let* ((env-vars (map car defined-macros))
+                     (env-vals (map (lambda (v)
+                                      (list 'macro (cdr v)))
+                                    defined-macros))
+                     (env (create-environment env-vars env-vals)))
                 ;; Assume evaluated macro
                 (eval
                   (list
@@ -65,10 +70,8 @@
                     (list 'quote exp)
                     rename
                     compare?)
-                ;; TODO: environment (would need to create a new macro
+                  env))
-                ;; type in eval though, and then format defined-macros 
+              ))))
-                ;; to create an env of macros
-              )))))
 
     ; TODO: get macro name, transformer
     ; TODO: base off of syntactic closures instead of ER macros??

scheme/eval.sld

@@ -38,6 +38,8 @@
 ;; - vars => Identifiers in the new environment
 ;; - vals => List of each value assigned to each identifier
 (define (create-environment vars vals)
+  ;(write `(DEBUG vars ,vars))
+  ;(write `(DEBUG vals ,vals))
   (extend-environment vars vals *global-environment*)) ;; TODO: setup?
 
 (define (eval exp . env)
@@ -114,6 +116,11 @@
 (define (procedure-body p) (caddr p))
 (define (procedure-environment p) (cadddr p))
 
+;; Evaluated macros
+(define macro-tag 'macro)
+(define (compound-macro? exp)
+  (tagged-list? macro-tag exp))
+
 ;; Environments
 (define (enclosing-environment env) (cdr env))
 (define (first-frame env) (car env))
@@ -433,13 +440,8 @@
     (loop (car procs) (cdr procs))))
 
 (define (pre-analyze-application exp a-env)
-  (let* ((op (operator exp))
+  ;; Notes:
-         (var (if (symbol? op)
+  ;;
-                  (_lookup-variable-value op a-env
-                    (lambda () #f)) ; Not found
-                  #f)))
-    (cond
-      ((macro? var)
   ;; look up symbol in env, and expand if it is a macro
   ;; Adds some extra overhead into eval, which is not ideal. may need to 
   ;; reduce that overhead later...
@@ -451,11 +453,28 @@
 
   ;; see macro-expand in that module. believe these are the only
   ;; two places so far that introduce instances of rename/compare?
-       (analyze (apply var
+  (let* ((op (operator exp))
-                      (list (cons var (operands exp))
+         (var (if (symbol? op)
+                  (_lookup-variable-value op a-env
+                    (lambda () #f)) ; Not found
+                  #f))
+         (expand (lambda (macro-op)
+                   (analyze (apply macro-op
+                                  (list (cons macro-op (operands exp))
                                         (lambda (sym) sym)
                                         (lambda (a b) (eq? a b)))) 
-                a-env))
+                            a-env))))
+    (cond
+      ;; compiled macro
+      ((macro? var)
+       (expand var))
+      ;; compiled macro in compound form
+      ((compound-macro? var)
+       (expand (Cyc-get-cvar (cadr var))))
+      ;; standard interpreted macro
+      ((compound-macro? op)
+       (expand (cdr op)))
+      ;; normal function
       (else
        (analyze-application exp a-env)))))
 

test2.scm

@@ -46,18 +46,6 @@
        ;(my-or 1 2 3) ; breaks
        (and ''test ''test2))))
 
-
-;(define-syntax or
-;  (er-macro-transformer
-;     (lambda (expr rename compare)
-;       (cond ((null? (cdr expr)) #f)
-;             ((null? (cddr expr)) (cadr expr))
-;             (else
-;              (list (rename 'let) (list (list (rename 'tmp) (cadr expr)))
-;                    (list (rename 'if) (rename 'tmp)
-;                          (rename 'tmp)
-;                          (cons (rename 'or) (cddr expr)))))))))
-
 (write (test2 1 2 3))
 (write (test 1 2 3))
 (write (my-or 1 2 3 'or))