Merge branch 'syntax-dev2'

CHANGELOG.md

@@ -2,6 +2,16 @@
 
 ## 0.7.1 - TBD
 
+Features
+
+- 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. Cyclone's `(scheme cyclone macros)` library is now obsolete.
+
 ## 0.7 - November 17, 2017
 
 Features

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

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

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

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");
+  Cyc_check_num_args(data, "Cyc-get-cvar", 1, args);
-  exit(1);
+  return_closcall1(data, cont, Cyc_get_cvar((car(args))));
 }
 
 void _Cyc_91set_91cvar_67(void *data, object cont, object args)

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)

scheme/cyclone/macros.sld

@@ -13,152 +13,8 @@
           (scheme cyclone util)
   )
   (export
-    define-syntax?
-    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 (define-syntax? exp)
-      (tagged-list? 'define-syntax exp))
-
-    (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
   ))

scheme/cyclone/transforms.sld

@@ -18,18 +18,15 @@
           (scheme cyclone ast)
           (scheme cyclone common)
           (scheme cyclone libraries)
-          (scheme cyclone macros)
           (scheme cyclone primitives)
           (scheme cyclone pretty-print)
           (scheme cyclone util)
           (srfi 69)
   )
   (export
-    *defined-macros* 
     *do-code-gen*
     *trace-level*
     *primitives*
-    get-macros
     built-in-syms
     trace
     trace:error
@@ -67,8 +64,6 @@
     app->args 
     precompute-prim-app? 
     begin->exps 
-    define-lambda? 
-    define->lambda 
     closure? 
     closure->lam 
     closure->env 
@@ -88,8 +83,6 @@
     cell->value 
     cell-get? 
     cell-get->cell 
-    expand 
-    expand-lambda-body
     isolate-globals 
     has-global? 
     global-vars 
@@ -127,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))
 
@@ -411,26 +400,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))
@@ -506,199 +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
-(define (expand exp env rename-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)
-                          ;,@(map 
-                          ;  ;; TODO: use extend env here?
-                          ;  (lambda (expr) (expand expr env rename-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)
-                            ,(if (if-else? exp)
-                                 (expand (if->else exp) env rename-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))
-           env rename-env))
-        (else
-         ;; TODO: for now, do not let a compiled macro be re-defined.
-         ;; this is a hack for performance compiling (scheme base)
-         (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)))))))
-    ((app? exp)
-     (cond
-       ((symbol? (car exp))
-        (let ((val (env:lookup (car exp) env #f)))
-          (if (tagged-list? 'macro val)
-            (expand ; Could expand into another macro
-              (macro:expand exp val env rename-env)
-              env rename-env)
-            (map
-              (lambda (expr) (expand expr env rename-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))
-          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)
-  (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))
-       ((define? this-exp)
-;(log this-exp)
-        (expand-body 
-          (cons
-            (expand this-exp env rename-env)
-            result)
-          (cdr exp)
-          env
-          rename-env))
-       ((or (define-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)
-            result)
-          (cdr exp)
-          env
-          rename-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)))
-       ((app? this-exp)
-        (cond
-          ((symbol? (caar exp))
-;(log (car this-exp))
-           (let ((val (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))
-              ;; No macro, use main expand function to process
-              (expand-body
-               (cons 
-                 (map
-                  (lambda (expr) (expand expr env rename-env))
-                  this-exp)
-                 result)
-               (cdr exp)
-               env
-               rename-env))))
-          (else
-;(log 'app)
-           (expand-body
-             (cons 
-               (map
-                (lambda (expr) (expand expr env rename-env))
-                this-exp)
-               result)
-             (cdr exp)
-             env
-             rename-env))))
-       (else
-        (error "unknown exp: " this-exp))))))
-
-
 ;; Top-level analysis
 
 ; Separate top-level defines (globals) from other expressions

scheme/cyclone/util.sld

@@ -11,12 +11,17 @@
           (scheme char))
   (export
     ;; Code analysis
+    define-syntax?
+    let-syntax?
+    letrec-syntax?
     tagged-list?
     if?
     if-syntax?
     begin?
     lambda?
     pair->list 
+    define-lambda? 
+    define->lambda 
     formals->list
     lambda-formals->list
     lambda-varargs?
@@ -120,7 +125,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) 
@@ -239,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))
@@ -629,6 +662,8 @@
    '(
      (define . define)
      (define-syntax . define-syntax)
+     (let-syntax . let-syntax)
+     (letrec-syntax . letrec-syntax)
      (define-c . define-c)
      (if . if)
      (lambda . lambda)

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
@@ -25,6 +26,17 @@
     %import
     imported?
     %set-import-dirs!
