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

fixed bug in fasl-reading #0=((x . #0#) (y . z))

This commit is contained in:
Abdulaziz Ghuloum 2008-11-26 01:40:01 -05:00
parent 3049d3d22e
commit d88babf935
3 changed files with 18 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
scheme/ikarus.fasl.ss
View File

@ -222,6 +222,18 @@
(let ([code (read-code cm m)])
(if m (vector-ref marks m) ($code->closure code))))]
[else (die who "invalid code header" c)])))
(define (read-list len m)
(let ([ls (make-list (+ len 1))])
(when m (put-mark m ls))
(let f ([ls ls])
(set-car! ls (read))
(let ([d (cdr ls)])
(if (null? d)
(set-cdr! ls (read))
(f d))))
ls))
(define (read/mark m)
(define (nom)
(when m (die who "unhandled mark")))
@ -333,27 +345,9 @@
(or (vector-ref marks m)
(error who "uninitialized mark" m)))]
[(#\l) ;;; list of length <= 255
(let ([ls
(let ([n (read-u8 p)])
(let f ([n n])
(cond
[(< n 0) (read)]
[else
(let ([x (read)])
(cons x (f (- n 1))))])))])
(when m (put-mark m ls))
ls)]
(read-list (read-u8 p) m)]
[(#\L) ;;; list of length > 255
(let ([ls
(let ([n (read-int p)])
(let f ([n n])
(cond
[(< n 0) (read)]
[else
(let ([x (read)])
(cons x (f (- n 1))))])))])
(when m (put-mark m ls))
ls)]
(read-list (read-int p) m)]
[(#\W) ;;; r6rs record type descriptor
(let* ([name (read)]
[parent (read)]

2
scheme/last-revision
View File

@ -1 +1 @@
1692
1693

4
scheme/tests/fasl.ss
View File

@ -49,7 +49,9 @@
(test (make-rectangular 12.0 13.0))
(test (string #\a))
(test (string #\x3bb))
(test-cycle))
(test-cycle)
(test '#1=((x . #1#) (y . z)))
)
)