conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* still working on the run-library-expander

This commit is contained in:
Abdulaziz Ghuloum 2007-05-02 19:07:48 -04:00
parent 1fdce919d7
commit eb0d58f2aa
2 changed files with 23 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

31
src/libsyntax.ss
View File

@ -1996,21 +1996,36 @@
(map build-export lex*) (map build-export lex*)
(chi-expr* init* r mr))))]) (chi-expr* init* r mr))))])
(values (values
name name imp*
(build-letrec no-source lex* rhs* body) (build-letrec no-source lex* rhs* body)
(map (find-export rib r) exp*))))))))))) (map (find-export rib r) exp*)))))))))))
(define library-expander (define run-library-expander
(lambda (x) (lambda (x)
(let ([rtc (make-collector)]) (let ([rtc (make-collector)])
(parameterize ([run-collector rtc]) (parameterize ([run-collector rtc])
(let-values ([(name invoke-code export-subst) (let-values ([(name imp* invoke-code exp*)
(core-library-expander x)]) (core-library-expander x)])
invoke-code))))) ;;; we need: name/ver/id,
;;; imports, visit, invoke name/ver/id
;;; export-subst, export-env
;;; visit-code, invoke-code
(let ([id (gensym)]
[ver '()]
[exp-subst
(map (lambda (x) (cons (car x) (cadr x))) exp*)]
[exp-env
(map (lambda (x)
(let ([label (cadr x)] [type (caddr x)] [val (cadddr x)])
(cons label (cons type val))))
exp*)])
invoke-code))))))
(define boot-library-expander (define boot-library-expander
(lambda (x) (lambda (x)
(let-values ([(name invoke-code exp*) (let ([rtc (make-collector)])
(core-library-expander x)]) (parameterize ([run-collector rtc])
(values invoke-code exp*)))) (let-values ([(name imp* invoke-code exp*)
(core-library-expander x)])
(values invoke-code exp*))))))
(define build-export (define build-export
(lambda (x) (lambda (x)
;;; exports use the same gensym ;;; exports use the same gensym
@ -2051,7 +2066,7 @@
(strip x '())))) (strip x '()))))
(primitive-set! 'syntax-dispatch syntax-dispatch) (primitive-set! 'syntax-dispatch syntax-dispatch)
(primitive-set! 'boot-library-expand boot-library-expander) (primitive-set! 'boot-library-expand boot-library-expander)
(primitive-set! 'chi-top-library library-expander)) (primitive-set! 'chi-top-library run-library-expander))