diff options
author | Andy Wingo <wingo@pobox.com> | 2010-07-09 18:22:08 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-07-09 18:22:08 +0200 |
commit | 3ae78d95e62e36078bb86e22450f2e7830ea2ddf (patch) | |
tree | e0e230323c026e4a91c099c3638adc40c16ee53e /module/system/repl/repl.scm | |
parent | 33df2ec719d281c70a5c7595dceee9f47770e910 (diff) | |
download | guile-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.scm | 83 |
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?)) |