* 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)]
[$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)]
[installed-libraries installed-libraries-label (core-prim . installed-libraries)]
))
;;; install a null environment that has nothing and gets generated
;;; afresh everytime ikarus is run. just for the heck of it
(lm:install-library (gensym) ;;; id
'(one-shot) ;;; name
'() ;;; version
'() ;;; import libs
'() ;;; visit libs
'() ;;; invoke libs
'() ;;; subst
'() ;;; env
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)
(let ([subst
(map (lambda (x) (cons (car x) (cadr x))) scheme-env)]
[env
(map (lambda (x) (cons (cadr x) (caddr x))) scheme-env)])
(lm:install-library 'scheme-id ;;; id
'(scheme) ;;; name
'() ;;; version
'() '() '() ;;; req
subst env
void void))
(primitive-set! 'installed-libraries
(lambda () *all-libraries*))
(primitive-set! 'install-library lm:install-library))

View File

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

View File

@ -73,7 +73,10 @@
(let ([subst (map cons name* label*)]
[env (map (lambda (name label type loc)
(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
"invalid export type ~s for ~s"
type name)]))
@ -88,8 +91,8 @@
'() ;;; import libs
'() ;;; visit libs
'() ;;; invoke libs
',subst
',env
',subst ;;; substitution
',env ;;; environment
void void)))))
(define (expand-all ls)