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

* library manager exports library-name/id/version prims

This commit is contained in:
Abdulaziz Ghuloum 2007-05-02 19:19:37 -04:00
parent eb0d58f2aa
commit 63d35807c1
3 changed files with 43 additions and 37 deletions

BIN
src/ikarus.boot
View File

Binary file not shown.

7
src/library-manager.ss
View File

@ -488,6 +488,9 @@
[library-subst/env library-subst/env-label (core-prim . library-subst/env)] [library-subst/env library-subst/env-label (core-prim . library-subst/env)]
[find-library-by-name find-library-by-name-label (core-prim . find-library-by-name)] [find-library-by-name find-library-by-name-label (core-prim . find-library-by-name)]
[imported-label->binding imported-label->binding-label (core-prim . imported-label->binding)] [imported-label->binding imported-label->binding-label (core-prim . imported-label->binding)]
[xlibrary-id xlibrary-id-label (core-prim . xlibrary-id)]
[xlibrary-name xlibrary-name-label (core-prim . xlibrary-name)]
[xlibrary-version xlibrary-version-label (core-prim . xlibrary-version)]
)) ))
(define (lm:imported-label->binding lab) (define (lm:imported-label->binding lab)
(let f ([ls *all-libraries*]) (let f ([ls *all-libraries*])
@ -513,6 +516,10 @@
(unless (library? x) (unless (library? x)
(error 'library-subst/env "~s is not a library" x)) (error 'library-subst/env "~s is not a library" x))
(values (library-subst x) (library-env x)))) (values (library-subst x) (library-env x))))
(primitive-set! 'xlibrary-id library-id)
(primitive-set! 'xlibrary-name library-name)
(primitive-set! 'xlibrary-version library-ver)
(primitive-set! 'find-library-by-name lm:find-library-by-name) (primitive-set! 'find-library-by-name lm:find-library-by-name)
(primitive-set! 'imported-label->binding lm:imported-label->binding) (primitive-set! 'imported-label->binding lm:imported-label->binding)
(primitive-set! 'install-library lm:install-library)) (primitive-set! 'install-library lm:install-library))

21
src/libsyntax.ss
View File

@ -1985,7 +1985,9 @@
(let ([rib (make-top-rib subst)]) (let ([rib (make-top-rib subst)])
(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)])
(parameterize ([run-collector rtc])
(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*)])
(let ([rhs* (chi-rhs* rhs* r mr)]) (let ([rhs* (chi-rhs* rhs* r mr)])
@ -1996,20 +1998,19 @@
(map build-export lex*) (map build-export lex*)
(chi-expr* init* r mr))))]) (chi-expr* init* r mr))))])
(values (values
name imp* name imp* (rtc)
(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 run-library-expander (define run-library-expander
(lambda (x) (lambda (x)
(let ([rtc (make-collector)]) (let-values ([(name imp* run* invoke-code exp*)
(parameterize ([run-collector rtc])
(let-values ([(name imp* invoke-code exp*)
(core-library-expander x)]) (core-library-expander x)])
;;; we need: name/ver/id, ;;; we need: name/ver/id,
;;; imports, visit, invoke name/ver/id ;;; imports, visit, invoke name/ver/id
;;; export-subst, export-env ;;; export-subst, export-env
;;; visit-code, invoke-code ;;; visit-code, invoke-code
(let ([id (gensym)] (let ([id (gensym)]
[name name]
[ver '()] [ver '()]
[exp-subst [exp-subst
(map (lambda (x) (cons (car x) (cadr x))) exp*)] (map (lambda (x) (cons (car x) (cadr x))) exp*)]
@ -2018,14 +2019,12 @@
(let ([label (cadr x)] [type (caddr x)] [val (cadddr x)]) (let ([label (cadr x)] [type (caddr x)] [val (cadddr x)])
(cons label (cons type val)))) (cons label (cons type val))))
exp*)]) exp*)])
invoke-code)))))) invoke-code))))
(define boot-library-expander (define boot-library-expander
(lambda (x) (lambda (x)
(let ([rtc (make-collector)]) (let-values ([(name imp* run* invoke-code exp*)
(parameterize ([run-collector rtc])
(let-values ([(name imp* invoke-code exp*)
(core-library-expander x)]) (core-library-expander x)])
(values invoke-code exp*)))))) (values invoke-code exp*))))
(define build-export (define build-export
(lambda (x) (lambda (x)
;;; exports use the same gensym ;;; exports use the same gensym