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

* install-library now takes all 11 arguments!

This commit is contained in:
Abdulaziz Ghuloum 2007-05-07 04:54:10 -04:00
parent 8226619438
commit 036292f3fc
2 changed files with 23 additions and 30 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.

53
src/ikarus.library-manager.ss
View File

@ -65,36 +65,29 @@
(define label->binding-table (make-hash-table))
(define install-library
(case-lambda
; [(id name ver imp* vis* inv* exp-subst exp-env
; visit-code invoke-code)
; (install-library id name ver imp* vis* inv* exp-subst exp-env
; visit-code invoke-code #t)]
[(id name ver imp* vis* inv* exp-subst exp-env
visit-code invoke-code visible?)
(let ([imp-lib* (map find-library-by-spec/die imp*)]
[vis-lib* (map find-library-by-spec/die vis*)]
[inv-lib* (map find-library-by-spec/die inv*)])
(unless (and (symbol? id) (list? name) (list? ver))
(error 'install-library "invalid spec ~s ~s ~s" id name ver))
(when (library-exists? name)
(error 'install-library "~s is already installed" name))
(let ([lib (make-library id name ver imp-lib* vis-lib* inv-lib*
exp-subst exp-env visit-code invoke-code
visible?)])
(for-each
(lambda (x)
(let ([label (car x)] [binding (cdr x)])
(let ([binding
(case (car binding)
[(global)
(cons 'global (cons lib (cdr binding)))]
[else binding])])
(put-hash-table! label->binding-table label binding))))
exp-env)
((current-library-collection) lib)
lib))]))
(define (install-library id name ver imp* vis* inv*
exp-subst exp-env visit-code invoke-code visible?)
(let ([imp-lib* (map find-library-by-spec/die imp*)]
[vis-lib* (map find-library-by-spec/die vis*)]
[inv-lib* (map find-library-by-spec/die inv*)])
(unless (and (symbol? id) (list? name) (list? ver))
(error 'install-library "invalid spec ~s ~s ~s" id name ver))
(when (library-exists? name)
(error 'install-library "~s is already installed" name))
(let ([lib (make-library id name ver imp-lib* vis-lib* inv-lib*
exp-subst exp-env visit-code invoke-code
visible?)])
(for-each
(lambda (x)
(let ([label (car x)] [binding (cdr x)])
(let ([binding
(case (car binding)
[(global)
(cons 'global (cons lib (cdr binding)))]
[else binding])])
(put-hash-table! label->binding-table label binding))))
exp-env)
((current-library-collection) lib))))
(define (imported-label->binding lab)
(get-hash-table label->binding-table lab #f))