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

* libfasl handles writing thunks by writing the character Q followed 

by the code of the thunk.
This commit is contained in:
Abdulaziz Ghuloum 2006-12-04 10:26:32 -05:00
parent 925cecbe3b
commit 24aa0fffb3
2 changed files with 10 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
lib/ikarus.boot
View File

Binary file not shown.

12
lib/libfasl.ss
View File

@ -132,6 +132,9 @@
(fasl-write (fasl-write
((record-field-accessor rtd (car names)) x) ((record-field-accessor rtd (car names)) x)
p h m))]))]))] p h m))]))]))]
[(procedure? x)
(write-char #\Q p)
(fasl-write ($closure-code x) p h m)]
[else (error 'fasl-write "~s is not fasl-writable" x)]))) [else (error 'fasl-write "~s is not fasl-writable" x)])))
(define fasl-write (define fasl-write
(lambda (x p h m) (lambda (x p h m)
@ -196,8 +199,13 @@
(lambda (name) (lambda (name)
(make-graph ((record-field-accessor rtd name) x) h)) (make-graph ((record-field-accessor rtd name) x) h))
(record-type-field-names rtd))]))] (record-type-field-names rtd))]))]
;[(procedure? x) [(procedure? x)
; (make-graph ($closure-code x) h)] (let ([code ($closure-code x)])
(unless (fxzero? ($code-freevars code))
(error 'fasl-write
"Cannot write a non-thunk procedure; the one given has ~s free vars"
($code-freevars code)))
(make-graph code h))]
[else (error 'fasl-write "~s is not fasl-writable" x)])])))) [else (error 'fasl-write "~s is not fasl-writable" x)])]))))
(define do-fasl-write (define do-fasl-write
(lambda (x port) (lambda (x port)