mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

add repl inport and outport fields and accessors

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

15
module/system/repl/command.scm
View file

@ -106,12 +106,12 @@
(format #t " ,~24A ~8@A - ~A\n" usage abbrev summary))) (format #t " ,~24A ~8@A - ~A\n" usage abbrev summary)))
(define (read-datum repl) (define (read-datum repl)
(read)) (read (repl-inport repl)))
(define read-line (define read-line
(let ((orig-read-line read-line)) (let ((orig-read-line read-line))
(lambda (repl) (lambda (repl)
(orig-read-line)))) (orig-read-line (repl-inport repl)))))
(define (meta-command repl) (define (meta-command repl)
(let ((command (read-datum repl))) (let ((command (read-datum repl)))
@ -129,14 +129,13 @@
docstring docstring
(let* ((expression0 (let* ((expression0
(repl-reader "" (repl-reader ""
(lambda args (lambda* (#:optional (port (repl-inport repl)))
(let ((port (if (pair? args)
(car args)
(current-input-port))))
((language-reader (repl-language repl)) ((language-reader (repl-language repl))
port (current-module)))))) 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 ((port (open-input-string (read-line repl))))
(let lp ((out '())) (let lp ((out '()))
(let ((x (read port))) (let ((x (read port)))

18
module/system/repl/common.scm
View file

@ -25,7 +25,7 @@
#:use-module (system vm program) #:use-module (system vm program)
#:use-module (ice-9 control) #:use-module (ice-9 control)
#:export (<repl> make-repl repl-language repl-options #: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-welcome repl-prompt repl-read repl-compile repl-eval
repl-parse repl-print repl-option-ref repl-option-set! repl-parse repl-print repl-option-ref repl-option-set!
repl-default-option-set! repl-default-prompt-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 ;;; 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 (define repl-default-options
'((compile-options . (#:warnings (unbound-variable arity-mismatch))) '((compile-options . (#:warnings (unbound-variable arity-mismatch)))
@ -107,11 +108,14 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(interp . #f))) (interp . #f)))
(define %make-repl make-repl) (define %make-repl make-repl)
(define (make-repl lang) (define* (make-repl lang #:optional debug)
(%make-repl #:language (lookup-language lang) (%make-repl #:language (lookup-language lang)
#:options repl-default-options #:options repl-default-options
#:tm-stats (times) #: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) (define (repl-welcome repl)
(display *version*) (display *version*)
@ -130,7 +134,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
(if (zero? level) "" (format #f " [~a]" level))))))) (if (zero? level) "" (format #f " [~a]" level)))))))
(define (repl-read repl) (define (repl-read repl)
((language-reader (repl-language repl)) (current-input-port) ((language-reader (repl-language repl)) (repl-inport repl)
(current-module))) (current-module)))
(define (repl-compile-options repl) (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 ;; should be printed with the generic printer, `write'. The
;; language-printer is something else: it prints expressions of ;; language-printer is something else: it prints expressions of
;; a given language, not the result of evaluation. ;; a given language, not the result of evaluation.
(write val) (write val (repl-outport repl))
(newline)))) (newline (repl-outport repl)))))
(define (repl-option-ref repl key) (define (repl-option-ref repl key)
(assq-ref (repl-options repl) key)) (assq-ref (repl-options repl) key))