From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: David Pirotte Newsgroups: gmane.lisp.guile.bugs Subject: bug#29684: exception printers - request for improvement Date: Wed, 13 Dec 2017 01:26:33 -0200 Message-ID: <20171213012435.34d43175@capac> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/signed; micalg=pgp-sha512; boundary="Sig_/C6XpQvcB=C2fh9ZKEDbL5EQ"; protocol="application/pgp-signature" X-Trace: blaine.gmane.org 1513135695 31396 195.159.176.226 (13 Dec 2017 03:28:15 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 13 Dec 2017 03:28:15 +0000 (UTC) To: 29684@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Wed Dec 13 04:28:11 2017 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eOxiM-0007qC-Sv for guile-bugs@m.gmane.org; Wed, 13 Dec 2017 04:28:11 +0100 Original-Received: from localhost ([::1]:33367 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eOxiS-0001fo-7e for guile-bugs@m.gmane.org; Tue, 12 Dec 2017 22:28:16 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37731) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eOxiJ-0001fe-VQ for bug-guile@gnu.org; Tue, 12 Dec 2017 22:28:09 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eOxiE-0004mo-WA for bug-guile@gnu.org; Tue, 12 Dec 2017 22:28:07 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:50546) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eOxiE-0004mh-QR for bug-guile@gnu.org; Tue, 12 Dec 2017 22:28:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1eOxiE-0002JH-IY for bug-guile@gnu.org; Tue, 12 Dec 2017 22:28:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: David Pirotte Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Wed, 13 Dec 2017 03:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 29684 X-GNU-PR-Package: guile X-GNU-PR-Keywords: X-Debbugs-Original-To: Original-Received: via spool by submit@debbugs.gnu.org id=B.15131356258794 (code B ref -1); Wed, 13 Dec 2017 03:28:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 13 Dec 2017 03:27:05 +0000 Original-Received: from localhost ([127.0.0.1]:59227 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eOxhI-0002Hm-Kd for submit@debbugs.gnu.org; Tue, 12 Dec 2017 22:27:04 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:46574) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eOxhG-0002HF-Ox for submit@debbugs.gnu.org; Tue, 12 Dec 2017 22:27:03 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eOxh9-0004Ib-Vb for submit@debbugs.gnu.org; Tue, 12 Dec 2017 22:26:57 -0500 Original-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 ) id 1eOxh9-0004IV-RC for submit@debbugs.gnu.org; Tue, 12 Dec 2017 22:26:55 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37530) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eOxh8-0000Kg-22 for bug-guile@gnu.org; Tue, 12 Dec 2017 22:26:55 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eOxh3-0004GQ-3J for bug-guile@gnu.org; Tue, 12 Dec 2017 22:26:54 -0500 Original-Received: from maximusconfessor.all2all.org ([79.99.200.102]:33960) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eOxh2-0004G8-Nj for bug-guile@gnu.org; Tue, 12 Dec 2017 22:26:49 -0500 Original-Received: from localhost (unknown [192.168.0.2]) by maximusconfessor.all2all.org (Postfix) with ESMTP id 8278BA04C1BC for ; Wed, 13 Dec 2017 04:26:47 +0100 (CET) Original-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 ; Wed, 13 Dec 2017 04:26:43 +0100 (CET) Original-Received: from capac (unknown [179.210.16.171]) by maximusconfessor.all2all.org (Postfix) with ESMTPSA id 4A6AEA04C1B9 for ; Wed, 13 Dec 2017 04:26:42 +0100 (CET) X-Mailer: Claws Mail 3.15.1-dirty (GTK+ 2.24.31; x86_64-pc-linux-gnu) 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-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: "bug-guile" Xref: news.gmane.org gmane.lisp.guile.bugs:8929 Archived-At: --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 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) "")) (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--