diff --git a/chicken.import.scm b/chicken.import.scm index 9811d8f..512a5c1 100644 --- a/chicken.import.scm +++ b/chicken.import.scm @@ -202,9 +202,12 @@ set-finalizer! set-gc-report! set-parameterized-read-syntax! + set-parameterized-read-syntax!* set-port-name! set-read-syntax! + set-read-syntax!* set-sharp-read-syntax! + set-sharp-read-syntax!* setter signal signum diff --git a/library.scm b/library.scm index 31c8b37..0070e48 100644 --- a/library.scm +++ b/library.scm @@ -2696,7 +2696,7 @@ EOF [h (and srst (##sys#slot srst (char->integer c)) ) ] ) (if h ;then handled by read-table entry - (h c port) + (h c port readrec) ;otherwise chicken extended r5rs syntax (case c ((#\') @@ -2720,7 +2720,7 @@ EOF (spdrst (##sys#slot crt 3)) (h (and spdrst (##sys#slot spdrst (char->integer dchar)) ) ) ) ;# handled by parameterized # read-table entry? - (cond (h (h dchar port n)) + (cond (h (h dchar port n readrec)) ;#? ((or (eq? dchar #\)) (char-whitespace? dchar)) (##sys#sharp-number-hook port n)) (else (##sys#read-error port "invalid parameterized read syntax" dchar n) ) ) ) @@ -2728,7 +2728,7 @@ EOF (h (and sdrst (##sys#slot sdrst (char->integer dchar)) ) ) ) (if h ;then handled by # read-table entry - (h dchar port) + (h dchar port readrec) ;otherwise chicken extended r5rs syntax (case (char-downcase dchar) ((#\x) (##sys#read-char-0 port) (r-number-with-exactness 16)) @@ -2903,8 +2903,11 @@ EOF (set! read-marks (cons (cons sym proc) read-marks)) ) ) ) (define set-read-syntax!) +(define set-read-syntax!*) (define set-sharp-read-syntax!) +(define set-sharp-read-syntax!*) (define set-parameterized-read-syntax!) +(define set-parameterized-read-syntax!*) (let ((crt current-read-table)) @@ -2923,25 +2926,49 @@ EOF (syntax-setter 'set-read-syntax! 1 (lambda (proc) - (lambda (_ port) + (lambda (_ port restart) (##sys#read-char-0 port) (proc port) ) ) ) ) + (set! set-read-syntax!* + (syntax-setter + 'set-read-syntax!* 1 + (lambda (proc) + (lambda (_ port restart) + (##sys#read-char-0 port) + (proc port restart) ) ) ) ) + (set! set-sharp-read-syntax! (syntax-setter 'set-sharp-read-syntax! 2 (lambda (proc) - (lambda (_ port) + (lambda (_ port restart) (##sys#read-char-0 port) (proc port) ) ) ) ) + (set! set-sharp-read-syntax!* + (syntax-setter + 'set-sharp-read-syntax!* 2 + (lambda (proc) + (lambda (_ port restart) + (##sys#read-char-0 port) + (proc port restart) ) ) ) ) + (set! set-parameterized-read-syntax! (syntax-setter 'set-parameterized-read-syntax! 3 (lambda (proc) - (lambda (_ port num) + (lambda (_ port num restart) + (##sys#read-char-0 port) + (proc port num) ) ) ) ) + + (set! set-parameterized-read-syntax!* + (syntax-setter + 'set-parameterized-read-syntax!* 3 + (lambda (proc) + (lambda (_ port num restart) (##sys#read-char-0 port) - (proc port num) ) ) ) ) ) + (proc port num restart) ) ) ) ) ) ;;; Read-table operations: diff --git a/types.db b/types.db index 0f32e67..eb77658 100644 --- a/types.db +++ b/types.db @@ -402,9 +402,12 @@ (set-finalizer! (procedure set-finalizer! (* (procedure (*) . *)) *)) (set-gc-report! (procedure set-gc-report! (*) undefined)) (set-parameterized-read-syntax! (procedure set-parameterized-read-syntax! (char procedure) undefined)) +(set-parameterized-read-syntax!* (procedure set-parameterized-read-syntax!* (char procedure) undefined)) (set-port-name! (procedure set-port-name! (port string) undefined)) (set-read-syntax! (procedure set-read-syntax! (char procedure) undefined)) +(set-read-syntax!* (procedure set-read-syntax!* (char procedure) undefined)) (set-sharp-read-syntax! (procedure set-sharp-read-syntax! (char procedure) undefined)) +(set-sharp-read-syntax!* (procedure set-sharp-read-syntax!* (char procedure) undefined)) (setter (procedure setter (procedure) procedure)) (signal (procedure signal (*) . *)) (signum (procedure signum (number) number))