unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* R6RS exception printing -- take #2
@ 2011-02-01  0:19 Andreas Rottmann
  2011-02-01  1:07 ` Andreas Rottmann
  2011-02-01 20:06 ` Andy Wingo
  0 siblings, 2 replies; 6+ messages in thread
From: Andreas Rottmann @ 2011-02-01  0:19 UTC (permalink / raw)
  To: Guile Development

Hi!

I've started refreshing the patch[0] to improve exception presentation for
R6RS exceptions, initially discussed in [1].  I'd like to solicit
clarification on a few points.

To recap, it was agreed to add something like the following internal API
to boot-9.scm:

  exception-printer := port key args exception-printer -> nothing

  set-exception-printer! : key exception-printer -> nothing
  exception-printer : key -> exception-printer OR #f

In the above, exception-printer is a procedure that's supposed to either
display the exception it got passed (via `args') on `port', or "punt",
by calling the exception printer passed to it.  Note that, relative to
the previous discussion, I've added the argument `key', to make it
possible for the fallback (generic) exception printer, as passed to any
registered exception printer as its last argument, to display the key of
the raised exception.  Another option (which I slightly prefer) would be
this change, relative to the above API:

  exception-printer := port args thunk

In this variant, the exception printer may call `thunk' to punt on
handling the exception -- the `key' argument is not necessary anymore,
as it can be closed over by the thunk.

This exception registry would be used in the REPL error-handling code
primarily, via a `print-exception' procedure querying the registry and
invoking the matching printer (or the default one, if no printer is
matching).

Another open issue is the potential `frame' argument; it seems this is
only used at one place in `(system repl error-handling)', inside
`call-with-error-handling' (I did a quick grep for "display-error" and
"Throw to" to identify the sites where I'd plug in the exception
registry via the `print-exception' procedure).  

If we decide that `frame' should not be part of the exception-printer
arguments, we'd lose source information in the exception printout in
this case.  As `call-with-error-handling' is only used in the REPL
(where one could get source information via the ",bt" meta-command) and
in `(web server)', I guess the loss would be bearable.

[ Just a thought: it looks like it /might/ make sense to contemplate
  deprecating passing the frame information to `display-error' and
  untangle displaying the exception object and displaying a backtrace
  completely. ]

Regards, Rotty
-- 
Andreas Rottmann -- <http://rotty.yi.org/>



^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: R6RS exception printing -- take #2
  2011-02-01  0:19 R6RS exception printing -- take #2 Andreas Rottmann
@ 2011-02-01  1:07 ` Andreas Rottmann
  2011-02-01 20:06 ` Andy Wingo
  1 sibling, 0 replies; 6+ messages in thread
From: Andreas Rottmann @ 2011-02-01  1:07 UTC (permalink / raw)
  To: Guile Development

Andreas Rottmann <a.rottmann@gmx.at> writes:

> Hi!
>
> I've started refreshing the patch[0] to improve exception presentation for
> R6RS exceptions, initially discussed in [1].  I'd like to solicit
> clarification on a few points.
>
Sorry, forgot the link (it's both the same URL):

[0] [1] http://thread.gmane.org/gmane.lisp.guile.devel/11066
-- 
Andreas Rottmann -- <http://rotty.yi.org/>



^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: R6RS exception printing -- take #2
  2011-02-01  0:19 R6RS exception printing -- take #2 Andreas Rottmann
  2011-02-01  1:07 ` Andreas Rottmann
@ 2011-02-01 20:06 ` Andy Wingo
  2011-02-06 18:09   ` Andreas Rottmann
  2011-02-07 12:07   ` [PATCH] " Andreas Rottmann
  1 sibling, 2 replies; 6+ messages in thread
From: Andy Wingo @ 2011-02-01 20:06 UTC (permalink / raw)
  To: Andreas Rottmann; +Cc: Guile Development

Heya Andreas,

You proposed a choice between two options:

On Tue 01 Feb 2011 01:19, Andreas Rottmann <a.rottmann@gmx.at> writes:

>   exception-printer := port key args exception-printer -> nothing
>   exception-printer := port args thunk

The `key' argument is necessary, at least if you want one printer to
handle multiple keys (as the default printer might).  I prefer the
first, FWIW.

> This exception registry would be used in the REPL error-handling code
> primarily, via a `print-exception' procedure querying the registry and
> invoking the matching printer (or the default one, if no printer is
> matching).

There are other cases that it would be nice to use it: in the catch-all
in throw.c, and in general when printing exceptions from C.

> Another open issue is the potential `frame' argument; it seems this is
> only used at one place in `(system repl error-handling)', inside
> `call-with-error-handling' (I did a quick grep for "display-error" and
> "Throw to" to identify the sites where I'd plug in the exception
> registry via the `print-exception' procedure).
>
> If we decide that `frame' should not be part of the exception-printer
> arguments, we'd lose source information in the exception printout in
> this case.

Let's keep the frame out of the exception-printer functions, but still
pass it to the procedure that does the exception printing dispatch
(perhaps called print-exception or something).  That way we can print
source information, then let exception printers do their thing.

> [ Just a thought: it looks like it /might/ make sense to contemplate
>   deprecating passing the frame information to `display-error' and
>   untangle displaying the exception object and displaying a backtrace
>   completely. ]

There are certainly some tangles here.  If you find The Right Thing, let
us know...

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: R6RS exception printing -- take #2
  2011-02-01 20:06 ` Andy Wingo
@ 2011-02-06 18:09   ` Andreas Rottmann
  2011-02-11 15:08     ` Andy Wingo
  2011-02-07 12:07   ` [PATCH] " Andreas Rottmann
  1 sibling, 1 reply; 6+ messages in thread
From: Andreas Rottmann @ 2011-02-06 18:09 UTC (permalink / raw)
  To: Andy Wingo; +Cc: Guile Development

Andy Wingo <wingo@pobox.com> writes:

> Heya Andreas,
>
Hi! I've attached an updated patch; see below for some points that are
still to be discussed.  If this patch is deemed OK, I'll work on
converting all relevant sites in the REPL to use `print-exception'.

> You proposed a choice between two options:
>
> On Tue 01 Feb 2011 01:19, Andreas Rottmann <a.rottmann@gmx.at> writes:
>
>>   exception-printer := port key args exception-printer -> nothing
>>   exception-printer := port args thunk
>
> The `key' argument is necessary, at least if you want one printer to
> handle multiple keys (as the default printer might).  I prefer the
> first, FWIW.
>
OK, I've now done this:

  exception-printer := port key args thunk -> nothing

The rationale of passing in a thunk instead of an exception printer is
that, to invoke the exception printer passed as last argument, the
procedure would have to pass a fallback printer to *that* printer, which
it can't do, as it doesn't know what that should be.  Additionally, the
fallback printer has to be a closure anyway, as it needs access to the
`frame' argument passed to `print-exception' (see below).

>> This exception registry would be used in the REPL error-handling code
>> primarily, via a `print-exception' procedure querying the registry and
>> invoking the matching printer (or the default one, if no printer is
>> matching).
>
> There are other cases that it would be nice to use it: in the catch-all
> in throw.c, and in general when printing exceptions from C.
>
I'll defer looking into that; I'll first make a follow-up patch dealing
with the call sites inside the REPL code.

>> Another open issue is the potential `frame' argument; it seems this is
>> only used at one place in `(system repl error-handling)', inside
>> `call-with-error-handling' (I did a quick grep for "display-error" and
>> "Throw to" to identify the sites where I'd plug in the exception
>> registry via the `print-exception' procedure).
>>
>> If we decide that `frame' should not be part of the exception-printer
>> arguments, we'd lose source information in the exception printout in
>> this case.
>
> Let's keep the frame out of the exception-printer functions, but still
> pass it to the procedure that does the exception printing dispatch
> (perhaps called print-exception or something).  That way we can print
> source information, then let exception printers do their thing.
>
The source info printing is now done only in the fallback printer, and
only on "regular match" exceptions (i.e. those that have the
conventional `args' structure).  This is the same behavior as without
the patch.  However, I think it would be more consistent to always print
source information if available; this would entail:

- Duplicating the source-information-printing logic of `display-error' in
  `print-exception'.

- Always call `display-error' with #f as `frame', or perhaps stop
  calling `display-error' and just print the exception ourselves.

What do you think?

>> [ Just a thought: it looks like it /might/ make sense to contemplate
>>   deprecating passing the frame information to `display-error' and
>>   untangle displaying the exception object and displaying a backtrace
>>   completely. ]
>
> There are certainly some tangles here.  If you find The Right Thing, let
> us know...
>
If we decide to do the source-information printing inside
`print-exception' (as proposed above), we might think about deprecating
`display-error' in favor of `print-exception'.  Unfortunatly,
`display-error' cannot be implemented in terms of `print-exception', as
the former is missing the `key' argument that the latter requires.

Regards, Rotty
-- 
Andreas Rottmann -- <http://rotty.yi.org/>



^ permalink raw reply	[flat|nested] 6+ messages in thread

* [PATCH] R6RS exception printing -- take #2
  2011-02-01 20:06 ` Andy Wingo
  2011-02-06 18:09   ` Andreas Rottmann
@ 2011-02-07 12:07   ` Andreas Rottmann
  1 sibling, 0 replies; 6+ messages in thread
From: Andreas Rottmann @ 2011-02-07 12:07 UTC (permalink / raw)
  To: Andy Wingo; +Cc: Guile Development

[-- Attachment #1: Type: text/plain, Size: 169 bytes --]

Andy Wingo <wingo@pobox.com> writes:

> Heya Andreas,
>
> You proposed a choice between two options:
>
[...]

I forgot to attach the patch in my last mail, here it is:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: r6rs-exception-print.diff --]
[-- Type: text/x-diff, Size: 9581 bytes --]

From: Andreas Rottmann <a.rottmann@gmx.at>
Subject: Show R6RS exceptions in a reasonable way in the debugger

* module/ice-9/boot-9.scm (exception-printer, set-exception-printer!):
  New procedures, implementing the exception printer registry.

* module/system/repl/error-handling.scm (error-string): Replaced with
  `print-exception' procedure which makes use of the exception printer
  registry. Call sites adjusted.

* module/rnrs/exceptions.scm (exception-printer, format-condition,
  format-simple-condition): New procedures implementing an exception
  printer for R6RS exceptions.  Register the exception printer for the
  `r6rs:exception' key.


---
 module/ice-9/boot-9.scm               |   15 ++++++
 module/rnrs/exceptions.scm            |   83 ++++++++++++++++++++++++++++++++-
 module/system/repl/error-handling.scm |   50 +++++++++++---------
 3 files changed, 123 insertions(+), 25 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 29e2cd7..23b3123 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -197,6 +197,21 @@ If there is no handler at all, Guile prints an error and then exits."
               (apply (exception-handler) key args)))))
 
 
