Allow expanding interpreted macro from within another

scheme/cyclone/macros.sld

@@ -58,17 +58,20 @@
                 rename
                 compare?))
             (else
-              ;; Assume evaluated macro
-              (eval
-                (list
-                  (cdr macro)
-                  (list 'quote exp)
-                  rename
-                  compare?)
-                ;; TODO: environment (would need to create a new macro
-                ;; type in eval though, and then format defined-macros 
-                ;; to create an env of macros
-              )))))
+              (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
+                    (cdr macro)
+                    (list 'quote exp)
+                    rename
+                    compare?)
+                  env))
+              ))))
 
     ; 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,29 +440,41 @@
     (loop (car procs) (cdr procs))))
 
 (define (pre-analyze-application exp a-env)
+  ;; Notes:
+  ;;
+  ;; 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...
+  ;;(write (list 'JAE-DEBUG 'expanding exp)) ;; DEBUG-only
+
+  ;; TODO: need to use common rename/compare functions
+  ;; instead of fudging them here. maybe keep common
+  ;; functions in the macros module and hook into them???
+
+  ;; see macro-expand in that module. believe these are the only
+  ;; two places so far that introduce instances of rename/compare?
   (let* ((op (operator exp))
          (var (if (symbol? op)
                   (_lookup-variable-value op a-env
                     (lambda () #f)) ; Not found
-                  #f)))
+                  #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))))
     (cond
+      ;; compiled macro
       ((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...
-       ;;(write (list 'JAE-DEBUG 'expanding exp)) ;; DEBUG-only
-
-       ;; TODO: need to use common rename/compare functions
-       ;; instead of fudging them here. maybe keep common
-       ;; functions in the macros module and hook into them???
-
-       ;; see macro-expand in that module. believe these are the only
-       ;; two places so far that introduce instances of rename/compare?
-       (analyze (apply var
-                      (list (cons var (operands exp))
-                            (lambda (sym) sym)
-                            (lambda (a b) (eq? a b)))) 
-                a-env))
+       (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

@@ -45,18 +45,6 @@
        (test 1 2 3) ; breaks
        ;(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))