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

Change rename env to a local instead of a global

Browse source
This commit is contained in:
Justin Ethier 2016-09-21 17:25:36 -04:00
parent 5f93f3e9cb
commit 7b441dcfcf
3 changed files with 54 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
cyclone.scm
View file

@ -37,6 +37,7 @@
(define lib-exports '()) (define lib-exports '())
(define lib-renamed-exports '()) (define lib-renamed-exports '())
(define c-headers '()) (define c-headers '())
(define rename-env (env:extend-environment '() '() '()))
(emit *c-file-header-comment*) ; Guarantee placement at top of C file (emit *c-file-header-comment*) ; Guarantee placement at top of C file
@ -133,10 +134,11 @@
(set! input-program (set! input-program
(cond (cond
(program? (program?
(expand-lambda-body input-program (macro:get-env))) (expand-lambda-body input-program (macro:get-env) rename-env))
(else (else
(let ((expanded (expand `(begin ,@input-program) (let ((expanded (expand `(begin ,@input-program)
(macro:get-env)))) (macro:get-env)
rename-env)))
(cond (cond
((and (pair? expanded) ((and (pair? expanded)
(tagged-list? 'lambda (car expanded))) (tagged-list? 'lambda (car expanded)))
@ -148,13 +150,13 @@
(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 rename-env))
(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
(isolate-globals input-program program? lib-name)) (isolate-globals input-program program? lib-name rename-env))
;; Optimize-out unused global variables ;; Optimize-out unused global variables
;; For now, do not do this if eval is used. ;; For now, do not do this if eval is used.

13
scheme/cyclone/macros.sld
View file

@ -52,8 +52,7 @@
(define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros)) (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros))
(define *macro:renamed-variables* (env:extend-environment '() '() '())) (define (macro:expand exp macro mac-env rename-env)
(define (macro:expand exp macro mac-env) ;;rename-tbl
(let* ((use-env (env:extend-environment '() '() '())) (let* ((use-env (env:extend-environment '() '() '()))
(compiled-macro? (or (Cyc-macro? (Cyc-get-cvar (cadr macro))) (compiled-macro? (or (Cyc-macro? (Cyc-get-cvar (cadr macro)))
(procedure? (cadr macro)))) (procedure? (cadr macro))))
@ -72,14 +71,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 *macro:renamed-variables*))) (Cyc-er-compare? use-env rename-env)))
(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 *macro:renamed-variables*)) (Cyc-er-compare? use-env rename-env))
mac-env)))) mac-env))))
; (newline) ; (newline)
; (display "/* ") ; (display "/* ")
@ -87,7 +86,7 @@
; (newline) ; (newline)
; (display (list result)) ; (display (list result))
; (display "*/ ") ; (display "*/ ")
(macro:add-renamed-vars! use-env *macro:renamed-variables*) (macro:add-renamed-vars! use-env rename-env)
result)) result))
(define (macro:add-renamed-vars! env renamed-env) (define (macro:add-renamed-vars! env renamed-env)
@ -98,7 +97,7 @@
(env:all-variables env) (env:all-variables env)
(env:all-values env)))) (env:all-values env))))
(define (macro:cleanup expr) (define (macro:cleanup expr rename-env)
(define (clean expr bv) ;; Bound variables (define (clean expr bv) ;; Bound variables
;(newline) ;(newline)
;(display "/* macro:cleanup->clean, bv =") ;(display "/* macro:cleanup->clean, bv =")
@ -116,7 +115,7 @@
((ref? expr) ((ref? expr)
;; if symbol has been renamed and is not a bound variable, ;; if symbol has been renamed and is not a bound variable,
;; undo the rename ;; undo the rename
(let ((val (env:lookup expr *macro:renamed-variables* #f))) (let ((val (env:lookup expr rename-env #f)))
(if (and val (not (member expr bv))) (if (and val (not (member expr bv)))
(clean val bv) (clean val bv)
expr))) expr)))

77
scheme/cyclone/transforms.sld
View file

@ -502,7 +502,7 @@
;TODO: modify this whole section to use macros:get-env instead of *defined-macros*. macro:get-env becomes the mac-env. any new scopes need to extend that env, and an env parameter needs to be added to (expand). any macros defined with define-syntax use that env as their mac-env (how to store that)? ;TODO: modify this whole section to use macros:get-env instead of *defined-macros*. macro:get-env becomes the mac-env. any new scopes need to extend that env, and an env parameter needs to be added to (expand). any macros defined with define-syntax use that env as their mac-env (how to store that)?
; expand : exp -> exp ; expand : exp -> exp
(define (expand exp env) (define (expand exp env rename-env)
(define (log e) (define (log e)
(display (display
(list 'expand e 'env (list 'expand e 'env
@ -517,22 +517,22 @@
((ref? exp) exp) ((ref? exp) exp)
((quote? exp) exp) ((quote? exp) exp)
((lambda? exp) `(lambda ,(lambda->formals exp) ((lambda? exp) `(lambda ,(lambda->formals exp)
,@(expand-body '() (lambda->exp exp) env) ,@(expand-body '() (lambda->exp exp) env rename-env)
;,@(map ;,@(map
; ;; TODO: use extend env here? ; ;; TODO: use extend env here?
; (lambda (expr) (expand expr env)) ; (lambda (expr) (expand expr env rename-env))
; (lambda->exp exp)) ; (lambda->exp exp))
)) ))
((define? exp) (if (define-lambda? exp) ((define? exp) (if (define-lambda? exp)
(expand (define->lambda exp) env) (expand (define->lambda exp) env rename-env)
`(define ,(expand (define->var exp) env) `(define ,(expand (define->var exp) env rename-env)
,@(expand (define->exp exp) env)))) ,@(expand (define->exp exp) env rename-env))))
((set!? exp) `(set! ,(expand (set!->var exp) env) ((set!? exp) `(set! ,(expand (set!->var exp) env rename-env)
,(expand (set!->exp exp) env))) ,(expand (set!->exp exp) env rename-env)))
((if? exp) `(if ,(expand (if->condition exp) env) ((if? exp) `(if ,(expand (if->condition exp) env rename-env)
,(expand (if->then exp) env) ,(expand (if->then exp) env rename-env)
,(if (if-else? exp) ,(if (if-else? exp)
(expand (if->else exp) env) (expand (if->else exp) env rename-env)
;; Insert default value for missing else clause ;; Insert default value for missing else clause
;; FUTURE: append the empty (unprinted) value ;; FUTURE: append the empty (unprinted) value
;; instead of #f ;; instead of #f
@ -546,8 +546,8 @@
(cond (cond
((tagged-list? 'syntax-rules trans) ;; TODO: what if syntax-rules is renamed? ((tagged-list? 'syntax-rules trans) ;; TODO: what if syntax-rules is renamed?
(expand (expand
`(define-syntax ,name ,(expand trans env)) `(define-syntax ,name ,(expand trans env rename-env))
env)) env rename-env))
(else (else
;; TODO: for now, do not let a compiled macro be re-defined. ;; TODO: for now, do not let a compiled macro be re-defined.
;; this is a hack for performance compiling (scheme base) ;; this is a hack for performance compiling (scheme base)
@ -568,17 +568,17 @@
;; TODO: may run into issues with expanding now, before some ;; TODO: may run into issues with expanding now, before some
;; of the macros are defined. may need to make a special pass ;; of the macros are defined. may need to make a special pass
;; to do loading or expansion of macro bodies ;; to do loading or expansion of macro bodies
`(define ,name ,(expand body env))))))) `(define ,name ,(expand body env rename-env)))))))
((app? exp) ((app? exp)
(cond (cond
((symbol? (car exp)) ((symbol? (car exp))
(let ((val (env:lookup (car exp) env #f))) (let ((val (env:lookup (car exp) env #f)))
(if (tagged-list? 'macro val) (if (tagged-list? 'macro val)
(expand ; Could expand into another macro (expand ; Could expand into another macro
(macro:expand exp val env) (macro:expand exp val env rename-env)
env) env rename-env)
(map (map
(lambda (expr) (expand expr env)) (lambda (expr) (expand expr env rename-env))
exp)))) exp))))
(else (else
;; TODO: note that map does not guarantee that expressions are ;; TODO: note that map does not guarantee that expressions are
@ -586,17 +586,17 @@
;; in reverse order. Might be better to use a fold here and ;; in reverse order. Might be better to use a fold here and
;; elsewhere in (expand). ;; elsewhere in (expand).
(map (map
(lambda (expr) (expand expr env)) (lambda (expr) (expand expr env rename-env))
exp)))) exp))))
(else (else
(error "unknown exp: " exp)))) (error "unknown exp: " exp))))
;; Nicer interface to expand-body ;; Nicer interface to expand-body
(define (expand-lambda-body exp env) (define (expand-lambda-body exp env rename-env)
(expand-body '() exp env)) (expand-body '() exp env rename-env))
;; Helper to expand a lambda body, so we can splice in any begin's ;; Helper to expand a lambda body, so we can splice in any begin's
(define (expand-body result exp env) (define (expand-body result exp env rename-env)
(define (log e) (define (log e)
(display (list 'expand-body e 'env (display (list 'expand-body e 'env
(env:frame-variables (env:first-frame env))) (env:frame-variables (env:first-frame env)))
@ -615,15 +615,16 @@
(quote? this-exp) (quote? this-exp)
(define-c? this-exp)) (define-c? this-exp))
;(log this-exp) ;(log this-exp)
(expand-body (cons this-exp result) (cdr exp) env)) (expand-body (cons this-exp result) (cdr exp) env rename-env))
((define? this-exp) ((define? this-exp)
;(log this-exp) ;(log this-exp)
(expand-body (expand-body
(cons (cons
(expand this-exp env) (expand this-exp env rename-env)
result) result)
(cdr exp) (cdr exp)
env)) env
rename-env))
((or (define-syntax? this-exp) ((or (define-syntax? this-exp)
(lambda? this-exp) (lambda? this-exp)
(set!? this-exp) (set!? this-exp)
@ -631,10 +632,11 @@
;(log (car this-exp)) ;(log (car this-exp))
(expand-body (expand-body
(cons (cons
(expand this-exp env) (expand this-exp env rename-env)
result) result)
(cdr exp) (cdr exp)
env)) env
rename-env))
;; Splice in begin contents and keep expanding body ;; Splice in begin contents and keep expanding body
((begin? this-exp) ((begin? this-exp)
(let* ((expr this-exp) (let* ((expr this-exp)
@ -643,7 +645,8 @@
(expand-body (expand-body
result result
(append begin-exprs (cdr exp)) (append begin-exprs (cdr exp))
env))) env
rename-env)))
((app? this-exp) ((app? this-exp)
(cond (cond
((symbol? (caar exp)) ((symbol? (caar exp))
@ -653,33 +656,36 @@
(if (tagged-list? 'macro val) (if (tagged-list? 'macro val)
;; Expand macro here so we can catch begins in the expanded code, ;; Expand macro here so we can catch begins in the expanded code,
;; including nested begins ;; including nested begins
(let ((expanded (macro:expand this-exp val env))) (let ((expanded (macro:expand this-exp val env rename-env)))
;(log `(DONE WITH macro:expand)) ;(log `(DONE WITH macro:expand))
(expand-body (expand-body
result result
(cons (cons
expanded ;(macro:expand this-exp val env) expanded ;(macro:expand this-exp val env)
(cdr exp)) (cdr exp))
env)) env
rename-env))
;; No macro, use main expand function to process ;; No macro, use main expand function to process
(expand-body (expand-body
(cons (cons
(map (map
(lambda (expr) (expand expr env)) (lambda (expr) (expand expr env rename-env))
this-exp) this-exp)
result) result)
(cdr exp) (cdr exp)
env)))) env
rename-env))))
(else (else
;(log 'app) ;(log 'app)
(expand-body (expand-body
(cons (cons
(map (map
(lambda (expr) (expand expr env)) (lambda (expr) (expand expr env rename-env))
this-exp) this-exp)
result) result)
(cdr exp) (cdr exp)
env)))) env
rename-env))))
(else (else
(error "unknown exp: " this-exp)))))) (error "unknown exp: " this-exp))))))
@ -691,7 +697,7 @@
; This function extracts out non-define statements, and adds them to ; This function extracts out non-define statements, and adds them to
; a "main" after the defines. ; a "main" after the defines.
; ;
(define (isolate-globals exp program? lib-name) (define (isolate-globals exp program? lib-name rename-env)
(let loop ((top-lvl exp) (let loop ((top-lvl exp)
(globals '()) (globals '())
(exprs '())) (exprs '()))
@ -710,7 +716,8 @@
;; This is a library, keep inits in their own function ;; This is a library, keep inits in their own function
`((define ,(lib:name->symbol lib-name) `((define ,(lib:name->symbol lib-name)
(lambda () 0 ,@(reverse exprs)))))) (lambda () 0 ,@(reverse exprs))))))
(macro:get-env)))) (macro:get-env)
rename-env)))
(else (else
(cond (cond
((define? (car top-lvl)) ((define? (car top-lvl))