readline integration for guile-vm

* 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.

diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index a37ffb4..d6039be 100644 (file)
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -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)))))

diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 57d78b1..65c7713 100644 (file)
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -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?))