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

* Added an imported-binding->label primitive to the library manager

This commit is contained in:
Abdulaziz Ghuloum 2007-05-02 18:13:31 -04:00
parent 402f6e48ed
commit 7aa29c5a00
2 changed files with 9 additions and 2 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.

11
src/library-manager.ss
View File

@ -487,14 +487,20 @@
[installed-libraries installed-libraries-label (core-prim . installed-libraries)] [installed-libraries installed-libraries-label (core-prim . installed-libraries)]
[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)]
)) ))
(define (lm:imported-label->binding lab)
(let f ([ls *all-libraries*])
(cond
[(null? ls) #f]
[(assq lab (library-env (car ls))) => cdr]
[else (f (cdr ls))])))
(let ([subst (let ([subst
(map (lambda (x) (cons (car x) (cadr x))) scheme-env)] (map (lambda (x) (cons (car x) (cadr x))) scheme-env)]
[env [env
(map (lambda (x) (cons (cadr x) (caddr x))) scheme-env)]) (map (lambda (x) (cons (cadr x) (caddr x))) scheme-env)])
(lm:install-library 'scheme-id ;;; id (lm:install-library 'scheme-id ;;; id
'(scheme) ;;; name '(scheme) ;;; name
'() ;;; version '() ;;; version
'() '() '() ;;; req '() '() '() ;;; req
subst env subst env
@ -508,4 +514,5 @@
(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! '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! 'install-library lm:install-library)) (primitive-set! 'install-library lm:install-library))