+;; Procedures for looking up and registering exception printers. Hide
+;; the shared state in a lexical contour. Note that this is a
+;; Guile-internal API, and should not be used outside of Guile itself.
+
+(define exception-printer #f)
+(define set-exception-printer! #f)
+
+(let ((exception-printers '()))
+  (set! exception-printer
+        (lambda (key)
+          (assq-ref exception-printers key)))
+  (set! set-exception-printer!
+        (lambda (key proc)
+          (set! exception-printers (acons key proc exception-printers)))))
+
 \f
 
 ;;; {R4RS compliance}
diff --git a/module/rnrs/exceptions.scm b/module/rnrs/exceptions.scm
index ff4049b..95d01df 100644
--- a/module/rnrs/exceptions.scm
+++ b/module/rnrs/exceptions.scm
@@ -1,6 +1,6 @@
 ;;; exceptions.scm --- The R6RS exceptions library
 
-;;      Copyright (C) 2010 Free Software Foundation, Inc.
+;;      Copyright (C) 2010, 2011 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
@@ -20,9 +20,19 @@
 (library (rnrs exceptions (6))
   (export guard with-exception-handler raise raise-continuable)
   (import (rnrs base (6))
+          (rnrs control (6))
           (rnrs conditions (6))
 	  (rnrs records procedural (6))
-	  (only (guile) with-throw-handler *unspecified* @@))
+	  (rnrs records inspection (6))
+	  (only (guile)
+                format
+                newline
+                display
+                filter
+                set-exception-printer!
+                with-throw-handler
+                *unspecified*
+                @@))
 
   (define raise (@@ (rnrs records procedural) r6rs-raise))
   (define raise-continuable 
@@ -64,4 +74,73 @@
        (guard0 (variable cond-clause ... (else else-clause ...)) . body))
       ((_ (variable cond-clause ...) . body)
        (guard0 (variable cond-clause ... (else (raise variable))) . body))))
+
+  ;;; Exception printing
+
+  (define (exception-printer port key args punt)
+    (cond ((and (= 1 (length args))
+                (raise-object-wrapper? (car args)))
+           (let ((obj (raise-object-wrapper-obj (car args))))
+             (cond ((condition? obj)
+                    (display "ERROR: R6RS exception:\n" port)
+                    (format-condition port obj))
+                   (else
+                    (format port "ERROR: R6RS exception: `~s'" obj)))))
+          (else
+           (punt))))
+
+  (define (format-condition port condition)
+    (let ((components (simple-conditions condition)))
+      (if (null? components)
+          (format port "Empty condition object")
+          (let loop ((i 1) (components components))
+            (cond ((pair? components)
+                   (format port "  ~a. " i)
+                   (format-simple-condition port (car components))
+                   (when (pair? (cdr components))
+                     (newline port))
+                   (loop (+ i 1) (cdr components))))))))
+
+  (define (format-simple-condition port condition)
+    (define (print-rtd-fields rtd field-names)
+      (let ((n-fields (vector-length field-names)))
+        (do ((i 0 (+ i 1)))
+            ((>= i n-fields))
+          (format port "      ~a: ~s"
+                  (vector-ref field-names i)
+                  ((record-accessor rtd i) condition))
+          (unless (= i (- n-fields 1))
+            (newline port)))))
+    (let ((condition-name (record-type-name (record-rtd condition))))
+      (let loop ((rtd (record-rtd condition))
+                 (rtd.fields-list '())
+                 (n-fields 0))
+        (cond (rtd
+               (let ((field-names (record-type-field-names rtd)))
+                 (loop (record-type-parent rtd)
+                       (cons (cons rtd field-names) rtd.fields-list)
+                       (+ n-fields (vector-length field-names)))))
+              (else
+               (let ((rtd.fields-list
+                      (filter (lambda (rtd.fields)
+                                (not (zero? (vector-length (cdr rtd.fields)))))
+                              (reverse rtd.fields-list))))
+                 (case n-fields
+                   ((0) (format port "~a" condition-name))
+                   ((1) (format port "~a: ~s"
+                                condition-name
+                                ((record-accessor (caar rtd.fields-list) 0)
+                                 condition)))
+                   (else
+                    (format port "~a:\n" condition-name)
+                    (let loop ((lst rtd.fields-list))
+                      (when (pair? lst)
+                        (let ((rtd.fields (car lst)))
+                          (print-rtd-fields (car rtd.fields) (cdr rtd.fields))
+                          (when (pair? (cdr lst))
+                            (newline port))
+                          (loop (cdr lst)))))))))))))
+
+  (set-exception-printer! 'r6rs:exception exception-printer)
+
 )
diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm
index 7d30bf0..a875496 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -1,6 +1,6 @@
 ;;; Error handling in the REPL
 
-;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011 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
@@ -33,16 +33,18 @@
 ;;; Error handling via repl debugging
 ;;;
 
-(define (error-string stack key args)
-  (pmatch args
-    ((,subr ,msg ,args . ,rest)
-     (guard (> (vector-length stack) 0))
-     (with-output-to-string
-       (lambda ()
-         (display-error (vector-ref stack 0) (current-output-port)
-                        subr msg args rest))))
-    (else
-     (format #f "Throw to key `~a' with args `~s'." key args))))
+(define (print-exception port frame key args)
+  (define (print-default)
+    (pmatch args
+      ((,subr ,msg ,args . ,rest)
+       (display-error frame port subr msg args rest))
+      (else
+       (format port "ERROR: Throw to key `~a' with args `~s'." key args))))
+  (cond ((exception-printer key)
+         => (lambda (printer)
+              (printer port key args print-default)))
+        (else
+         (print-default))))
 
 (define* (call-with-error-handling thunk #:key
                                    (on-error 'debug) (post-error 'catch)
@@ -107,17 +109,12 @@
            (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)))
+                 (with-saved-ports
+                   (lambda ()
+                     (run-hook before-error-hook)
+                     (print-exception err #f key args)
+                     (run-hook after-error-hook)
+                     (force-output err)))
                  (if #f #f)))))
         ((catch)
          (lambda (key . args)
@@ -145,7 +142,14 @@
                           ;; And one more frame, because %start-stack invoking
                           ;; the start-stack thunk has its own frame too.
                           0 (and tag 1)))
-                  (error-msg (error-string stack key args))
+                  (error-msg
+                   (call-with-output-string
+                     (lambda (port)
+                       (print-exception port
+                                        (and (< 0 (vector-length stack))
+                                             (vector-ref stack 0))
+                                        key
+                                        args))))
                   (debug (make-debug stack 0 error-msg #f)))
              (with-saved-ports
               (lambda ()
-- 
tg: (9d427b2..) t/r6rs-exception-print (depends on: master)

[-- Attachment #3: Type: text/plain, Size: 48 bytes --]


-- 
Andreas Rottmann -- <http://rotty.yi.org/>

^ permalink raw reply related	[flat|nested] 6+ messages in thread

* Re: R6RS exception printing -- take #2
  2011-02-06 18:09   ` Andreas Rottmann
@ 2011-02-11 15:08     ` Andy Wingo
  0 siblings, 0 replies; 6+ messages in thread
From: Andy Wingo @ 2011-02-11 15:08 UTC (permalink / raw)
  To: Andreas Rottmann; +Cc: Guile Development

Hi Andreas,

On Sun 06 Feb 2011 19:09, Andreas Rottmann <a.rottmann@gmx.at> writes:

>   exception-printer := port key args thunk -> nothing

I ended up adopting this.  Thanks for the patch.

I reworked your patch a bit -- for example, print-exception is now in
boot-9, and used by C also.  The C bits were actually more important to
me than the R6RS exceptions, so I poked that first.

> However, I think it would be more consistent to always print source
> information if available

> If we decide to do the source-information printing inside
> `print-exception' (as proposed above), we might think about deprecating
> `display-error' in favor of `print-exception'.

Done.  I don't like display-error, let's stop using it.  I didn't
actually deprecate display-error, but it's on the list...  I guess
we need to fix the docs now.

> `display-error' cannot be implemented in terms of `print-exception', as
> the former is missing the `key' argument that the latter requires.

I just made it fabricate a "misc-error" key.  It's not lying if no one
knows, right?

Cheers,

Andy
-- 
http://wingolog.org/



^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2011-02-11 15:08 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2011-02-01  0:19 R6RS exception printing -- take #2 Andreas Rottmann
2011-02-01  1:07 ` Andreas Rottmann
2011-02-01 20:06 ` Andy Wingo
2011-02-06 18:09   ` Andreas Rottmann
2011-02-11 15:08     ` Andy Wingo
2011-02-07 12:07   ` [PATCH] " Andreas Rottmann

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).