From e9c5e873bd3001b1076eaec48e77a3671c66244d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 26 Aug 2015 22:49:52 -0400 Subject: [PATCH] Refactoring ER code --- scheme/cyclone/macros.sld | 20 +++--------- scheme/cyclone/transforms.sld | 21 ------------- scheme/cyclone/util.sld | 58 +++++++++++++++++++++++++++++++++++ scheme/eval.sld | 16 +++------- 4 files changed, 67 insertions(+), 48 deletions(-) diff --git a/scheme/cyclone/macros.sld b/scheme/cyclone/macros.sld index 4d3b98c2..fb027804 100644 --- a/scheme/cyclone/macros.sld +++ b/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* ( - ;; 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)) + (let* ((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 - compare?)) + Cyc-er-rename + 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 - compare?) + Cyc-er-rename + Cyc-er-compare?) env)))))) ; TODO: get macro name, transformer diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 8472500a..89a199b4 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -34,7 +34,6 @@ cyc:error basename list-index - 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 boolean (define (symbolstring sym1) diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld index 4a5c1a0f..f942c879 100644 --- a/scheme/cyclone/util.sld +++ b/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. diff --git a/scheme/eval.sld b/scheme/eval.sld index 74717455..6dfbe6a3 100644 --- a/scheme/eval.sld +++ b/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 - compare?)) + Cyc-er-rename + 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 - compare?)))) + Cyc-er-rename + Cyc-er-compare?)))) (analyze (eval expr a-env) ;; Expand macro a-env))))))