diff options
author | Andy Wingo <wingo@pobox.com> | 2010-07-09 17:04:34 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-07-09 17:05:25 +0200 |
commit | 33df2ec719d281c70a5c7595dceee9f47770e910 (patch) | |
tree | 6d0fc69ef15d3243f13985eb85c1f01628f1f1df /module/system/repl/error-handling.scm | |
parent | ddfb5e2bb02e167c734af5091d40d7db4ffeffa1 (diff) | |
download | guile-33df2ec719d281c70a5c7595dceee9f47770e910.tar.gz |
integrate the debugger into the repl
* module/system/repl/debug.scm: New file, defines a data type to hold
state for a debugger stack, and some helper procedures to print the
stack or print a frame. Most pieces are from (system vm debug).
* module/system/repl/error-handling.scm: New file, implements
call-with-error-handling and with-error-handling, and instead of going
into a debugger, we go into a recursive repl that happens to have
debugging information. Will be removing the old debugger from (system
vm debug) shortly.
* module/Makefile.am (SYSTEM_SOURCES): Add error-handling and debug scm
files.
* module/system/repl/repl.scm (prompting-meta-read): Better error
handling -- we don't want to go into a debugger when reading a
command.
(start-repl): Add #:debug keyword argument, and just dispatch to
run-repl.
(run-repl): New function, with the guts of the old start-repl. Added a
prompt, to which a throw to 'quit will abort.
* module/system/repl/common.scm (repl-prepare-eval-thunk): New
helper. In the future we will use this to not enter the debugger on
errors that happen at compile time.
(repl-eval): Use repl-prepare-eval-thunk.
(repl-print): Run the before-print-hook when printing a value.
* module/system/repl/command.scm (*command-table*): Move `option' to the
`system' group. Move `trace' to the `profile' group. Add `debug' and
`inspect' groups.
(command-abbrevs): Rename from command-abbrev, and allow multiple
abbreviations.
(display-group): Fix the case where abbrev? was #f.
(display-summary): Fix alignment of the command and
abbreviations. Allow multiple abbreviations.
(read-command): Rename from read-datum, and have better error
handling.
(meta-command): Better error handling.
(define-meta-command): Better error handling.
(help, show, import, compile, disassemble, time, profile, trace): Fix
docstrings and error messages.
(define-stack-command): New helper, for commands that operate on a
saved stack.
(backtrace, up, down, frame, procedure, locals): New debugger
commands, in the REPL now.
(inspect, pretty-print): New "inspect" commands.
Diffstat (limited to 'module/system/repl/error-handling.scm')
-rw-r--r-- | module/system/repl/error-handling.scm | 114 |
1 files changed, 114 insertions, 0 deletions
diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm new file mode 100644 index 000000000..d7d43bd71 --- /dev/null +++ b/module/system/repl/error-handling.scm @@ -0,0 +1,114 @@ +;;; Error handling in the REPL + +;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. + +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Code: + +(define-module (system repl error-handling) + #:use-module (system base pmatch) + #:use-module (system repl debug) + #:export (call-with-error-handling + with-error-handling)) + + + + +;;; +;;; Error handling via repl debugging +;;; + +(define* (call-with-error-handling thunk #:key + (on-error 'debug) (post-error 'catch) + (pass-keys '(quit))) + (let ((in (current-input-port)) + (out (current-output-port)) + (err (current-error-port))) + (define (with-saved-ports thunk) + (with-input-from-port in + (lambda () + (with-output-to-port out + (lambda () + (with-error-to-port err + thunk)))))) + + (catch #t + (lambda () (%start-stack #t thunk)) + + (case post-error + ((catch) + (lambda (key . args) + (if (memq key pass-keys) + (apply throw key args) + (begin + (pmatch args + ((,subr ,msg ,args . ,rest) + (with-saved-ports + (lambda () + (run-hook before-error-hook) + (display-error #f err subr msg args rest) + (run-hook after-error-hook) + (force-output err)))) + (else + (format err "\nERROR: uncaught throw to `~a', args: ~a\n" + key args))) + (if #f #f))))) + (else + (if (procedure? post-error) + post-error ; a handler proc + (error "Unknown post-error strategy" post-error)))) + + (case on-error + ((debug) + (lambda (key . args) + (let ((stack (make-stack #t))) + (with-saved-ports + (lambda () + (pmatch args + ((,subr ,msg ,args . ,rest) + (format #t "Throw to key `~a':\n" key) + (display-error stack (current-output-port) subr msg args rest)) + (else + (format #t "Throw to key `~a' with args `~s'." key args))) + (format #t "Entering a new prompt. Type `,bt' for a backtrace") + (format #t " or `,q' to return to the old prompt.\n") + (let ((debug + (make-debug + (narrow-stack->vector + stack + ;; Cut three frames from the top of the stack: + ;; make-stack, this one, and the throw handler. + 3 + ;; Narrow the end of the stack to the most recent + ;; start-stack. + (and (pair? (fluid-ref %stacks)) + (cdar (fluid-ref %stacks)))) + 0))) + ((@ (system repl repl) start-repl) #:debug debug))))))) + ((pass) + (lambda (key . args) + ;; fall through to rethrow + #t)) + (else + (if (procedure? on-error) + on-error ; pre-unwind handler + (error "Unknown on-error strategy" on-error))))))) + +(define-syntax with-error-handling + (syntax-rules () + ((_ form) + (call-with-error-handling (lambda () form))))) |