diff --git a/scheme/cyclone/macros.sld b/scheme/cyclone/macros.sld index e60a461e..184f2800 100644 --- a/scheme/cyclone/macros.sld +++ b/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?? diff --git a/scheme/eval.sld b/scheme/eval.sld index 7fbcbd57..6280f823 100644 --- a/scheme/eval.sld +++ b/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))))) diff --git a/test2.scm b/test2.scm index aab95ebe..a8803e9f 100644 --- a/test2.scm +++ b/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))