fixed bug in fasl-reading #0=((x . #0#) (y . z))
This commit is contained in:
parent
3049d3d22e
commit
d88babf935
|
@ -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)]
|
||||
|
|
|
@ -1 +1 @@
|
|||
1692
|
||||
1693
|
||||
|
|
|
@ -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)))
|
||||
)
|
||||
|
||||
)
|
||||
|
||||
|
|
Loading…
Reference in New Issue