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

* the expander now creates a visit-time-collector that's supposed to 

collect the visit-time requirements.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-07 21:11:28 -04:00
parent 6b39f738a0
commit 795f87b499
2 changed files with 20 additions and 10 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.

30
src/ikarus.syntax.ss
View File

@ -1652,7 +1652,7 @@
[(global) [(global)
(let* ([lib (car value)] (let* ([lib (car value)]
[loc (cdr value)]) [loc (cdr value)])
((run-collector) lib) ((inv-collector) lib)
(build-global-reference no-source loc))] (build-global-reference no-source loc))]
[(core-prim) [(core-prim)
(let ([name value]) (let ([name value])
@ -2153,13 +2153,21 @@
(case-lambda (case-lambda
[() ls] [() ls]
[(x) (set! ls (set-cons x ls))]))) [(x) (set! ls (set-cons x ls))])))
(define run-collector (define inv-collector
(make-parameter (make-parameter
(lambda args (lambda args
(error 'run-collector "not initialized")) (error 'inv-collector "not initialized"))
(lambda (x) (lambda (x)
(unless (procedure? x) (unless (procedure? x)
(error 'run-collector "~s is not a procedure" x)) (error 'inv-collector "~s is not a procedure" x))
x)))
(define vis-collector
(make-parameter
(lambda args
(error 'vis-collector "not initialized"))
(lambda (x)
(unless (procedure? x)
(error 'vis-collector "~s is not a procedure" x))
x))) x)))
(define core-library-expander (define core-library-expander
(lambda (e) (lambda (e)
@ -2169,8 +2177,10 @@
(let ([b* (map (lambda (x) (stx x top-mark* (list rib))) b*)] (let ([b* (map (lambda (x) (stx x top-mark* (list rib))) b*)]
[kwd* (map (lambda (sym mark*) (stx sym mark* (list rib))) [kwd* (map (lambda (sym mark*) (stx sym mark* (list rib)))
(rib-sym* rib) (rib-mark** rib))] (rib-sym* rib) (rib-mark** rib))]
[rtc (make-collector)]) [rtc (make-collector)]
(parameterize ([run-collector rtc]) [vtc (make-collector)])
(parameterize ([inv-collector rtc]
[vis-collector vtc])
(let-values ([(init* r mr lex* rhs*) (let-values ([(init* r mr lex* rhs*)
(chi-library-internal b* rib kwd*)]) (chi-library-internal b* rib kwd*)])
(seal-rib! rib) (seal-rib! rib)
@ -2185,7 +2195,7 @@
(let-values ([(export-subst export-env macro*) (let-values ([(export-subst export-env macro*)
(find-exports exp-int* exp-ext* rib r)]) (find-exports exp-int* exp-ext* rib r)])
(values (values
name imp* (rtc) name imp* (rtc) (vtc)
(build-letrec no-source lex* rhs* invoke-body) (build-letrec no-source lex* rhs* invoke-body)
macro* macro*
export-subst export-env)))))))))))) export-subst export-env))))))))))))
@ -2203,14 +2213,14 @@
(build-global-assignment no-source loc src))) (build-global-assignment no-source loc src)))
macro*)))) macro*))))
(define (library-expander x) (define (library-expander x)
(let-values ([(name imp* run* invoke-code macro* export-subst export-env) (let-values ([(name imp* inv* vis* invoke-code macro* export-subst export-env)
(core-library-expander x)]) (core-library-expander x)])
(let ([id (gensym)] (let ([id (gensym)]
[name name] [name name]
[ver '()] ;;; FIXME [ver '()] ;;; FIXME
[imp* (map library-spec imp*)] [imp* (map library-spec imp*)]
[vis* '()] ;;; FIXME [vis* (map library-spec vis*)]
[inv* (map library-spec run*)]) [inv* (map library-spec inv*)])
(install-library id name ver (install-library id name ver
imp* vis* inv* export-subst export-env imp* vis* inv* export-subst export-env
(lambda () (visit! macro*)) (lambda () (visit! macro*))