[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 3c97272: * lisp/emacs-lisp/subr-x.el (with-memoization): New macr
From: |
Stefan Monnier |
Subject: |
master 3c97272: * lisp/emacs-lisp/subr-x.el (with-memoization): New macro |
Date: |
Fri, 1 Oct 2021 14:33:46 -0400 (EDT) |
branch: master
commit 3c972723e44c9428ea990562033acfbd84ed29d9
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* lisp/emacs-lisp/subr-x.el (with-memoization): New macro
Extracted from `cl-generic.el`.
* lisp/emacs-lisp/cl-generic.el (cl--generic-get-dispatcher)
(cl--generic-build-combined-method, cl-generic-generalizers): Use it.
(cl--generic-with-memoization): Delete.
---
etc/NEWS | 4 ++++
lisp/emacs-lisp/cl-generic.el | 18 +++++-------------
lisp/emacs-lisp/subr-x.el | 12 ++++++++++++
3 files changed, 21 insertions(+), 13 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 9acde7e..8c22230 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -61,6 +61,10 @@ This change also affects 'cl-macrolet', 'cl-flet*' and
The new command 'image-dired-unmark-all-marks' has been added with a
binding in the menu.
+
+** subr-x
+*** New macro 'with-memoization' provides a very primitive form of memoization
+
* New Modes and Packages in Emacs 29.1
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 4834fb1..2051613 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -100,6 +100,7 @@
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'cl-macs)) ;For cl--find-class.
(eval-when-compile (require 'pcase))
+(eval-when-compile (require 'subr-x))
(cl-defstruct (cl--generic-generalizer
(:constructor nil)
@@ -589,19 +590,10 @@ The set of acceptable TYPEs (also called
\"specializers\") is defined
;; e.g. for tracing/debug-on-entry.
(defalias sym gfun)))))
-(defmacro cl--generic-with-memoization (place &rest code)
- (declare (indent 1) (debug t))
- (gv-letplace (getter setter) place
- `(or ,getter
- ,(macroexp-let2 nil val (macroexp-progn code)
- `(progn
- ,(funcall setter val)
- ,val)))))
-
(defvar cl--generic-dispatchers (make-hash-table :test #'equal))
(defun cl--generic-get-dispatcher (dispatch)
- (cl--generic-with-memoization
+ (with-memoization
(gethash dispatch cl--generic-dispatchers)
;; (message "cl--generic-get-dispatcher (%S)" dispatch)
(let* ((dispatch-arg (car dispatch))
@@ -647,7 +639,7 @@ The set of acceptable TYPEs (also called \"specializers\")
is defined
(let ((method-cache (make-hash-table :test #'eql)))
(lambda (,@fixedargs &rest args)
(let ,bindings
- (apply (cl--generic-with-memoization
+ (apply (with-memoization
(gethash ,tag-exp method-cache)
(cl--generic-cache-miss
generic ',dispatch-arg dispatches-left methods
@@ -691,7 +683,7 @@ for all those different tags in the method-cache.")
;; Special case needed to fix a circularity during bootstrap.
(cl--generic-standard-method-combination generic methods)
(let ((f
- (cl--generic-with-memoization
+ (with-memoization
;; FIXME: Since the fields of `generic' are modified, this
;; hash-table won't work right, because the hashes will change!
;; It's not terribly serious, but reduces the effectiveness of
@@ -1143,7 +1135,7 @@ These match if the argument is a cons cell whose car is
`eql' to VAL."
;; since we can't use the `head' specializer to implement itself.
(if (not (eq (car-safe specializer) 'head))
(cl-call-next-method)
- (cl--generic-with-memoization
+ (with-memoization
(gethash (cadr specializer) cl--generic-head-used)
specializer)
(list cl--generic-head-generalizer)))
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 3de6666..91ebbf9 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -400,6 +400,18 @@ as the new values of the bound variables in the recursive
invocation."
(cl-labels ((,name ,fargs . ,body)) #',name)
. ,aargs)))
+(defmacro with-memoization (place &rest code)
+ "Return the value of CODE and stash it in PLACE.
+If PLACE's value is non-nil, then don't bother evaluating CODE
+and return the value found in PLACE instead."
+ (declare (indent 1) (debug (gv-place body)))
+ (gv-letplace (getter setter) place
+ `(or ,getter
+ ,(macroexp-let2 nil val (macroexp-progn code)
+ `(progn
+ ,(funcall setter val)
+ ,val)))))
+
(provide 'subr-x)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 3c97272: * lisp/emacs-lisp/subr-x.el (with-memoization): New macro,
Stefan Monnier <=