diff options
| author | Nicolas Petton | 2015-06-21 23:44:50 +0200 |
|---|---|---|
| committer | Nicolas Petton | 2015-06-21 23:44:50 +0200 |
| commit | fa52edd4c4eb9e2d8ae2e43821460cfd594593b5 (patch) | |
| tree | 15e99f0614f5cefc8218b54c3112a4e2dd235ecc | |
| parent | 5fac0dee87ea5d4aa90ee93606c19785919da105 (diff) | |
| download | emacs-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.el | 52 | ||||
| -rw-r--r-- | test/automated/map-tests.el | 24 |
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 | ||
| 83 | An error is thrown if MAP is neither a list, hash-table nor array. | 83 | An error is thrown if MAP is neither a list, hash-table nor array. |
| 84 | 84 | ||
| 85 | Return RESULT if non-nil or the result of evaluation of the form. | 85 | Return RESULT if non-nil or the result of evaluation of the |
| 86 | form. | ||
| 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. | |||
| 105 | If MAP is a list, `eql' is used to lookup KEY. | 109 | If MAP is a list, `eql' is used to lookup KEY. |
| 106 | 110 | ||
| 107 | MAP can be a list, hash-table or array." | 111 | MAP 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. |
| 130 | If KEY is already present in MAP, replace the associated value | 119 | If KEY is already present in MAP, replace the associated value |
| 131 | with VALUE. | 120 | with VALUE. |
| 132 | 121 | ||
| 133 | MAP can be a list, hash-table or array." | 122 | MAP 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))) |