From 09cb431219f20814e88a304592de8389ed226afb Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 21 Nov 2017 13:23:08 -0500 Subject: [PATCH 01/57] Added new predicates --- scheme/cyclone/macros.sld | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/scheme/cyclone/macros.sld b/scheme/cyclone/macros.sld index 1696248e..003a872f 100644 --- a/scheme/cyclone/macros.sld +++ b/scheme/cyclone/macros.sld @@ -14,6 +14,8 @@ ) (export define-syntax? + let-syntax? + letrec-syntax? macro:macro? macro:expand macro:add! @@ -52,6 +54,12 @@ (define (define-syntax? exp) (tagged-list? 'define-syntax exp)) + (define (let-syntax? exp) + (tagged-list? 'let-syntax exp)) + + (define (letrec-syntax? exp) + (tagged-list? 'letrec-syntax exp)) + (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros)) (define (macro:expand exp macro mac-env rename-env) From 5b8f47af43b6a170d5c5f4059a1ea9d07dcb5c11 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 21 Nov 2017 19:07:52 -0500 Subject: [PATCH 02/57] WIP for let-syntax --- scheme/cyclone/transforms.sld | 23 +++++++++++++++++++++++ tests/let-syntax.scm | 22 +++++++++++----------- 2 files changed, 34 insertions(+), 11 deletions(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index bb6cbd60..1ede1845 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -511,6 +511,12 @@ ;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 + +;; TODO: need a local version of each expand that receives a local env built by +;; let-syntax forms +;;(define (expand exp env rename-env local-env) +;;(define (_expand exp env rename-env) + (define (expand exp env rename-env) (define (log e) (display @@ -578,6 +584,23 @@ ;; 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 rename-env))))))) + ((let-syntax? exp) + (let* ((body (cddr exp)) + (bindings (cadr exp)) + (bindings-as-macros + (map + (lambda (b) + (let ((name (car b)) + (binding (cadr b))) + (cons name (if (tagged-list? 'syntax-rules binding) + (expand binding env rename-env) + binding)))) + bindings)) + ; TODO: (new-local-macro-env (append bindings-as-macros local-env)) + ) +(trace:error `(let-syntax ,bindings-as-macros)) + (expand body env rename-env) ;; TODO: new-local-macro-env + )) ((app? exp) (cond ((symbol? (car exp)) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index 69af2d17..a47135cd 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -9,17 +9,17 @@ ;; (given-that if (set! if 'now)) ;; if)) ;; => now -;;(let ((x 'outer)) -;; (let-syntax ((m (syntax-rules () ((m) x)))) -;; (let ((x 'inner)) -;; (m)))) ;; Should be outer - -(write (let ((x 'outer)) - (define-syntax m ;; Testing this out, but let-syntax needs to work, too - (syntax-rules () ((m) x))) + (let-syntax ((m (syntax-rules () ((m) x)))) (let ((x 'inner)) - (m))) ;; Should be outer - ) + (m)))) ;; Should be outer -(write (m)) ;; Should be an error, of course +;(write +;(let ((x 'outer)) +; (define-syntax m ;; Testing this out, but let-syntax needs to work, too +; (syntax-rules () ((m) x))) +; (let ((x 'inner)) +; (m))) ;; Should be outer +; ) +; +;(write (m)) ;; Should be an error, of course From 454fe2c26c99b4761cad2f9da33e38235830aa64 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 24 Nov 2017 17:49:42 -0500 Subject: [PATCH 03/57] Additional hook required for let-syntax --- scheme/cyclone/transforms.sld | 1 + 1 file changed, 1 insertion(+) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 1ede1845..7e236a75 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -658,6 +658,7 @@ env rename-env)) ((or (define-syntax? this-exp) + (let-syntax? this-exp) (lambda? this-exp) (set!? this-exp) (if? this-exp)) From d590d1bf8b14405891574b739f505426ea495152 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 25 Nov 2017 17:34:38 -0500 Subject: [PATCH 04/57] Added local-env parameter --- scheme/cyclone/transforms.sld | 88 ++++++++++++++++++++--------------- 1 file changed, 51 insertions(+), 37 deletions(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 7e236a75..31496556 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -518,6 +518,9 @@ ;;(define (_expand exp env rename-env) (define (expand exp env rename-env) + (_expand exp env rename-env '())) + +(define (_expand exp env rename-env local-env) (define (log e) (display (list 'expand e 'env @@ -532,22 +535,22 @@ ((ref? exp) exp) ((quote? exp) exp) ((lambda? exp) `(lambda ,(lambda->formals exp) - ,@(expand-body '() (lambda->exp exp) env rename-env) + ,@(_expand-body '() (lambda->exp exp) env rename-env local-env) ;,@(map ; ;; TODO: use extend env here? - ; (lambda (expr) (expand expr env rename-env)) + ; (lambda (expr) (_expand expr env rename-env local-env)) ; (lambda->exp exp)) )) ((define? exp) (if (define-lambda? exp) - (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-syntax? exp) `(if ,(expand (if->condition exp) env rename-env) - ,(expand (if->then exp) env rename-env) + (_expand (define->lambda exp) env rename-env local-env) + `(define ,(_expand (define->var exp) env rename-env local-env) + ,@(_expand (define->exp exp) env rename-env local-env)))) + ((set!? exp) `(set! ,(_expand (set!->var exp) env rename-env local-env) + ,(_expand (set!->exp exp) env rename-env local-env))) + ((if-syntax? exp) `(if ,(_expand (if->condition exp) env rename-env local-env) + ,(_expand (if->then exp) env rename-env local-env) ,(if (if-else? exp) - (expand (if->else exp) env rename-env) + (_expand (if->else exp) env rename-env local-env) ;; Insert default value for missing else clause ;; FUTURE: append the empty (unprinted) value ;; instead of #f @@ -560,9 +563,9 @@ (body (cadr trans))) (cond ((tagged-list? 'syntax-rules trans) ;; TODO: what if syntax-rules is renamed? - (expand - `(define-syntax ,name ,(expand trans env rename-env)) - env rename-env)) + (_expand + `(define-syntax ,name ,(_expand trans env rename-env local-env)) + env rename-env local-env)) (else ;; TODO: for now, do not let a compiled macro be re-defined. ;; this is a hack for performance compiling (scheme base) @@ -583,7 +586,7 @@ ;; 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 rename-env))))))) + `(define ,name ,(_expand body env rename-env local-env))))))) ((let-syntax? exp) (let* ((body (cddr exp)) (bindings (cadr exp)) @@ -593,24 +596,26 @@ (let ((name (car b)) (binding (cadr b))) (cons name (if (tagged-list? 'syntax-rules binding) - (expand binding env rename-env) + (_expand binding env rename-env local-env) binding)))) bindings)) ; TODO: (new-local-macro-env (append bindings-as-macros local-env)) ) (trace:error `(let-syntax ,bindings-as-macros)) - (expand body env rename-env) ;; TODO: new-local-macro-env + (_expand body env rename-env local-env) ;; TODO: new-local-macro-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 + (_expand ; Could expand into another macro (macro:expand exp val env rename-env) - env rename-env) + env + rename-env + local-env) (map - (lambda (expr) (expand expr env rename-env)) + (lambda (expr) (_expand expr env rename-env local-env)) exp)))) (else ;; TODO: note that map does not guarantee that expressions are @@ -618,7 +623,7 @@ ;; in reverse order. Might be better to use a fold here and ;; elsewhere in (expand). (map - (lambda (expr) (expand expr env rename-env)) + (lambda (expr) (_expand expr env rename-env local-env)) exp)))) (else (error "unknown exp: " exp)))) @@ -629,6 +634,9 @@ ;; Helper to expand a lambda body, so we can splice in any begin's (define (expand-body result exp env rename-env) + (_expand-body result exp env rename-env '())) + +(define (_expand-body result exp env rename-env local-env) (define (log e) (display (list 'expand-body e 'env (env:frame-variables (env:first-frame env))) @@ -647,39 +655,42 @@ (quote? this-exp) (define-c? this-exp)) ;(log this-exp) - (expand-body (cons this-exp result) (cdr exp) env rename-env)) + (_expand-body (cons this-exp result) (cdr exp) env rename-env local-env)) ((define? this-exp) ;(log this-exp) - (expand-body + (_expand-body (cons - (expand this-exp env rename-env) + (_expand this-exp env rename-env local-env) result) (cdr exp) env - rename-env)) + rename-env + local-env)) ((or (define-syntax? this-exp) (let-syntax? this-exp) (lambda? this-exp) (set!? this-exp) (if? this-exp)) ;(log (car this-exp)) - (expand-body + (_expand-body (cons - (expand this-exp env rename-env) + (_expand this-exp env rename-env local-env) result) (cdr exp) env - rename-env)) + rename-env + local-env)) ;; Splice in begin contents and keep expanding body ((begin? this-exp) (let* ((expr this-exp) (begin-exprs (begin->exps expr))) ;(log (car this-exp)) - (expand-body + (_expand-body result (append begin-exprs (cdr exp)) env - rename-env))) + rename-env + local-env))) ((app? this-exp) (cond ((symbol? (caar exp)) @@ -691,34 +702,37 @@ ;; including nested begins (let ((expanded (macro:expand this-exp val env rename-env))) ;(log `(DONE WITH macro:expand)) - (expand-body + (_expand-body result (cons expanded ;(macro:expand this-exp val env) (cdr exp)) env - rename-env)) + rename-env + local-env)) ;; No macro, use main expand function to process - (expand-body + (_expand-body (cons (map - (lambda (expr) (expand expr env rename-env)) + (lambda (expr) (_expand expr env rename-env local-env)) this-exp) result) (cdr exp) env - rename-env)))) + rename-env + local-env)))) (else ;(log 'app) - (expand-body + (_expand-body (cons (map - (lambda (expr) (expand expr env rename-env)) + (lambda (expr) (_expand expr env rename-env local-env)) this-exp) result) (cdr exp) env - rename-env)))) + rename-env + local-env)))) (else (error "unknown exp: " this-exp)))))) From 044d135b84be5fc90dbc7f00b1f477d7456dc533 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 25 Nov 2017 19:03:00 -0500 Subject: [PATCH 05/57] First working version of let-syntax --- scheme/cyclone/transforms.sld | 34 +++++++++++++++++++++++----------- tests/let-syntax.scm | 2 ++ 2 files changed, 25 insertions(+), 11 deletions(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 31496556..2e241f48 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -588,26 +588,35 @@ ;; to do loading or expansion of macro bodies `(define ,name ,(_expand body env rename-env local-env))))))) ((let-syntax? exp) - (let* ((body (cddr exp)) + (let* ((body (cons 'begin (cddr exp))) (bindings (cadr exp)) (bindings-as-macros (map (lambda (b) - (let ((name (car b)) - (binding (cadr b))) - (cons name (if (tagged-list? 'syntax-rules binding) - (_expand binding env rename-env local-env) - binding)))) + (let* ((name (car b)) + (binding (cadr b)) + (binding-body (cadr binding))) + (cons + name + (list + 'macro + (if (tagged-list? 'syntax-rules binding) + ;; TODO: is this ok? + (cadr (_expand binding env rename-env local-env)) + binding-body))))) bindings)) - ; TODO: (new-local-macro-env (append bindings-as-macros local-env)) + (new-local-macro-env (append bindings-as-macros local-env)) ) -(trace:error `(let-syntax ,bindings-as-macros)) - (_expand body env rename-env local-env) ;; TODO: new-local-macro-env +(trace:error `(let-syntax ,new-local-macro-env)) + (_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env )) ((app? exp) (cond ((symbol? (car exp)) - (let ((val (env:lookup (car exp) env #f))) + (let ((val (let ((local (assoc (car exp) local-env))) + (if local + (cdr local) + (env:lookup (car exp) env #f))))) (if (tagged-list? 'macro val) (_expand ; Could expand into another macro (macro:expand exp val env rename-env) @@ -695,7 +704,10 @@ (cond ((symbol? (caar exp)) ;(log (car this-exp)) - (let ((val (env:lookup (caar exp) env #f))) + (let ((val (let ((local (assoc (caar exp) local-env))) + (if local + (cdr local) + (env:lookup (caar exp) env #f))))) ;(log `(DONE WITH env:lookup ,(caar exp) ,val ,(tagged-list? 'macro val))) (if (tagged-list? 'macro val) ;; Expand macro here so we can catch begins in the expanded code, diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index a47135cd..5b5f01a1 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -9,10 +9,12 @@ ;; (given-that if (set! if 'now)) ;; if)) ;; => now +(write (let ((x 'outer)) (let-syntax ((m (syntax-rules () ((m) x)))) (let ((x 'inner)) (m)))) ;; Should be outer + ) ;(write ;(let ((x 'outer)) From 957672fe70a4f17acff23aadd498aa03cee7c021 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 27 Nov 2017 17:13:49 -0500 Subject: [PATCH 06/57] Relocated functions --- scheme/cyclone/macros.sld | 12 ------------ scheme/cyclone/util.sld | 13 ++++++++++++- 2 files changed, 12 insertions(+), 13 deletions(-) diff --git a/scheme/cyclone/macros.sld b/scheme/cyclone/macros.sld index 003a872f..0015636d 100644 --- a/scheme/cyclone/macros.sld +++ b/scheme/cyclone/macros.sld @@ -13,9 +13,6 @@ (scheme cyclone util) ) (export - define-syntax? - let-syntax? - letrec-syntax? macro:macro? macro:expand macro:add! @@ -51,15 +48,6 @@ (define (macro:get-defined-macros) *macro:defined-macros*) ;; Macro section - (define (define-syntax? exp) - (tagged-list? 'define-syntax exp)) - - (define (let-syntax? exp) - (tagged-list? 'let-syntax exp)) - - (define (letrec-syntax? exp) - (tagged-list? 'letrec-syntax exp)) - (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros)) (define (macro:expand exp macro mac-env rename-env) diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld index 7fa9050b..897a4bef 100644 --- a/scheme/cyclone/util.sld +++ b/scheme/cyclone/util.sld @@ -11,6 +11,9 @@ (scheme char)) (export ;; Code analysis + define-syntax? + let-syntax? + letrec-syntax? tagged-list? if? if-syntax? @@ -120,7 +123,15 @@ (or (= (length exp) 3) (= (length exp) 4)))) - + +(define (define-syntax? exp) + (tagged-list? 'define-syntax exp)) + +(define (let-syntax? exp) + (tagged-list? 'let-syntax exp)) + +(define (letrec-syntax? exp) + (tagged-list? 'letrec-syntax exp)) ; begin? : exp -> boolean (define (begin? exp) From eac413a2f5d905103cbb6f07e3dea7f9656098b0 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 27 Nov 2017 17:43:44 -0500 Subject: [PATCH 07/57] Relocated functions --- scheme/cyclone/transforms.sld | 22 ---------------------- scheme/cyclone/util.sld | 22 ++++++++++++++++++++++ 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 2e241f48..67bf3188 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -67,8 +67,6 @@ app->args precompute-prim-app? begin->exps - define-lambda? - define->lambda closure? closure->lam closure->env @@ -411,26 +409,6 @@ (define (begin->exps exp) (cdr exp)) -(define (define-lambda? exp) - (let ((var (cadr exp))) - (or - ;; Standard function - (and (list? var) - (> (length var) 0) - (symbol? (car var))) - ;; Varargs function - (and (pair? var) - (symbol? (car var)))))) - -(define (define->lambda exp) - (cond - ((define-lambda? exp) - (let ((var (caadr exp)) - (args (cdadr exp)) - (body (cddr exp))) - `(define ,var (lambda ,args ,@body)))) - (else exp))) - ; closure? : exp -> boolean (define (closure? exp) (tagged-list? 'closure exp)) diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld index 897a4bef..d002a3fd 100644 --- a/scheme/cyclone/util.sld +++ b/scheme/cyclone/util.sld @@ -20,6 +20,8 @@ begin? lambda? pair->list + define-lambda? + define->lambda formals->list lambda-formals->list lambda-varargs? @@ -250,6 +252,26 @@ (cons lst '()) (cons (car lst) (loop (cdr lst)))))) +(define (define-lambda? exp) + (let ((var (cadr exp))) + (or + ;; Standard function + (and (list? var) + (> (length var) 0) + (symbol? (car var))) + ;; Varargs function + (and (pair? var) + (symbol? (car var)))))) + +(define (define->lambda exp) + (cond + ((define-lambda? exp) + (let ((var (caadr exp)) + (args (cdadr exp)) + (body (cddr exp))) + `(define ,var (lambda ,args ,@body)))) + (else exp))) + ; lambda->formals : lambda-exp -> list[symbol] (define (lambda->formals exp) (cadr exp)) From c5271f05fe74920971e0fc65fc462405c6f0ad43 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 27 Nov 2017 18:52:13 -0500 Subject: [PATCH 08/57] Relocating code --- scheme/cyclone/macros.sld | 140 ------------------------------------- scheme/eval.sld | 142 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 142 insertions(+), 140 deletions(-) diff --git a/scheme/cyclone/macros.sld b/scheme/cyclone/macros.sld index 0015636d..c09751ba 100644 --- a/scheme/cyclone/macros.sld +++ b/scheme/cyclone/macros.sld @@ -13,148 +13,8 @@ (scheme cyclone util) ) (export - macro:macro? - macro:expand - macro:add! - macro:cleanup - macro:load-env! - macro:get-env - macro:get-defined-macros ) (inline macro:macro?) (begin - ;; top-level macro environment - (define *macro:env* '()) - - ;; A list of all macros defined by the program/library being compiled - (define *macro:defined-macros* '()) - - (define (macro:add! name body) - (set! *macro:defined-macros* - (cons (cons name body) *macro:defined-macros*)) - #t) - - (define (macro:load-env! defined-macros base-env) - (set! *macro:env* (env:extend-environment - (map car defined-macros) - (map (lambda (v) - (list 'macro (cdr v))) - defined-macros) - base-env))) - - (define (macro:get-env) *macro:env*) - - (define (macro:get-defined-macros) *macro:defined-macros*) - - ;; Macro section - (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros)) - - (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)))) - (result #f)) - ;(newline) - ;(display "/* ") - ;(display (list 'macro:expand exp macro compiled-macro?)) - ;(display "*/ ") - - ;; Invoke ER macro - (set! result - (cond - ((not macro) - (error "macro not found" exp)) - (compiled-macro? - ((Cyc-get-cvar (cadr macro)) - exp - (Cyc-er-rename use-env mac-env) - (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 rename-env)) - mac-env)))) -; (newline) -; (display "/* ") -; (display (list 'macro:expand exp macro compiled-macro?)) -; (newline) -; (display (list result)) -; (display "*/ ") - (macro:add-renamed-vars! use-env rename-env) - result)) - - (define (macro:add-renamed-vars! env renamed-env) - (let ((frame (env:first-frame renamed-env))) - (for-each - (lambda (var val) - (env:add-binding-to-frame! var val frame)) - (env:all-variables env) - (env:all-values env)))) - - (define (macro:cleanup expr rename-env) - (define (clean expr bv) ;; Bound variables -;(newline) -;(display "/* macro:cleanup->clean, bv =") -;(write bv) -;(newline) -;(write expr) -;(newline) -;(display "*/ ") - (cond - ((const? expr) expr) - ((null? expr) expr) - ((quote? expr) - (let ((atom (cadr expr))) - ;; Clean up any renamed symbols that are quoted - ;; TODO: good enough for quoted pairs or do - ;; we need to traverse those, too? - (if (ref? atom) - `(quote ,(clean atom bv)) - expr))) - ((define-c? expr) expr) - ((ref? expr) - ;; if symbol has been renamed and is not a bound variable, - ;; undo the rename - (let ((val (env:lookup expr rename-env #f))) - (if (and val (not (member expr bv))) - (clean val bv) - expr))) - ((if-syntax? expr) - `(if ,(clean (if->condition expr) bv) - ,(clean (if->then expr) bv) - ,(if (if-else? expr) - (clean (if->else expr) bv) - #f))) - ((lambda? expr) - `(lambda ,(lambda->formals expr) - ,@(map (lambda (e) - (clean e (append - (lambda-formals->list expr) - bv))) - (lambda->exp expr)))) - ;; At this point defines cannot be in lambda form. - ;; EG: (define (f x) ...) - ((define? expr) - (let ((bv* (cons (define->var expr) bv))) - `(define ,(define->var expr) - ,@(map - (lambda (e) (clean e bv*)) - (define->exp expr))))) - ;; For now, assume set is not introducing a new binding - ((set!? expr) - `(set! ,(clean (set!->var expr) bv) - ,(clean (set!->exp expr) bv))) - ((app? expr) - (map (lambda (e) (clean e bv)) - expr)) - (else - (error "macro cleanup unexpected expression: " expr)))) - (clean expr '())) - - ; TODO: get macro name, transformer - ; TODO: let-syntax forms )) diff --git a/scheme/eval.sld b/scheme/eval.sld index 78bbe3c8..d5421f3b 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -25,6 +25,13 @@ %import imported? %set-import-dirs! + macro:macro? + macro:expand + macro:add! + macro:cleanup + macro:load-env! + macro:get-env + macro:get-defined-macros ) (inline primitive-implementation @@ -43,6 +50,7 @@ assignment-value assignment-variable variable? + macro:macro? ) (begin @@ -663,4 +671,138 @@ " Cyc_check_str(data, name); return_closcall1(data, k, is_library_loaded(string_str(name))); ") +;; Macro section + ;; top-level macro environment + (define *macro:env* '()) + + ;; A list of all macros defined by the program/library being compiled + (define *macro:defined-macros* '()) + + (define (macro:add! name body) + (set! *macro:defined-macros* + (cons (cons name body) *macro:defined-macros*)) + #t) + + (define (macro:load-env! defined-macros base-env) + (set! *macro:env* (env:extend-environment + (map car defined-macros) + (map (lambda (v) + (list 'macro (cdr v))) + defined-macros) + base-env))) + + (define (macro:get-env) *macro:env*) + + (define (macro:get-defined-macros) *macro:defined-macros*) + + ;; Macro section + (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros)) + + (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)))) + (result #f)) + ;(newline) + ;(display "/* ") + ;(display (list 'macro:expand exp macro compiled-macro?)) + ;(display "*/ ") + + ;; Invoke ER macro + (set! result + (cond + ((not macro) + (error "macro not found" exp)) + (compiled-macro? + ((Cyc-get-cvar (cadr macro)) + exp + (Cyc-er-rename use-env mac-env) + (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 rename-env)) + mac-env)))) +; (newline) +; (display "/* ") +; (display (list 'macro:expand exp macro compiled-macro?)) +; (newline) +; (display (list result)) +; (display "*/ ") + (macro:add-renamed-vars! use-env rename-env) + result)) + + (define (macro:add-renamed-vars! env renamed-env) + (let ((frame (env:first-frame renamed-env))) + (for-each + (lambda (var val) + (env:add-binding-to-frame! var val frame)) + (env:all-variables env) + (env:all-values env)))) + + (define (macro:cleanup expr rename-env) + (define (clean expr bv) ;; Bound variables +;(newline) +;(display "/* macro:cleanup->clean, bv =") +;(write bv) +;(newline) +;(write expr) +;(newline) +;(display "*/ ") + (cond + ((const? expr) expr) + ((null? expr) expr) + ((quote? expr) + (let ((atom (cadr expr))) + ;; Clean up any renamed symbols that are quoted + ;; TODO: good enough for quoted pairs or do + ;; we need to traverse those, too? + (if (ref? atom) + `(quote ,(clean atom bv)) + expr))) + ((define-c? expr) expr) + ((ref? expr) + ;; if symbol has been renamed and is not a bound variable, + ;; undo the rename + (let ((val (env:lookup expr rename-env #f))) + (if (and val (not (member expr bv))) + (clean val bv) + expr))) + ((if-syntax? expr) + `(if ,(clean (if->condition expr) bv) + ,(clean (if->then expr) bv) + ,(if (if-else? expr) + (clean (if->else expr) bv) + #f))) + ((lambda? expr) + `(lambda ,(lambda->formals expr) + ,@(map (lambda (e) + (clean e (append + (lambda-formals->list expr) + bv))) + (lambda->exp expr)))) + ;; At this point defines cannot be in lambda form. + ;; EG: (define (f x) ...) + ((define? expr) + (let ((bv* (cons (define->var expr) bv))) + `(define ,(define->var expr) + ,@(map + (lambda (e) (clean e bv*)) + (define->exp expr))))) + ;; For now, assume set is not introducing a new binding + ((set!? expr) + `(set! ,(clean (set!->var expr) bv) + ,(clean (set!->exp expr) bv))) + ((app? expr) + (map (lambda (e) (clean e bv)) + expr)) + (else + (error "macro cleanup unexpected expression: " expr)))) + (clean expr '())) + + ; TODO: get macro name, transformer + ; TODO: let-syntax forms )) From b52119f2cd7cabbc992f520e3cf39fc8fa711850 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Nov 2017 16:36:08 -0500 Subject: [PATCH 09/57] Import prim module --- scheme/eval.sld | 1 + 1 file changed, 1 insertion(+) diff --git a/scheme/eval.sld b/scheme/eval.sld index d5421f3b..d92e3baa 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -11,6 +11,7 @@ (import (scheme cyclone util) (scheme cyclone libraries) ;; for handling import sets + (scheme cyclone primitives) (scheme base) (scheme file) (scheme write) ;; Only used for debugging From a55ab6780c6edd087d90d6595705020a851d8f42 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Nov 2017 17:01:41 -0500 Subject: [PATCH 10/57] Remove obsolete imports --- cyclone.scm | 1 - scheme/cyclone/transforms.sld | 1 - 2 files changed, 2 deletions(-) diff --git a/cyclone.scm b/cyclone.scm index 68fdc262..e35e2480 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -20,7 +20,6 @@ (scheme cyclone primitives) (scheme cyclone transforms) (scheme cyclone cps-optimizations) - (scheme cyclone macros) (scheme cyclone libraries)) (define *optimization-level* 2) ;; Default level diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 67bf3188..38167bb1 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -18,7 +18,6 @@ (scheme cyclone ast) (scheme cyclone common) (scheme cyclone libraries) - (scheme cyclone macros) (scheme cyclone primitives) (scheme cyclone pretty-print) (scheme cyclone util) From 6441ce940934b2d49308e6356723baeb50ababc9 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 28 Nov 2017 18:46:48 -0500 Subject: [PATCH 11/57] Relocated macro expansion code --- scheme/cyclone/cgen.sld | 1 + scheme/cyclone/transforms.sld | 251 --------------------------------- scheme/eval.sld | 254 ++++++++++++++++++++++++++++++++++ 3 files changed, 255 insertions(+), 251 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index d3456d11..84b207cf 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -9,6 +9,7 @@ (define-library (scheme cyclone cgen) (import (scheme base) (scheme char) + (scheme eval) (scheme inexact) (scheme write) (scheme cyclone primitives) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 38167bb1..1153a351 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -24,11 +24,9 @@ (srfi 69) ) (export - *defined-macros* *do-code-gen* *trace-level* *primitives* - get-macros built-in-syms trace trace:error @@ -85,8 +83,6 @@ cell->value cell-get? cell-get->cell - expand - expand-lambda-body isolate-globals has-global? global-vars @@ -124,10 +120,6 @@ ) (begin -;; Container for built-in macros -(define (get-macros) *defined-macros*) -(define *defined-macros* (list)) - (define (built-in-syms) '(call/cc define)) @@ -483,249 +475,6 @@ (define (cell-get->cell exp) (cadr exp)) - -;; Macro expansion - -;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 - -;; TODO: need a local version of each expand that receives a local env built by -;; let-syntax forms -;;(define (expand exp env rename-env local-env) -;;(define (_expand exp env rename-env) - -(define (expand exp env rename-env) - (_expand exp env rename-env '())) - -(define (_expand exp env rename-env local-env) - (define (log e) - (display - (list 'expand e 'env - (env:frame-variables (env:first-frame env))) - (current-error-port)) - (newline (current-error-port))) - ;(log exp) - ;(trace:error `(expand ,exp)) - (cond - ((const? exp) exp) - ((prim? exp) exp) - ((ref? exp) exp) - ((quote? exp) exp) - ((lambda? exp) `(lambda ,(lambda->formals exp) - ,@(_expand-body '() (lambda->exp exp) env rename-env local-env) - ;,@(map - ; ;; TODO: use extend env here? - ; (lambda (expr) (_expand expr env rename-env local-env)) - ; (lambda->exp exp)) - )) - ((define? exp) (if (define-lambda? exp) - (_expand (define->lambda exp) env rename-env local-env) - `(define ,(_expand (define->var exp) env rename-env local-env) - ,@(_expand (define->exp exp) env rename-env local-env)))) - ((set!? exp) `(set! ,(_expand (set!->var exp) env rename-env local-env) - ,(_expand (set!->exp exp) env rename-env local-env))) - ((if-syntax? exp) `(if ,(_expand (if->condition exp) env rename-env local-env) - ,(_expand (if->then exp) env rename-env local-env) - ,(if (if-else? exp) - (_expand (if->else exp) env rename-env local-env) - ;; Insert default value for missing else clause - ;; FUTURE: append the empty (unprinted) value - ;; instead of #f - #f))) - ((define-c? exp) exp) - ((define-syntax? exp) - ;(trace:info `(define-syntax ,exp)) - (let* ((name (cadr exp)) - (trans (caddr exp)) - (body (cadr trans))) - (cond - ((tagged-list? 'syntax-rules trans) ;; TODO: what if syntax-rules is renamed? - (_expand - `(define-syntax ,name ,(_expand trans env rename-env local-env)) - env rename-env local-env)) - (else - ;; TODO: for now, do not let a compiled macro be re-defined. - ;; this is a hack for performance compiling (scheme base) - (let ((macro (env:lookup name env #f))) - (cond - ((and (tagged-list? 'macro macro) - (or (Cyc-macro? (Cyc-get-cvar (cadr macro))) - (procedure? (cadr macro)))) - (trace:info `(DEBUG compiled macro ,name do not redefine))) - (else - ;; Use this to keep track of macros for filtering unused defines - (set! *defined-macros* (cons (cons name body) *defined-macros*)) - ;; Keep track of macros added during compilation. - ;; TODO: why in both places? - (macro:add! name body) - (env:define-variable! name (list 'macro body) env))) - ;; Keep as a 'define' form so available at runtime - ;; 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 rename-env local-env))))))) - ((let-syntax? exp) - (let* ((body (cons 'begin (cddr exp))) - (bindings (cadr exp)) - (bindings-as-macros - (map - (lambda (b) - (let* ((name (car b)) - (binding (cadr b)) - (binding-body (cadr binding))) - (cons - name - (list - 'macro - (if (tagged-list? 'syntax-rules binding) - ;; TODO: is this ok? - (cadr (_expand binding env rename-env local-env)) - binding-body))))) - bindings)) - (new-local-macro-env (append bindings-as-macros local-env)) - ) -(trace:error `(let-syntax ,new-local-macro-env)) - (_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env - )) - ((app? exp) - (cond - ((symbol? (car exp)) - (let ((val (let ((local (assoc (car exp) local-env))) - (if local - (cdr local) - (env:lookup (car exp) env #f))))) - (if (tagged-list? 'macro val) - (_expand ; Could expand into another macro - (macro:expand exp val env rename-env) - env - rename-env - local-env) - (map - (lambda (expr) (_expand expr env rename-env local-env)) - exp)))) - (else - ;; TODO: note that map does not guarantee that expressions are - ;; evaluated in order. For example, the list might be processed - ;; in reverse order. Might be better to use a fold here and - ;; elsewhere in (expand). - (map - (lambda (expr) (_expand expr env rename-env local-env)) - exp)))) - (else - (error "unknown exp: " exp)))) - -;; Nicer interface to expand-body -(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 rename-env) - (_expand-body result exp env rename-env '())) - -(define (_expand-body result exp env rename-env local-env) - (define (log e) - (display (list 'expand-body e 'env - (env:frame-variables (env:first-frame env))) - (current-error-port)) - (newline (current-error-port))) - - (if (null? exp) - (reverse result) - (let ((this-exp (car exp))) -;(display (list 'expand-body this-exp) (current-error-port)) -;(newline (current-error-port)) - (cond - ((or (const? this-exp) - (prim? this-exp) - (ref? this-exp) - (quote? this-exp) - (define-c? this-exp)) -;(log this-exp) - (_expand-body (cons this-exp result) (cdr exp) env rename-env local-env)) - ((define? this-exp) -;(log this-exp) - (_expand-body - (cons - (_expand this-exp env rename-env local-env) - result) - (cdr exp) - env - rename-env - local-env)) - ((or (define-syntax? this-exp) - (let-syntax? this-exp) - (lambda? this-exp) - (set!? this-exp) - (if? this-exp)) -;(log (car this-exp)) - (_expand-body - (cons - (_expand this-exp env rename-env local-env) - result) - (cdr exp) - env - rename-env - local-env)) - ;; Splice in begin contents and keep expanding body - ((begin? this-exp) - (let* ((expr this-exp) - (begin-exprs (begin->exps expr))) -;(log (car this-exp)) - (_expand-body - result - (append begin-exprs (cdr exp)) - env - rename-env - local-env))) - ((app? this-exp) - (cond - ((symbol? (caar exp)) -;(log (car this-exp)) - (let ((val (let ((local (assoc (caar exp) local-env))) - (if local - (cdr local) - (env:lookup (caar exp) env #f))))) -;(log `(DONE WITH env:lookup ,(caar exp) ,val ,(tagged-list? 'macro val))) - (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 rename-env))) -;(log `(DONE WITH macro:expand)) - (_expand-body - result - (cons - expanded ;(macro:expand this-exp val env) - (cdr exp)) - env - rename-env - local-env)) - ;; No macro, use main expand function to process - (_expand-body - (cons - (map - (lambda (expr) (_expand expr env rename-env local-env)) - this-exp) - result) - (cdr exp) - env - rename-env - local-env)))) - (else -;(log 'app) - (_expand-body - (cons - (map - (lambda (expr) (_expand expr env rename-env local-env)) - this-exp) - result) - (cdr exp) - env - rename-env - local-env)))) - (else - (error "unknown exp: " this-exp)))))) - - ;; Top-level analysis ; Separate top-level defines (globals) from other expressions diff --git a/scheme/eval.sld b/scheme/eval.sld index d92e3baa..3621490f 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -26,6 +26,8 @@ %import imported? %set-import-dirs! + *defined-macros* + get-macros macro:macro? macro:expand macro:add! @@ -33,6 +35,8 @@ macro:load-env! macro:get-env macro:get-defined-macros + expand + expand-lambda-body ) (inline primitive-implementation @@ -806,4 +810,254 @@ ; TODO: get macro name, transformer ; TODO: let-syntax forms + +;; Macro expansion + +;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 + +;; TODO: need a local version of each expand that receives a local env built by +;; let-syntax forms +;;(define (expand exp env rename-env local-env) +;;(define (_expand exp env rename-env) + +(define (expand exp env rename-env) + (_expand exp env rename-env '())) + +(define (_expand exp env rename-env local-env) + (define (log e) + (display + (list 'expand e 'env + (env:frame-variables (env:first-frame env))) + (current-error-port)) + (newline (current-error-port))) + ;(log exp) + ;(trace:error `(expand ,exp)) + (cond + ((const? exp) exp) + ((prim? exp) exp) + ((ref? exp) exp) + ((quote? exp) exp) + ((lambda? exp) `(lambda ,(lambda->formals exp) + ,@(_expand-body '() (lambda->exp exp) env rename-env local-env) + ;,@(map + ; ;; TODO: use extend env here? + ; (lambda (expr) (_expand expr env rename-env local-env)) + ; (lambda->exp exp)) + )) + ((define? exp) (if (define-lambda? exp) + (_expand (define->lambda exp) env rename-env local-env) + `(define ,(_expand (define->var exp) env rename-env local-env) + ,@(_expand (define->exp exp) env rename-env local-env)))) + ((set!? exp) `(set! ,(_expand (set!->var exp) env rename-env local-env) + ,(_expand (set!->exp exp) env rename-env local-env))) + ((if-syntax? exp) `(if ,(_expand (if->condition exp) env rename-env local-env) + ,(_expand (if->then exp) env rename-env local-env) + ,(if (if-else? exp) + (_expand (if->else exp) env rename-env local-env) + ;; Insert default value for missing else clause + ;; FUTURE: append the empty (unprinted) value + ;; instead of #f + #f))) + ((define-c? exp) exp) + ((define-syntax? exp) + ;(trace:info `(define-syntax ,exp)) + (let* ((name (cadr exp)) + (trans (caddr exp)) + (body (cadr trans))) + (cond + ((tagged-list? 'syntax-rules trans) ;; TODO: what if syntax-rules is renamed? + (_expand + `(define-syntax ,name ,(_expand trans env rename-env local-env)) + env rename-env local-env)) + (else + ;; TODO: for now, do not let a compiled macro be re-defined. + ;; this is a hack for performance compiling (scheme base) + (let ((macro (env:lookup name env #f))) + (cond + ((and (tagged-list? 'macro macro) + (or (Cyc-macro? (Cyc-get-cvar (cadr macro))) + (procedure? (cadr macro)))) + ;(trace:info `(DEBUG compiled macro ,name do not redefine)) + ) + (else + ;; Use this to keep track of macros for filtering unused defines + (set! *defined-macros* (cons (cons name body) *defined-macros*)) + ;; Keep track of macros added during compilation. + ;; TODO: why in both places? + (macro:add! name body) + (env:define-variable! name (list 'macro body) env))) + ;; Keep as a 'define' form so available at runtime + ;; 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 rename-env local-env))))))) + ((let-syntax? exp) + (let* ((body (cons 'begin (cddr exp))) + (bindings (cadr exp)) + (bindings-as-macros + (map + (lambda (b) + (let* ((name (car b)) + (binding (cadr b)) + (binding-body (cadr binding))) + (cons + name + (list + 'macro + (if (tagged-list? 'syntax-rules binding) + ;; TODO: is this ok? + (cadr (_expand binding env rename-env local-env)) + binding-body))))) + bindings)) + (new-local-macro-env (append bindings-as-macros local-env)) + ) +;(trace:error `(let-syntax ,new-local-macro-env)) + (_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env + )) + ((app? exp) + (cond + ((symbol? (car exp)) + (let ((val (let ((local (assoc (car exp) local-env))) + (if local + (cdr local) + (env:lookup (car exp) env #f))))) + (if (tagged-list? 'macro val) + (_expand ; Could expand into another macro + (macro:expand exp val env rename-env) + env + rename-env + local-env) + (map + (lambda (expr) (_expand expr env rename-env local-env)) + exp)))) + (else + ;; TODO: note that map does not guarantee that expressions are + ;; evaluated in order. For example, the list might be processed + ;; in reverse order. Might be better to use a fold here and + ;; elsewhere in (expand). + (map + (lambda (expr) (_expand expr env rename-env local-env)) + exp)))) + (else + (error "unknown exp: " exp)))) + +;; Nicer interface to expand-body +(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 rename-env) + (_expand-body result exp env rename-env '())) + +(define (_expand-body result exp env rename-env local-env) + (define (log e) + (display (list 'expand-body e 'env + (env:frame-variables (env:first-frame env))) + (current-error-port)) + (newline (current-error-port))) + + (if (null? exp) + (reverse result) + (let ((this-exp (car exp))) +;(display (list 'expand-body this-exp) (current-error-port)) +;(newline (current-error-port)) + (cond + ((or (const? this-exp) + (prim? this-exp) + (ref? this-exp) + (quote? this-exp) + (define-c? this-exp)) +;(log this-exp) + (_expand-body (cons this-exp result) (cdr exp) env rename-env local-env)) + ((define? this-exp) +;(log this-exp) + (_expand-body + (cons + (_expand this-exp env rename-env local-env) + result) + (cdr exp) + env + rename-env + local-env)) + ((or (define-syntax? this-exp) + (let-syntax? this-exp) + (lambda? this-exp) + (set!? this-exp) + (if? this-exp)) +;(log (car this-exp)) + (_expand-body + (cons + (_expand this-exp env rename-env local-env) + result) + (cdr exp) + env + rename-env + local-env)) + ;; Splice in begin contents and keep expanding body + ((begin? this-exp) + (let* ((expr this-exp) + (begin-exprs (begin->exps expr))) +;(log (car this-exp)) + (_expand-body + result + (append begin-exprs (cdr exp)) + env + rename-env + local-env))) + ((app? this-exp) + (cond + ((symbol? (caar exp)) +;(log (car this-exp)) + (let ((val (let ((local (assoc (caar exp) local-env))) + (if local + (cdr local) + (env:lookup (caar exp) env #f))))) +;(log `(DONE WITH env:lookup ,(caar exp) ,val ,(tagged-list? 'macro val))) + (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 rename-env))) +;(log `(DONE WITH macro:expand)) + (_expand-body + result + (cons + expanded ;(macro:expand this-exp val env) + (cdr exp)) + env + rename-env + local-env)) + ;; No macro, use main expand function to process + (_expand-body + (cons + (map + (lambda (expr) (_expand expr env rename-env local-env)) + this-exp) + result) + (cdr exp) + env + rename-env + local-env)))) + (else +;(log 'app) + (_expand-body + (cons + (map + (lambda (expr) (_expand expr env rename-env local-env)) + this-exp) + result) + (cdr exp) + env + rename-env + local-env)))) + (else + (error "unknown exp: " this-exp)))))) + +;; Container for built-in macros +(define (get-macros) *defined-macros*) +(define *defined-macros* (list)) + +(define (begin->exps exp) + (cdr exp)) + )) From aadd07943b6df09c1352e22acd1e86c4f6b08cd3 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 30 Nov 2017 16:40:06 -0500 Subject: [PATCH 12/57] Added TODO's --- scheme/eval.sld | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/scheme/eval.sld b/scheme/eval.sld index 3621490f..8f70f2ab 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -401,6 +401,9 @@ ((and (syntax? exp) (not (null? (cdr exp)))) (analyze-syntax exp env)) + ;;((and (tagged-list? 'let-syntax exp) + ;; (not (null? (cdr exp)))) + ;; (analyze-let-syntax exp env)) ((and (if? exp) (not (null? (cdr exp)))) (analyze-if exp env)) @@ -447,6 +450,12 @@ (env:define-variable! var (vproc env) env) 'ok))) +(define (analyze-let-syntax exp a-env) + ;; TODO: probably just create a fresh env for renames + ;; TODO: expand, do we need to clean as well? + ;; TODO: run results back through analyze: (analyze (expand env? rename-env? +) + (define (analyze-syntax exp a-env) (let ((var (cadr exp))) (cond From 18eed21246c34afa0888ecb90f183144e4c2c5bc Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 30 Nov 2017 19:02:15 -0500 Subject: [PATCH 13/57] WIP, added debugging --- scheme/eval.sld | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 8f70f2ab..f2f16aee 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -401,9 +401,9 @@ ((and (syntax? exp) (not (null? (cdr exp)))) (analyze-syntax exp env)) - ;;((and (tagged-list? 'let-syntax exp) - ;; (not (null? (cdr exp)))) - ;; (analyze-let-syntax exp env)) + ((and (tagged-list? 'let-syntax exp) + (not (null? (cdr exp)))) + (analyze-let-syntax exp env)) ((and (if? exp) (not (null? (cdr exp)))) (analyze-if exp env)) @@ -451,10 +451,15 @@ 'ok))) (define (analyze-let-syntax exp a-env) - ;; TODO: probably just create a fresh env for renames - ;; TODO: expand, do we need to clean as well? - ;; TODO: run results back through analyze: (analyze (expand env? rename-env? -) + (let* ((rename-env (env:extend-environment '() '() '())) + (expanded (expand exp (macro:get-env) rename-env)) + ) + ;; TODO: probably just create a fresh env for renames + ;; TODO: expand, do we need to clean as well? + ;; TODO: run results back through analyze: (analyze (expand env? rename-env? +(write `(DEBUG ,expanded)) +(newline) + (analyze expanded a-env))) (define (analyze-syntax exp a-env) (let ((var (cadr exp))) @@ -841,7 +846,8 @@ (current-error-port)) (newline (current-error-port))) ;(log exp) - ;(trace:error `(expand ,exp)) +(write `(expand ,exp)) +(newline) (cond ((const? exp) exp) ((prim? exp) exp) From 046c1f9d22b4c814f4f749277b132facb7ed15f0 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 1 Dec 2017 11:56:07 -0500 Subject: [PATCH 14/57] WIP, able to expand some let-syntax now Still is debugging here though, needs lots of cleanup --- scheme/eval.sld | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index f2f16aee..37e24a9b 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -452,14 +452,16 @@ (define (analyze-let-syntax exp a-env) (let* ((rename-env (env:extend-environment '() '() '())) - (expanded (expand exp (macro:get-env) rename-env)) + (expanded (expand exp a-env rename-env)) + ;(expanded (expand exp (macro:get-env) rename-env)) + (cleaned (macro:cleanup expanded rename-env)) ) ;; TODO: probably just create a fresh env for renames ;; TODO: expand, do we need to clean as well? ;; TODO: run results back through analyze: (analyze (expand env? rename-env? -(write `(DEBUG ,expanded)) +(write `(DEBUG ,cleaned)) (newline) - (analyze expanded a-env))) + (analyze cleaned a-env))) (define (analyze-syntax exp a-env) (let ((var (cadr exp))) @@ -937,15 +939,25 @@ (if local (cdr local) (env:lookup (car exp) env #f))))) - (if (tagged-list? 'macro val) +(write `(app DEBUG ,(car exp) ,val)) +(newline) + (cond + ((tagged-list? 'macro val) (_expand ; Could expand into another macro (macro:expand exp val env rename-env) env rename-env - local-env) + local-env)) + ((Cyc-macro? val) + (_expand ; Could expand into another macro + (macro:expand exp (list 'macro val) env rename-env) + env + rename-env + local-env)) + (else (map (lambda (expr) (_expand expr env rename-env local-env)) - exp)))) + exp))))) (else ;; TODO: note that map does not guarantee that expressions are ;; evaluated in order. For example, the list might be processed From dd4b7243e059abf7fe6cf02d158d689922b92944 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 1 Dec 2017 13:15:53 -0500 Subject: [PATCH 15/57] Disable debugging --- scheme/eval.sld | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 37e24a9b..cefab2ed 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -459,8 +459,8 @@ ;; TODO: probably just create a fresh env for renames ;; TODO: expand, do we need to clean as well? ;; TODO: run results back through analyze: (analyze (expand env? rename-env? -(write `(DEBUG ,cleaned)) -(newline) +;(write `(DEBUG ,cleaned)) +;(newline) (analyze cleaned a-env))) (define (analyze-syntax exp a-env) @@ -848,8 +848,8 @@ (current-error-port)) (newline (current-error-port))) ;(log exp) -(write `(expand ,exp)) -(newline) +;(write `(expand ,exp)) +;(newline) (cond ((const? exp) exp) ((prim? exp) exp) @@ -939,8 +939,8 @@ (if local (cdr local) (env:lookup (car exp) env #f))))) -(write `(app DEBUG ,(car exp) ,val)) -(newline) +;(write `(app DEBUG ,(car exp) ,val)) +;(newline) (cond ((tagged-list? 'macro val) (_expand ; Could expand into another macro From 7f6271d6228cff94debc081d053d44412ebb53dc Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 1 Dec 2017 14:08:30 -0500 Subject: [PATCH 16/57] Add let-syntax to list of keywords --- scheme/cyclone/util.sld | 1 + 1 file changed, 1 insertion(+) diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld index d002a3fd..9bec8218 100644 --- a/scheme/cyclone/util.sld +++ b/scheme/cyclone/util.sld @@ -662,6 +662,7 @@ '( (define . define) (define-syntax . define-syntax) + (let-syntax . let-syntax) (define-c . define-c) (if . if) (lambda . lambda) From a8527380a64a9bf7a353962a598f14ef94a9972e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 1 Dec 2017 16:11:14 -0500 Subject: [PATCH 17/57] Re-enabled debugging --- scheme/eval.sld | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index cefab2ed..5b9bb559 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -384,10 +384,10 @@ ;; - env => Environment used to expand macros ;; (define (analyze exp env) -;(newline) -;(display "/* ") -;(write (list 'analyze exp)) -;(display " */") +(newline) +(display "/* ") +(write (list 'analyze exp)) +(display " */") (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) @@ -459,8 +459,10 @@ ;; TODO: probably just create a fresh env for renames ;; TODO: expand, do we need to clean as well? ;; TODO: run results back through analyze: (analyze (expand env? rename-env? -;(write `(DEBUG ,cleaned)) -;(newline) +(display "/* ") +(write `(DEBUG ,cleaned)) +(display "*/ ") +(newline) (analyze cleaned a-env))) (define (analyze-syntax exp a-env) @@ -848,8 +850,10 @@ (current-error-port)) (newline (current-error-port))) ;(log exp) -;(write `(expand ,exp)) -;(newline) +(display "/* ") +(write `(expand ,exp)) +(display "*/ ") +(newline) (cond ((const? exp) exp) ((prim? exp) exp) @@ -939,8 +943,10 @@ (if local (cdr local) (env:lookup (car exp) env #f))))) -;(write `(app DEBUG ,(car exp) ,val)) -;(newline) +(display "/* ") +(write `(app DEBUG ,(car exp) ,val)) +(display "*/ ") +(newline) (cond ((tagged-list? 'macro val) (_expand ; Could expand into another macro From 0353930feb4d6516d5ae3c56c5a69227a8f894b1 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 4 Dec 2017 13:15:32 -0500 Subject: [PATCH 18/57] New test file --- tests/when.scm | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 tests/when.scm diff --git a/tests/when.scm b/tests/when.scm new file mode 100644 index 00000000..8a8a2089 --- /dev/null +++ b/tests/when.scm @@ -0,0 +1,9 @@ +(import (scheme base) (scheme write)) +(define-syntax when + (syntax-rules () + ((when test result1 result2 ...) + (if test + (begin result1 result2 ...))))) + +(write + (when #t 1)) From 2a3e236469e0b9e676ebb0db1e4ae85cb947a6f9 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 4 Dec 2017 13:18:30 -0500 Subject: [PATCH 19/57] Renamed to 'my-when' --- tests/when.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/when.scm b/tests/when.scm index 8a8a2089..b41ac5b4 100644 --- a/tests/when.scm +++ b/tests/when.scm @@ -1,9 +1,9 @@ (import (scheme base) (scheme write)) -(define-syntax when +(define-syntax my-when (syntax-rules () - ((when test result1 result2 ...) + ((my-when test result1 result2 ...) (if test (begin result1 result2 ...))))) (write - (when #t 1)) + (my-when #t 1)) From ff5055664b1bce75a94fb71c56a7ed5a50c68810 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 4 Dec 2017 17:59:22 -0500 Subject: [PATCH 20/57] WIP --- tests/when.scm | 43 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 42 insertions(+), 1 deletion(-) diff --git a/tests/when.scm b/tests/when.scm index b41ac5b4..85c554b0 100644 --- a/tests/when.scm +++ b/tests/when.scm @@ -5,5 +5,46 @@ (if test (begin result1 result2 ...))))) +(define-syntax my-when2 + (syntax-rules () + ((my-when test result1 result2 ...) + (list test)))) + (write - (my-when #t 1)) + (my-when2 #t 1)) + + (define my-when2* + (lambda (expr$28 rename$29 compare$30) + (car ((lambda (tmp$42) + (if tmp$42 + tmp$42 + (cons (error "no expansion for" expr$28) #f))) + ((lambda (v.1$36) + (if (pair? v.1$36) + ((lambda (v.2$37) + ((lambda (test) + ((lambda (v.3$38) + (if (pair? v.3$38) + ((lambda (v.4$39) + ((lambda (result1) + ((lambda (v.5$40) + (if (list? v.5$40) + ((lambda (result2) + (cons (cons-source + (rename$29 'list) + (cons-source test '() '(test)) + '(list test)) + #f)) + v.5$40) + #f)) + (cdr v.3$38))) + v.4$39)) + (car v.3$38)) + #f)) + (cdr v.1$36))) + v.2$37)) + (car v.1$36)) + #f)) + (cdr expr$28)))))) +(write + (my-when2* '(my-when2* 't 1) (lambda (a) a) (lambda X #f))) From a260474e7d277b4975e70f19951ac8ca3bd31118 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 4 Dec 2017 17:29:12 -0500 Subject: [PATCH 21/57] WIP --- tests/when.scm | 37 +++++++++++++++++++++++++++++++++---- 1 file changed, 33 insertions(+), 4 deletions(-) diff --git a/tests/when.scm b/tests/when.scm index 85c554b0..c097ba8d 100644 --- a/tests/when.scm +++ b/tests/when.scm @@ -8,10 +8,10 @@ (define-syntax my-when2 (syntax-rules () ((my-when test result1 result2 ...) - (list test)))) + (list result2 ...)))) -(write - (my-when2 #t 1)) +;(write +; (my-when2 #t 1)) (define my-when2* (lambda (expr$28 rename$29 compare$30) @@ -46,5 +46,34 @@ (car v.1$36)) #f)) (cdr expr$28)))))) + + +;; TODO: seems broken +(define-syntax my-when4 + (syntax-rules () + ((my-when test result1 result2 ...) + (let-syntax + ((second + (syntax-rules () + ((second a b c) + b)))) + (second 33 44 55))))) (write - (my-when2* '(my-when2* 't 1) (lambda (a) a) (lambda X #f))) + (my-when4 't 1 2 3)) + + +; (my-when2 +; 't +; 1 +; (let-syntax +; ((my-when3 +; (syntax-rules () +; ((my-when3 test result1 result2 ...) +; (list result2 ...))))) +; (my-when3 33 44 55)) +; 2 +; 3)) +;(write +; (my-when2 '(my-when2 't 1 2 3) (lambda (a) a) (lambda X #f))) +;(write +; (my-when2 '(my-when2 "testing" 1) (lambda (a) a) (lambda X #f))) From f561428d7e8a558ead77506cd31fba4a1bba4adc Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 4 Dec 2017 18:54:39 -0500 Subject: [PATCH 22/57] WIP --- tests/when.scm | 137 +++++++++++++++++++++++++++++-------------------- 1 file changed, 80 insertions(+), 57 deletions(-) diff --git a/tests/when.scm b/tests/when.scm index c097ba8d..d210cb2f 100644 --- a/tests/when.scm +++ b/tests/when.scm @@ -1,65 +1,88 @@ (import (scheme base) (scheme write)) -(define-syntax my-when - (syntax-rules () - ((my-when test result1 result2 ...) - (if test - (begin result1 result2 ...))))) - -(define-syntax my-when2 - (syntax-rules () - ((my-when test result1 result2 ...) - (list result2 ...)))) - -;(write -; (my-when2 #t 1)) - - (define my-when2* - (lambda (expr$28 rename$29 compare$30) - (car ((lambda (tmp$42) - (if tmp$42 - tmp$42 - (cons (error "no expansion for" expr$28) #f))) - ((lambda (v.1$36) - (if (pair? v.1$36) - ((lambda (v.2$37) - ((lambda (test) - ((lambda (v.3$38) - (if (pair? v.3$38) - ((lambda (v.4$39) - ((lambda (result1) - ((lambda (v.5$40) - (if (list? v.5$40) - ((lambda (result2) - (cons (cons-source - (rename$29 'list) - (cons-source test '() '(test)) - '(list test)) - #f)) - v.5$40) - #f)) - (cdr v.3$38))) - v.4$39)) - (car v.3$38)) - #f)) - (cdr v.1$36))) - v.2$37)) - (car v.1$36)) - #f)) - (cdr expr$28)))))) +;(define-syntax my-when +; (syntax-rules () +; ((my-when test result1 result2 ...) +; (if test +; (begin result1 result2 ...))))) +; +;(define-syntax my-when2 +; (syntax-rules () +; ((my-when test result1 result2 ...) +; (list result2 ...)))) +; +;;(write +;; (my-when2 #t 1)) +; +; (define my-when2* +; (lambda (expr$28 rename$29 compare$30) +; (car ((lambda (tmp$42) +; (if tmp$42 +; tmp$42 +; (cons (error "no expansion for" expr$28) #f))) +; ((lambda (v.1$36) +; (if (pair? v.1$36) +; ((lambda (v.2$37) +; ((lambda (test) +; ((lambda (v.3$38) +; (if (pair? v.3$38) +; ((lambda (v.4$39) +; ((lambda (result1) +; ((lambda (v.5$40) +; (if (list? v.5$40) +; ((lambda (result2) +; (cons (cons-source +; (rename$29 'list) +; (cons-source test '() '(test)) +; '(list test)) +; #f)) +; v.5$40) +; #f)) +; (cdr v.3$38))) +; v.4$39)) +; (car v.3$38)) +; #f)) +; (cdr v.1$36))) +; v.2$37)) +; (car v.1$36)) +; #f)) +; (cdr expr$28)))))) ;; TODO: seems broken -(define-syntax my-when4 - (syntax-rules () - ((my-when test result1 result2 ...) - (let-syntax - ((second - (syntax-rules () - ((second a b c) - b)))) - (second 33 44 55))))) +;(define-syntax my-when4 +; (syntax-rules () +; ((my-when test result1 result2 ...) +; (let-syntax +; ((second +; (syntax-rules () +; ((second a b c) +; b)))) +; (second 33 44 55))))) +;(write +; (my-when4 't 1 2 3)) + +;; The symbol?? macro from oleg: +;; http://okmij.org/ftp/Scheme/macros.html#macro-symbol-p + (define-syntax symbol?? + (syntax-rules () + ((symbol?? (x . y) kt kf) kf) ; It's a pair, not a symbol + ((symbol?? #(x ...) kt kf) kf) ; It's a vector, not a symbol + ((symbol?? maybe-symbol kt kf) + (let-syntax + ((test + (syntax-rules () + ((test maybe-symbol t f) t) + ((test x t f) f)))) + (test abracadabra kt kf))))) +;;(write (symbol?? a)) + (write - (my-when4 't 1 2 3)) + (let-syntax + ((second + (syntax-rules () + ((second a b c) + b)))) + (second 33 44 55))) ; (my-when2 From 344eb59381641eb8bfb9cf1caacba0bccf8160f2 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 6 Dec 2017 13:12:38 -0500 Subject: [PATCH 23/57] New test case, still does not work --- tests/let-syntax-298.scm | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 tests/let-syntax-298.scm diff --git a/tests/let-syntax-298.scm b/tests/let-syntax-298.scm new file mode 100644 index 00000000..0758b69a --- /dev/null +++ b/tests/let-syntax-298.scm @@ -0,0 +1,14 @@ +;; From: +;; https://github.com/ashinn/chibi-scheme/issues/298 +(import (scheme base)) + +(define-syntax bar + (syntax-rules () + ((_) + (let-syntax ((foo (syntax-rules () ((_) 'ok)))) + (foo))))) + +(define-syntax foo (syntax-rules ())) + +(bar) +(foo) From b2e9524e70edfcf6d7918aa42b7dafc62f8db7a8 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 6 Dec 2017 17:55:49 -0500 Subject: [PATCH 24/57] Handled renamed syntax-rules during macro expansion --- scheme/eval.sld | 25 +++++++++++++++++++++---- tests/let-syntax-298.scm | 8 +++++--- 2 files changed, 26 insertions(+), 7 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 5b9bb559..40bae95b 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -922,14 +922,24 @@ (let* ((name (car b)) (binding (cadr b)) (binding-body (cadr binding))) +;(define tmp (env:lookup (car binding) env #f)) +;(display "/* ") +;(write `(DEBUG expand let-syntax +; ,(if (tagged-list? 'macro tmp) +; (Cyc-get-cvar (cadr tmp)) +; tmp) +; ,syntax-rules)) +;(display "*/ ") +;(newline) (cons name (list 'macro - (if (tagged-list? 'syntax-rules binding) - ;; TODO: is this ok? - (cadr (_expand binding env rename-env local-env)) - binding-body))))) + ;; Broken for renames, replace w/below: (if (tagged-list? 'syntax-rules binding) + (if (macro:syntax-rules? (env:lookup (car binding) env #f)) + ;; TODO: is this ok? + (cadr (_expand binding env rename-env local-env)) + binding-body))))) bindings)) (new-local-macro-env (append bindings-as-macros local-env)) ) @@ -975,6 +985,13 @@ (else (error "unknown exp: " exp)))) +(define (macro:syntax-rules? exp) + (eq? + syntax-rules + (if (tagged-list? 'macro exp) + (Cyc-get-cvar (cadr exp)) + exp))) + ;; Nicer interface to expand-body (define (expand-lambda-body exp env rename-env) (expand-body '() exp env rename-env)) diff --git a/tests/let-syntax-298.scm b/tests/let-syntax-298.scm index 0758b69a..93a688c9 100644 --- a/tests/let-syntax-298.scm +++ b/tests/let-syntax-298.scm @@ -1,6 +1,6 @@ ;; From: ;; https://github.com/ashinn/chibi-scheme/issues/298 -(import (scheme base)) +(import (scheme base) (scheme write)) (define-syntax bar (syntax-rules () @@ -8,7 +8,9 @@ (let-syntax ((foo (syntax-rules () ((_) 'ok)))) (foo))))) -(define-syntax foo (syntax-rules ())) +;(define-syntax foo (syntax-rules ())) +(write (bar) -(foo) +) +;(foo) From f40232e9eb893cf207e4c24fceb0b0b97da8232c Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 6 Dec 2017 17:59:49 -0500 Subject: [PATCH 25/57] Removed debug traces --- scheme/eval.sld | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 40bae95b..761d4bfd 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -384,10 +384,10 @@ ;; - env => Environment used to expand macros ;; (define (analyze exp env) -(newline) -(display "/* ") -(write (list 'analyze exp)) -(display " */") +;;(newline) +;;(display "/* ") +;;(write (list 'analyze exp)) +;;(display " */") (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) @@ -459,10 +459,10 @@ ;; TODO: probably just create a fresh env for renames ;; TODO: expand, do we need to clean as well? ;; TODO: run results back through analyze: (analyze (expand env? rename-env? -(display "/* ") -(write `(DEBUG ,cleaned)) -(display "*/ ") -(newline) +;;(display "/* ") +;;(write `(DEBUG ,cleaned)) +;;(display "*/ ") +;;(newline) (analyze cleaned a-env))) (define (analyze-syntax exp a-env) @@ -850,10 +850,10 @@ (current-error-port)) (newline (current-error-port))) ;(log exp) -(display "/* ") -(write `(expand ,exp)) -(display "*/ ") -(newline) +;;(display "/* ") +;;(write `(expand ,exp)) +;;(display "*/ ") +;;(newline) (cond ((const? exp) exp) ((prim? exp) exp) @@ -953,10 +953,10 @@ (if local (cdr local) (env:lookup (car exp) env #f))))) -(display "/* ") -(write `(app DEBUG ,(car exp) ,val)) -(display "*/ ") -(newline) +;;(display "/* ") +;;(write `(app DEBUG ,(car exp) ,val)) +;;(display "*/ ") +;;(newline) (cond ((tagged-list? 'macro val) (_expand ; Could expand into another macro From 23e67294ec391d1456a6bd25c9793446abb32aee Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 7 Dec 2017 12:41:03 -0500 Subject: [PATCH 26/57] Handle renamed syntax-rules when expanding define-syntax --- scheme/eval.sld | 2 +- tests/when.scm | 16 ++++++++-------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 761d4bfd..4474322a 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -887,7 +887,7 @@ (trans (caddr exp)) (body (cadr trans))) (cond - ((tagged-list? 'syntax-rules trans) ;; TODO: what if syntax-rules is renamed? + ((macro:syntax-rules? (env:lookup (car trans) env #f)) ;; Handles renamed 'syntax-rules' identifier (_expand `(define-syntax ,name ,(_expand trans env rename-env local-env)) env rename-env local-env)) diff --git a/tests/when.scm b/tests/when.scm index d210cb2f..c24cbf20 100644 --- a/tests/when.scm +++ b/tests/when.scm @@ -4,14 +4,14 @@ ; ((my-when test result1 result2 ...) ; (if test ; (begin result1 result2 ...))))) -; -;(define-syntax my-when2 -; (syntax-rules () -; ((my-when test result1 result2 ...) -; (list result2 ...)))) -; -;;(write -;; (my-when2 #t 1)) + +(define-syntax my-when2 + (syntax-rules () + ((my-when test result1 result2 ...) + (list result2 ...)))) + +(write + (my-when2 #t 1)) ; ; (define my-when2* ; (lambda (expr$28 rename$29 compare$30) From 2fe78947ab05b0e2507b304ee46229b5d444d58f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 7 Dec 2017 12:57:38 -0500 Subject: [PATCH 27/57] WIP, testing --- tests/let-syntax-298.scm | 6 ++++-- tests/when.scm | 3 ++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/tests/let-syntax-298.scm b/tests/let-syntax-298.scm index 93a688c9..652f30c4 100644 --- a/tests/let-syntax-298.scm +++ b/tests/let-syntax-298.scm @@ -8,9 +8,11 @@ (let-syntax ((foo (syntax-rules () ((_) 'ok)))) (foo))))) -;(define-syntax foo (syntax-rules ())) +(define-syntax foo (syntax-rules () ((_) 'foo))) (write (bar) ) -;(foo) +(write +(foo) +) diff --git a/tests/when.scm b/tests/when.scm index c24cbf20..40f7d1c7 100644 --- a/tests/when.scm +++ b/tests/when.scm @@ -74,7 +74,8 @@ ((test maybe-symbol t f) t) ((test x t f) f)))) (test abracadabra kt kf))))) -;;(write (symbol?? a)) +(write (symbol?? a #t #f)) +(write (symbol?? "a" #t #f)) (write (let-syntax From 28c5672b0a1f60071772db272bea2c846a47e894 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 7 Dec 2017 12:58:04 -0500 Subject: [PATCH 28/57] Added a note about let-syntax --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2228da42..13c54106 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## 0.7.1 - TBD +Features + +- WIP: let-syntax + ## 0.7 - November 17, 2017 Features From 5adf35a3644b7cb8d59e30e817032fac7dbb9157 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 8 Dec 2017 12:56:55 -0500 Subject: [PATCH 29/57] Allow eval to handle syntax-rules --- scheme/eval.sld | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 4474322a..5e0de3e8 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -468,23 +468,21 @@ (define (analyze-syntax exp a-env) (let ((var (cadr exp))) (cond - ((tagged-list? 'er-macro-transformer (caddr exp)) - (let ((sproc (make-macro (cadr (caddr exp))))) ;(analyze-syntax-lambda (cadr (caddr exp)) a-env))) + ((tagged-list? 'er-macro-transformer (caddr exp)) ;; TODO: need to handle renamed er symbol here?? + (let ((sproc (make-macro (cadr (caddr exp))))) (lambda (env) (env:define-variable! var sproc env) 'ok))) (else - ;; TODO: need to support syntax-rules, and other methods of - ;; building a macro. maybe call into something like - ;; analyze-syntax-lambda instead of erroring here - (error "macro syntax not supported yet"))))) - -;(define (analyze-syntax-lambda exp a-env) -; (let ((vars (lambda-parameters exp)) -; (bproc (analyze-sequence (lambda-body exp) a-env))) -; (write `(debug ,(lambda-body exp))) -; ;(lambda (env) -; (make-macro `(lambda ,vars ,@(lambda-body exp))))) + ;; Just expand the syntax rules + ;; Possibly want to check the macro system here + (let* ((rename-env (env:extend-environment '() '() '())) + (expanded (expand exp a-env rename-env)) + (cleaned (macro:cleanup expanded rename-env))) + (let ((sproc (make-macro (caddr cleaned)))) + (lambda (env) + (env:define-variable! var sproc env) + 'ok))))))) (define (analyze-import exp env) (lambda (env) From b96813bb689e388904d979159bd2e9cc209934fa Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 8 Dec 2017 12:58:56 -0500 Subject: [PATCH 30/57] WIP --- CHANGELOG.md | 7 ++++++- tests/when.scm | 24 ++++++++++++------------ 2 files changed, 18 insertions(+), 13 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 13c54106..58752e93 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,7 +4,12 @@ Features -- WIP: let-syntax +- Added `let-syntax` to the compiler and interpreter. +- Allow `eval` to recognize `syntax-rules` macros. + +Internal Changes + +- Relocated all macro expansion code to the `(scheme eval)` module. `(scheme cyclone macros)` is now obsolete. ## 0.7 - November 17, 2017 diff --git a/tests/when.scm b/tests/when.scm index 40f7d1c7..8d044155 100644 --- a/tests/when.scm +++ b/tests/when.scm @@ -85,18 +85,18 @@ b)))) (second 33 44 55))) - -; (my-when2 -; 't -; 1 -; (let-syntax -; ((my-when3 -; (syntax-rules () -; ((my-when3 test result1 result2 ...) -; (list result2 ...))))) -; (my-when3 33 44 55)) -; 2 -; 3)) +(write + (my-when2 + 't + 1 + (let-syntax + ((my-when3 + (syntax-rules () + ((my-when3 test result1 result2 ...) + (list result2 ...))))) + (my-when3 33 44 55)) + 2 + 3)) ;(write ; (my-when2 '(my-when2 't 1 2 3) (lambda (a) a) (lambda X #f))) ;(write From 1903a87cb95ba7350d69be184047801e18cf49c9 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 8 Dec 2017 19:50:44 -0500 Subject: [PATCH 31/57] Testing with syntax-rules macro --- tests/let-syntax.scm | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index 5b5f01a1..280d7a15 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -1,5 +1,22 @@ (import (scheme base) (scheme write)) +(define-syntax my-let + (syntax-rules + () + ((my-let ((name val) ...) body1 body2 ...) + ((lambda (name ...) body1 body2 ...) val ...)) + ((my-let tag ((name val) ...) body1 body2 ...) + ((letrec ((tag (lambda (name ...) body1 body2 ...))) + tag) + val ...)))) +(write +(my-let ((x 'outer)) + (let-syntax ((m (syntax-rules () ((m) x)))) + (my-let ((x 'inner)) + (m)))) ;; Should be outer + ) + + ;; (let-syntax ((given-that (syntax-rules () ;; ((given-that test stmt1 stmt2 ...) ;; (if test From 7e2a9f46c2187f3b94ac72602ceca4384fd8eb1e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 Dec 2017 12:15:07 -0500 Subject: [PATCH 32/57] Added letrec-syntax example from r7rs --- tests/let-syntax.scm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index 280d7a15..e85d0df6 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -1,4 +1,14 @@ -(import (scheme base) (scheme write)) +(import (scheme base) (scheme write) (scheme cyclone pretty-print)) + +#;(letrec-syntax + ((my-or (syntax-rules + () + ((my-or) #f) + ((my-or e) e) + ((my-or e1 e2 ...) + (let ((temp e1)) (if temp temp (my-or e2 ...))))))) + (let ((x #f) (y 7) (temp 8) (let odd?) (if even?)) + (my-or x (let temp) (if y) y))) ;; ==> 7 (define-syntax my-let (syntax-rules From 04b32d6a5e4d8112f25761dcfe7cc2e5d5efee2e Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 Dec 2017 13:44:47 -0500 Subject: [PATCH 33/57] Tweaked syntax --- tests/let-syntax.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index e85d0df6..e2508f4f 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -1,13 +1,16 @@ (import (scheme base) (scheme write) (scheme cyclone pretty-print)) #;(letrec-syntax - ((my-or (syntax-rules - () + ((my-or (syntax-rules () ((my-or) #f) ((my-or e) e) ((my-or e1 e2 ...) (let ((temp e1)) (if temp temp (my-or e2 ...))))))) - (let ((x #f) (y 7) (temp 8) (let odd?) (if even?)) + (let ((x #f) + (y 7) + (temp 8) + (let odd?) + (if even?)) (my-or x (let temp) (if y) y))) ;; ==> 7 (define-syntax my-let From d2e6139e5bfc06d2ccff173b7d4d5ccab33d12e3 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 Dec 2017 13:56:21 -0500 Subject: [PATCH 34/57] Added letrec-syntax to list of keywords in the rename code --- scheme/cyclone/util.sld | 1 + 1 file changed, 1 insertion(+) diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld index 9bec8218..984d3ceb 100644 --- a/scheme/cyclone/util.sld +++ b/scheme/cyclone/util.sld @@ -663,6 +663,7 @@ (define . define) (define-syntax . define-syntax) (let-syntax . let-syntax) + (letrec-syntax . letrec-syntax) (define-c . define-c) (if . if) (lambda . lambda) From 9ebd079c8bfd0ac6c91b5333ca65e3cc35b1d7f5 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 11 Dec 2017 19:07:05 -0500 Subject: [PATCH 35/57] Added a debug version of the letrec-syntax macro --- tests/let-syntax.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index e2508f4f..856f431f 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -1,5 +1,18 @@ (import (scheme base) (scheme write) (scheme cyclone pretty-print)) +(let-syntax + ((my-or (syntax-rules () + ((my-or) #f) + ((my-or e) e) + ((my-or e1 e2 ...) + (let ((temp e1)) (if temp temp (my-or e2 ...))))))) + (let ((x #f) + (y 7) + (temp 8) + (my-let odd?) + (my-if even?)) + (my-or x (my-let temp) (my-if y) y))) ;; ==> 7 + #;(letrec-syntax ((my-or (syntax-rules () ((my-or) #f) From 19ee3de542688ad8128fcd5ed59871a0763acd77 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Dec 2017 10:34:52 -0500 Subject: [PATCH 36/57] More tests --- tests/let-syntax.scm | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index 856f431f..91d0c13b 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -26,6 +26,27 @@ (if even?)) (my-or x (let temp) (if y) y))) ;; ==> 7 + +;; From Chibi +#;(let () + (letrec-syntax () + (define internal-def 'ok)) + internal-def) + + +#;(let ((a 1)) + (let-syntax + ;;(letrec-syntax + ((foo (syntax-rules () + ((_ b) + (bar a b)))) + (bar (syntax-rules () ((_ c d) + (cons c (let ((c 3)) + (list d c 'c))))))) + (let ((a 2)) + (foo a)))) + + (define-syntax my-let (syntax-rules () From 29739bc7310b9a52c50fc5f67b5d09f065ce1031 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Dec 2017 10:37:04 -0500 Subject: [PATCH 37/57] More examples --- tests/let-syntax.scm | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index 91d0c13b..e9ec041c 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -33,6 +33,40 @@ (define internal-def 'ok)) internal-def) +;; From Husk: +;; +; Examples from the source to R5RS pitfall 3.3 +;; (assert/equal +;; (let ((a 1)) +;; (letrec-syntax +;; ((foo (syntax-rules () +;; ((_ b) +;; (bar a b)))) +;; (bar (syntax-rules () +;; ((_ c d) +;; (cons c (let ((c 3)) +;; (list d c 'c))))))) +;; (let ((a 2)) +;; (foo a)))) +;; '(1 2 3 a)) +;; +;; ; Examples from/based on pitfall 8.3 (assert/equal 1 +;; (let ((x 1)) +;; (let-syntax ((foo (syntax-rules () ((_) 2)))) +;; (define x (foo)) +;; 3) +;; x)) +;; (assert/equal 1 +;; (let ((x 1)) +;; (letrec-syntax ((foo (syntax-rules () ((_) 2)))) (define x (foo)) +;; 3) +;; x)) +;; +;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros +;; (assert/equal +;; (let ((unquote 'foo)) `(,'bar)) +;; '(,'bar)) + #;(let ((a 1)) (let-syntax From 55b112afbd4fe04d5e996a6c52f0f3a480d13bb3 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Dec 2017 14:19:10 -0500 Subject: [PATCH 38/57] WIP --- scheme/eval.sld | 24 ++++++++++++++++++++++-- tests/let-syntax.scm | 10 ++++++++++ 2 files changed, 32 insertions(+), 2 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 5e0de3e8..5933247c 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -950,9 +950,14 @@ (let ((val (let ((local (assoc (car exp) local-env))) (if local (cdr local) - (env:lookup (car exp) env #f))))) + (let ((v (env:lookup (car exp) env #f))) + v ;; TODO: below was for looking up a renamed macro. may want to consider using it + ;; in the symbol condition below... + #;(if v + v + (env:lookup (car exp) rename-env #f))))))) ;;(display "/* ") -;;(write `(app DEBUG ,(car exp) ,val)) +;;(write `(app DEBUG ,(car exp) ,val ,local-env ,rename-env ,(env:lookup (car exp) env #f))) ;;(display "*/ ") ;;(newline) (cond @@ -968,6 +973,21 @@ env rename-env local-env)) +;; TODO: if we are doing this, only want to do so if the original variable is a macro. +;; this is starting to get overly complicated though. +;; if nothing else should encapsulate the above lookup into a function and call that +;; in both places (above and here) to simplify things +;; +;; ((and (symbol? val) +;; (not (eq? val (car exp)))) +;; ;; Original macro symbol was renamed. So try again with the orignal symbol +;;(display "/* ") +;;(write `(app DEBUG-syms ,(car exp) ,val ,local-env ,(cdr exp))) +;;(display "*/ ") +;;(newline) +;; (_expand +;; (cons val (cdr exp)) +;; env rename-env local-env)) (else (map (lambda (expr) (_expand expr env rename-env local-env)) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index e9ec041c..bf2fef38 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -1,5 +1,15 @@ (import (scheme base) (scheme write) (scheme cyclone pretty-print)) +;; Just testing, may want to remove this one once the recursive macro expansion works + (define-syntax my-or2 (syntax-rules () + ((my-or2) #f) + ((my-or2 e) e) + ((my-or2 e1 e2 ...) + (let ((temp e1)) (if temp temp (my-or2 e2 ...)))))) +(write (my-or2 #t)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (let-syntax ((my-or (syntax-rules () ((my-or) #f) From b283c50341e100bec1d0c7522c09a8d0516786b8 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Dec 2017 18:13:19 -0500 Subject: [PATCH 39/57] Placeholders for letrec-syntax --- scheme/eval.sld | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/scheme/eval.sld b/scheme/eval.sld index 5933247c..22be99ab 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -404,6 +404,9 @@ ((and (tagged-list? 'let-syntax exp) (not (null? (cdr exp)))) (analyze-let-syntax exp env)) + ((and (tagged-list? 'letrec-syntax exp) + (not (null? (cdr exp)))) + (analyze-letrec-syntax exp env)) ((and (if? exp) (not (null? (cdr exp)))) (analyze-if exp env)) @@ -465,6 +468,14 @@ ;;(newline) (analyze cleaned a-env))) +;; TODO: following is just a placeholder, does not work yet +(define (analyze-letrec-syntax exp a-env) + (let* ((body-env a-env) ;;(env:extend-environment '() '() a-env)) + (expanded (expand exp body-env body-env)) + (cleaned (macro:cleanup expanded body-env)) + ) + (analyze cleaned body-env))) + (define (analyze-syntax exp a-env) (let ((var (cadr exp))) (cond From 8301c70e7073e74addc78d58e46136b68b59860d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Dec 2017 18:13:36 -0500 Subject: [PATCH 40/57] Working through let*-syntax --- tests/let-syntax.scm | 39 ++++++++++++++++++++++++++++++++------- 1 file changed, 32 insertions(+), 7 deletions(-) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index bf2fef38..afbec23b 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -1,16 +1,41 @@ (import (scheme base) (scheme write) (scheme cyclone pretty-print)) ;; Just testing, may want to remove this one once the recursive macro expansion works - (define-syntax my-or2 (syntax-rules () - ((my-or2) #f) - ((my-or2 e) e) - ((my-or2 e1 e2 ...) - (let ((temp e1)) (if temp temp (my-or2 e2 ...)))))) -(write (my-or2 #t)) +; (define-syntax my-or2 (syntax-rules () +; ((my-or2) #f) +; ((my-or2 e) e) +; ((my-or2 e1 e2 ...) +; (let ((temp e1)) (if temp temp (my-or2 e2 ...)))))) +;(write (my-or2 #t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (define-syntax my-or (syntax-rules () + ((my-or) #f) + ((my-or e) e) + ((my-or e1 e2 ...) + (let ((temp e1)) (if temp temp (my-or e2 ...)))))) + (write + (let ((x #f) + (y 7) + (temp 8) + (my-let odd?) + (my-if even?)) + (my-or x (my-let temp) (my-if y) y))) ;; ==> 7 -(let-syntax + (define-syntax foo (syntax-rules () + ((_ b) + (bar a b)))) + (define-syntax bar (syntax-rules () ((_ c d) + (cons c (let ((c 3)) + (list d c 'c)))))) + (write + (let ((a 2)) + (foo a))) + +;; Chibi also fails with the same error when this is a let-synatx macro, +;; so it may be that Cyclone works just fine here! Obviously it needs +;; to be able to handle this macro in letrec-syntax form, though +#;(let-syntax ((my-or (syntax-rules () ((my-or) #f) ((my-or e) e) From 4eaa61c0a44d3a8553f1387a295c1dc5c35ccdad Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Dec 2017 19:03:45 -0500 Subject: [PATCH 41/57] Partially-working version of letrec-syntax --- scheme/eval.sld | 31 ++++++++++++++++---- tests/let-syntax.scm | 68 ++++++++++++++++++++++++-------------------- 2 files changed, 63 insertions(+), 36 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 22be99ab..1db88f8d 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -468,13 +468,12 @@ ;;(newline) (analyze cleaned a-env))) -;; TODO: following is just a placeholder, does not work yet (define (analyze-letrec-syntax exp a-env) - (let* ((body-env a-env) ;;(env:extend-environment '() '() a-env)) - (expanded (expand exp body-env body-env)) - (cleaned (macro:cleanup expanded body-env)) + (let* ((rename-env (env:extend-environment '() '() '())) + (expanded (expand exp a-env rename-env)) + (cleaned (macro:cleanup expanded rename-env)) ) - (analyze cleaned body-env))) + (analyze cleaned a-env))) (define (analyze-syntax exp a-env) (let ((var (cadr exp))) @@ -955,6 +954,28 @@ ;(trace:error `(let-syntax ,new-local-macro-env)) (_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env )) + ;; TODO: does not work yet: + ((letrec-syntax? exp) + (let* ((body (cons 'begin (cddr exp))) + (body-env (env:extend-environment '() '() env)) + (bindings (cadr exp)) + ;(new-local-macro-env (append bindings-as-macros local-env)) + ) + (for-each + (lambda (b) + (let* ((name (car b)) + (binding (cadr b)) + (binding-body (cadr binding)) + (macro-val + (list + 'macro + (if (macro:syntax-rules? (env:lookup (car binding) body-env #f)) + (cadr (_expand binding body-env rename-env local-env)) + binding-body)))) + (env:define-variable! name macro-val) body-env)) + bindings) + (_expand body body-env rename-env local-env) ;;new-local-macro-env) ;; TODO: new-local-macro-env + )) ((app? exp) (cond ((symbol? (car exp)) diff --git a/tests/let-syntax.scm b/tests/let-syntax.scm index afbec23b..a13ac537 100644 --- a/tests/let-syntax.scm +++ b/tests/let-syntax.scm @@ -9,28 +9,28 @@ ;(write (my-or2 #t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (define-syntax my-or (syntax-rules () - ((my-or) #f) - ((my-or e) e) - ((my-or e1 e2 ...) - (let ((temp e1)) (if temp temp (my-or e2 ...)))))) - (write - (let ((x #f) - (y 7) - (temp 8) - (my-let odd?) - (my-if even?)) - (my-or x (my-let temp) (my-if y) y))) ;; ==> 7 - - (define-syntax foo (syntax-rules () - ((_ b) - (bar a b)))) - (define-syntax bar (syntax-rules () ((_ c d) - (cons c (let ((c 3)) - (list d c 'c)))))) - (write - (let ((a 2)) - (foo a))) +; (define-syntax my-or (syntax-rules () +; ((my-or) #f) +; ((my-or e) e) +; ((my-or e1 e2 ...) +; (let ((temp e1)) (if temp temp (my-or e2 ...)))))) +; (write +; (let ((x #f) +; (y 7) +; (temp 8) +; (my-let odd?) +; (my-if even?)) +; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7 +; +; (define-syntax foo (syntax-rules () +; ((_ b) +; (bar a b)))) +; (define-syntax bar (syntax-rules () ((_ c d) +; (cons c (let ((c 3)) +; (list d c 'c)))))) +; (write +; (let ((a 2)) +; (foo a))) ;; Chibi also fails with the same error when this is a let-synatx macro, ;; so it may be that Cyclone works just fine here! Obviously it needs @@ -48,7 +48,10 @@ (my-if even?)) (my-or x (my-let temp) (my-if y) y))) ;; ==> 7 -#;(letrec-syntax +;; TODO: below should work with "let" and "if" instead of "my-let" and "my-if" +;; TODO: below does not work in eval - WTF? +(write +(letrec-syntax ((my-or (syntax-rules () ((my-or) #f) ((my-or e) e) @@ -57,16 +60,19 @@ (let ((x #f) (y 7) (temp 8) - (let odd?) - (if even?)) - (my-or x (let temp) (if y) y))) ;; ==> 7 + (my-let odd?) + (my-if even?)) + (my-or x (my-let temp) (my-if y) y))) ;; ==> 7 +) -;; From Chibi -#;(let () - (letrec-syntax () - (define internal-def 'ok)) - internal-def) +;; From Chibi - isn't this a bug though? +;(write +;(let () +; (letrec-syntax () +; (define internal-def 'ok)) +; internal-def) +;) ;; From Husk: ;; From 6f37b8597bf37860567a18ce1617d640c6f0e654 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 12 Dec 2017 19:07:40 -0500 Subject: [PATCH 42/57] WIP - letrec-syntax --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 58752e93..80b53354 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ Features - Added `let-syntax` to the compiler and interpreter. +TBD: `letrec-syntax` - Allow `eval` to recognize `syntax-rules` macros. Internal Changes From dcc49baa3bf78ec169197f03f1564cd42ac43b2a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 13 Dec 2017 19:12:13 -0500 Subject: [PATCH 43/57] WIP, enabled debugging for diagnostic --- scheme/eval.sld | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 1db88f8d..c9f02556 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -858,10 +858,10 @@ (current-error-port)) (newline (current-error-port))) ;(log exp) -;;(display "/* ") -;;(write `(expand ,exp)) -;;(display "*/ ") -;;(newline) +(display "/* ") +(write `(expand ,exp)) +(display "*/ ") +(newline) (cond ((const? exp) exp) ((prim? exp) exp) @@ -988,10 +988,10 @@ #;(if v v (env:lookup (car exp) rename-env #f))))))) -;;(display "/* ") -;;(write `(app DEBUG ,(car exp) ,val ,local-env ,rename-env ,(env:lookup (car exp) env #f))) -;;(display "*/ ") -;;(newline) +(display "/* ") +(write `(app DEBUG ,(car exp) ,val ,local-env ,rename-env ,(env:lookup (car exp) env #f))) +(display "*/ ") +(newline) (cond ((tagged-list? 'macro val) (_expand ; Could expand into another macro @@ -1081,6 +1081,7 @@ rename-env local-env)) ((or (define-syntax? this-exp) + (letrec-syntax? this-exp) (let-syntax? this-exp) (lambda? this-exp) (set!? this-exp) From 9817ecd465f696ce16ab7f093a0e6fbf1ec3f7a4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 14 Dec 2017 19:04:15 -0500 Subject: [PATCH 44/57] WIP --- scheme/eval.sld | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index c9f02556..912bca51 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -470,6 +470,24 @@ (define (analyze-letrec-syntax exp a-env) (let* ((rename-env (env:extend-environment '() '() '())) + +;; (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env)) +;; (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env)) +;; (zipped (apply map list vars (list vals))) +;; (defined-macros +;; (filter +;; (lambda (v) +;; (Cyc-macro? (Cyc-get-cvar (cdr v)))) +;; zipped)) +;; (macro-env +;; (env:extend-environment +;; (map car defined-macros) +;; (map (lambda (v) +;; (list 'macro (cdr v))) +;; defined-macros) +;; '())) ;; base-env + + ;(expanded (expand exp macro-env rename-env)) (expanded (expand exp a-env rename-env)) (cleaned (macro:cleanup expanded rename-env)) ) @@ -989,7 +1007,7 @@ v (env:lookup (car exp) rename-env #f))))))) (display "/* ") -(write `(app DEBUG ,(car exp) ,val ,local-env ,rename-env ,(env:lookup (car exp) env #f))) +(write `(app DEBUG ,(car exp) ,val ,env ,local-env ,rename-env ,(env:lookup (car exp) env #f))) (display "*/ ") (newline) (cond From 218650e77070ef99513d815ffd6af25ae9a95f17 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 14 Dec 2017 19:04:40 -0500 Subject: [PATCH 45/57] Temporary test file --- tmp-macro-test.scm | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 tmp-macro-test.scm diff --git a/tmp-macro-test.scm b/tmp-macro-test.scm new file mode 100644 index 00000000..eeefbe65 --- /dev/null +++ b/tmp-macro-test.scm @@ -0,0 +1,22 @@ +(import (scheme base) (scheme write) (scheme eval) (scheme cyclone util)) + +(define a-env (create-environment '() '())) + +(let* ( +(vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env)) +(vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env)) +(zipped (apply map list vars (list vals))) +(defined-macros + (filter + (lambda (v) + (Cyc-macro? (Cyc-get-cvar (cdr v)))) + zipped)) +(macro-env + (env:extend-environment + (map car defined-macros) + (map (lambda (v) + (list 'macro (cdr v))) + defined-macros) + '())) ;; base-env +) + (write macro-env)) From f6d61f645143631062b69029a507378eb47a32f3 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 14 Dec 2017 19:05:15 -0500 Subject: [PATCH 46/57] WIP --- tmp-macro-test.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/tmp-macro-test.scm b/tmp-macro-test.scm index eeefbe65..1a9789a2 100644 --- a/tmp-macro-test.scm +++ b/tmp-macro-test.scm @@ -1,3 +1,4 @@ +;; This is a temporary test file (import (scheme base) (scheme write) (scheme eval) (scheme cyclone util)) (define a-env (create-environment '() '())) From d75cd52850ea56fd1184a2a05853a1bf73ded6ca Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 15 Dec 2017 13:51:13 -0500 Subject: [PATCH 47/57] Allow calling Cyc-get-cvar from eval --- runtime.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/runtime.c b/runtime.c index c2d379cb..a163cd87 100644 --- a/runtime.c +++ b/runtime.c @@ -4208,8 +4208,8 @@ void _symbol_127(void *data, object cont, object args) void _Cyc_91get_91cvar(void *data, object cont, object args) { - printf("not implemented\n"); - exit(1); + Cyc_check_num_args(data, "Cyc-get-cvar", 1, args); + return_closcall1(data, cont, Cyc_get_cvar((car(args)))); } void _Cyc_91set_91cvar_67(void *data, object cont, object args) From a92cb172f85974df15ac453c3287876a1a3b8b65 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 15 Dec 2017 14:17:14 -0500 Subject: [PATCH 48/57] WIP --- tmp-macro-test.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/tmp-macro-test.scm b/tmp-macro-test.scm index 1a9789a2..5c18a472 100644 --- a/tmp-macro-test.scm +++ b/tmp-macro-test.scm @@ -1,6 +1,9 @@ ;; This is a temporary test file (import (scheme base) (scheme write) (scheme eval) (scheme cyclone util)) +(define env (env:extend-environment '() '() env:the-empty-environment)) +(define env2 (env:extend-environment '(a b c) '(1 2 3) env)) + (define a-env (create-environment '() '())) (let* ( @@ -10,14 +13,14 @@ (defined-macros (filter (lambda (v) - (Cyc-macro? (Cyc-get-cvar (cdr v)))) + (Cyc-macro? (Cyc-get-cvar (cadr v)))) zipped)) (macro-env (env:extend-environment (map car defined-macros) (map (lambda (v) - (list 'macro (cdr v))) + (list 'macro (cadr v))) defined-macros) '())) ;; base-env ) - (write macro-env)) + (write (list vars vals zipped defined-macros macro-env))) From 4ea55e062a159b996fd5abfa68faf0d656f34825 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 15 Dec 2017 14:17:54 -0500 Subject: [PATCH 49/57] WIP --- scheme/eval.sld | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 912bca51..ef17f2e5 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -471,21 +471,21 @@ (define (analyze-letrec-syntax exp a-env) (let* ((rename-env (env:extend-environment '() '() '())) -;; (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env)) -;; (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env)) -;; (zipped (apply map list vars (list vals))) -;; (defined-macros -;; (filter -;; (lambda (v) -;; (Cyc-macro? (Cyc-get-cvar (cdr v)))) -;; zipped)) -;; (macro-env -;; (env:extend-environment -;; (map car defined-macros) -;; (map (lambda (v) -;; (list 'macro (cdr v))) -;; defined-macros) -;; '())) ;; base-env +; (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env)) +; (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env)) +; (zipped (apply map list vars (list vals))) +; (defined-macros +; (filter +; (lambda (v) +; (Cyc-macro? (Cyc-get-cvar (cadr v)))) +; zipped)) +; (macro-env +; (env:extend-environment +; (map car defined-macros) +; (map (lambda (v) +; (list 'macro (cadr v))) +; defined-macros) +; '())) ;; base-env ;(expanded (expand exp macro-env rename-env)) (expanded (expand exp a-env rename-env)) From c962050c9b164af38a58ed41b423d0fdda1144f8 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 15 Dec 2017 14:23:11 -0500 Subject: [PATCH 50/57] Added new linbrary --- Makefile | 1 + scheme/repl.sld | 17 +++++++++++++++++ 2 files changed, 18 insertions(+) create mode 100644 scheme/repl.sld diff --git a/Makefile b/Makefile index d5c974cf..36db4a6c 100644 --- a/Makefile +++ b/Makefile @@ -206,6 +206,7 @@ bootstrap : icyc libs cp scheme/char.c $(BOOTSTRAP_DIR)/scheme cp scheme/complex.c $(BOOTSTRAP_DIR)/scheme cp scheme/eval.c $(BOOTSTRAP_DIR)/scheme + cp scheme/repl.c $(BOOTSTRAP_DIR)/scheme cp scheme/file.c $(BOOTSTRAP_DIR)/scheme cp scheme/inexact.c $(BOOTSTRAP_DIR)/scheme cp scheme/lazy.c $(BOOTSTRAP_DIR)/scheme diff --git a/scheme/repl.sld b/scheme/repl.sld new file mode 100644 index 00000000..38f56fd0 --- /dev/null +++ b/scheme/repl.sld @@ -0,0 +1,17 @@ +;;;; Cyclone Scheme +;;;; https://github.com/justinethier/cyclone +;;;; +;;;; Copyright (c) 2014-2016, Justin Ethier +;;;; All rights reserved. +;;;; +;;;; This module contains the repl library from r7rs. +;;;; +(define-library (scheme repl) + (export + interaction-environment + ) + (import (scheme eval)) + (begin + (define (interaction-environment) + (setup-environment)) + )) From f97192f230344d8303e88e47eacaad90a7a7eea4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 15 Dec 2017 17:24:04 -0500 Subject: [PATCH 51/57] Added (scheme repl) --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 80b53354..52820cff 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ Features - Added `let-syntax` to the compiler and interpreter. TBD: `letrec-syntax` - Allow `eval` to recognize `syntax-rules` macros. +- Added the `(scheme repl)` library and `interaction-environment` function from R7RS. Internal Changes From b397e00522aaaa7f15a2978a72aecb6807d5f9c0 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 15 Dec 2017 17:34:18 -0500 Subject: [PATCH 52/57] letrec-syntax now has some support, too --- CHANGELOG.md | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 52820cff..e435cbc5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,14 +4,13 @@ Features -- Added `let-syntax` to the compiler and interpreter. -TBD: `letrec-syntax` -- Allow `eval` to recognize `syntax-rules` macros. +- Added `let-syntax` and `letrec-syntax` to the compiler and interpreter. - Added the `(scheme repl)` library and `interaction-environment` function from R7RS. +- Allow `eval` to recognize `syntax-rules` macros. Internal Changes -- Relocated all macro expansion code to the `(scheme eval)` module. `(scheme cyclone macros)` is now obsolete. +- Relocated all macro expansion code to the `(scheme eval)` module. Cyclone's `(scheme cyclone macros)` library is now obsolete. ## 0.7 - November 17, 2017 From c404a6b5887adc514a8a615638fd8501117bb54b Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 15 Dec 2017 18:10:28 -0500 Subject: [PATCH 53/57] Working letrec-syntax Need to understand a bit more why this works, though... --- scheme/eval.sld | 50 ++++++++++++++++++++++++------------------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index ef17f2e5..21b48bee 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -471,24 +471,24 @@ (define (analyze-letrec-syntax exp a-env) (let* ((rename-env (env:extend-environment '() '() '())) -; (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env)) -; (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env)) -; (zipped (apply map list vars (list vals))) -; (defined-macros -; (filter -; (lambda (v) -; (Cyc-macro? (Cyc-get-cvar (cadr v)))) -; zipped)) -; (macro-env -; (env:extend-environment -; (map car defined-macros) -; (map (lambda (v) -; (list 'macro (cadr v))) -; defined-macros) -; '())) ;; base-env + (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env)) + (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env)) + (zipped (apply map list vars (list vals))) + (defined-macros + (filter + (lambda (v) + (Cyc-macro? (Cyc-get-cvar (cadr v)))) + zipped)) + (macro-env + (env:extend-environment + (map car defined-macros) + (map (lambda (v) + (list 'macro (cadr v))) + defined-macros) + (create-environment '() '()))) - ;(expanded (expand exp macro-env rename-env)) - (expanded (expand exp a-env rename-env)) + (expanded (expand exp macro-env rename-env)) + ;(expanded (expand exp a-env rename-env)) (cleaned (macro:cleanup expanded rename-env)) ) (analyze cleaned a-env))) @@ -876,10 +876,10 @@ (current-error-port)) (newline (current-error-port))) ;(log exp) -(display "/* ") -(write `(expand ,exp)) -(display "*/ ") -(newline) +;;(display "/* ") +;;(write `(expand ,exp)) +;;(display "*/ ") +;;(newline) (cond ((const? exp) exp) ((prim? exp) exp) @@ -1006,10 +1006,10 @@ #;(if v v (env:lookup (car exp) rename-env #f))))))) -(display "/* ") -(write `(app DEBUG ,(car exp) ,val ,env ,local-env ,rename-env ,(env:lookup (car exp) env #f))) -(display "*/ ") -(newline) +;;(display "/* ") +;;(write `(app DEBUG ,(car exp) ,val ,env ,local-env ,rename-env ,(env:lookup (car exp) env #f))) +;;(display "*/ ") +;;(newline) (cond ((tagged-list? 'macro val) (_expand ; Could expand into another macro From ee7cf5a435b340cd6747bdb1b994f1cf22a83209 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 15 Dec 2017 18:31:44 -0500 Subject: [PATCH 54/57] Removed dead code --- scheme/eval.sld | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 21b48bee..896a39b5 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -972,12 +972,10 @@ ;(trace:error `(let-syntax ,new-local-macro-env)) (_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env )) - ;; TODO: does not work yet: ((letrec-syntax? exp) (let* ((body (cons 'begin (cddr exp))) (body-env (env:extend-environment '() '() env)) (bindings (cadr exp)) - ;(new-local-macro-env (append bindings-as-macros local-env)) ) (for-each (lambda (b) @@ -992,7 +990,7 @@ binding-body)))) (env:define-variable! name macro-val) body-env)) bindings) - (_expand body body-env rename-env local-env) ;;new-local-macro-env) ;; TODO: new-local-macro-env + (_expand body body-env rename-env local-env) )) ((app? exp) (cond From aa77252310647129ffaaa8e7fb37e62721b5239c Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sat, 16 Dec 2017 18:46:26 -0500 Subject: [PATCH 55/57] Use a-env as backing env for letrec-syntax --- scheme/eval.sld | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 896a39b5..3caa8e12 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -485,7 +485,8 @@ (map (lambda (v) (list 'macro (cadr v))) defined-macros) - (create-environment '() '()))) + a-env)) + ;(create-environment '() '()))) (expanded (expand exp macro-env rename-env)) ;(expanded (expand exp a-env rename-env)) From 274bf0acfa20f63c3f2ee15520f42c772180017d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 17 Dec 2017 18:15:39 -0500 Subject: [PATCH 56/57] Use "rm -rf" instead of rmdir --- Makefile.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.config b/Makefile.config index 55bdac0b..e405deaf 100644 --- a/Makefile.config +++ b/Makefile.config @@ -52,7 +52,7 @@ RM ?= rm -f #LN ?= ln INSTALL ?= install MKDIR ?= $(INSTALL) -d -RMDIR ?= rmdir +RMDIR ?= rm -rf PREFIX ?= /usr/local BINDIR ?= $(PREFIX)/bin From 7d7ae2e89e774046bbbd3cadef6c92f62a3d87de Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 17 Dec 2017 18:44:37 -0500 Subject: [PATCH 57/57] Cleanup, removed dead code --- scheme/eval.sld | 42 +++++++++++++++++------------------------- 1 file changed, 17 insertions(+), 25 deletions(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index 3caa8e12..837a5f7b 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -470,26 +470,24 @@ (define (analyze-letrec-syntax exp a-env) (let* ((rename-env (env:extend-environment '() '() '())) - - (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env)) - (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env)) - (zipped (apply map list vars (list vals))) - (defined-macros - (filter - (lambda (v) - (Cyc-macro? (Cyc-get-cvar (cadr v)))) - zipped)) - (macro-env - (env:extend-environment - (map car defined-macros) - (map (lambda (v) - (list 'macro (cadr v))) - defined-macros) - a-env)) - ;(create-environment '() '()))) - + ;; Build up a macro env + (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env)) + (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env)) + (zipped (apply map list vars (list vals))) + (defined-macros + (filter + (lambda (v) + (Cyc-macro? (Cyc-get-cvar (cadr v)))) + zipped)) + (macro-env + (env:extend-environment + (map car defined-macros) + (map (lambda (v) + (list 'macro (cadr v))) + defined-macros) + a-env)) ;(create-environment '() '()))) + ;; Proceed with macro env (expanded (expand exp macro-env rename-env)) - ;(expanded (expand exp a-env rename-env)) (cleaned (macro:cleanup expanded rename-env)) ) (analyze cleaned a-env))) @@ -854,18 +852,12 @@ (clean expr '())) ; TODO: get macro name, transformer - ; TODO: let-syntax forms ;; Macro expansion ;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 -;; TODO: need a local version of each expand that receives a local env built by -;; let-syntax forms -;;(define (expand exp env rename-env local-env) -;;(define (_expand exp env rename-env) - (define (expand exp env rename-env) (_expand exp env rename-env '()))