From: Nicolas Petton Date: Sun, 21 Jun 2015 21:44:50 +0000 (+0200) Subject: Revert "Define `map-elt' as a generalized variable" X-Git-Tag: emacs-25.0.90~1684 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fa52edd4c4eb9e2d8ae2e43821460cfd594593b5;p=emacs.git Revert "Define `map-elt' as a generalized variable" This reverts commit 8b6d82d3ca86f76ed964063b3941a7c6ab0bf1c6. --- 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', 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))) - `(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) + (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))) (defun map-elt (map key &optional default) "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. 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))) -(defun map-put (map key value) +(defmacro 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." - (setf (map-elt map key) value) - map) + (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))))) (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 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. (let ((alist (make-symbol "alist")) (vec (make-symbol "vec")) (ht (make-symbol "ht"))) - `(let ((,alist (list (cons 0 3) - (cons 1 4) - (cons 2 5))) - (,vec (make-vector 3 nil)) - (,ht (make-hash-table))) + `(let ((,alist '((0 . 3) + (1 . 4) + (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)))