[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 8b6d82d: Define `map-elt' as a generalized variable
From: |
Nicolas Petton |
Subject: |
[Emacs-diffs] master 8b6d82d: Define `map-elt' as a generalized variable |
Date: |
Sun, 21 Jun 2015 18:49:26 +0000 |
branch: master
commit 8b6d82d3ca86f76ed964063b3941a7c6ab0bf1c6
Author: Nicolas Petton <address@hidden>
Commit: Nicolas Petton <address@hidden>
Define `map-elt' as a generalized variable
* lisp/emacs-lisp/map.el (map-elt): Define a gv-expander.
* lisp/emacs-lisp/map.el (map--dispatch): Tighten the code.
* lisp/emacs-lisp/map.el (map-put): Redefine it as a function using a
`setf' with `map-elt'.
* test/automated/map-tests.el: Comment out `test-map-put-literal'.
---
lisp/emacs-lisp/map.el | 52 +++++++++++++++++++++++-------------------
test/automated/map-tests.el | 24 ++++++++++----------
2 files changed, 40 insertions(+), 36 deletions(-)
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 1d8a312..8759616 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -82,25 +82,21 @@ The following keyword types are meaningful: `:list',
An error is thrown if MAP is neither a list, hash-table nor array.
-Return RESULT if non-nil or the result of evaluation of the
-form.
+Return RESULT if non-nil or the result of evaluation of the form.
\(fn (VAR MAP [RESULT]) &rest ARGS)"
(declare (debug t) (indent 1))
(unless (listp spec)
(setq spec `(,spec ,spec)))
- (let ((map-var (car spec))
- (result-var (make-symbol "result")))
- `(let ((,map-var ,(cadr spec))
- ,result-var)
- (setq ,result-var
- (cond ((listp ,map-var) ,(plist-get args :list))
- ((hash-table-p ,map-var) ,(plist-get args :hash-table))
- ((arrayp ,map-var) ,(plist-get args :array))
- (t (error "Unsupported map: %s" ,map-var))))
- ,@(when (cddr spec)
- `((setq ,result-var ,@(cddr spec))))
- ,result-var)))
+ (let ((map-var (car spec)))
+ `(let* ,(unless (eq map-var (cadr spec)) `((,map-var ,(cadr spec))))
+ (cond ((listp ,map-var) ,(plist-get args :list))
+ ((hash-table-p ,map-var) ,(plist-get args :hash-table))
+ ((arrayp ,map-var) ,(plist-get args :array))
+ (t (error "Unsupported map: %s" ,map-var)))
+ ,@(cddr spec))))
+
+(put 'map--raw-place 'gv-expander #'funcall)
(defun map-elt (map key &optional default)
"Perform a lookup in MAP of KEY and return its associated value.
@@ -109,26 +105,34 @@ If KEY is not found, return DEFAULT which defaults to nil.
If MAP is a list, `eql' is used to lookup KEY.
MAP can be a list, hash-table or array."
+ (declare
+ (gv-expander
+ (lambda (do)
+ (gv-letplace (mgetter msetter) map
+ (macroexp-let2* nil
+ ;; Eval them once and for all in the right order.
+ ((key key) (default default))
+ `(map--dispatch ,mgetter
+ :list ,(gv-get `(alist-get ,key (map--raw-place ,mgetter ,msetter)
+ ,default)
+ do)
+ :hash-table ,(gv-get `(gethash ,key (map--raw-place ,mgetter
,msetter)
+ ,default))
+ :array ,(gv-get (aref (map--raw-place ,mgetter ,msetter) ,key)
+ do)))))))
(map--dispatch map
:list (alist-get key map default)
:hash-table (gethash key map default)
:array (map--elt-array map key default)))
-(defmacro map-put (map key value)
+(defun map-put (map key value)
"In MAP, associate KEY with VALUE and return MAP.
If KEY is already present in MAP, replace the associated value
with VALUE.
MAP can be a list, hash-table or array."
- (declare (debug t))
- (let ((symbol (symbolp map)))
- `(progn
- (map--dispatch (m ,map m)
- :list (if ,symbol
- (setq ,map (cons (cons ,key ,value) m))
- (error "Literal lists are not allowed, %s must be a symbol"
',map))
- :hash-table (puthash ,key ,value m)
- :array (aset m ,key ,value)))))
+ (setf (map-elt map key) value)
+ map)
(defmacro map-delete (map key)
"In MAP, delete the key KEY if present and return MAP.
diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el
index abda03d..402fead 100644
--- a/test/automated/map-tests.el
+++ b/test/automated/map-tests.el
@@ -40,11 +40,11 @@ Evaluate BODY for each created map.
(let ((alist (make-symbol "alist"))
(vec (make-symbol "vec"))
(ht (make-symbol "ht")))
- `(let ((,alist '((0 . 3)
- (1 . 4)
- (2 . 5)))
- (,vec (make-vector 3 nil))
- (,ht (make-hash-table)))
+ `(let ((,alist (list (cons 0 3)
+ (cons 1 4)
+ (cons 2 5)))
+ (,vec (make-vector 3 nil))
+ (,ht (make-hash-table)))
(aset ,vec 0 '3)
(aset ,vec 1 '4)
(aset ,vec 2 '5)
@@ -87,13 +87,13 @@ Evaluate BODY for each created map.
(let ((vec [3 4 5]))
(should-error (map-put vec 3 6))))
-(ert-deftest test-map-put-literal ()
- (should (= (map-elt (map-put [1 2 3] 1 4) 1)
- 4))
- (should (= (map-elt (map-put (make-hash-table) 'a 2) 'a)
- 2))
- (should-error (map-put '((a . 1)) 'b 2))
- (should-error (map-put '() 'a 1)))
+;; (ert-deftest test-map-put-literal ()
+;; (should (= (map-elt (map-put [1 2 3] 1 4) 1)
+;; 4))
+;; (should (= (map-elt (map-put (make-hash-table) 'a 2) 'a)
+;; 2))
+;; (should-error (map-put '((a . 1)) 'b 2))
+;; (should-error (map-put '() 'a 1)))
(ert-deftest test-map-put-return-value ()
(let ((ht (make-hash-table)))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 8b6d82d: Define `map-elt' as a generalized variable,
Nicolas Petton <=