From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: npostavs@users.sourceforge.net Newsgroups: gmane.emacs.bugs Subject: bug#25122: 24.5; function describe-variable hangs on large variables Date: Sat, 11 Mar 2017 00:40:03 -0500 Message-ID: <87mvcs8j7w.fsf@users.sourceforge.net> References: <20161206022112.GF25778@E15-2016.optimum.net> <87twahk19y.fsf@gmail.com> <87d1h4fld5.fsf@users.sourceforge.net> <871sxkyv2m.fsf@gmail.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1489210761 11341 195.159.176.226 (11 Mar 2017 05:39:21 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 11 Mar 2017 05:39:21 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.2 (gnu/linux) Cc: 25122@debbugs.gnu.org, Boruch Baum To: Thierry Volpiatto Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Mar 11 06:39:12 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 1cmZkB-0001It-Ap for geb-bug-gnu-emacs@m.gmane.org; Sat, 11 Mar 2017 06:39:07 +0100 Original-Received: from localhost ([::1]:42026 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cmZkH-0007TE-0J for geb-bug-gnu-emacs@m.gmane.org; Sat, 11 Mar 2017 00:39:13 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:46535) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cmZkA-0007T5-NB for bug-gnu-emacs@gnu.org; Sat, 11 Mar 2017 00:39:08 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cmZk6-00057w-Nv for bug-gnu-emacs@gnu.org; Sat, 11 Mar 2017 00:39:06 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:51979) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cmZk6-00057m-Hv for bug-gnu-emacs@gnu.org; Sat, 11 Mar 2017 00:39:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cmZk6-0006r6-6C for bug-gnu-emacs@gnu.org; Sat, 11 Mar 2017 00:39:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 11 Mar 2017 05:39:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 25122 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 25122-submit@debbugs.gnu.org id=B25122.148921073626336 (code B ref 25122); Sat, 11 Mar 2017 05:39:02 +0000 Original-Received: (at 25122) by debbugs.gnu.org; 11 Mar 2017 05:38:56 +0000 Original-Received: from localhost ([127.0.0.1]:50178 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cmZjy-0006qg-Uk for submit@debbugs.gnu.org; Sat, 11 Mar 2017 00:38:56 -0500 Original-Received: from mail-it0-f44.google.com ([209.85.214.44]:38373) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cmZjw-0006qN-Lh for 25122@debbugs.gnu.org; Sat, 11 Mar 2017 00:38:53 -0500 Original-Received: by mail-it0-f44.google.com with SMTP id m27so7905907iti.1 for <25122@debbugs.gnu.org>; Fri, 10 Mar 2017 21:38:52 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=WmDp4YuoB/ykfbjpfi7PuD6YaldbY5JYVjwhHMg4jBk=; b=YW4BTb2UFN8JpAwn1+KmFX62D8wTLC0QTnDMXVar/xvH8O/QLqFPYWQtTw8m3I2fiL FQaPoGyUM/Zaoit2FXB9wSyYhoFC754HzdNFfchjs9IfmLAk2brv8TC+DNMG70UU5DJG D6RPDLjQn1F50T00i1lNoVd0SdRC9dT7Bi6XuNHGpxUMljah+laOi7+FTfoOpty8hL+H rEUjgLp2LBEXQrDEsKEC+inu74l9tTXlxgydHBw5UVte6o3lxCoOAkE8RgqDpfVXGMQv rAi6Z05JoRPorSKZMELwsSIlBXspjKv8uwgaQzepoAvcGH+58bPWZbdoy0lgYJC79JKa y0LQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:cc:subject:references:date :in-reply-to:message-id:user-agent:mime-version; bh=WmDp4YuoB/ykfbjpfi7PuD6YaldbY5JYVjwhHMg4jBk=; b=isq0Dw7eFdJqViMfifzlxyuSdKzYnAONDSDnoKohI6Vh1GBFKbswp7Gv15UcFmQBkN cXosAUs5Ujd0AgLVODGDJC8BgYSzfAQc2HHDug6BVUYk7ZvOYdSIZU8S2vsgm8j2OUEi dXc+/QoO7nnpq4JgJE4ofECMBSKjlOwKh6DYem3b0CuR1mS2tY7qFZTJEmH73fXcFa4w LVCat3k/NUHA36e5E/Gnanfw26nHl9FIQaf3c1b9cfx5G1bMPNDi46fY3/i9I3o4GjD0 0gXyrz26NIpDLVSS20JTUKchl5/wkArqQ/83Wkh24kYIrJN6ZJfpQpEB4s4vI7/INV6l xwFA== X-Gm-Message-State: AFeK/H0P4dSbZCwsCwbcjkA4gQ/XTN9eSSYs4yziDBC3TP4D7QWsoxsTGc32m3p5rt9a5A== X-Received: by 10.36.116.71 with SMTP id o68mr2490419itc.60.1489210727074; Fri, 10 Mar 2017 21:38:47 -0800 (PST) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id p140sm757479itc.27.2017.03.10.21.38.45 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Fri, 10 Mar 2017 21:38:45 -0800 (PST) In-Reply-To: <871sxkyv2m.fsf@gmail.com> (Thierry Volpiatto's message of "Wed, 07 Dec 2016 09:58:25 +0100") 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:130462 Archived-At: --=-=-= Content-Type: text/plain Thierry Volpiatto writes: > > I don't think it would be as fast as printing one by one each elements. > What is slow is printing the whole object. > See how bookmark file is saved, it was taking more than one minute for > my bookmarks before printing one by one, now it is instant or nearly. Actually, it's the indent-sexp on the whole object that takes time. Possibly we could sacrifice some indentation correctness if the printed representation is big. I've been attempting an alternate approach which prettyprints the object while scanning it instead of the current way of printing and then reindenting. Without optimizing, it's about 3 times as fast as the current pp (it's the pp-prin1 in the benchmarks below), though more than 3 times slower than your mapc pp trick. On the other hand, it also doesn't yet handle function-specific indentation or any compound structure apart from lists, so I'm not sure if it will end up being much faster. (benchmark 1 '(with-temp-buffer (pp-prin1 long-list (current-buffer)) nil)) "Elapsed time: 3.391232s (0.565806s in 11 GCs)" (benchmark 1 '(progn (pp-to-string long-list) nil)) "Elapsed time: 9.988515s (0.148034s in 3 GCs)" (benchmark 1 '(progn (with-output-to-string (mapc 'pp long-list)) nil)) "Elapsed time: 0.983493s (0.144424s in 3 GCs)" (benchmark 1 '(progn (cl-prin1-to-string long-list) nil)) "Elapsed time: 0.511617s (0.152483s in 3 GCs)" (benchmark 1 '(progn (prin1-to-string long-list) nil)) "Elapsed time: 0.029320s" --=-=-= Content-Type: text/plain Content-Disposition: attachment; filename=v1-0001-Initial-draft-of-new-pretty-printer-Bug-25122.patch Content-Description: draft patch >From 66f6dda0507fa4699ba929379cd1c58ef8b540f5 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Mar 2017 00:09:36 -0500 Subject: [PATCH v1] Initial draft of new pretty printer (Bug#25122) * lisp/emacs-lisp/pp.el (pp-state): New struct. (pp--scan): New function, measures length of sublists (actually "logical blocks" to allow for more customizable grouping than just by lists). Calls pp--print when scanned tokens are too wide to fit on a single line. (pp--print): New function, prints tokens horizontally or vertically depending on whether the sublist can fit within the line. (pp-prin1): New function, entry point for pp--scan and pp-print. Wraps stream so that cl-print will dispatch to prettyprinting methods. (cl-print-object) <_ (head :pprint)>: New method, wraps cl-prin1-to-string for prettyprinting. (cl-print-object) : New mthod, prettyprinter for lists. --- lisp/emacs-lisp/pp.el | 143 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 143 insertions(+) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 7ef46a48bd..3809325c4b 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -24,6 +24,9 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) +(require 'ring) + (defvar font-lock-verbose) (defgroup pp nil @@ -121,6 +124,146 @@ pp-display-expression (setq buffer-read-only nil) (set (make-local-variable 'font-lock-verbose) nil))))) + +(cl-defstruct (pp-state (:constructor + make-pp-state + (stream + &aux + (right-margin fill-column) + (left-margin 0) + (indent '(0)) + (scan-depth 0) + (print-depth 0) + (print-width 0) + (scan-width 0) + (block-mode (list nil)) + (fifo (make-ring 30))))) + stream + right-margin ; how far we may go. + left-margin ; how far printer has gone + print-width ; total width of tokens printed so far. + indent ; left-margin, stack per depth. + scan-width ; total width of tokens scanned so far. + scan-depth + print-depth + block-widths + block-mode ; `:vertical', `:horizontal', nil (undecided); stack per depth. + fifo + ) + +(defun pp--print (state) + (cl-symbol-macrolet ((stream (pp-state-stream state)) + (depth (pp-state-print-depth state)) + (scan-depth (pp-state-scan-depth state)) + (fifo (pp-state-fifo state)) + (left-margin (pp-state-left-margin state)) + (width (pp-state-print-width state)) + (indent (pp-state-indent state)) + (right-margin (pp-state-right-margin state)) + (block-mode (pp-state-block-mode state))) + (catch 'rescan + (while (not (ring-empty-p fifo)) + (pcase (ring-remove fifo) + ((and `(,len . :open-block) token) + (if (<= len 0) + ;; Not ready to print this yet! + (progn (ring-insert-at-beginning fifo token) + (throw 'rescan nil)) + (cl-incf depth) + (push left-margin indent) + (push (if (> (+ left-margin len) right-margin) + :vertical :horizontal) + block-mode))) + (:close-block (cl-decf depth) (pop indent) (pop block-mode)) + (:blank + (pcase (car block-mode) + (:vertical + (terpri stream) + (princ (make-string (car indent) ?\s) stream) + (setf left-margin (car indent))) + ((or :horizontal 'nil) + (write-char ?\s stream) + (cl-incf left-margin)) + (_ (error "oops"))) + (cl-incf width)) + (:eof nil) + ((and (pred characterp) char) + (write-char char stream) + (cl-incf left-margin (char-width char)) + (cl-incf width (char-width char))) + (string + (princ string stream) + (cl-incf left-margin (string-width string)) + (cl-incf width (string-width string)))))))) + +(defun pp--scan (token state) + (cl-symbol-macrolet ((stream (pp-state-stream state)) + (depth (pp-state-scan-depth state)) + (print-depth (pp-state-print-depth state)) + (fifo (pp-state-fifo state)) + (width (pp-state-scan-width state)) + (right-margin (pp-state-right-margin state)) + (block-widths (pp-state-block-widths state))) + (cl-flet ((scanlen (len) (cl-incf width len))) + (cl-assert (> (ring-size fifo) (ring-length fifo))) + (ring-insert fifo token) + (pcase token + (:open-block + (cl-incf depth) + (let ((block-token (cons (- width) (ring-remove fifo 0)))) + (push block-token block-widths) + (ring-insert fifo block-token))) + (:close-block + (cl-incf (caar block-widths) width) + (when (> (caar block-widths) right-margin) + (pp--print state)) + (cl-decf depth) + (pop block-widths)) + (:blank (scanlen 1)) + (:eof (pp--print state)) + ((pred characterp) (scanlen (char-width token))) + (_ (scanlen (string-width token))))) + (when block-widths + (when (> (+ (caar block-widths) width) right-margin) + (dolist (block-width block-widths) + (setf (car block-width) (+ right-margin 1)))) + (when (> (caar block-widths) right-margin) + (pp--print state))))) + +(defvar cl-print-readably) ; cl-print.el + +(defun pp-prin1 (object &optional stream) + (let ((cl-print-readably nil) + (stream (make-pp-state (or stream standard-output)))) + (pp--scan :open-block stream) + (prog1 (cl-prin1 object (cons :pprint stream)) + (pp--scan :close-block stream) + (pp--scan :eof stream)))) + +;; fallback to standard `cl-print-object'. +(cl-defmethod cl-print-object (object (stream (head :pprint))) + (pp--scan (cl-prin1-to-string object) (cdr stream)) + object) + +(cl-defmethod cl-print-object ((list cons) (stream (head :pprint))) + (let ((state (cdr stream))) + (pcase list + (`(,head . ,tail) + (pp--scan "(" state) + (pp--scan :open-block state) + (cl-print-object head stream) + (while (consp tail) + (pp--scan :blank state) + (cl-print-object (pop tail) stream)) + (when tail + (pp--scan :blank state) + (pp--scan ?\. state) + (pp--scan :blank state) + (cl-print-object tail stream)) + (pp--scan :close-block state) + (pp--scan ")" state)))) + list) + ;;;###autoload (defun pp-eval-expression (expression) "Evaluate EXPRESSION and pretty-print its value. -- 2.11.1 --=-=-=--