[PATCH] Add new debug meta-command ,error

[PATCH] Add new debug meta-command ,error

[Jose A. Ortega Ruiz]

* 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

Re: [PATCH] Add new debug meta-command ,error

[Andy Wingo]

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/

Re: [PATCH] Add new debug meta-command ,error

[Jose A. Ortega Ruiz]

[-- 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

Re: [PATCH] Add new debug meta-command ,error

[Andy Wingo]

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/

Re: [PATCH] Add new debug meta-command ,error

[Jose A. Ortega Ruiz]

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.

Re: [PATCH] Add new debug meta-command ,error

[Andy Wingo]

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/

Re: [PATCH] Add new debug meta-command ,error

[Jose A. Ortega Ruiz]

[-- 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

Re: [PATCH] Add new debug meta-command ,error

[Andy Wingo]

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/

Re: [PATCH] Add new debug meta-command ,error

[Jose A. Ortega Ruiz]

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