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

readline integration for guile-vm

Browse source 
* module/system/repl/common.scm (repl-prompt): Return a string instead of
  outputting to the port, for better readline integration.

* module/system/repl/repl.scm (meta-reader, prompting-meta-read)
  (start-repl): Integrate with (ice-9 readline) via the current-reader
  fluid and the repl-reader function, both from boot-9.scm.
This commit is contained in:
Andy Wingo 2008-05-09 13:15:15 +02:00
parent f116f92318
commit 3a6f6678cf
2 changed files with 39 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -59,9 +59,8 @@
(display "Enter `,help' for help.\n"))
(define (repl-prompt repl)
(format #t "~A@~A> " (language-name (cenv-language (repl-env repl)))
(module-name (cenv-module (repl-env repl))))
(force-output))
(format #f "~A@~A> " (language-name (cenv-language (repl-env repl)))
(module-name (cenv-module (repl-env repl)))))
(define (repl-read repl)
((language-reader (cenv-language (repl-env repl)))))

53
module/system/repl/repl.scm
View file

@ -21,32 +21,53 @@
(define-module (system repl repl)
:use-syntax (system base syntax)
:use-module (system base compile)
:use-module (system base language)
:use-module (system repl common)
:use-module (system repl command)
:use-module (system vm core)
:use-module (ice-9 rdelim)
:export (start-repl))
(define meta-command-token (cons 'meta 'command))
(define (meta-reader read)
(lambda ()
(if (eqv? (next-char #t) #\,)
(begin (read-char) meta-command-token)
(read))))
;; 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
;; to be able to re-use the existing readline machinery.
(define (prompting-meta-read repl)
(let ((prompt (lambda () (repl-prompt repl)))
(lread (language-reader (cenv-language (repl-env repl)))))
(with-fluid* current-reader (meta-reader lread)
(lambda () (repl-reader (lambda () (repl-prompt repl)))))))
(define (start-repl lang)
(let ((repl (make-repl lang)))
(repl-welcome repl)
(let prompt-loop ()
(repl-prompt repl)
(catch 'vm-error
(lambda ()
(if (eq? (next-char #t) #\,)
;; meta command
(begin (read-char) (meta-command repl (read-line)))
;; evaluation
(let rep-loop ()
(call-with-values (lambda () (repl-eval repl (repl-read repl)))
(lambda l (for-each (lambda (v) (repl-print repl v)) l)))
(if (next-char #f) (rep-loop)))))
(lambda (key fun msg args)
(display "ERROR: ")
(apply format #t msg args)
(newline)))
(prompt-loop))))
(let ((exp (prompting-meta-read repl)))
(cond
((eq? exp meta-command-token)
(meta-command repl (read-line)))
((eof-object? exp)
(throw 'quit))
(else
(catch 'vm-error
(lambda ()
(call-with-values (lambda () (repl-eval repl exp))
(lambda l
(for-each (lambda (v) (repl-print repl v)) l))))
(lambda (key fun msg args)
(display "ERROR: ")
(apply format #t msg args)
(newline)))))
(next-char #f) ;; consume trailing whitespace
(prompt-loop)))))
(define (next-char wait)
(if (or wait (char-ready?))