~ chicken-r7rs (master) dbd01fdd21f383736395c43c503d202f5d6b9d9a
commit dbd01fdd21f383736395c43c503d202f5d6b9d9a
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Sat May 9 21:59:41 2015 +0000
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Sat May 9 21:59:41 2015 +0000
Hook read so that csi comma commands handle circular data
diff --git a/scheme.read.scm b/scheme.read.scm
index 56d9de3..8ca0b13 100644
--- a/scheme.read.scm
+++ b/scheme.read.scm
@@ -1,6 +1,6 @@
(module scheme.read (read)
(import (except scheme read)
- (only chicken : current-read-table feature? fx+ fx= optional unless when)
+ (only chicken : current-read-table feature? fluid-let fx+ fx= optional unless when)
(only chicken case-sensitive define-constant define-inline parameterize))
;;;
@@ -27,20 +27,17 @@
(##sys#setslot p port-fold-case-slot 'no-fold-case)
(read p)))
+ (define sys-read ##sys#read)
+
(set! ##sys#read
- (let ((read ##sys#read))
- (lambda (port hook)
- (parameterize ((case-sensitive
- (case (port-fold-case port)
- ((fold-case) #f)
- ((no-fold-case) #t)
- (else (case-sensitive)))))
- (read port hook)))))
-
- (when (feature? 'csi)
- (set! ##sys#repl-read-hook
- (lambda (#!optional (p (current-input-port)))
- (read p))))
+ (lambda (port hook)
+ (parameterize ((case-sensitive
+ (case (port-fold-case port)
+ ((fold-case) #f)
+ ((no-fold-case) #t)
+ (else (case-sensitive)))))
+ (fluid-let ((##sys#default-read-info-hook hook))
+ (read port)))))
;;;
;;; 6.13.2 Input
@@ -98,11 +95,11 @@
(##sys#read-char-0 p)
(letrec ((o (begin
(register-shared! n (lambda () o))
- (##sys#read p ##sys#default-read-info-hook))))
+ (sys-read p ##sys#default-read-info-hook))))
o))
(define (read/shared p)
- (let ((o (##sys#read port ##sys#default-read-info-hook)))
+ (let ((o (sys-read port ##sys#default-read-info-hook)))
(when (pair? shared)
(unthunkify! o (lambda a (apply ##sys#read-error p a))))
o))
diff --git a/scheme.write.scm b/scheme.write.scm
index 6aac5f9..3a24f15 100644
--- a/scheme.write.scm
+++ b/scheme.write.scm
@@ -8,7 +8,7 @@
(when (feature? 'csi)
(set! ##sys#repl-print-hook
(lambda (o p)
- (display o p)
+ (write o p)
(newline))))
(define (interesting? o)
Trap