* unified the two library-expanders into one procedure

* made boot-library-expander install the library in the 
  current-library-collection.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-04 02:33:58 -04:00
parent 6922733809
commit 8d19b91270
4 changed files with 31 additions and 19 deletions

Binary file not shown.

View File

@ -19,7 +19,7 @@
(primitive-set! 'string->flonum string->flonum)
))
(library (ikarus flonums)
(library (ikarus generic-arithmetic)
(export)
(import (scheme))

View File

@ -1,4 +1,15 @@
#| current-library-collection procedure
Calling (current-library-collection) returns a procedure that:
- when called with no arguments, it returns a list of the set
of
libraries in the collection.
- when called with a single argument, it adds that library to
the set of libraries in the collection.
Calling (current-library-collection f) sets the current library
collection to be the procedure f which must follow the protocol
above.
|#

View File

@ -2023,25 +2023,24 @@
name imp* (rtc)
(build-letrec no-source lex* rhs* body)
export-subst export-env))))))))))))
(define run-library-expander
(lambda (x)
(let-values ([(name imp* run* invoke-code export-subst export-env)
(core-library-expander x)])
(let ([id (gensym)]
[name name]
[ver '()] ;;; FIXME
[imp* (map library-spec imp*)]
[vis* '()] ;;; FIXME
[inv* (map library-spec run*)])
(install-library id name ver
imp* vis* inv* export-subst export-env
void ;;; FIXME
(lambda () (eval-core invoke-code)))))))
(define boot-library-expander
(lambda (x)
(let-values ([(name imp* run* invoke-code export-subst export-env)
(define (library-expander x)
(let-values ([(name imp* run* invoke-code export-subst export-env)
(core-library-expander x)])
(let ([id (gensym)]
[name name]
[ver '()] ;;; FIXME
[imp* (map library-spec imp*)]
[vis* '()] ;;; FIXME
[inv* (map library-spec run*)])
(install-library id name ver
imp* vis* inv* export-subst export-env
void ;;; FIXME
(lambda () (eval-core invoke-code)))
(values invoke-code export-subst export-env))))
(define (boot-library-expander x)
(let-values ([(invoke-code export-subst export-env)
(library-expander x)])
(values invoke-code export-subst export-env)))
(define build-export
(lambda (x)
;;; exports use the same gensym
@ -2091,7 +2090,9 @@
(unless (pair? x)
(error #f "invalid expression at top-level ~s" x))
(case (car x)
[(library) (run-library-expander x)]
[(library)
(library-expander x)
(void)]
[(invoke)
(syntax-match x ()
[(_ (id** ...) ...)