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.
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.
(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)
(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)))