[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] Add new debug meta-command ,error
From: |
Jose A. Ortega Ruiz |
Subject: |
Re: [PATCH] Add new debug meta-command ,error |
Date: |
Tue, 31 Aug 2010 04:30:18 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.0.50 (gnu/linux) |
On Tue, Aug 31 2010, Andy Wingo wrote:
[...]
> I would prefer ,error-message and ,error, I think; I feel like we could
> use ,e for other things (eval, expand, ...).
Ah, makes sense. So ,error it is. Should i commit to master?
>From 9f601e08e40e2d90f2425e6a5dc7a142cac4ae35 Mon Sep 17 00:00:00 2001
From: Jose A. Ortega Ruiz <address@hidden>
Date: Mon, 30 Aug 2010 06:37:24 +0200
Subject: [PATCH] Add new debug meta-command ,error-message
* module/system/repl/error-handling.scm: use the error string to
construct the <debug> instance.
* module/system/repl/command.scm: new debug command `error-message'
that extracts the new <debug> field, available to stack commands as
`message'.
* doc/ref/scheme-using.texi: documentation for new command.
* module/system/repl/debug.scm: <debug> stores the error string in a
new field.
Signed-off-by: Jose A. Ortega Ruiz <address@hidden>
---
doc/ref/scheme-using.texi | 7 +++++++
module/system/repl/command.scm | 28 +++++++++++++++++++---------
module/system/repl/debug.scm | 4 ++--
module/system/repl/error-handling.scm | 26 ++++++++++++++++----------
4 files changed, 44 insertions(+), 21 deletions(-)
diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index e07b148..a89b152 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -311,6 +311,13 @@ Show local variables.
Show locally-bound variables in the selected frame.
@end deffn
address@hidden {REPL Command} error-message [error]
+Show error message.
+
+Display the message associated with the error that started the current
+debugging REPL.
address@hidden deffn
+
@c FIXME: whenever we regain support for stepping, here are the docs..
@c The commands in this subsection all apply only when the stack is
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 8a62a16..c98d328 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -6,12 +6,12 @@
;; 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
@@ -55,7 +55,7 @@
(disassemble x) (disassemble-file xx))
(profile (time t) (profile pr) (trace tr))
(debug (backtrace bt) (up) (down) (frame fr)
- (procedure proc) (locals))
+ (procedure proc) (locals) (error-message error))
(inspect (inspect i) (pretty-print pp))
(system (gc) (statistics stat) (option o)
(quit q continue cont))))
@@ -171,7 +171,7 @@
(format #t "Throw to key `~a' with args `~s' while reading
address@hidden argument `~A' of ~]command `~A'.\n"
key args form-name 'name)))
(abort))
-
+
(% (let* ((expression0
(catch #t
(lambda ()
@@ -463,6 +463,8 @@ Trace execution."
(letrec-syntax
((#,(datum->syntax #'repl 'frames)
(identifier-syntax (debug-frames debug)))
+ (#,(datum->syntax #'repl 'message)
+ (identifier-syntax (debug-error-message debug)))
(#,(datum->syntax #'repl 'index)
(identifier-syntax
(id (debug-index debug))
@@ -474,6 +476,14 @@ Trace execution."
body body* ...)
(format #t "Nothing to debug.~%"))))))))
+(define-stack-command (error-message repl)
+ "error-message
+Show error message.
+
+Display the message associated with the error that started the current
+debugging REPL."
+ (format #t "~a~%" (if (string? message) message "No error message")))
+
(define-stack-command (backtrace repl #:optional count
#:key (width 72) full?)
"backtrace [COUNT] [#:width W] [#:full? F]
@@ -481,11 +491,11 @@ Print a backtrace.
Print a backtrace of all stack frames, or innermost COUNT frames.
If COUNT is negative, the last COUNT frames will be shown."
- (print-frames frames
+ (print-frames frames
#:count count
#:width width
#:full? full?))
-
+
(define-stack-command (up repl #:optional (count 1))
"up [COUNT]
Select a calling stack frame.
@@ -548,14 +558,14 @@ With an argument, select a frame by index, then show it."
"procedure
Print the procedure for the selected frame."
(repl-print repl (frame-procedure cur)))
-
+
(define-stack-command (locals repl)
"locals
Show local variables.
Show locally-bound variables in the selected frame."
(print-locals cur))
-
+
;;;
;;; Inspection commands
@@ -581,7 +591,7 @@ Pretty-print the result(s) of evaluating EXP."
;;;
-;;; System commands
+;;; System commands
;;;
(define guile:gc gc)
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 293b790..1876d31 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -30,7 +30,7 @@
#:use-module ((system vm inspect) #:select ((inspect . %inspect)))
#:use-module (system vm program)
#:export (<debug>
- make-debug debug? debug-frames debug-index
+ make-debug debug? debug-frames debug-index debug-error-message
print-locals print-frame print-frames frame->module
stack->vector narrow-stack->vector))
@@ -66,7 +66,7 @@
;;; accessors, and provides some helper functions.
;;;
-(define-record <debug> frames index)
+(define-record <debug> frames index error-message)
diff --git a/module/system/repl/error-handling.scm
b/module/system/repl/error-handling.scm
index db0beeb..e77ea96 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -32,6 +32,16 @@
;;; Error handling via repl debugging
;;;
+(define (error-string stack key args)
+ (with-output-to-string
+ (lambda ()
+ (pmatch args
+ ((,subr ,msg ,args . ,rest)
+ (display-error (vector-ref stack 0) (current-output-port)
+ subr msg args rest))
+ (else
+ (format #t "Throw to key `~a' with args `~s'." key args))))))
+
(define* (call-with-error-handling thunk #:key
(on-error 'debug) (post-error 'catch)
(pass-keys '(quit)))
@@ -45,7 +55,7 @@
(lambda ()
(with-error-to-port err
thunk))))))
-
+
(catch #t
(lambda () (%start-stack #t thunk))
@@ -75,7 +85,7 @@
(if (procedure? post-error)
post-error ; a handler proc
(error "Unknown post-error strategy" post-error))))
-
+
(case on-error
((debug)
(lambda (key . args)
@@ -85,22 +95,18 @@
(make-stack #t)
;; Cut three frames from the top of the stack:
;; make-stack, this one, and the throw handler.
- 3
+ 3
;; Narrow the end of the stack to the most recent
;; start-stack.
tag
;; And one more frame, because %start-stack invoking
;; the start-stack thunk has its own frame too.
0 (and tag 1)))
- (debug (make-debug stack 0)))
+ (error-msg (error-string stack key args))
+ (debug (make-debug stack 0 error-msg)))
(with-saved-ports
(lambda ()
- (pmatch args
- ((,subr ,msg ,args . ,rest)
- (display-error (vector-ref stack 0) (current-output-port)
- subr msg args rest))
- (else
- (format #t "Throw to key `~a' with args `~s'." key args)))
+ (format #t error-msg)
(format #t "Entering a new prompt. ")
(format #t "Type `,bt' for a backtrace or `,q' to continue.\n")
((@ (system repl repl) start-repl) #:debug debug))))))
--
1.7.1
- [PATCH] Add new debug meta-command ,error, Jose A. Ortega Ruiz, 2010/08/30
- Re: [PATCH] Add new debug meta-command ,error, Andy Wingo, 2010/08/30
- Re: [PATCH] Add new debug meta-command ,error, Jose A. Ortega Ruiz, 2010/08/30
- Re: [PATCH] Add new debug meta-command ,error, Andy Wingo, 2010/08/30
- Re: [PATCH] Add new debug meta-command ,error, Jose A. Ortega Ruiz, 2010/08/30
- Re: [PATCH] Add new debug meta-command ,error, Andy Wingo, 2010/08/30
- Re: [PATCH] Add new debug meta-command ,error,
Jose A. Ortega Ruiz <=
- Re: [PATCH] Add new debug meta-command ,error, Andy Wingo, 2010/08/30
- Re: [PATCH] Add new debug meta-command ,error, Jose A. Ortega Ruiz, 2010/08/31