GNU bug report logs - #29684
exception printers - request for improvement

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guile; Reported by: David Pirotte <david@HIDDEN>; dated Wed, 13 Dec 2017 03:28:02 UTC; Maintainer for guile is bug-guile@HIDDEN.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 13 Dec 2017 03:27:05 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Tue Dec 12 22:27:05 2017
Received: from localhost ([127.0.0.1]:59227 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1eOxhI-0002Hm-Kd
	for submit <at> debbugs.gnu.org; Tue, 12 Dec 2017 22:27:04 -0500
Received: from eggs.gnu.org ([208.118.235.92]:46574)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <david@HIDDEN>) id 1eOxhG-0002HF-Ox
 for submit <at> debbugs.gnu.org; Tue, 12 Dec 2017 22:27:03 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <david@HIDDEN>) id 1eOxh9-0004Ib-Vb
 for submit <at> debbugs.gnu.org; Tue, 12 Dec 2017 22:26:57 -0500
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled
 version=3.3.2
Received: from lists.gnu.org ([2001:4830:134:3::11]:35076)
 by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32)
 (Exim 4.71) (envelope-from <david@HIDDEN>) id 1eOxh9-0004IV-RC
 for submit <at> debbugs.gnu.org; Tue, 12 Dec 2017 22:26:55 -0500
Received: from eggs.gnu.org ([2001:4830:134:3::10]:37530)
 by lists.gnu.org with esmtp (Exim 4.71)
 (envelope-from <david@HIDDEN>) id 1eOxh8-0000Kg-22
 for bug-guile@HIDDEN; Tue, 12 Dec 2017 22:26:55 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <david@HIDDEN>) id 1eOxh3-0004GQ-3J
 for bug-guile@HIDDEN; Tue, 12 Dec 2017 22:26:54 -0500
Received: from maximusconfessor.all2all.org ([79.99.200.102]:33960)
 by eggs.gnu.org with esmtp (Exim 4.71)
 (envelope-from <david@HIDDEN>) id 1eOxh2-0004G8-Nj
 for bug-guile@HIDDEN; Tue, 12 Dec 2017 22:26:49 -0500
Received: from localhost (unknown [192.168.0.2])
 by maximusconfessor.all2all.org (Postfix) with ESMTP id 8278BA04C1BC
 for <bug-guile@HIDDEN>; Wed, 13 Dec 2017 04:26:47 +0100 (CET)
Received: from maximusconfessor.all2all.org ([192.168.0.1])
 by localhost (maximusconfessor.all2all.org [192.168.0.2]) (amavisd-new,
 port 10024) with ESMTP id vOaprWLFPSJN for <bug-guile@HIDDEN>;
 Wed, 13 Dec 2017 04:26:43 +0100 (CET)
Received: from capac (unknown [179.210.16.171])
 by maximusconfessor.all2all.org (Postfix) with ESMTPSA id 4A6AEA04C1B9
 for <bug-guile@HIDDEN>; Wed, 13 Dec 2017 04:26:42 +0100 (CET)
Date: Wed, 13 Dec 2017 01:26:33 -0200
From: David Pirotte <david@HIDDEN>
To: <bug-guile@HIDDEN>
Subject: exception printers - request for improvement
Message-ID: <20171213012435.34d43175@capac>
X-Mailer: Claws Mail 3.15.1-dirty (GTK+ 2.24.31; x86_64-pc-linux-gnu)
MIME-Version: 1.0
Content-Type: multipart/signed; micalg=pgp-sha512;
 boundary="Sig_/C6XpQvcB=C2fh9ZKEDbL5EQ"; protocol="application/pgp-signature"
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy]
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x
X-Received-From: 2001:4830:134:3::11
X-Spam-Score: -5.0 (-----)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -5.0 (-----)

--Sig_/C6XpQvcB=C2fh9ZKEDbL5EQ
Content-Type: multipart/mixed; boundary="MP_/SfZDFOGZvgBhiXJsATPDlJ/"

--MP_/SfZDFOGZvgBhiXJsATPDlJ/
Content-Type: text/plain; charset=US-ASCII
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline

Hello,

	The attached patched is from Daniel Lloren, I'm just 'a messenger' (and ad=
ded
	a comment in the source, preceding the new binding).

The proposed patch is to allow  exception printers user customization.

