Refactoring ER code

scheme/cyclone/macros.sld

@@ -29,17 +29,7 @@
 
     (define (macro:macro? exp defined-macros) (assoc (car exp) defined-macros))
     (define (macro:expand exp defined-macros)
-      (let* (
+      (let* ((macro (assoc (car exp) defined-macros))
-             ;; TODO: not good enough, need to actually rename, 
-             ;; and keep same results if
-             ;; the same symbol is renamed more than once
-             (rename (lambda (sym) 
-                       sym))       
-             ;; TODO: the compare function from exrename.
-             ;; this may need to be more sophisticated
-             (compare? (lambda (sym-a sym-b)  
-                          (eq? sym-a sym-b))) 
-             (macro (assoc (car exp) defined-macros))
              (compiled-macro? (or (macro? (Cyc-get-cvar (cdr macro)))
                                   (procedure? (cdr macro)))))
           ;; Invoke ER macro
@@ -49,8 +39,8 @@
             (compiled-macro?
               ((Cyc-get-cvar (cdr macro))
                 exp
-                rename
+                Cyc-er-rename
-                compare?))
+                Cyc-er-compare?))
             (else
               ;; Assume evaluated macro
               (let* ((env-vars (map car defined-macros))
@@ -63,8 +53,8 @@
                   (list
                     (cdr macro)
                     (list 'quote exp)
-                    rename
+                    Cyc-er-rename
-                    compare?)
+                    Cyc-er-compare?)
                   env))))))
 
     ; TODO: get macro name, transformer

scheme/cyclone/transforms.sld

@@ -34,7 +34,6 @@
     cyc:error
     basename
     list-index
-    gensym
     symbol<? 
     insert
     remove 
@@ -203,26 +202,6 @@
     (define (void) (if #f #t)))
   (else #f))
 
-; gensym-count : integer
-(define gensym-count 0)
-
-; gensym : symbol -> symbol
-(define gensym (lambda params
-                 (if (null? params)
-                     (begin
-                       (set! gensym-count (+ gensym-count 1))
-                       (string->symbol (string-append
-                                        "$"
-                                        (number->string gensym-count))))
-                     (begin
-                       (set! gensym-count (+ gensym-count 1))
-                       (string->symbol (string-append 
-                                        (if (symbol? (car params))
-                                            (symbol->string (car params))
-                                            (car params))
-                                        "$"
-                                        (number->string gensym-count)))))))
-
 ; symbol<? : symbol symobl -> boolean
 (define (symbol<? sym1 sym2)
   (string<? (symbol->string sym1)

scheme/cyclone/util.sld

@@ -15,10 +15,14 @@
     if?
     begin?
     lambda?
+    ;; ER macro supporting functions
+    Cyc-er-rename
+    Cyc-er-compare?
     ;; Code generation
     mangle
     mangle-global
     ;; Scheme library functions
+    gensym
     delete
     delete-duplicates
     list-insert-at!
@@ -94,6 +98,60 @@
    (else
     (list-insert-at! (cdr lis) obj (- k 1)))))
 
+; gensym-count : integer
+(define gensym-count 0)
+
+; gensym : symbol -> symbol
+(define gensym (lambda params
+                 (if (null? params)
+                     (begin
+                       (set! gensym-count (+ gensym-count 1))
+                       (string->symbol (string-append
+                                        "$"
+                                        (number->string gensym-count))))
+                     (begin
+                       (set! gensym-count (+ gensym-count 1))
+                       (string->symbol (string-append 
+                                        (if (symbol? (car params))
+                                            (symbol->string (car params))
+                                            (car params))
+                                        "$"
+                                        (number->string gensym-count)))))))
+
+;;; Explicit renaming macros
+
+;; ER macro rename function, based on code from Chibi scheme
+(define Cyc-er-rename
+  (lambda (sym) sym)) ; placeholder
+; TODO:
+;  ;; TODO: this is not good enough, need to take macro environment
+;  ;; into account
+;  ((lambda (renames)
+;     (lambda (identifier)
+;       ((lambda (cell)
+;          (if cell
+;              (cdr cell)
+;              ((lambda (name)
+;                 (set! renames (cons (cons identifier name) renames))
+;                 name)
+;               (gensym identifier)
+;               ;(make-syntactic-closure mac-env '() identifier)
+;              )))
+;        (assq identifier renames))))
+;   ;; TODO: For now, do not allow renaming of special form symbols to 
+;   ;; prevent issues within the compiler
+;   '(
+;     (define . define)
+;     (define-syntax . define-syntax)
+;     (if . if)
+;     (lambda . lambda)
+;     (quote . quote)
+;     (set! . set!)
+;    )))
+(define (Cyc-er-compare? a b)
+  ;; TODO: this is not good enough, need to determine if these symbols
+  ;; are the same identifier in their *environment of use*
+  (eq? a b))
 
 ;; Name-mangling.
 

scheme/eval.sld

@@ -454,30 +454,22 @@
                   (_lookup-variable-value op a-env
                     (lambda () #f)) ; Not found
                   #f))
-;; TODO: need to use common rename/compare functions
-;; instead of fudging them here. maybe keep common
-;; functions in the macros module and hook into them???
-;;
-;; see macro-expand in that module. believe these are the only
-;; two places so far that introduce instances of rename/compare?
-         (rename (lambda (sym) sym))
-         (compare? (lambda (a b) (eq? a b))) 
          (expand 
            (lambda (macro-op)
              (if (macro? macro-op)
                ;; Compiled macro, call directly
                (analyze (apply macro-op
                               (list (cons (car exp) (operands exp))
-                                    rename
+                                    Cyc-er-rename
-                                    compare?)) 
+                                    Cyc-er-compare?)) 
                         a-env)
                ;; Interpreted macro, build expression and eval
                (let ((expr (cons macro-op 
                              (list (cons 'quote 
                                          (list (cons (car exp) 
                                                      (operands exp))))
-                                   rename
+                                   Cyc-er-rename
-                                   compare?))))
+                                   Cyc-er-compare?))))
                  (analyze
                    (eval expr a-env) ;; Expand macro
                    a-env))))))