conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

library record now contains original file name for libraries loaded 

from files.
This commit is contained in:
Abdulaziz Ghuloum 2008-02-18 20:39:42 -05:00
parent c430a91bb8
commit e751c15bc4
5 changed files with 69 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.prebuilt
View File

Binary file not shown.

2
scheme/last-revision
View File

@ -1 +1 @@
1393
1394

2
scheme/makefile.ss
View File

@ -1543,7 +1543,7 @@
'()))])
`(install-library
',id ',name ',version ',import-libs ',visit-libs ',invoke-libs
',subst ',env void void '#f '#f ',visible?)))))
',subst ',env void void '#f '#f ',visible? '#f)))))
(let ([code `(library (ikarus primlocs)
(export) ;;; must be empty
(import

74
scheme/psyntax.expander.ss
View File

@ -3523,41 +3523,45 @@
;;; Given a (library . _) s-expression, library-expander expands
;;; it to core-form, registers it with the library manager, and
;;; returns its invoke-code, visit-code, subst and env.
(define (library-expander x)
(define (build-visit-code macro*)
(if (null? macro*)
(build-void)
(build-sequence no-source
(map (lambda (x)
(let ((loc (car x)) (src (cddr x)))
(build-global-assignment no-source loc src)))
macro*))))
(define (visit! macro*)
(for-each (lambda (x)
(let ((loc (car x)) (proc (cadr x)))
(set-symbol-value! loc proc)))
macro*))
(let-values (((name ver imp* inv* vis*
invoke-code macro* export-subst export-env)
(core-library-expander x)))
(let ((id (gensym))
(name name)
(ver ver)
(imp* (map library-spec imp*))
(vis* (map library-spec vis*))
(inv* (map library-spec inv*))
(visit-proc (lambda () (visit! macro*)))
(invoke-proc (lambda () (eval-core (expanded->core invoke-code))))
(visit-code (build-visit-code macro*))
(invoke-code invoke-code))
(install-library id name ver
imp* vis* inv* export-subst export-env
visit-proc invoke-proc
visit-code invoke-code
#t)
(values id name ver imp* vis* inv*
invoke-code visit-code
export-subst export-env))))
(define library-expander
(case-lambda
[(x filename)
(define (build-visit-code macro*)
(if (null? macro*)
(build-void)
(build-sequence no-source
(map (lambda (x)
(let ((loc (car x)) (src (cddr x)))
(build-global-assignment no-source loc src)))
macro*))))
(define (visit! macro*)
(for-each (lambda (x)
(let ((loc (car x)) (proc (cadr x)))
(set-symbol-value! loc proc)))
macro*))
(let-values (((name ver imp* inv* vis*
invoke-code macro* export-subst export-env)
(core-library-expander x)))
(let ((id (gensym))
(name name)
(ver ver)
(imp* (map library-spec imp*))
(vis* (map library-spec vis*))
(inv* (map library-spec inv*))
(visit-proc (lambda () (visit! macro*)))
(invoke-proc
(lambda () (eval-core (expanded->core invoke-code))))
(visit-code (build-visit-code macro*))
(invoke-code invoke-code))
(install-library id name ver
imp* vis* inv* export-subst export-env
visit-proc invoke-proc
visit-code invoke-code
#t filename)
(values id name ver imp* vis* inv*
invoke-code visit-code
export-subst export-env)))]
[(x) (library-expander x #f)]))
;;; when bootstrapping the system, visit-code is not (and cannot
;;; be) be used in the "next" system. So, we drop it.

46
scheme/psyntax.library-manager.ss
View File

@ -50,7 +50,8 @@
(define-record library
(id name version imp* vis* inv* subst env visit-state
invoke-state visit-code invoke-code visible?)
invoke-state visit-code invoke-code visible?
source-file-name)
(lambda (x p)
(unless (library? x)
(assertion-violation 'record-type-printer "not a library"))
@ -199,7 +200,8 @@
[(try-load-from-file file-name)]
[else
((current-library-expander)
(with-input-from-file file-name read-annotated))])))
(with-input-from-file file-name read-annotated)
file-name)])))
(lambda (f)
(if (procedure? f)
f
@ -269,22 +271,30 @@
exp-env))
((current-library-collection) lib))
(define (install-library id name ver imp* vis* inv*
exp-subst exp-env visit-proc invoke-proc
visit-code invoke-code visible?)
(let ((imp-lib* (map find-library-by-spec/die imp*))
(vis-lib* (map find-library-by-spec/die vis*))
(inv-lib* (map find-library-by-spec/die inv*)))
(unless (and (symbol? id) (list? name) (list? ver))
(assertion-violation 'install-library
"invalid spec with id/name/ver" id name ver))
(when (library-exists? name)
(assertion-violation 'install-library
"library is already installed" name))
(let ((lib (make-library id name ver imp-lib* vis-lib* inv-lib*
exp-subst exp-env visit-proc invoke-proc
visit-code invoke-code visible?)))
(install-library-record lib))))
(define install-library
(case-lambda
[(id name ver imp* vis* inv* exp-subst exp-env
visit-proc invoke-proc visit-code invoke-code
visible? source-file-name)
(let ((imp-lib* (map find-library-by-spec/die imp*))
(vis-lib* (map find-library-by-spec/die vis*))
(inv-lib* (map find-library-by-spec/die inv*)))
(unless (and (symbol? id) (list? name) (list? ver))
(assertion-violation 'install-library
"invalid spec with id/name/ver" id name ver))
(when (library-exists? name)
(assertion-violation 'install-library
"library is already installed" name))
(let ((lib (make-library id name ver imp-lib* vis-lib* inv-lib*
exp-subst exp-env visit-proc invoke-proc
visit-code invoke-code visible? source-file-name)))
(install-library-record lib)))]
#;[(id name ver imp* vis* inv* exp-subst exp-env
visit-proc invoke-proc visit-code invoke-code
visible?)
(install-library id name ver imp* vis* inv* exp-subst exp-env
visit-proc invoke-proc visit-code invoke-code
visible? #f)]))
(define extend-library-subst!
(lambda (lib sym label)