summaryrefslogtreecommitdiff
path: root/module/system/repl/repl.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-07-09 18:22:08 +0200
committerAndy Wingo <wingo@pobox.com>2010-07-09 18:22:08 +0200
commit3ae78d95e62e36078bb86e22450f2e7830ea2ddf (patch)
treee0e230323c026e4a91c099c3638adc40c16ee53e /module/system/repl/repl.scm
parent33df2ec719d281c70a5c7595dceee9f47770e910 (diff)
downloadguile-3ae78d95e62e36078bb86e22450f2e7830ea2ddf.tar.gz
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.
Diffstat (limited to 'module/system/repl/repl.scm')
-rw-r--r--module/system/repl/repl.scm83
1 files changed, 40 insertions, 43 deletions
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index ce309a9b9..878fd232f 100644
--- 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))
@@ -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?))