From 7b441dcfcf626c18cbc4866b8afc070396a57090 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 21 Sep 2016 17:25:36 -0400 Subject: [PATCH] Change rename env to a local instead of a global --- cyclone.scm | 10 +++-- scheme/cyclone/macros.sld | 13 +++--- scheme/cyclone/transforms.sld | 77 +++++++++++++++++++---------------- 3 files changed, 54 insertions(+), 46 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index cc23e24b..645a5e7e 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -37,6 +37,7 @@ (define lib-exports '()) (define lib-renamed-exports '()) (define c-headers '()) + (define rename-env (env:extend-environment '() '() '())) (emit *c-file-header-comment*) ; Guarantee placement at top of C file @@ -133,10 +134,11 @@ (set! input-program (cond (program? - (expand-lambda-body input-program (macro:get-env))) + (expand-lambda-body input-program (macro:get-env) rename-env)) (else (let ((expanded (expand `(begin ,@input-program) - (macro:get-env)))) + (macro:get-env) + rename-env))) (cond ((and (pair? expanded) (tagged-list? 'lambda (car expanded))) @@ -148,13 +150,13 @@ (trace:info "---------------- after macro expansion:") (trace:info input-program) ;pretty-print ; 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 input-program) ;pretty-print ;; Separate global definitions from the rest of the top-level code (set! input-program - (isolate-globals input-program program? lib-name)) + (isolate-globals input-program program? lib-name rename-env)) ;; Optimize-out unused global variables ;; For now, do not do this if eval is used. diff --git a/scheme/cyclone/macros.sld b/scheme/cyclone/macros.sld index 733bdbba..24e6dca3 100644 --- a/scheme/cyclone/macros.sld +++ b/scheme/cyclone/macros.sld @@ -52,8 +52,7 @@ (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-tbl + (define (macro:expand exp macro mac-env rename-env) (let* ((use-env (env:extend-environment '() '() '())) (compiled-macro? (or (Cyc-macro? (Cyc-get-cvar (cadr macro))) (procedure? (cadr macro)))) @@ -72,14 +71,14 @@ ((Cyc-get-cvar (cadr macro)) exp (Cyc-er-rename use-env mac-env) - (Cyc-er-compare? use-env *macro:renamed-variables*))) + (Cyc-er-compare? use-env rename-env))) (else (eval (list (Cyc-get-cvar (cadr macro)) (list 'quote exp) (Cyc-er-rename use-env mac-env) - (Cyc-er-compare? use-env *macro:renamed-variables*)) + (Cyc-er-compare? use-env rename-env)) mac-env)))) ; (newline) ; (display "/* ") @@ -87,7 +86,7 @@ ; (newline) ; (display (list result)) ; (display "*/ ") - (macro:add-renamed-vars! use-env *macro:renamed-variables*) + (macro:add-renamed-vars! use-env rename-env) result)) (define (macro:add-renamed-vars! env renamed-env) @@ -98,7 +97,7 @@ (env:all-variables env) (env:all-values env)))) - (define (macro:cleanup expr) + (define (macro:cleanup expr rename-env) (define (clean expr bv) ;; Bound variables ;(newline) ;(display "/* macro:cleanup->clean, bv =") @@ -116,7 +115,7 @@ ((ref? expr) ;; if symbol has been renamed and is not a bound variable, ;; 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))) (clean val bv) expr))) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index d022cf5f..5adab105 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -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)? ; expand : exp -> exp -(define (expand exp env) +(define (expand exp env rename-env) (define (log e) (display (list 'expand e 'env @@ -517,22 +517,22 @@ ((ref? exp) exp) ((quote? exp) exp) ((lambda? exp) `(lambda ,(lambda->formals exp) - ,@(expand-body '() (lambda->exp exp) env) + ,@(expand-body '() (lambda->exp exp) env rename-env) ;,@(map ; ;; TODO: use extend env here? - ; (lambda (expr) (expand expr env)) + ; (lambda (expr) (expand expr env rename-env)) ; (lambda->exp exp)) )) ((define? exp) (if (define-lambda? exp) - (expand (define->lambda exp) env) - `(define ,(expand (define->var exp) env) - ,@(expand (define->exp exp) env)))) - ((set!? exp) `(set! ,(expand (set!->var exp) env) - ,(expand (set!->exp exp) env))) - ((if? exp) `(if ,(expand (if->condition exp) env) - ,(expand (if->then exp) env) + (expand (define->lambda exp) env rename-env) + `(define ,(expand (define->var exp) env rename-env) + ,@(expand (define->exp exp) env rename-env)))) + ((set!? exp) `(set! ,(expand (set!->var exp) env rename-env) + ,(expand (set!->exp exp) env rename-env))) + ((if? exp) `(if ,(expand (if->condition exp) env rename-env) + ,(expand (if->then exp) env rename-env) ,(if (if-else? exp) - (expand (if->else exp) env) + (expand (if->else exp) env rename-env) ;; Insert default value for missing else clause ;; FUTURE: append the empty (unprinted) value ;; instead of #f @@ -546,8 +546,8 @@ (cond ((tagged-list? 'syntax-rules trans) ;; TODO: what if syntax-rules is renamed? (expand - `(define-syntax ,name ,(expand trans env)) - env)) + `(define-syntax ,name ,(expand trans env rename-env)) + env rename-env)) (else ;; TODO: for now, do not let a compiled macro be re-defined. ;; this is a hack for performance compiling (scheme base) @@ -568,17 +568,17 @@ ;; TODO: may run into issues with expanding now, before some ;; of the macros are defined. may need to make a special pass ;; to do loading or expansion of macro bodies - `(define ,name ,(expand body env))))))) + `(define ,name ,(expand body env rename-env))))))) ((app? exp) (cond ((symbol? (car exp)) (let ((val (env:lookup (car exp) env #f))) (if (tagged-list? 'macro val) (expand ; Could expand into another macro - (macro:expand exp val env) - env) + (macro:expand exp val env rename-env) + env rename-env) (map - (lambda (expr) (expand expr env)) + (lambda (expr) (expand expr env rename-env)) exp)))) (else ;; 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 ;; elsewhere in (expand). (map - (lambda (expr) (expand expr env)) + (lambda (expr) (expand expr env rename-env)) exp)))) (else (error "unknown exp: " exp)))) ;; Nicer interface to expand-body -(define (expand-lambda-body exp env) - (expand-body '() exp env)) +(define (expand-lambda-body exp env rename-env) + (expand-body '() exp env rename-env)) ;; 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) (display (list 'expand-body e 'env (env:frame-variables (env:first-frame env))) @@ -615,15 +615,16 @@ (quote? this-exp) (define-c? 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) ;(log this-exp) (expand-body (cons - (expand this-exp env) + (expand this-exp env rename-env) result) (cdr exp) - env)) + env + rename-env)) ((or (define-syntax? this-exp) (lambda? this-exp) (set!? this-exp) @@ -631,10 +632,11 @@ ;(log (car this-exp)) (expand-body (cons - (expand this-exp env) + (expand this-exp env rename-env) result) (cdr exp) - env)) + env + rename-env)) ;; Splice in begin contents and keep expanding body ((begin? this-exp) (let* ((expr this-exp) @@ -643,7 +645,8 @@ (expand-body result (append begin-exprs (cdr exp)) - env))) + env + rename-env))) ((app? this-exp) (cond ((symbol? (caar exp)) @@ -653,33 +656,36 @@ (if (tagged-list? 'macro val) ;; Expand macro here so we can catch begins in the expanded code, ;; 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)) (expand-body result (cons expanded ;(macro:expand this-exp val env) (cdr exp)) - env)) + env + rename-env)) ;; No macro, use main expand function to process (expand-body (cons (map - (lambda (expr) (expand expr env)) + (lambda (expr) (expand expr env rename-env)) this-exp) result) (cdr exp) - env)))) + env + rename-env)))) (else ;(log 'app) (expand-body (cons (map - (lambda (expr) (expand expr env)) + (lambda (expr) (expand expr env rename-env)) this-exp) result) (cdr exp) - env)))) + env + rename-env)))) (else (error "unknown exp: " this-exp)))))) @@ -691,7 +697,7 @@ ; This function extracts out non-define statements, and adds them to ; 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) (globals '()) (exprs '())) @@ -710,7 +716,8 @@ ;; This is a library, keep inits in their own function `((define ,(lib:name->symbol lib-name) (lambda () 0 ,@(reverse exprs)))))) - (macro:get-env)))) + (macro:get-env) + rename-env))) (else (cond ((define? (car top-lvl))