aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNicolas Petton2015-06-21 23:44:50 +0200
committerNicolas Petton2015-06-21 23:44:50 +0200
commitfa52edd4c4eb9e2d8ae2e43821460cfd594593b5 (patch)
tree15e99f0614f5cefc8218b54c3112a4e2dd235ecc
parent5fac0dee87ea5d4aa90ee93606c19785919da105 (diff)
downloademacs-fa52edd4c4eb9e2d8ae2e43821460cfd594593b5.tar.gz
emacs-fa52edd4c4eb9e2d8ae2e43821460cfd594593b5.zip
Revert "Define `map-elt' as a generalized variable"
This reverts commit 8b6d82d3ca86f76ed964063b3941a7c6ab0bf1c6.
-rw-r--r--lisp/emacs-lisp/map.el52
-rw-r--r--test/automated/map-tests.el24
2 files changed, 36 insertions, 40 deletions
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 8759616053a..1d8a3126bba 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -82,21 +82,25 @@ The following keyword types are meaningful: `:list',
82 82
83An error is thrown if MAP is neither a list, hash-table nor array. 83An error is thrown if MAP is neither a list, hash-table nor array.
84 84
85Return RESULT if non-nil or the result of evaluation of the form. 85Return RESULT if non-nil or the result of evaluation of the
86form.
86 87
87\(fn (VAR MAP [RESULT]) &rest ARGS)" 88\(fn (VAR MAP [RESULT]) &rest ARGS)"
88 (declare (debug t) (indent 1)) 89 (declare (debug t) (indent 1))
89 (unless (listp spec) 90 (unless (listp spec)
90 (setq spec `(,spec ,spec))) 91 (setq spec `(,spec ,spec)))
91 (let ((map-var (car spec))) 92 (let ((map-var (car spec))
92 `(let* ,(unless (eq map-var (cadr spec)) `((,map-var ,(cadr spec)))) 93 (result-var (make-symbol "result")))
93 (cond ((listp ,map-var) ,(plist-get args :list)) 94 `(let ((,map-var ,(cadr spec))
94 ((hash-table-p ,map-var) ,(plist-get args :hash-table)) 95 ,result-var)
95 ((arrayp ,map-var) ,(plist-get args :array)) 96 (setq ,result-var
96 (t (error "Unsupported map: %s" ,map-var))) 97 (cond ((listp ,map-var) ,(plist-get args :list))
97 ,@(cddr spec)))) 98 ((hash-table-p ,map-var) ,(plist-get args :hash-table))
98 99 ((arrayp ,map-var) ,(plist-get args :array))
99(put 'map--raw-place 'gv-expander #'funcall) 100 (t (error "Unsupported map: %s" ,map-var))))
101 ,@(when (cddr spec)
102 `((setq ,result-var ,@(cddr spec))))
103 ,result-var)))
100 104
101(defun map-elt (map key &optional default) 105(defun map-elt (map key &optional default)
102 "Perform a lookup in MAP of KEY and return its associated value. 106 "Perform a lookup in MAP of KEY and return its associated value.
@@ -105,34 +109,26 @@ If KEY is not found, return DEFAULT which defaults to nil.
105If MAP is a list, `eql' is used to lookup KEY. 109If MAP is a list, `eql' is used to lookup KEY.
106 110
107MAP can be a list, hash-table or array." 111MAP can be a list, hash-table or array."
108 (declare
109 (gv-expander
110 (lambda (do)
111 (gv-letplace (mgetter msetter) map
112 (macroexp-let2* nil
113 ;; Eval them once and for all in the right order.
114 ((key key) (default default))
115 `(map--dispatch ,mgetter
116 :list ,(gv-get `(alist-get ,key (map--raw-place ,mgetter ,msetter)
117 ,default)
118 do)
119 :hash-table ,(gv-get `(gethash ,key (map--raw-place ,mgetter ,msetter)
120 ,default))
121 :array ,(gv-get (aref (map--raw-place ,mgetter ,msetter) ,key)
122 do)))))))
123 (map--dispatch map 112 (map--dispatch map
124 :list (alist-get key map default) 113 :list (alist-get key map default)
125 :hash-table (gethash key map default) 114 :hash-table (gethash key map default)
126 :array (map--elt-array map key default))) 115 :array (map--elt-array map key default)))
127 116
128(defun map-put (map key value) 117(defmacro map-put (map key value)
129 "In MAP, associate KEY with VALUE and return MAP. 118 "In MAP, associate KEY with VALUE and return MAP.
130If KEY is already present in MAP, replace the associated value 119If KEY is already present in MAP, replace the associated value
131with VALUE. 120with VALUE.
132 121
133MAP can be a list, hash-table or array." 122MAP can be a list, hash-table or array."
134 (setf (map-elt map key) value) 123 (declare (debug t))
135 map) 124 (let ((symbol (symbolp map)))
125 `(progn
126 (map--dispatch (m ,map m)
127 :list (if ,symbol
128 (setq ,map (cons (cons ,key ,value) m))
129 (error "Literal lists are not allowed, %s must be a symbol" ',map))
130 :hash-table (puthash ,key ,value m)
131 :array (aset m ,key ,value)))))
136 132
137(defmacro map-delete (map key) 133(defmacro map-delete (map key)
138 "In MAP, delete the key KEY if present and return MAP. 134 "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 402fead88f7..abda03d9d04 100644
--- a/test/automated/map-tests.el
+++ b/test/automated/map-tests.el
@@ -40,11 +40,11 @@ Evaluate BODY for each created map.
40 (let ((alist (make-symbol "alist")) 40 (let ((alist (make-symbol "alist"))
41 (vec (make-symbol "vec")) 41 (vec (make-symbol "vec"))
42 (ht (make-symbol "ht"))) 42 (ht (make-symbol "ht")))
43 `(let ((,alist (list (cons 0 3) 43 `(let ((,alist '((0 . 3)
44 (cons 1 4) 44 (1 . 4)
45 (cons 2 5))) 45 (2 . 5)))
46 (,vec (make-vector 3 nil)) 46 (,vec (make-vector 3 nil))
47 (,ht (make-hash-table))) 47 (,ht (make-hash-table)))
48 (aset ,vec 0 '3) 48 (aset ,vec 0 '3)
49 (aset ,vec 1 '4) 49 (aset ,vec 1 '4)
50 (aset ,vec 2 '5) 50 (aset ,vec 2 '5)
@@ -87,13 +87,13 @@ Evaluate BODY for each created map.
87 (let ((vec [3 4 5])) 87 (let ((vec [3 4 5]))
88 (should-error (map-put vec 3 6)))) 88 (should-error (map-put vec 3 6))))
89 89
90;; (ert-deftest test-map-put-literal () 90(ert-deftest test-map-put-literal ()
91;; (should (= (map-elt (map-put [1 2 3] 1 4) 1) 91 (should (= (map-elt (map-put [1 2 3] 1 4) 1)
92;; 4)) 92 4))
93;; (should (= (map-elt (map-put (make-hash-table) 'a 2) 'a) 93 (should (= (map-elt (map-put (make-hash-table) 'a 2) 'a)
94;; 2)) 94 2))
95;; (should-error (map-put '((a . 1)) 'b 2)) 95 (should-error (map-put '((a . 1)) 'b 2))
96;; (should-error (map-put '() 'a 1))) 96 (should-error (map-put '() 'a 1)))
97 97
98(ert-deftest test-map-put-return-value () 98(ert-deftest test-map-put-return-value ()
99 (let ((ht (make-hash-table))) 99 (let ((ht (make-hash-table)))