tweaks to new repl

* module/system/repl/command.scm (read-command): Remove a pk.
* module/system/repl/repl.scm (run-repl): Export. Use % and abort to
  implement the prompt.

diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 7b092e6..bf8e0b2 100644 (file)
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -128,7 +128,7 @@
 
 (define (read-command repl)
   (catch #t
-    (lambda () (read (pk (repl-inport repl))))
+    (lambda () (read (repl-inport repl)))
     (lambda (key . args)
       (pmatch args
         ((,subr ,msg ,args . ,rest)

diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index ce309a9..878fd23 100644 (file)
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -28,7 +28,8 @@
   #:use-module (system repl error-handling)
   #:use-module (system repl common)
   #:use-module (system repl command)
-  #:export (start-repl))
+  #:use-module (ice-9 control)
+  #:export (start-repl run-repl))
 
 \f
 
@@ -89,49 +90,45 @@
   (run-repl (make-repl lang debug)))
 
 (define (run-repl repl)
-  (let ((tag (make-prompt-tag "repl ")))
-    (call-with-prompt
-     tag
-     (lambda ()
-       (with-fluids ((*repl-stack*
-                      (cons repl (or (fluid-ref *repl-stack*) '()))))
-         (if (null? (cdr (fluid-ref *repl-stack*)))
-             (repl-welcome repl))
-         (let prompt-loop ()
-           (let ((exp (prompting-meta-read repl)))
-             (cond
-              ((eqv? exp *unspecified*))   ; read error, pass
-              ((eq? exp meta-command-token)
-               (catch 'quit
-                 (lambda () (meta-command repl))
-                 (lambda (k . args)
-                   (abort-to-prompt tag args))))
-              ((eof-object? exp)
-               (newline)
-               (abort-to-prompt tag '()))
-              (else
-               ;; since the input port is line-buffered, consume up to the
-               ;; newline
-               (flush-to-newline)
-               (call-with-error-handling
-                (lambda ()
-                  (catch 'quit
-                    (lambda ()
-                      (call-with-values
-                          (lambda ()
-                            (run-hook before-eval-hook exp)
-                            (start-stack #t
-                                         (repl-eval repl (repl-parse repl exp))))
-                        (lambda l
-                          (for-each (lambda (v)
-                                      (repl-print repl v))
-                                    l))))
-                    (lambda (k . args)
-                      (abort-to-prompt tag args)))))))
-             (next-char #f) ;; consume trailing whitespace
-             (prompt-loop)))))
+  (% (with-fluids ((*repl-stack*
+                    (cons repl (or (fluid-ref *repl-stack*) '()))))
+       (if (null? (cdr (fluid-ref *repl-stack*)))
+           (repl-welcome repl))
+       (let prompt-loop ()
+         (let ((exp (prompting-meta-read repl)))
+           (cond
+            ((eqv? exp *unspecified*))  ; read error, pass
+            ((eq? exp meta-command-token)
+             (catch 'quit
+               (lambda () (meta-command repl))
+               (lambda (k . args)
+                 (abort args))))
+            ((eof-object? exp)
+             (newline)
+             (abort '()))
+            (else
+             ;; since the input port is line-buffered, consume up to the
+             ;; newline
+             (flush-to-newline)
+             (call-with-error-handling
+              (lambda ()
+                (catch 'quit
+                  (lambda ()
+                    (call-with-values
+                        (lambda ()
+                          (run-hook before-eval-hook exp)
+                          (start-stack #t
+                                       (repl-eval repl (repl-parse repl exp))))
+                      (lambda l
+                        (for-each (lambda (v)
+                                    (repl-print repl v))
+                                  l))))
+                  (lambda (k . args)
+                    (abort args)))))))
+           (next-char #f) ;; consume trailing whitespace
+           (prompt-loop))))
      (lambda (k status)
-       status))))
+       status)))
 
 (define (next-char wait)
   (if (or wait (char-ready?))