* [PATCH] Add new debug meta-command ,error @ 2010-08-30 4:52 Jose A. Ortega Ruiz 2010-08-30 15:01 ` Andy Wingo 0 siblings, 1 reply; 9+ messages in thread From: Jose A. Ortega Ruiz @ 2010-08-30 4:52 UTC (permalink / raw) To: guile-devel, wingo; +Cc: jao * module/system/repl/debug.scm: <debug> stores the error string in a new field. * module/system/repl/error-handling.scm: use the error string to construct the <debug> instance. * module/system/repl/command.scm: new debug command `error' that extracts the new <debug> field. Signed-off-by: Jose A. Ortega Ruiz <jao@gnu.org> --- module/system/repl/command.scm | 12 +++++++++--- module/system/repl/debug.scm | 4 ++-- module/system/repl/error-handling.scm | 26 ++++++++++++++++---------- 3 files changed, 27 insertions(+), 15 deletions(-) diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index 8a62a16..52b0708 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 e)) (inspect (inspect i) (pretty-print pp)) (system (gc) (statistics stat) (option o) (quit q continue cont)))) @@ -474,6 +474,12 @@ Trace execution." body body* ...) (format #t "Nothing to debug.~%")))))))) +(define-meta-command (error repl) + "error +Display the original error message." + (let ((debug (repl-debug repl))) + (format #t "~a~%" (if debug (debug-error-message debug) "")))) + (define-stack-command (backtrace repl #:optional count #:key (width 72) full?) "backtrace [COUNT] [#:width W] [#:full? F] 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) \f 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 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] Add new debug meta-command ,error 2010-08-30 4:52 [PATCH] Add new debug meta-command ,error Jose A. Ortega Ruiz @ 2010-08-30 15:01 ` Andy Wingo 2010-08-30 19:39 ` Jose A. Ortega Ruiz 0 siblings, 1 reply; 9+ messages in thread From: Andy Wingo @ 2010-08-30 15:01 UTC (permalink / raw) To: Jose A. Ortega Ruiz; +Cc: guile-devel Hi, Thanks for the patch. Only one small comment; feel free to commit when you're happy with it (I think you have access). On Sun 29 Aug 2010 21:52, "Jose A. Ortega Ruiz" <jao@gnu.org> writes: > +(define-meta-command (error repl) > + "error > +Display the original error message." > + (let ((debug (repl-debug repl))) > + (format #t "~a~%" (if debug (debug-error-message debug) "")))) > + Perhaps use define-stack-command to handle the no-debug case. In any case if there is no debug, we need a better message. Thanks, Andy -- http://wingolog.org/ ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Add new debug meta-command ,error 2010-08-30 15:01 ` Andy Wingo @ 2010-08-30 19:39 ` Jose A. Ortega Ruiz 2010-08-30 20:44 ` Andy Wingo 0 siblings, 1 reply; 9+ messages in thread From: Jose A. Ortega Ruiz @ 2010-08-30 19:39 UTC (permalink / raw) To: Andy Wingo; +Cc: guile-devel [-- Attachment #1: Type: text/plain, Size: 1230 bytes --] On Mon, Aug 30 2010, Andy Wingo wrote: > Hi, > > Thanks for the patch. Only one small comment; feel free to commit when > you're happy with it (I think you have access). > > On Sun 29 Aug 2010 21:52, "Jose A. Ortega Ruiz" <jao@gnu.org> writes: > >> +(define-meta-command (error repl) >> + "error >> +Display the original error message." >> + (let ((debug (repl-debug repl))) >> + (format #t "~a~%" (if debug (debug-error-message debug) "")))) >> + > > Perhaps use define-stack-command to handle the no-debug case. In any > case if there is no debug, we need a better message. Yes, that makes sense. I've made the new command a stack one, added a binding in define-stack-command for the new debug field and changed the name of the command from `error' to `message' (because the former shadows the built-in procedure, which is used by other commands). I've also added an entry for `message' in the manual. I'm not specially happy with the new name, but couldn't think of anything better. Suggestions welcome. I'm attaching the new patch: i've checked and yes, i do have commit access, so, if you feel that's okay, i'll submit it myself. Thanks a lot for the review, jao ------------------------------------------------ [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Add-new-debug-meta-command-message.patch --] [-- Type: text/x-diff, Size: 8525 bytes --] From 60e83442ef16427f47ca8b76d14743812dfc66ae Mon Sep 17 00:00:00 2001 From: Jose A. Ortega Ruiz <jao@gnu.org> Date: Mon, 30 Aug 2010 06:37:24 +0200 Subject: [PATCH] Add new debug meta-command ,message * module/system/repl/debug.scm: <debug> stores the error string in a new field. * module/system/repl/error-handling.scm: use the error string to construct the <debug> instance. * module/system/repl/command.scm: new debug command `message' that extracts the new <debug> field, available to stack commands as error-message. * doc/ref/scheme-using.texi: documentation for new command. Signed-off-by: Jose A. Ortega Ruiz <jao@gnu.org> --- doc/ref/scheme-using.texi | 7 +++++++ module/system/repl/command.scm | 30 +++++++++++++++++++++--------- module/system/repl/debug.scm | 4 ++-- module/system/repl/error-handling.scm | 26 ++++++++++++++++---------- 4 files changed, 46 insertions(+), 21 deletions(-) diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi index e07b148..b22b2d4 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 +@deffn {REPL Command} message +Show error message. + +Display the message associated with the error that started the current +debugging REPL. +@end 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..0ac449d 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) (message msg)) (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 ~@[ 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 'error-message) + (identifier-syntax (debug-error-message debug))) (#,(datum->syntax #'repl 'index) (identifier-syntax (id (debug-index debug)) @@ -474,6 +476,16 @@ Trace execution." body body* ...) (format #t "Nothing to debug.~%")))))))) +(define-stack-command (message repl) + "message +Show error message. + +Display the message associated with the error that started the current +debugging REPL." + (format #t "~a~%" (if (string? error-message) + error-message + "No error message"))) + (define-stack-command (backtrace repl #:optional count #:key (width 72) full?) "backtrace [COUNT] [#:width W] [#:full? F] @@ -481,11 +493,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 +560,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)) - + \f ;;; ;;; Inspection commands @@ -581,7 +593,7 @@ Pretty-print the result(s) of evaluating EXP." \f ;;; -;;; 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) \f 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 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] Add new debug meta-command ,error 2010-08-30 19:39 ` Jose A. Ortega Ruiz @ 2010-08-30 20:44 ` Andy Wingo 2010-08-30 20:45 ` Jose A. Ortega Ruiz 0 siblings, 1 reply; 9+ messages in thread From: Andy Wingo @ 2010-08-30 20:44 UTC (permalink / raw) To: Jose A. Ortega Ruiz; +Cc: guile-devel On Mon 30 Aug 2010 12:39, "Jose A. Ortega Ruiz" <jao@gnu.org> writes: > changed the name of the command from `error' to `message' > I'm not specially happy with the new name, but couldn't think of > anything better. Suggestions welcome. How about "error-message" ? Perhaps abbreviated as ,error ? A -- http://wingolog.org/ ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Add new debug meta-command ,error 2010-08-30 20:44 ` Andy Wingo @ 2010-08-30 20:45 ` Jose A. Ortega Ruiz 2010-08-31 1:54 ` Andy Wingo 0 siblings, 1 reply; 9+ messages in thread From: Jose A. Ortega Ruiz @ 2010-08-30 20:45 UTC (permalink / raw) To: Andy Wingo; +Cc: guile-devel On Mon, Aug 30 2010, Andy Wingo wrote: > On Mon 30 Aug 2010 12:39, "Jose A. Ortega Ruiz" <jao@gnu.org> writes: > >> changed the name of the command from `error' to `message' > >> I'm not specially happy with the new name, but couldn't think of >> anything better. Suggestions welcome. > > How about "error-message" ? Perhaps abbreviated as ,error ? yeah, that was my first idea, but i thought you'd find it too long :) i'm for it if you like it, though -- perhaps we could abbreviate it as ,e to compensate? jao -- How many Zen Buddhist does it take to change a light bulb? Two. One to change it and one not to change it. ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Add new debug meta-command ,error 2010-08-30 20:45 ` Jose A. Ortega Ruiz @ 2010-08-31 1:54 ` Andy Wingo 2010-08-31 2:30 ` Jose A. Ortega Ruiz 0 siblings, 1 reply; 9+ messages in thread From: Andy Wingo @ 2010-08-31 1:54 UTC (permalink / raw) To: Jose A. Ortega Ruiz; +Cc: guile-devel On Mon 30 Aug 2010 13:45, "Jose A. Ortega Ruiz" <jao@gnu.org> writes: > On Mon, Aug 30 2010, Andy Wingo wrote: > >> On Mon 30 Aug 2010 12:39, "Jose A. Ortega Ruiz" <jao@gnu.org> writes: >> >>> changed the name of the command from `error' to `message' >> >>> I'm not specially happy with the new name, but couldn't think of >>> anything better. Suggestions welcome. >> >> How about "error-message" ? Perhaps abbreviated as ,error ? > > yeah, that was my first idea, but i thought you'd find it too long :) > i'm for it if you like it, though -- perhaps we could abbreviate it as > ,e to compensate? I would prefer ,error-message and ,error, I think; I feel like we could use ,e for other things (eval, expand, ...). Andy -- http://wingolog.org/ ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Add new debug meta-command ,error 2010-08-31 1:54 ` Andy Wingo @ 2010-08-31 2:30 ` Jose A. Ortega Ruiz 2010-08-31 3:23 ` Andy Wingo 0 siblings, 1 reply; 9+ messages in thread From: Jose A. Ortega Ruiz @ 2010-08-31 2:30 UTC (permalink / raw) To: Andy Wingo; +Cc: guile-devel [-- Attachment #1: Type: text/plain, Size: 234 bytes --] 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? [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Add-new-debug-meta-command-error-message.patch --] [-- Type: text/x-diff, Size: 8497 bytes --] From 9f601e08e40e2d90f2425e6a5dc7a142cac4ae35 Mon Sep 17 00:00:00 2001 From: Jose A. Ortega Ruiz <jao@gnu.org> 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 <jao@gnu.org> --- 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 +@deffn {REPL Command} error-message [error] +Show error message. + +Display the message associated with the error that started the current +debugging REPL. +@end 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 ~@[ 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)) - + \f ;;; ;;; Inspection commands @@ -581,7 +591,7 @@ Pretty-print the result(s) of evaluating EXP." \f ;;; -;;; 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) \f 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 ^ permalink raw reply related [flat|nested] 9+ messages in thread
* Re: [PATCH] Add new debug meta-command ,error 2010-08-31 2:30 ` Jose A. Ortega Ruiz @ 2010-08-31 3:23 ` Andy Wingo 2010-08-31 11:56 ` Jose A. Ortega Ruiz 0 siblings, 1 reply; 9+ messages in thread From: Andy Wingo @ 2010-08-31 3:23 UTC (permalink / raw) To: Jose A. Ortega Ruiz; +Cc: guile-devel Hi, On Mon 30 Aug 2010 19:30, "Jose A. Ortega Ruiz" <jao@gnu.org> writes: > Should i commit to master? Yes please, modulo one fix: > +@deffn {REPL Command} error-message [error] > +Show error message. This would indicate that ERROR is an optional arg. I think you want @deffnx instead. Andy -- http://wingolog.org/ ^ permalink raw reply [flat|nested] 9+ messages in thread
* Re: [PATCH] Add new debug meta-command ,error 2010-08-31 3:23 ` Andy Wingo @ 2010-08-31 11:56 ` Jose A. Ortega Ruiz 0 siblings, 0 replies; 9+ messages in thread From: Jose A. Ortega Ruiz @ 2010-08-31 11:56 UTC (permalink / raw) To: Andy Wingo; +Cc: guile-devel On Tue, Aug 31 2010, Andy Wingo wrote: > Hi, > > On Mon 30 Aug 2010 19:30, "Jose A. Ortega Ruiz" <jao@gnu.org> writes: > >> Should i commit to master? > > Yes please, modulo one fix: > >> +@deffn {REPL Command} error-message [error] >> +Show error message. > > This would indicate that ERROR is an optional arg. I think you want > @deffnx instead. Yes. Fixed and pushed. Thanks a lot. jao ^ permalink raw reply [flat|nested] 9+ messages in thread
end of thread, other threads:[~2010-08-31 11:56 UTC | newest] Thread overview: 9+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2010-08-30 4:52 [PATCH] Add new debug meta-command ,error Jose A. Ortega Ruiz 2010-08-30 15:01 ` Andy Wingo 2010-08-30 19:39 ` Jose A. Ortega Ruiz 2010-08-30 20:44 ` Andy Wingo 2010-08-30 20:45 ` Jose A. Ortega Ruiz 2010-08-31 1:54 ` Andy Wingo 2010-08-31 2:30 ` Jose A. Ortega Ruiz 2010-08-31 3:23 ` Andy Wingo 2010-08-31 11:56 ` Jose A. Ortega Ruiz
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).