1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00

add repl inport and outport fields and accessors

* module/system/repl/common.scm (<repl>): Add inport and outport fields
  and accessors.
  (make-repl): Add optional "debug" argument. Bind inport and outport to
  the current inport and output ports at the time of repl creation.
  (repl-read): Read from the repl inport.
  (repl-print): Write to the repl outport.

* module/system/repl/command.scm (read-datum, read-line, meta-command):
  Respect repl-inport, and bind the outport of meta-commands to the repl
  outport.
This commit is contained in:
Andy Wingo 2010-06-26 21:55:13 +02:00
parent fda1dd3860
commit 5b27d9d25e
2 changed files with 19 additions and 16 deletions

View file

@ -106,12 +106,12 @@
(format #t " ,~24A ~8@A - ~A\n" usage abbrev summary)))
(define (read-datum repl)
(read))
(read (repl-inport repl)))
(define read-line
(let ((orig-read-line read-line))
(lambda (repl)
(orig-read-line))))
(orig-read-line (repl-inport repl)))))
(define (meta-command repl)
(let ((command (read-datum repl)))
@ -129,14 +129,13 @@
docstring
(let* ((expression0
(repl-reader ""
(lambda args
(let ((port (if (pair? args)
(car args)
(current-input-port))))
((language-reader (repl-language repl))
port (current-module))))))
(lambda* (#:optional (port (repl-inport repl)))
((language-reader (repl-language repl))
port (current-module)))))
...)
(apply (lambda* datums b0 b1 ...)
(apply (lambda* datums
(with-output-to-port (repl-outport repl)
(lambda () b0 b1 ...)))
(let ((port (open-input-string (read-line repl))))
(let lp ((out '()))
(let ((x (read port)))

View file

@ -25,7 +25,7 @@
#:use-module (system vm program)
#:use-module (ice-9 control)
#:export (<repl> make-repl repl-language repl-options
repl-tm-stats repl-gc-stats
repl-tm-stats repl-gc-stats repl-inport repl-outport repl-debug
repl-welcome repl-prompt repl-read repl-compile repl-eval
repl-parse repl-print repl-option-ref repl-option-set!
repl-default-option-set! repl-default-prompt-set!
@ -99,7 +99,8 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
;;; Repl type
;;;
(define-record/keywords <repl> language options tm-stats gc-stats)
(define-record/keywords <repl>
language options tm-stats gc-stats inport outport debug)
(define repl-default-options
'((compile-options . (#:warnings (unbound-variable arity-mismatch)))
@ -107,11 +108,14 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(interp . #f)))
(define %make-repl make-repl)
(define (make-repl lang)
(define* (make-repl lang #:optional debug)
(%make-repl #:language (lookup-language lang)
#:options repl-default-options
#:tm-stats (times)
#:gc-stats (gc-stats)))
#:gc-stats (gc-stats)
#:inport (current-input-port)
#:outport (current-output-port)
#:debug debug))
(define (repl-welcome repl)
(display *version*)
@ -130,7 +134,7 @@ 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)) (current-input-port)
((language-reader (repl-language repl)) (repl-inport repl)
(current-module)))
(define (repl-compile-options repl)
@ -162,8 +166,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)
(newline))))
(write val (repl-outport repl))
(newline (repl-outport repl)))))
(define (repl-option-ref repl key)
(assq-ref (repl-options repl) key))