summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-11-18 14:32:53 +0100
committerAndy Wingo <wingo@pobox.com>2010-11-18 14:32:53 +0100
commitc372cd74fdc5de5b3ee3299b77a7881e271c649c (patch)
tree1892c7c079a02554be31ef10c5075f3a4026bbc0
parent9b5fcde6f9488e9836b090f8da292bf3f2642ca6 (diff)
downloadguile-c372cd74fdc5de5b3ee3299b77a7881e271c649c.tar.gz
repl read/write using current ports, not captured ports
Fixes bug in repl meta-commands after activating readline, which changes the current input port. * module/system/repl/common.scm (<repl>): Remove inport and outport fields. (make-repl): Adapt. (repl-read, repl-print): Just read and write to the current ports. * module/system/repl/repl.scm (meta-reader): Meta-read from the current input port. * module/system/repl/command.scm (read-command, define-meta-command): Read from the current input port.
-rw-r--r--module/system/repl/command.scm21
-rw-r--r--module/system/repl/common.scm14
-rw-r--r--module/system/repl/repl.scm27
3 files changed, 27 insertions, 35 deletions
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 4fc203806..94bb863bc 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -136,7 +136,7 @@
(define (read-command repl)
(catch #t
- (lambda () (read (repl-inport repl)))
+ (lambda () (read))
(lambda (key . args)
(pmatch args
((,subr ,msg ,args . ,rest)
@@ -148,11 +148,6 @@
(force-output)
*unspecified*)))
-(define read-line
- (let ((orig-read-line read-line))
- (lambda (repl)
- (orig-read-line (repl-inport repl)))))
-
(define (meta-command repl)
(let ((command (read-command repl)))
(cond
@@ -183,19 +178,19 @@
(% (let* ((expression0
(catch #t
(lambda ()
- (repl-reader ""
- (lambda* (#:optional (port (repl-inport repl)))
- ((language-reader (repl-language repl))
- port (current-module)))))
+ (repl-reader
+ ""
+ (lambda* (#:optional (port (current-input-port)))
+ ((language-reader (repl-language repl))
+ port (current-module)))))
(lambda (k . args)
(handle-read-error 'expression0 k args))))
...)
(apply (lambda* datums
- (with-output-to-port (repl-outport repl)
- (lambda () b0 b1 ...)))
+ b0 b1 ...)
(catch #t
(lambda ()
- (let ((port (open-input-string (read-line repl))))
+ (let ((port (open-input-string (read-line))))
(let lp ((out '()))
(let ((x (read port)))
(if (eof-object? x)
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 4fc8697d5..e03bf9339 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -26,7 +26,7 @@
#:use-module (ice-9 control)
#:use-module (ice-9 history)
#:export (<repl> make-repl repl-language repl-options
- repl-tm-stats repl-gc-stats repl-inport repl-outport repl-debug
+ repl-tm-stats repl-gc-stats repl-debug
repl-welcome repl-prompt
repl-read repl-compile repl-prepare-eval-thunk repl-eval
repl-parse repl-print repl-option-ref repl-option-set!
@@ -102,7 +102,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
;;;
(define-record/keywords <repl>
- language options tm-stats gc-stats inport outport debug)
+ language options tm-stats gc-stats debug)
(define repl-default-options
(copy-tree
@@ -128,8 +128,6 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
#:options (copy-tree repl-default-options)
#:tm-stats (times)
#:gc-stats (gc-stats)
- #:inport (current-input-port)
- #:outport (current-output-port)
#:debug debug))
(define (repl-welcome repl)
@@ -151,8 +149,8 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(if (zero? level) "" (format #f " [~a]" level)))))))
(define (repl-read repl)
- ((language-reader (repl-language repl)) (repl-inport repl)
- (current-module)))
+ (let ((reader (language-reader (repl-language repl))))
+ (reader (current-input-port) (current-module))))
(define (repl-compile-options repl)
(repl-option-ref repl 'compile-options))
@@ -187,8 +185,8 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
;; should be printed with the generic printer, `write'. The
;; language-printer is something else: it prints expressions of
;; a given language, not the result of evaluation.
- (write val (repl-outport repl))
- (newline (repl-outport repl)))))
+ (write val)
+ (newline))))
(define (repl-option-ref repl key)
(cadr (or (assq key (repl-options repl))
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 7847b50e9..b135dbb71 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -63,20 +63,19 @@
(define meta-command-token (cons 'meta 'command))
(define (meta-reader read env)
- (lambda read-args
- (let ((port (if (pair? read-args) (car read-args) (current-input-port))))
- (with-input-from-port port
- (lambda ()
- (let ((ch (next-char #t)))
- (cond ((eof-object? ch)
- ;; EOF objects are not buffered. It's quite possible
- ;; to peek an EOF then read something else. It's
- ;; strange but it's how it works.
- ch)
- ((eqv? ch #\,)
- (read-char port)
- meta-command-token)
- (else (read port env)))))))))
+ (lambda* (#:optional (port (current-input-port)))
+ (with-input-from-port port
+ (lambda ()
+ (let ((ch (next-char #t)))
+ (cond ((eof-object? ch)
+ ;; EOF objects are not buffered. It's quite possible
+ ;; to peek an EOF then read something else. It's
+ ;; strange but it's how it works.
+ ch)
+ ((eqv? ch #\,)
+ (read-char port)
+ meta-command-token)
+ (else (read port env))))))))
;; repl-reader is a function defined in boot-9.scm, and is replaced by
;; something else if readline has been activated. much of this hoopla is