| 1 | diff --git a/library.scm b/library.scm
|
|---|
| 2 | index 31c8b37..db4b553 100644
|
|---|
| 3 | --- a/library.scm
|
|---|
| 4 | +++ b/library.scm
|
|---|
| 5 | @@ -2696,7 +2696,8 @@ EOF
|
|---|
| 6 | [h (and srst (##sys#slot srst (char->integer c)) ) ] )
|
|---|
| 7 | (if h
|
|---|
| 8 | ;then handled by read-table entry
|
|---|
| 9 | - (h c port)
|
|---|
| 10 | + (##sys#call-with-values (lambda () (h c port))
|
|---|
| 11 | + (lambda xs (if (null? xs) (readrec) (car xs))))
|
|---|
| 12 | ;otherwise chicken extended r5rs syntax
|
|---|
| 13 | (case c
|
|---|
| 14 | ((#\')
|
|---|
| 15 | @@ -2720,7 +2721,8 @@ EOF
|
|---|
| 16 | (spdrst (##sys#slot crt 3))
|
|---|
| 17 | (h (and spdrst (##sys#slot spdrst (char->integer dchar)) ) ) )
|
|---|
| 18 | ;#<num> handled by parameterized # read-table entry?
|
|---|
| 19 | - (cond (h (h dchar port n))
|
|---|
| 20 | + (cond (h (##sys#call-with-values (lambda () (h dchar port n))
|
|---|
| 21 | + (lambda xs (if (null? xs) (readrec) (car xs)))))
|
|---|
| 22 | ;#<num>?
|
|---|
| 23 | ((or (eq? dchar #\)) (char-whitespace? dchar)) (##sys#sharp-number-hook port n))
|
|---|
| 24 | (else (##sys#read-error port "invalid parameterized read syntax" dchar n) ) ) )
|
|---|
| 25 | @@ -2728,7 +2730,8 @@ EOF
|
|---|
| 26 | (h (and sdrst (##sys#slot sdrst (char->integer dchar)) ) ) )
|
|---|
| 27 | (if h
|
|---|
| 28 | ;then handled by # read-table entry
|
|---|
| 29 | - (h dchar port)
|
|---|
| 30 | + (##sys#call-with-values (lambda () (h dchar port))
|
|---|
| 31 | + (lambda xs (if (null? xs) (readrec) (car xs))))
|
|---|
| 32 | ;otherwise chicken extended r5rs syntax
|
|---|
| 33 | (case (char-downcase dchar)
|
|---|
| 34 | ((#\x) (##sys#read-char-0 port) (r-number-with-exactness 16))
|
|---|
| 35 | @@ -2795,7 +2798,9 @@ EOF
|
|---|
| 36 | (##sys#read-error
|
|---|
| 37 | port
|
|---|
| 38 | "invalid `#!' token" tok) ) ) ] ) ) ) ) ) )
|
|---|
| 39 | - (else (##sys#user-read-hook dchar port)) ) ) ) ) ) )
|
|---|
| 40 | + (else
|
|---|
| 41 | + (##sys#call-with-values (lambda () (##sys#user-read-hook dchar port))
|
|---|
| 42 | + (lambda xs (if (null? xs) (readrec) (car xs)))) ) ) ) ) ) ) )
|
|---|
| 43 | ((#\() (r-list #\( #\)))
|
|---|
| 44 | ((#\)) (##sys#read-char-0 port) (container c))
|
|---|
| 45 | ((#\") (##sys#read-char-0 port) (r-string #\"))
|
|---|
