diff --git a/scheme/ikarus.fasl.ss b/scheme/ikarus.fasl.ss index 0a0b978..19d4604 100644 --- a/scheme/ikarus.fasl.ss +++ b/scheme/ikarus.fasl.ss @@ -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)] diff --git a/scheme/last-revision b/scheme/last-revision index f245d2b..6c77d6a 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1692 +1693 diff --git a/scheme/tests/fasl.ss b/scheme/tests/fasl.ss index c8e6968..5345195 100644 --- a/scheme/tests/fasl.ss +++ b/scheme/tests/fasl.ss @@ -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))) + ) )