summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/pcase.el
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2011-03-05 23:48:17 -0500
committerStefan Monnier <monnier@iro.umontreal.ca>2011-03-05 23:48:17 -0500
commite2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6 (patch)
treeb9fb87041279f75ba8b6b304e0765bf412377af6 /lisp/emacs-lisp/pcase.el
parentd032d5e7dfabfae60f3304da02c97cd1e189b9a2 (diff)
downloademacs-e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.tar.gz
emacs-e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.tar.bz2
emacs-e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.zip
Fix pcase memoizing; change lexbound byte-code marker.
* src/bytecode.c (exec_byte_code): Remove old lexical binding slot handling and replace it with the a integer args-desc handling. * eval.c (funcall_lambda): Adjust arglist test accordingly. * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature): Handle integer arglist descriptor. (byte-compile-make-args-desc): Make integer arglist descriptor. (byte-compile-lambda): Use integer arglist descriptor to mark lexical byte-coded functions instead of an extra slot. * lisp/help-fns.el (help-add-fundoc-usage): Don't add a dummy doc. (help-split-fundoc): Return a nil doc if there was no actual doc. (help-function-arglist): Generate an arglist from an integer arg-desc. * lisp/emacs-lisp/pcase.el (pcase--memoize): Rename from pcase-memoize; Make only the key weak. (pcase): Change the key used in the memoization table, so it does not always get GC'd away. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Slight change to the pcase pattern to generate slightly better code.
Diffstat (limited to 'lisp/emacs-lisp/pcase.el')
-rw-r--r--lisp/emacs-lisp/pcase.el23
1 files changed, 18 insertions, 5 deletions
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 89bbff980c4..2300ebf721a 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -42,7 +42,7 @@
;; is in a loop, the repeated macro-expansion becomes terribly costly, so we
;; memoize previous macro expansions to try and avoid recomputing them
;; over and over again.
-(defconst pcase-memoize (make-hash-table :weakness t :test 'equal))
+(defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq))
(defconst pcase--dontcare-upats '(t _ dontcare))
@@ -78,10 +78,21 @@ E.g. you can match pairs where the cdr is larger than the car with a pattern
like `(,a . ,(pred (< a))) or, with more checks:
`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))"
(declare (indent 1) (debug case)) ;FIXME: edebug `guard' and vars.
- (or (gethash (cons exp cases) pcase-memoize)
- (puthash (cons exp cases)
- (pcase--expand exp cases)
- pcase-memoize)))
+ ;; We want to use a weak hash table as a cache, but the key will unavoidably
+ ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
+ ;; we're called so it'll be immediately GC'd. So we use (car cases) as key
+ ;; which does come straight from the source code and should hence not be GC'd
+ ;; so easily.
+ (let ((data (gethash (car cases) pcase--memoize)))
+ ;; data = (EXP CASES . EXPANSION)
+ (if (and (equal exp (car data)) (equal cases (cadr data)))
+ ;; We have the right expansion.
+ (cddr data)
+ (when data
+ (message "pcase-memoize: equal first branch, yet different"))
+ (let ((expansion (pcase--expand exp cases)))
+ (puthash (car cases) (cons exp (cons cases expansion)) pcase--memoize)
+ expansion))))
;;;###autoload
(defmacro pcase-let* (bindings &rest body)
@@ -135,6 +146,8 @@ of the form (UPAT EXP)."
(and (symbolp upat) (not (memq upat pcase--dontcare-upats))))
(defun pcase--expand (exp cases)
+ ;; (message "pid=%S (pcase--expand %S ...hash=%S)"
+ ;; (emacs-pid) exp (sxhash cases))
(let* ((defs (if (symbolp exp) '()
(let ((sym (make-symbol "x")))
(prog1 `((,sym ,exp)) (setq exp sym)))))