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

12
scheme/psyntax.expander.ss
View File

@ -3523,7 +3523,9 @@
;;; 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 library-expander
(case-lambda
[(x filename)
(define (build-visit-code macro*)
(if (null? macro*)
(build-void)
@ -3547,17 +3549,19 @@
(vis* (map library-spec vis*))
(inv* (map library-spec inv*))
(visit-proc (lambda () (visit! macro*)))
(invoke-proc (lambda () (eval-core (expanded->core invoke-code))))
(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)
#t filename)
(values id name ver imp* vis* inv*
invoke-code visit-code
export-subst export-env))))
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.

24
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,9 +271,11 @@
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?)
(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*)))
@ -283,8 +287,14 @@
"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))))
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)