summaryrefslogtreecommitdiff
path: root/module/system/repl/repl.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-07-09 18:58:01 +0200
committerAndy Wingo <wingo@pobox.com>2010-07-09 18:58:01 +0200
commitffe911f714d7064a42bb4e34e1add4e0a7ea398b (patch)
tree85a42a2cef414d7851298cd6e838cc4d2428c535 /module/system/repl/repl.scm
parent0ddbd88321fbddb581f642eea12bd713555d2f87 (diff)
downloadguile-ffe911f714d7064a42bb4e34e1add4e0a7ea398b.tar.gz
avoid running the debugger during parsing or compilation at the repl
* module/system/repl/repl.scm (abort-on-error): New helper. (run-repl): Don't enter the debugger during parsing or compilation of a repl expression. If you want to debug compilation, run compilation from the repl, not as part of the repl.
Diffstat (limited to 'module/system/repl/repl.scm')
-rw-r--r--module/system/repl/repl.scm29
1 files changed, 26 insertions, 3 deletions
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 878fd232f..fba67764f 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -89,6 +89,22 @@
(define* (start-repl #:optional (lang (current-language)) #:key debug)
(run-repl (make-repl lang debug)))
+;; (put 'abort-on-error 'scheme-indent-function 1)
+(define-syntax abort-on-error
+ (syntax-rules ()
+ ((_ string exp)
+ (catch #t
+ (lambda () exp)
+ (lambda (key . args)
+ (format #t "While ~A:~%" string)
+ (pmatch args
+ ((,subr ,msg ,args . ,rest)
+ (display-error #f (current-output-port) subr msg args rest))
+ (else
+ (format #t "ERROR: Throw to key `~a' with args `~s'.\n" key args)))
+ (force-output)
+ (abort))))))
+
(define (run-repl repl)
(% (with-fluids ((*repl-stack*
(cons repl (or (fluid-ref *repl-stack*) '()))))
@@ -116,9 +132,16 @@
(lambda ()
(call-with-values
(lambda ()
- (run-hook before-eval-hook exp)
- (start-stack #t
- (repl-eval repl (repl-parse repl exp))))
+ (% (let ((thunk
+ (abort-on-error "compiling expression"
+ (repl-prepare-eval-thunk
+ repl
+ (abort-on-error "parsing expression"
+ (repl-parse repl exp))))))
+ (run-hook before-eval-hook exp)
+ (with-error-handling
+ (start-stack #t (% (thunk)))))
+ (lambda (k) (values))))
(lambda l
(for-each (lambda (v)
(repl-print repl v))