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:
parent
fda1dd3860
commit
5b27d9d25e
2 changed files with 19 additions and 16 deletions
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue