* added initial code for a library manager
This commit is contained in:
parent
8383fd79d6
commit
896a4408fd
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -0,0 +1,53 @@
|
|||
|
||||
(library (ikarus library-manager)
|
||||
(export)
|
||||
(import (scheme))
|
||||
|
||||
(define-record library
|
||||
(id name ver imp* vis* inv* exp-subst exp-env visit-state invoke-state))
|
||||
|
||||
(define (find-dependencies ls)
|
||||
(cond
|
||||
[(null? ls) '()]
|
||||
[else (error 'find-dependencies "cannot handle deps yet")]))
|
||||
|
||||
(define *all-libraries* '())
|
||||
|
||||
(define (find-library-by pred)
|
||||
(let f ([ls *all-libraries*])
|
||||
(cond
|
||||
[(null? ls) #f]
|
||||
[(pred (car ls)) (car ls)]
|
||||
[else (f (cdr ls))])))
|
||||
|
||||
(define (find-library-by-name name)
|
||||
(find-library-by
|
||||
(lambda (x) (equal? (library-name x) name))))
|
||||
|
||||
(define (find-library-by-name/die name)
|
||||
(or (find-library-by-name name)
|
||||
(error #f "cannot find library ~s" name)))
|
||||
|
||||
(define (lm:install-library id name ver
|
||||
imp* vis* inv* exp-subst exp-env visit-code invoke-code)
|
||||
(let ([imp-lib* (map find-library-by-name/die imp*)]
|
||||
[vis-lib* (map find-library-by-name/die vis*)]
|
||||
[inv-lib* (map find-library-by-name/die inv*)])
|
||||
(unless (and (symbol? id) (list? name) (list? ver))
|
||||
(error 'install-library "invalid spec ~s ~s ~s" id name ver))
|
||||
(when (find-library-by-name 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)])
|
||||
(set! *all-libraries* (cons lib *all-libraries*)))))
|
||||
(lm:install-library (gensym "null") ;;; id
|
||||
'(null) '() ;;; name/version
|
||||
'() ;;; import libs
|
||||
'() ;;; visit libs
|
||||
'() ;;; invoke libs
|
||||
'() ;;; subst
|
||||
'() ;;; env
|
||||
void void)
|
||||
;(printf "ALL LIBRARIES:\n~s\n" *all-libraries*)
|
||||
(primitive-set! 'install-library lm:install-library)
|
||||
)
|
|
@ -940,7 +940,8 @@
|
|||
[new-cafe new-cafe-label (core-prim . new-cafe)]
|
||||
[command-line-arguments command-line-arguments-label (core-prim . command-line-arguments)]
|
||||
[list*->code* list*->code*-label (core-prim . list*->code*)]
|
||||
[primitive-location primitive-location-label (core-prim . primitive-location)]
|
||||
;[primitive-location primitive-location-label (core-prim . primitive-location)]
|
||||
[install-library install-library-label (core-prim . install-library)]
|
||||
;;; record/mid-level
|
||||
[record? record?-label (core-prim . record?)]
|
||||
[make-record-type make-record-type-label (core-prim . make-record-type)]
|
||||
|
@ -1017,6 +1018,7 @@
|
|||
[$frame->continuation $frame->continuation-label (core-prim . $frame->continuation)]
|
||||
[$current-frame $current-frame-label (core-prim . $current-frame)]
|
||||
[$seal-frame-and-call $seal-frame-and-call-label (core-prim . $seal-frame-and-call)]
|
||||
[foo foo-label (core-prim . foo)]
|
||||
))
|
||||
(define make-scheme-rib
|
||||
(lambda ()
|
||||
|
|
|
@ -5,10 +5,10 @@
|
|||
;;; Finally, we're ready to evaluate the files and enter the cafe.
|
||||
|
||||
(library (ikarus interaction)
|
||||
(export foo)
|
||||
(export bar)
|
||||
(import (scheme))
|
||||
|
||||
(define foo 'i-am-an-exported-primitive-named-foo)
|
||||
(define bar 'i-am-an-exported-primitive-named-foo)
|
||||
(define sc-expand
|
||||
(lambda (x)
|
||||
(if (and (pair? x) (equal? (car x) "noexpand"))
|
||||
|
|
|
@ -43,6 +43,7 @@
|
|||
"libcafe.ss"
|
||||
"libposix.ss"
|
||||
"libtimers.ss"
|
||||
"library-manager.ss"
|
||||
"libtoplevel.ss"))
|
||||
|
||||
(define (read-file file)
|
||||
|
@ -80,7 +81,8 @@
|
|||
[else #f])))]
|
||||
[else #f]))
|
||||
(lambda (x)
|
||||
(if (procedure? x) x
|
||||
(if (procedure? x)
|
||||
x
|
||||
(error 'primitive-location
|
||||
"~s is not a procedure" x)))))))
|
||||
|
||||
|
|
Loading…
Reference in New Issue