From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Leo Liu Newsgroups: gmane.emacs.devel Subject: Re: trunk r117969: Font-lock `cl-flet*', too. Date: Mon, 29 Sep 2014 14:41:49 +0800 Message-ID: References: <87bnpz981y.fsf@zigzag.favinet> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1411972959 26750 80.91.229.3 (29 Sep 2014 06:42:39 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 29 Sep 2014 06:42:39 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Sep 29 08:42:32 2014 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XYUfH-0005p4-GG for ged-emacs-devel@m.gmane.org; Mon, 29 Sep 2014 08:42:31 +0200 Original-Received: from localhost ([::1]:34506 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XYUfH-0004je-5u for ged-emacs-devel@m.gmane.org; Mon, 29 Sep 2014 02:42:31 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:44572) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XYUew-0004jS-9j for emacs-devel@gnu.org; Mon, 29 Sep 2014 02:42:19 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XYUen-0000PV-53 for emacs-devel@gnu.org; Mon, 29 Sep 2014 02:42:10 -0400 Original-Received: from mail-pd0-x22d.google.com ([2607:f8b0:400e:c02::22d]:49817) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XYUem-0000P4-Py for emacs-devel@gnu.org; Mon, 29 Sep 2014 02:42:01 -0400 Original-Received: by mail-pd0-f173.google.com with SMTP id w10so7021058pde.4 for ; Sun, 28 Sep 2014 23:41:54 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:cc:subject:references:face:date:in-reply-to:message-id :user-agent:mime-version:content-type; bh=opZuPw9vipwAmf4jhFdpXa7aMyKwKTJ2hTK9FFTE+Fg=; b=IsTgmUZMrsb1YHZZZFuAFDZjL3Qe3o1LYAhG+gtxgJ4vT5BuCkregLD4ua84DychAy kAz8CNulyUf0tAKaJlFFjkQMYrj3ndcOP/cNkgMTPdlbieCtayo+Ns8eKcNDQmX6kqZC RAdStOQhQAhZnuHTJ195g81g27wbWsSapdHSjVmgz+VwdyIKdCE4OlrOE4xQIfZ/a7kz 2VLbxlMkoQCdtkr6swoxJ4QEFfQuYqbdCOkseIbQpxSlTPwLq9BflD5pRlS9ASbiZ/UC e1MVWHA0XDGfNVi82teDX7O+Qlwb97as48xHOC4Hv00srmhdRg4tHDNmlHC+y30Nvgza 3USQ== X-Received: by 10.68.247.137 with SMTP id ye9mr57727783pbc.69.1411972914627; Sun, 28 Sep 2014 23:41:54 -0700 (PDT) Original-Received: from fortuna ([221.222.147.223]) by mx.google.com with ESMTPSA id qx4sm11331484pbc.14.2014.09.28.23.41.52 for (version=TLSv1.1 cipher=RC4-SHA bits=128/128); Sun, 28 Sep 2014 23:41:54 -0700 (PDT) Face: iVBORw0KGgoAAAANSUhEUgAAACgAAAAoBAMAAAB+0KVeAAAAGFBMVEUKDAg1NjRWV1V9fnyg op/DxcLk5uP8/voi63ReAAAACXBIWXMAAAWJAAAFiQFtaJ36AAAAB3RJTUUH1goZAgAz00bgXgAA AeVJREFUKM9lk0Fz2jAQhQXJD3CCO70CmcC1YMtcWyTZ14Bl69xats4N9r6/3zWQBlodNKNPu/s0 b1cCQFuZGpfVVh3vAvBJolIXRkapSuoRUtIdFyo1Y5xSdlAj7OtvD1XnXxmWRi+eWgcxyCed1lVV B1CrKyujMoi+eLA5kU1SsjoHlW+nQjTtFxk4MXgrOxvIqzoTZR8XgPaLl419zgsMaSGFPiUOZCIh thsx5Xy9NsK8Kwf/JoQgMxcVJ301HKkcSWaT0O7FY056J4U9xcYfnmVXG4801lW6lqwu2nKFZoHC HuzvaTVndZ+LaRQgZdthXw1cpynEkLEwyFHXk/aIxNQ6QeooJuzPMB+wn+D7JJNsiCcVA13/A3h/ xE9J+WidpAwoYNmRFwyvSRhNVtsdaAewzZZP5uw82QL9+tyNfocyP0McAzICUr5Mk9RdIjWasUNx aIIt6NK4ZtXIMdfMQt3nuMAyWbLI4DqZ4xPq/ag8jPond4XU/cLuOgw6XCFX/YCUfcDAMMH58fD4 G9kDchwfqVefkBwup2uZM+Q4WhJt5jN3AxXCsaS2yXEDuWgS8VOzW0gFjhEPmLyFMKBFaLb1HRwc DiaKwx0EeTMRYnYPQRW3PP4HApvlMv0PttX5v/D6Aws3IOSEwzmLAAAAAElFTkSuQmCC In-Reply-To: (Stefan Monnier's message of "Sun, 28 Sep 2014 21:30:11 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.4.50 (CentOS 6.5) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2607:f8b0:400e:c02::22d X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:174792 Archived-At: On 2014-09-28 21:30 -0400, Stefan Monnier wrote: > Notice the `setq's? These make a big difference in lexical-binding code > (since they mean that we can't close over the var's value but have to > close over the var's memory location, which gets reified as a cons > cell). I see them but didn't know they were inefficient. Would something along these lines be acceptable? Thanks, Leo === modified file 'lisp/emacs-lisp/cl-macs.el' --- lisp/emacs-lisp/cl-macs.el 2014-07-21 01:41:59 +0000 +++ lisp/emacs-lisp/cl-macs.el 2014-09-29 06:37:43 +0000 @@ -1811,6 +1811,20 @@ (setq cl--labels-convert-cache (cons f res)) res)))))) +(defun cl--labels-depend-p (body &optional deps) + "Return non-nil if BODY refers to any function in DEPS. " + (catch 'exit + (let ((newenv (cons (cons 'function + (lambda (f) + (and (memq f deps) (throw 'exit t)) + f)) + (append (mapcar (lambda (dep) + (cons dep (lambda (&rest _) (throw 'exit t)))) + deps) + macroexpand-all-environment)))) + (macroexpand-all (macroexp-progn body) newenv)) + nil)) + ;;;###autoload (defmacro cl-flet (bindings &rest body) "Make local function definitions. @@ -1855,19 +1869,28 @@ \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) (debug cl-flet)) - (let ((binds ()) (newenv macroexpand-all-environment)) + (let ((binds ()) + (setqs ()) + (newenv macroexpand-all-environment) + (deps (mapcar #'car bindings))) (dolist (binding bindings) (let ((var (make-symbol (format "--cl-%s--" (car binding))))) - (push (list var `(cl-function (lambda . ,(cdr binding)))) binds) + (if (cl--labels-depend-p (cddr binding) deps) + (progn + (push var binds) + (push `(setq ,var (cl-function (lambda . ,(cdr binding)))) setqs)) + (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)) (push (cons (car binding) - `(lambda (&rest cl-labels-args) - (cl-list* 'funcall ',var - cl-labels-args))) - newenv))) - (macroexpand-all `(letrec ,(nreverse binds) ,@body) - ;; Don't override lexical-let's macro-expander. - (if (assq 'function newenv) newenv - (cons (cons 'function #'cl--labels-convert) newenv))))) + `(lambda (&rest cl-labels-args) + (cl-list* 'funcall ',var cl-labels-args))) + newenv)) + (pop deps)) + (macroexpand-all `(let* ,(nreverse binds) + ,@(nreverse setqs) + ,@body) + ;; Don't override lexical-let's macro-expander. + (if (assq 'function newenv) newenv + (cons (cons 'function #'cl--labels-convert) newenv))))) ;; The following ought to have a better definition for use with newer ;; byte compilers.