This has been very important, not to say vital, for those of us who manipul=
ate large
structures, lists, arrays, sfri-4 bytevectors, ..., something we have been =
doing
locally ... but we need something for our users (aiscm, guile-cv ...), so t=
hey don't
have to patch guile locally... (most would be scared to do so and would not=
 do it
anyway...).

Once applied, users can, for example, customize the raised exception system=
 so it
uses truncated-print, either individually (in .guile), or guile admins can =
do
this globally (in share/guile-site/init.scm):

	(use-modules (ice-9 pretty-print))
                   =20
	(when (defined? 'exception-format)
	  (set! exception-format
	        (lambda (port fmt . args)
	          (for-each (lambda (arg)
	                      (truncated-print arg #:port port))
	              args))))

Maybe there is another/better approach, I don't know, but this works pretty=
 well
for me...

Thanks,
David

--MP_/SfZDFOGZvgBhiXJsATPDlJ/
Content-Type: text/x-patch
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
 filename=0002-Allowing-exception-printers-user-customization.patch

=46rom 772cc05b1fe481a43be4c17c90ed3788cf37d2a6 Mon Sep 17 00:00:00 2001
From: David Pirotte <david@HIDDEN>
Date: Wed, 13 Dec 2017 00:43:30 -0200
Subject: [PATCH 2/2] Allowing exception printers user customization

* module/ice-9/boot-9.scm (exception-format, dispatch-exception,
  exception-printers, scm-error-printer, syntax-error-printer,
  keyword-error-printer, getaddrinfo-error-printer, false-if-exception,
  make-record-type):  Instead of using 'format', let's define a specific
  format binding for exception printers, to allow its user
  customization.
---
 module/ice-9/boot-9.scm | 46 ++++++++++++++++++++++++++--------------------
 1 file changed, 26 insertions(+), 20 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 751a3bcd1..cbbedac15 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -326,6 +326,10 @@ If returning early, return the return value of F."
=20
 (define format simple-format)
=20
+;; instead of using the above, let's define a specific format binding
+;; for exception printers, to allow its user customization.
+(define exception-format simple-format)
+
 ;; this is scheme wrapping the C code so the final pred call is a tail cal=
l,
 ;; per SRFI-13 spec
 (define string-any
@@ -762,7 +766,7 @@ information is unavailable."
                        ((not (car args)) 1)
                        (else 0))))
      (else
-      (format (current-error-port) "guile: uncaught throw to ~a: ~a\n"
+      (exception-format (current-error-port) "guile: uncaught throw to ~a:=
 ~a\n"
               key args)
       (primitive-exit 1))))
=20
@@ -865,8 +869,8 @@ for key @var{k}, then invoke @var{thunk}."
           (let ((filename (or (cadr source) "<unnamed port>"))
                 (line (caddr source))
                 (col (cdddr source)))
-            (format port "~a:~a:~a: " filename (1+ line) col))
-          (format port "ERROR: "))))
+            (exception-format port "~a:~a:~a: " filename (1+ line) col))
+          (exception-format port "ERROR: "))))
=20
   (set! set-exception-printer!
         (lambda (key proc)
@@ -875,7 +879,7 @@ for key @var{k}, then invoke @var{thunk}."
   (set! print-exception
         (lambda (port frame key args)
           (define (default-printer)
-            (format port "Throw to key `~a' with args `~s'." key args))
+            (exception-format port "Throw to key `~a' with args `~s'." key=
 args))
=20
           (when frame
             (print-location frame port)
@@ -884,7 +888,7 @@ for key @var{k}, then invoke @var{thunk}."
                           (lambda () (frame-procedure-name frame))
                           (lambda _ #f))))
               (when name
-                (format port "In procedure ~a:\n" name))))
+                (exception-format port "In procedure ~a:\n" name))))
=20
           (catch #t
             (lambda ()
@@ -893,7 +897,9 @@ for key @var{k}, then invoke @var{thunk}."
                     (printer port key args default-printer)
                     (default-printer))))
             (lambda (k . args)
-              (format port "Error while printing exception.")))
+              (exception-format
+               port "Error while printing exception `~a`: `~a' with args [=
~s]"
+               key k args)))
           (newline port)
           (force-output port))))
