| 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 #\")) |
|---|
