* Added installed-libraries prim.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-02 16:55:54 -04:00
parent 4df202261b
commit ef4bb0951e
4 changed files with 20 additions and 28 deletions

Binary file not shown.

View File

@ -484,32 +484,20 @@
[$frame->continuation $frame->continuation-label (core-prim . $frame->continuation)] [$frame->continuation $frame->continuation-label (core-prim . $frame->continuation)]
[$current-frame $current-frame-label (core-prim . $current-frame)] [$current-frame $current-frame-label (core-prim . $current-frame)]
[$seal-frame-and-call $seal-frame-and-call-label (core-prim . $seal-frame-and-call)] [$seal-frame-and-call $seal-frame-and-call-label (core-prim . $seal-frame-and-call)]
[foo foo-label (core-prim . foo)] [installed-libraries installed-libraries-label (core-prim . installed-libraries)]
)) ))
;;; install a null environment that has nothing and gets generated (let ([subst
;;; afresh everytime ikarus is run. just for the heck of it (map (lambda (x) (cons (car x) (cadr x))) scheme-env)]
(lm:install-library (gensym) ;;; id [env
'(one-shot) ;;; name (map (lambda (x) (cons (cadr x) (caddr x))) scheme-env)])
'() ;;; version (lm:install-library 'scheme-id ;;; id
'() ;;; import libs '(scheme) ;;; name
'() ;;; visit libs '() ;;; version
'() ;;; invoke libs '() '() '() ;;; req
'() ;;; subst subst env
'() ;;; env void void))
void void)
;;; we also install the system library that has all the junk that
;;; the system provides.
(lm:install-library 'systemlib ;;; id
'(scheme) ;;; name
'() ;;; version
'() ;;; import libs
'() ;;; visit libs
'() ;;; invoke libs
'() ;;; subst
'() ;;; env
void void)
(primitive-set! 'installed-libraries
(lambda () *all-libraries*))
(primitive-set! 'install-library lm:install-library)) (primitive-set! 'install-library lm:install-library))

View File

@ -926,6 +926,7 @@
[list*->code* list*->code*-label (core-prim . list*->code*)] [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)] [install-library install-library-label (core-prim . install-library)]
[installed-libraries installed-libraries-label (core-prim . installed-libraries)]
;;; record/mid-level ;;; record/mid-level
[record? record?-label (core-prim . record?)] [record? record?-label (core-prim . record?)]
[make-record-type make-record-type-label (core-prim . make-record-type)] [make-record-type make-record-type-label (core-prim . make-record-type)]

View File

@ -73,7 +73,10 @@
(let ([subst (map cons name* label*)] (let ([subst (map cons name* label*)]
[env (map (lambda (name label type loc) [env (map (lambda (name label type loc)
(case type (case type
[(global) (cons label (cons type loc))] [(global)
;;; install the new exports as prims
;;; of the new system
(cons label (cons 'core-prim name))]
[else (error 'make-system-library [else (error 'make-system-library
"invalid export type ~s for ~s" "invalid export type ~s for ~s"
type name)])) type name)]))
@ -88,8 +91,8 @@
'() ;;; import libs '() ;;; import libs
'() ;;; visit libs '() ;;; visit libs
'() ;;; invoke libs '() ;;; invoke libs
',subst ',subst ;;; substitution
',env ',env ;;; environment
void void))))) void void)))))
(define (expand-all ls) (define (expand-all ls)