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