mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
Relocating code
This commit is contained in:
Justin Ethier
parent
eac413a2f5
commit
c5271f05fe
2 changed files with 142 additions and 140 deletions
|
|
@ -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
|
||||
))
|
||||
|
|
|
|||
142
scheme/eval.sld
142
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
|
||||
))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue