This commit is contained in:
Justin Ethier 2016-09-15 18:47:21 -04:00
parent 603d649336
commit d078e4d1c1
2 changed files with 14 additions and 9 deletions

View file

@ -483,11 +483,11 @@
(let ((renamed (gensym identifier))) (let ((renamed (gensym identifier)))
(env:define-variable! renamed val mac-env) (env:define-variable! renamed val mac-env)
renamed)) renamed))
#;((not (eq? val 'not-defined)) #;((eq? val 'not-defined)
;; Unrenamed variable identifier ;; Unrenamed variable identifier
(let ((renamed (gensym identifier))) (let ((renamed (gensym identifier)))
(env:define-variable! renamed identifier use-env) (env:define-variable! renamed identifier use-env)
(env:define-variable! renamed val mac-env) ;(env:define-variable! renamed val mac-env)
(Cyc-write `(ER rename ,identifier to ,renamed) (current-output-port)) (Cyc-write `(ER rename ,identifier to ,renamed) (current-output-port))
(Cyc-display "\n" (current-output-port)) (Cyc-display "\n" (current-output-port))
renamed) renamed)
@ -524,7 +524,11 @@
;; TODO: this is not good enough, need to determine if these symbols ;; TODO: this is not good enough, need to determine if these symbols
;; are the same identifier in their *environment of use* ;; are the same identifier in their *environment of use*
(lambda (a b) (lambda (a b)
(eq? a b))) (let ((aval (env:lookup a use-env #f))
(bval (env:lookup b use-env #f)))
(if (and aval bval)
(eq? aval bval)
(eq? a b)))))
;; Name-mangling. ;; Name-mangling.

View file

@ -13,7 +13,7 @@
;(scheme cyclone libraries) ;; for handling import sets ;(scheme cyclone libraries) ;; for handling import sets
(scheme base) (scheme base)
(scheme file) (scheme file)
;(scheme write) ;; Only used for debugging (scheme write) ;; Only used for debugging
(scheme read)) (scheme read))
(export (export
;environment ;environment
@ -341,7 +341,7 @@
(define (analyze exp env) (define (analyze exp env)
;(newline) ;(newline)
;(display "/* ") ;(display "/* ")
;(display (list 'analyze exp)) ;(write (list 'analyze exp))
;(display " */") ;(display " */")
(cond ((self-evaluating? exp) (cond ((self-evaluating? exp)
(analyze-self-evaluating exp)) (analyze-self-evaluating exp))
@ -436,20 +436,21 @@
#f)) #f))
(expand (expand
(lambda (macro-op) (lambda (macro-op)
(define use-env (env:extend-environment '() '() '()))
(if (Cyc-macro? macro-op) (if (Cyc-macro? macro-op)
;; Compiled macro, call directly ;; Compiled macro, call directly
(analyze (apply macro-op (analyze (apply macro-op
(list (cons (car exp) (operands exp)) (list (cons (car exp) (operands exp))
(Cyc-er-rename a-env a-env) (Cyc-er-rename use-env a-env)
(Cyc-er-compare? a-env))) (Cyc-er-compare? use-env)))
a-env) a-env)
;; Interpreted macro, build expression and eval ;; Interpreted macro, build expression and eval
(let ((expr (cons macro-op (let ((expr (cons macro-op
(list (cons 'quote (list (cons 'quote
(list (cons (car exp) (list (cons (car exp)
(operands exp)))) (operands exp))))
(Cyc-er-rename a-env a-env) (Cyc-er-rename use-env a-env)
(Cyc-er-compare? a-env))))) (Cyc-er-compare? use-env)))))
(analyze (analyze
(eval expr a-env) ;; Expand macro (eval expr a-env) ;; Expand macro
a-env)))))) a-env))))))