+    *defined-macros* 
+    get-macros
+    macro:macro?
+    macro:expand
+    macro:add!
+    macro:cleanup
+    macro:load-env!
+    macro:get-env
+    macro:get-defined-macros
+    expand 
+    expand-lambda-body
   )
   (inline
     primitive-implementation
@@ -43,6 +55,7 @@
     assignment-value
     assignment-variable
     variable?
+    macro:macro?
   )
   (begin
 
@@ -371,10 +384,10 @@
 ;; - env => Environment used to expand macros
 ;;
 (define (analyze exp env)
-;(newline)
+;;(newline)
-;(display "/* ")
+;;(display "/* ")
-;(write (list 'analyze exp))
+;;(write (list 'analyze exp))
-;(display " */")
+;;(display " */")
   (cond ((self-evaluating? exp) 
          (analyze-self-evaluating exp))
         ((quoted? exp) (analyze-quoted exp))
@@ -388,6 +401,12 @@
         ((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? 'letrec-syntax exp)
+              (not (null? (cdr exp))))
+         (analyze-letrec-syntax exp env))
         ((and (if? exp) 
               (not (null? (cdr exp))))
          (analyze-if exp env))
@@ -434,26 +453,63 @@
       (env:define-variable! var (vproc env) env)
       'ok)))
 
+(define (analyze-let-syntax exp a-env)
+  (let* ((rename-env (env:extend-environment '() '() '()))
+         (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?
+;;(display "/* ")
+;;(write `(DEBUG ,cleaned))
+;;(display "*/ ")
+;;(newline)
+    (analyze cleaned a-env)))
+
+(define (analyze-letrec-syntax exp a-env)
+  (let* ((rename-env (env:extend-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))
+         (cleaned (macro:cleanup expanded rename-env))
+        )
+    (analyze cleaned a-env)))
+
 (define (analyze-syntax exp a-env)
   (let ((var (cadr exp)))
     (cond
-      ((tagged-list? 'er-macro-transformer (caddr exp))
+      ((tagged-list? 'er-macro-transformer (caddr exp)) ;; TODO: need to handle renamed er symbol here??
-        (let ((sproc (make-macro (cadr (caddr exp))))) ;(analyze-syntax-lambda (cadr (caddr exp)) a-env)))
+        (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
+        ;; Just expand the syntax rules
-        ;; building a macro. maybe call into something like 
+        ;; Possibly want to check the macro system here
-        ;; analyze-syntax-lambda instead of erroring here
+        (let* ((rename-env (env:extend-environment '() '() '()))
-        (error "macro syntax not supported yet")))))
+               (expanded (expand exp a-env rename-env))
-
+               (cleaned (macro:cleanup expanded rename-env)))
-;(define (analyze-syntax-lambda exp a-env)
+          (let ((sproc (make-macro (caddr cleaned))))
-;  (let ((vars (lambda-parameters exp))
+            (lambda (env)
-;        (bproc (analyze-sequence (lambda-body exp) a-env)))
+              (env:define-variable! var sproc env)
-;    (write `(debug ,(lambda-body exp)))
+              'ok)))))))
-;    ;(lambda (env) 
-;      (make-macro `(lambda ,vars ,@(lambda-body exp)))))
 
 (define (analyze-import exp env)
   (lambda (env)
@@ -663,4 +719,455 @@
   " 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
+
+;; 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
+
+(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)
+;;(display "/* ")
+;;(write `(expand ,exp))
+;;(display "*/ ")
+;;(newline)
+  (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
+        ((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))
+        (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)))
+;(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
+                        ;; 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))
+           )
+;(trace:error `(let-syntax ,new-local-macro-env))
+       (_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env 
+       ))
+    ((letrec-syntax? exp)
+     (let* ((body (cons 'begin (cddr exp)))
+            (body-env (env:extend-environment '() '() env))
+            (bindings (cadr exp))
+           )
+       (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)
+       ))
+    ((app? exp)
+     (cond
+       ((symbol? (car exp))
+        (let ((val (let ((local (assoc (car exp) local-env)))
+                     (if local
+                         (cdr local)
+                         (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 ,env ,local-env ,rename-env ,(env:lookup (car exp) env #f)))
+;;(display "*/ ")
+;;(newline)
+          (cond
+           ((tagged-list? 'macro val)
+            (_expand ; Could expand into another macro
+              (macro:expand exp val env rename-env)
+              env 
+              rename-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))
+;; 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))
+              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))))
+
+(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))
+
+;; 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)
+            (letrec-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))
+
   ))

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))
+  ))

tests/let-syntax-298.scm

@@ -0,0 +1,18 @@
+;; From:
+;; https://github.com/ashinn/chibi-scheme/issues/298
+(import (scheme base) (scheme write))
+
+(define-syntax bar
+  (syntax-rules ()
+    ((_)
+     (let-syntax ((foo (syntax-rules () ((_) 'ok))))
+       (foo)))))
+
+(define-syntax foo (syntax-rules () ((_) 'foo)))
+
+(write
+(bar)
+)
+(write
+(foo) 
+)

tests/let-syntax.scm

@@ -1,4 +1,143 @@
-(import (scheme base) (scheme write))
+(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-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
+;; 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)
+            ((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
+
+;; 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)
+            ((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
+)
+
+
+;; From Chibi - isn't this a bug though?
+;(write
+;(let ()
+;  (letrec-syntax ()
+;    (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
+     ;;(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
+    ()
+    ((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 ...)
@@ -9,17 +148,19 @@
 ;; (given-that if (set! if 'now))
 ;; if)) ;; => now
 
-;;(let ((x 'outer))
+(write
-;;  (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
+  (let-syntax ((m (syntax-rules () ((m) x))))
-   (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

tests/when.scm

@@ -0,0 +1,103 @@
+(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))))))
+
+
+;; 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-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 #t #f))
+(write (symbol?? "a" #t #f))
+
+(write
+  (let-syntax 
+    ((second
+      (syntax-rules ()
+        ((second a b c)
+         b))))
+    (second 33 44 55)))
+
+(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
+;  (my-when2 '(my-when2 "testing" 1) (lambda (a) a) (lambda X #f)))

tmp-macro-test.scm

@@ -0,0 +1,26 @@
+;; 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* (
+(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
+)
+  (write (list vars vals zipped defined-macros macro-env)))