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

library records now cache expanded code.

This commit is contained in:
Abdulaziz Ghuloum 2008-02-18 19:15:47 -05:00
parent 163809f667
commit fa08c543bb
7 changed files with 42 additions and 41 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.

41
scheme/ikarus.fasl.ss
View File

@ -148,21 +148,22 @@
[freevars (read-fixnum p)])
(let ([code (make-code code-size freevars)])
(when code-m (put-mark code-m code))
(let ([annotations (read)])
(let f ([i 0])
(unless (fx= i code-size)
(code-set! code i (char->int (read-u8-as-char p)))
(f (fxadd1 i))))
(cond
[clos-m
(let ([clos ($code->closure code)])
(put-mark clos-m clos)
(set-code-reloc-vector! code (read))
code)]
[else
(let ([annotation (read)])
(set-code-annotation! code annotation))
(let f ([i 0])
(unless (fx= i code-size)
(code-set! code i (char->int (read-u8-as-char p)))
(f (fxadd1 i))))
(cond
[clos-m
(let ([clos ($code->closure code)])
(put-mark clos-m clos)
(set-code-reloc-vector! code (read))
code])))))
(define (read-thunk m)
code)]
[else
(set-code-reloc-vector! code (read))
code]))))
(define (read-procedure m)
(let ([c (read-u8-as-char p)])
(case c
[(#\x)
@ -244,8 +245,8 @@
v))]
[(#\x) ;;; code
(read-code m #f)]
[(#\Q) ;;; thunk
(read-thunk m)]
[(#\Q) ;;; procedure
(read-procedure m)]
[(#\R)
(let* ([rtd-name (read)]
[rtd-symbol (read)]
@ -271,12 +272,8 @@
($struct-set! x i (read))
(f (fxadd1 i))))
x)))]
;[(#\C)
; (let ([c (read-u8-as-char p)])
; (cond
; [(char? c) c]
; [else
; (die who "invalid eof inside a fasl object")]))]
[(#\C) (integer->char (read-int p))]
[(#\c) (read-u8-as-char p)]
[(#\>)
(let ([m (read-int p)])
(read/mark m))]

12
scheme/ikarus.separate-compilation.ss
View File

@ -9,16 +9,17 @@
(only (psyntax library-manager)
install-library current-library-expander))
(define-struct library (id name ver imp* vis* inv*
export-subst export-env visit-code invoke-code visible?))
(define-struct library
(id name ver imp* vis* inv* export-subst export-env
visit-code invoke-code visible?))
(define (install-library-from-file filename)
(let ([p (open-file-input-port filename)])
(let ([L (fasl-read p)])
(unless (library? L)
(error 'install-library "file does not contain a library"
filename))
(printf "L=~s\n" L)
(error 'install-library
"file does not contain a valid library"
filename))
(install-library (library-id L) (library-name L)
(library-ver L) (library-imp* L) (library-vis* L)
(library-inv* L) (library-export-subst L)
@ -34,6 +35,5 @@
(compile-core-expr visit-code)
(compile-core-expr invoke-code)
#t)])
(printf "L=~s\n" L)
(fasl-write L p)))))

2
scheme/last-revision
View File

@ -1 +1 @@
1391
1392

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 ',visible?)))))
',subst ',env void void '#f '#f ',visible?)))))
(let ([code `(library (ikarus primlocs)
(export) ;;; must be empty
(import

13
scheme/psyntax.expander.ss
View File

@ -3545,15 +3545,18 @@
(ver ver)
(imp* (map library-spec imp*))
(vis* (map library-spec vis*))
(inv* (map library-spec inv*)))
(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
(lambda () (visit! macro*))
(lambda () (eval-core (expanded->core invoke-code)))
visit-proc invoke-proc
visit-code invoke-code
#t)
(values id name ver imp* vis* inv*
invoke-code
(build-visit-code macro*)
invoke-code visit-code
export-subst export-env))))
;;; when bootstrapping the system, visit-code is not (and cannot

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

@ -23,8 +23,7 @@
visit-library library-name library-version library-exists?
find-library-by-name install-library library-spec invoke-library
extend-library-subst! extend-library-env! current-library-expander
current-library-collection library-path library-extensions
make-library)
current-library-collection library-path library-extensions)
(import (rnrs) (psyntax compat) (rnrs r5rs))
(define (make-collection)
@ -49,7 +48,8 @@
x)))
(define-record library
(id name version imp* vis* inv* subst env visit-state invoke-state visible?)
(id name version imp* vis* inv* subst env visit-state
invoke-state visit-code invoke-code visible?)
(lambda (x p)
(unless (library? x)
(assertion-violation 'record-type-printer "not a library"))
@ -241,7 +241,8 @@
((current-library-collection) lib))
(define (install-library id name ver imp* vis* inv*
exp-subst exp-env visit-code invoke-code visible?)
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*)))
@ -252,8 +253,8 @@
(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-code invoke-code
visible?)))
exp-subst exp-env visit-proc invoke-proc
visit-code invoke-code visible?)))
(install-library-record lib))))
(define extend-library-subst!