From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#25295: Represent eieio objects using object-print in backtraces and edebug Date: Tue, 21 Feb 2017 12:23:12 -0500 Message-ID: References: <87pokampa4.fsf@ericabrahamsen.net> <8760m2mmlq.fsf@ericabrahamsen.net> <87lguq5r87.fsf@ericabrahamsen.net> <878tp0i74g.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1487699116 25719 195.159.176.226 (21 Feb 2017 17:45:16 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 21 Feb 2017 17:45:16 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: Eric Abrahamsen , 25295@debbugs.gnu.org To: npostavs@users.sourceforge.net Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Feb 21 18:45:09 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@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 1cgEUs-0005n2-6K for geb-bug-gnu-emacs@m.gmane.org; Tue, 21 Feb 2017 18:45:06 +0100 Original-Received: from localhost ([::1]:47415 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cgEUy-0007cN-03 for geb-bug-gnu-emacs@m.gmane.org; Tue, 21 Feb 2017 12:45:12 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:35652) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cgEAX-0004Dg-OL for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 12:24:07 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cgEAU-0004iR-Ih for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 12:24:05 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:50943) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cgEAU-0004iK-EL for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 12:24:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cgEAU-0006LA-5y for bug-gnu-emacs@gnu.org; Tue, 21 Feb 2017 12:24:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 21 Feb 2017 17:24:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 25295 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 25295-submit@debbugs.gnu.org id=B25295.148769779624306 (code B ref 25295); Tue, 21 Feb 2017 17:24:02 +0000 Original-Received: (at 25295) by debbugs.gnu.org; 21 Feb 2017 17:23:16 +0000 Original-Received: from localhost ([127.0.0.1]:49139 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgE9k-0006Jx-DB for submit@debbugs.gnu.org; Tue, 21 Feb 2017 12:23:16 -0500 Original-Received: from chene.dit.umontreal.ca ([132.204.246.20]:53014) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cgE9i-0006Jp-Fz for 25295@debbugs.gnu.org; Tue, 21 Feb 2017 12:23:15 -0500 Original-Received: from ceviche.home (lechon.iro.umontreal.ca [132.204.27.242]) by chene.dit.umontreal.ca (8.14.7/8.14.1) with ESMTP id v1LHNCvE005349; Tue, 21 Feb 2017 12:23:13 -0500 Original-Received: by ceviche.home (Postfix, from userid 20848) id 400206627C; Tue, 21 Feb 2017 12:23:12 -0500 (EST) In-Reply-To: <878tp0i74g.fsf@users.sourceforge.net> (npostavs's message of "Mon, 20 Feb 2017 21:56:47 -0500") X-NAI-Spam-Flag: NO X-NAI-Spam-Level: X-NAI-Spam-Threshold: 5 X-NAI-Spam-Score: 0.1 X-NAI-Spam-Rules: 3 Rules triggered TRK_NCM1=0.1, EDT_SA_DN_PASS=0, RV5954=0 X-NAI-Spam-Version: 2.3.0.9418 : core <5954> : inlines <5711> : streams <1733922> : uri <2380983> 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-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:129623 Archived-At: > Can we allow overriding printing of primitive types too? > I'm wanting that for e.g., printing byte code functions in nicer ways. Maybe we should just switch to an Elisp version of printing, in that case. We could keep the C code for the "print-readably" case only. The main question is whether it's fast enough. Stefan ;;; cl-print.el --- Generic printer facilies -*- lexical-binding: t; -*- ;; Copyright (C) 2017 Stefan Monnier ;; Author: Stefan Monnier ;; Keywords: ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program 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 General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: ;;;###autoload (cl-defgeneric cl-print-object (object stream) "Dispatcher to print OBJECT on STREAM according to its type." (prin1 object stream)) (cl-defmethod cl-print-object ((object cons) stream) (let ((car (pop object))) (if (and (memq car '(\, quote \` \,@ \,.)) (consp object) (null (cdr object))) (progn (princ (if (eq car 'quote) '\' car) stream) (cl-print-object (car object) stream)) (princ "(" stream) (cl-print-object car stream) (while (consp object) (princ " " stream) (cl-print-object (pop object) stream)) (when object (princ " . ") (cl-print-object object stream)) (princ ")")))) (cl-defmethod cl-print-object ((object vector) stream) (princ "[" stream) (dotimes (i (length object)) (unless (zerop i) (princ " " stream)) (cl-print-object (aref object i) stream)) (princ "]" stream)) (cl-defmethod cl-print-object ((object compiled-function) stream) ;; FIXME: Give a prettier representation. (princ "#" stream)) (cl-defmethod cl-print-object ((object cl-structure-object) stream) (princ "#s(") (let* ((class (symbol-value (aref object 0))) (slots (cl--struct-class-slots class))) (princ (cl--struct-class-name class) stream) (dotimes (i (length slots)) (let ((slot (aref slots i))) (princ " :" stream) (princ (cl--slot-descriptor-name slot) stream) (princ " " stream) (cl-print-object (aref object (1+ i)) stream)))) (princ ")")) ;;; Circularity and sharing. ;; I don't try to support the `print-continuous-numbering', because ;; I think it's ill defined anyway: if an object appears only once in each call ;; its sharing can't be properly preserved! (defvar cl-print--number-index nil) (defvar cl-print--number-table nil) (cl-defmethod cl-print-object :around (object stream) ;; FIXME: Only put such an :around method on types where it's relevant. (let ((n (if cl-print--number-table (gethash object cl-print--number-table)))) (if (not (numberp n)) (cl-call-next-method) (if (> n 0) ;; Already printed. Just print a reference. (progn (princ "#" stream) (princ n stream) (princ "#" stream)) (puthash object (- n) cl-print--number-table) (princ "#" stream) (princ (- n) stream) (princ "=" stream) (cl-call-next-method))))) (defun cl-print--find-sharing (object table) (unless ;; Skip objects which don't have identity! (or (floatp object) (numberp object)) (let ((n (gethash object table))) (cond ((numberp n)) ;All done. (n ;Already seen, but only once. (let ((n (1+ cl-print--number-index))) (setq cl-print--number-index n) (puthash object (- n) table))) (t (puthash object t table) (pcase object (`(,car . ,cdr) (cl-print--find-sharing car table) (cl-print--find-sharing cdr table)) ((pred stringp) ;; We presumably won't print its text-properties. nil) ((pred arrayp) ;FIXME: Inefficient for char-tables! (dotimes (i (length object)) (cl-print--find-sharing (aref object i) table))))))))) ;;;###autoload (defun cl-prin1 (object &optional stream) (if (not print-circle) (cl-print-object object stream) (let ((cl-print--number-table (make-hash-table :test 'eq)) (cl-print--number-index 0)) (cl-print--find-sharing object cl-print--number-table) (cl-print-object object stream)))) (provide 'cl-print) ;;; cl-print.el ends here