=20
@@ -907,38 +913,38 @@ for key @var{k}, then invoke @var{thunk}."
     (apply (case-lambda
              ((subr msg args . rest)
               (if subr
-                  (format port "In procedure ~a: " subr))
-              (apply format port msg (or args '())))
+                  (exception-format port "In procedure ~a: " subr))
+              (apply exception-format port msg (or args '())))
              (_ (default-printer)))
            args))
=20
   (define (syntax-error-printer port key args default-printer)
     (apply (case-lambda
              ((who what where form subform . extra)
-              (format port "Syntax error:\n")
+              (exception-format port "Syntax error:\n")
               (if where
                   (let ((file (or (assq-ref where 'filename) "unknown file=
"))
                         (line (and=3D> (assq-ref where 'line) 1+))
                         (col (assq-ref where 'column)))
-                    (format port "~a:~a:~a: " file line col))
-                  (format port "unknown location: "))
+                    (exception-format port "~a:~a:~a: " file line col))
+                  (exception-format port "unknown location: "))
               (if who
-                  (format port "~a: " who))
-              (format port "~a" what)
+                  (exception-format port "~a: " who))
+              (exception-format port "~a" what)
               (if subform
-                  (format port " in subform ~s of ~s" subform form)
+                  (exception-format port " in subform ~s of ~s" subform fo=
rm)
                   (if form
-                      (format port " in form ~s" form))))
+                      (exception-format port " in form ~s" form))))
              (_ (default-printer)))
            args))
=20
   (define (keyword-error-printer port key args default-printer)
     (let ((message (cadr args))
           (faulty  (car (cadddr args)))) ; I won't do it again, I promise.
-      (format port "~a: ~s" message faulty)))
+      (exception-format port "~a: ~s" message faulty)))
=20
   (define (getaddrinfo-error-printer port key args default-printer)
-    (format port "In procedure getaddrinfo: ~a" (gai-strerror (car args))))
+    (exception-format port "In procedure getaddrinfo: ~a" (gai-strerror (c=
ar args))))
=20
   (set-exception-printer! 'goops-error scm-error-printer)
   (set-exception-printer! 'host-not-found scm-error-printer)
@@ -1066,11 +1072,11 @@ VALUE."
        (lambda (key . args)
          (for-each (lambda (s)
                      (if (not (string-null? s))
-                         (format (current-warning-port) ";;; ~a\n" s)))
+                         (exception-format (current-warning-port) ";;; ~a\=
n" s)))
                    (string-split
                     (call-with-output-string
                      (lambda (port)
-                       (format port template arg ...)
+                       (exception-format port template arg ...)
                        (print-exception port #f key args)))
                     #\newline))
          #f)))))
@@ -1229,7 +1235,7 @@ VALUE."
                 (if (=3D (length args) nfields)
                     (apply make-struct/no-tail rtd args)
                     (scm-error 'wrong-number-of-args
-                               (format #f "make-~a" type-name)
+                               (exception-format #f "make-~a" type-name)
                                "Wrong number of arguments" '() #f)))))))))
=20
   (define (default-record-printer s p)
--=20
2.15.1


--MP_/SfZDFOGZvgBhiXJsATPDlJ/--

--Sig_/C6XpQvcB=C2fh9ZKEDbL5EQ
Content-Type: application/pgp-signature
Content-Description: OpenPGP digital signature

-----BEGIN PGP SIGNATURE-----

iQEzBAEBCgAdFiEEhCJlRZtBM3furJHe83T9k6MFetcFAlownekACgkQ83T9k6MF
etc5pQgArOlyZXGyAOfDTVbmYi5rcIc7QlinvSHys68A8N1vhSGGP7u7jH7rIihT
vttfzF/qdG8NrJ7OXQWM3xfw+xWMmQkChL2i60Ux5xfpYT3IPFZDu1gXi/Cc2qOn
nC7HnONwx8x/qqyjOmallPOhlDHNTC2z4R45qtF0Fp16m0o6Re2xt2fLscTB38Vo
FAj4TR6rWnWOcqP78pbDeMmRnhi3A8LN2ZKnhAWnDv5TmpAbKwq+wZLNCTgPdDhw
cInss/VqId8wy0ig69JZulhPz3cD67Lf4EeEmg4MQ80hmkmTM1BY9f/XLd4kMHKW
ixAgWx0AXFr/qkVc5aHQCuhHrlOGlA==
=bqjF
-----END PGP SIGNATURE-----

--Sig_/C6XpQvcB=C2fh9ZKEDbL5EQ--




Acknowledgement sent to David Pirotte <david@HIDDEN>:
New bug report received and forwarded. Copy sent to bug-guile@HIDDEN. Full text available.
Report forwarded to bug-guile@HIDDEN:
bug#29684; Package guile. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Wed, 13 Dec 2017 03:30:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.