Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 04:55:04 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Get macros to work by adding a rename env

Browse source 
Each macro will use its own use environment to rename macros, but a common environment will be used by all macro expansions (and after the last expansion) to map any renamed free variables back to the expected symbol.
This commit is contained in:
Justin Ethier 2016-09-20 17:32:26 -04:00
parent d7bd650cfd
commit 796d5f9e0a
4 changed files with 17 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
cyclone.scm
View file

@ -148,9 +148,9 @@
(trace:info "---------------- after macro expansion:") (trace:info "---------------- after macro expansion:")
(trace:info input-program) ;pretty-print (trace:info input-program) ;pretty-print
; TODO: ; TODO:
;(set! input-program (macro:cleanup input-program)) (set! input-program (macro:cleanup input-program))
;(trace:info "---------------- after macro expansion cleanup:") (trace:info "---------------- after macro expansion cleanup:")
;(trace:info input-program) ;pretty-print (trace:info input-program) ;pretty-print
;; Separate global definitions from the rest of the top-level code ;; Separate global definitions from the rest of the top-level code
(set! input-program (set! input-program

18
scheme/cyclone/macros.sld
View file

@ -73,14 +73,14 @@
((Cyc-get-cvar (cadr macro)) ((Cyc-get-cvar (cadr macro))
exp exp
(Cyc-er-rename use-env mac-env) (Cyc-er-rename use-env mac-env)
(Cyc-er-compare? use-env))) (Cyc-er-compare? use-env *macro:renamed-variables*)))
(else (else
(eval (eval
(list (list
(Cyc-get-cvar (cadr macro)) (Cyc-get-cvar (cadr macro))
(list 'quote exp) (list 'quote exp)
(Cyc-er-rename use-env mac-env) (Cyc-er-rename use-env mac-env)
(Cyc-er-compare? use-env)) (Cyc-er-compare? use-env *macro:renamed-variables*))
mac-env)))) mac-env))))
; (newline) ; (newline)
; (display "/* ") ; (display "/* ")
@ -101,13 +101,13 @@
(define (macro:cleanup expr) (define (macro:cleanup expr)
(define (clean expr bv) ;; Bound variables (define (clean expr bv) ;; Bound variables
(newline) ;(newline)
(display "/* macro:cleanup->clean, bv =") ;(display "/* macro:cleanup->clean, bv =")
(write bv) ;(write bv)
(newline) ;(newline)
(write expr) ;(write expr)
(newline) ;(newline)
(display "*/ ") ;(display "*/ ")
(cond (cond
((const? expr) expr) ((const? expr) expr)
((null? expr) expr) ((null? expr) expr)

4
scheme/cyclone/util.sld
View file

@ -596,12 +596,14 @@
(begin . begin) ;; TODO: just a quick-fix, not a long-term solution (begin . begin) ;; TODO: just a quick-fix, not a long-term solution
))) )))
(define (Cyc-er-compare? use-env) (define (Cyc-er-compare? use-env renamed-env)
;; Keep looking up a symbol until the original non-renamed symbol is found ;; Keep looking up a symbol until the original non-renamed symbol is found
(define (find-original-sym sym) (define (find-original-sym sym)
(let ((val (env:lookup sym use-env #f))) (let ((val (env:lookup sym use-env #f)))
;(Cyc-write `(find-original-sym ,sym ,val) (current-output-port)) ;(Cyc-write `(find-original-sym ,sym ,val) (current-output-port))
;(Cyc-display "\n" (current-output-port)) ;(Cyc-display "\n" (current-output-port))
(if (not val)
(set! val (env:lookup sym renamed-env #f)))
(if val (if val
(find-original-sym val) ;; Keep going (find-original-sym val) ;; Keep going
sym))) ;; There was no rename, so sym is not renamed sym))) ;; There was no rename, so sym is not renamed

4
scheme/eval.sld
View file

@ -442,7 +442,7 @@
(analyze (apply macro-op (analyze (apply macro-op
(list (cons (car exp) (operands exp)) (list (cons (car exp) (operands exp))
(Cyc-er-rename use-env a-env) (Cyc-er-rename use-env a-env)
(Cyc-er-compare? use-env))) (Cyc-er-compare? use-env 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
@ -450,7 +450,7 @@
(list (cons (car exp) (list (cons (car exp)
(operands exp)))) (operands exp))))
(Cyc-er-rename use-env a-env) (Cyc-er-rename use-env a-env)
(Cyc-er-compare? use-env))))) (Cyc-er-compare? use-env use-env)))))
(analyze (analyze
(eval expr a-env) ;; Expand macro (eval expr a-env) ;; Expand macro
a-env)))))) a-env))))))