mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
Refactoring ER code
This commit is contained in:
Justin Ethier
parent
36b3ab745e
commit
e9c5e873bd
4 changed files with 67 additions and 48 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue