(cl-push, cl-pop): Remove. Use pop and push throughout the file instead.

(cl-hash-lookup): Remove.
(cl-make-hash-table, cl-hash-table-p, cl-gethash, cl-puthash)
(cl-remhash, cl-clrhash, cl-maphash, cl-hash-table-count): Simplify.

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index ac206a84afd8d6433e359863550dab851984632f..aa6b4f9ae48aee1891462d495b23edd5d5cd9d75 100644 (file)
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -42,13 +42,6 @@
     (error "Tried to load `cl-extra' before `cl'!"))
 
 
-;;; We define these here so that this file can compile without having
-;;; loaded the cl.el file already.
-
-(defmacro cl-push (x place) (list 'setq place (list 'cons x place)))
-(defmacro cl-pop (place)
-  (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
-
 ;;; Type coercion.
 
 (defun coerce (x type)
@@ -111,7 +104,7 @@ strings case-insensitively."
                          (setcar cl-p1 (cdr (car cl-p1))))
                      (aref (car cl-p1) cl-i)))
            (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))
-         (cl-push (apply cl-func cl-args) cl-res)
+         (push (apply cl-func cl-args) cl-res)
          (setq cl-i (1+ cl-i)))
        (nreverse cl-res))
     (let ((cl-res nil)
@@ -120,9 +113,9 @@ strings case-insensitively."
       (let ((cl-n (min (length cl-x) (length cl-y)))
            (cl-i -1))
        (while (< (setq cl-i (1+ cl-i)) cl-n)
-         (cl-push (funcall cl-func
-                           (if (consp cl-x) (cl-pop cl-x) (aref cl-x cl-i))
-                           (if (consp cl-y) (cl-pop cl-y) (aref cl-y cl-i)))
+         (push (funcall cl-func
+                           (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
+                           (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
                   cl-res)))
       (nreverse cl-res))))
 
@@ -142,13 +135,13 @@ the elements themselves."
            (cl-args (cons cl-list (copy-sequence cl-rest)))
            cl-p)
        (while (not (memq nil cl-args))
-         (cl-push (apply cl-func cl-args) cl-res)
+         (push (apply cl-func cl-args) cl-res)
          (setq cl-p cl-args)
-         (while cl-p (setcar cl-p (cdr (cl-pop cl-p)) )))
+         (while cl-p (setcar cl-p (cdr (pop cl-p)) )))
        (nreverse cl-res))
     (let ((cl-res nil))
       (while cl-list
-       (cl-push (funcall cl-func cl-list) cl-res)
+       (push (funcall cl-func cl-list) cl-res)
        (setq cl-list (cdr cl-list)))
       (nreverse cl-res))))
 
@@ -186,7 +179,7 @@ If so, return the true (non-nil) value returned by PREDICATE."
                             (if cl-res (throw 'cl-some cl-res)))))
               cl-seq cl-rest) nil)
     (let ((cl-x nil))
-      (while (and cl-seq (not (setq cl-x (funcall cl-pred (cl-pop cl-seq))))))
+      (while (and cl-seq (not (setq cl-x (funcall cl-pred (pop cl-seq))))))
       cl-x)))
 
 (defun every (cl-pred cl-seq &rest cl-rest)
@@ -318,28 +311,28 @@ If so, return the true (non-nil) value returned by PREDICATE."
 (defvar cl-progv-save)
 (defun cl-progv-before (syms values)
   (while syms
-    (cl-push (if (boundp (car syms))
+    (push (if (boundp (car syms))
                 (cons (car syms) (symbol-value (car syms)))
               (car syms)) cl-progv-save)
     (if values
-       (set (cl-pop syms) (cl-pop values))
-      (makunbound (cl-pop syms)))))
+       (set (pop syms) (pop values))
+      (makunbound (pop syms)))))
 
 (defun cl-progv-after ()
   (while cl-progv-save
     (if (consp (car cl-progv-save))
        (set (car (car cl-progv-save)) (cdr (car cl-progv-save)))
       (makunbound (car cl-progv-save)))
-    (cl-pop cl-progv-save)))
+    (pop cl-progv-save)))
 
 
 ;;; Numbers.
 
 (defun gcd (&rest args)
   "Return the greatest common divisor of the arguments."
-  (let ((a (abs (or (cl-pop args) 0))))
+  (let ((a (abs (or (pop args) 0))))
     (while args
-      (let ((b (abs (cl-pop args))))
+      (let ((b (abs (pop args))))
        (while (> b 0) (setq b (% a (setq a b))))))
     a))
 
@@ -347,9 +340,9 @@ If so, return the true (non-nil) value returned by PREDICATE."
   "Return the least common multiple of the arguments."
   (if (memq 0 args)
       0
-    (let ((a (abs (or (cl-pop args) 1))))
+    (let ((a (abs (or (pop args) 1))))
       (while args
-       (let ((b (abs (cl-pop args))))
+       (let ((b (abs (pop args))))
          (setq a (* (/ a (gcd a b)) b))))
       a)))
 
@@ -522,7 +515,7 @@ If START or END is negative, it counts from the end."
             (if end
                 (let ((res nil))
                   (while (>= (setq end (1- end)) start)
-                    (cl-push (cl-pop seq) res))
+                    (push (pop seq) res))
                   (nreverse res))
               (copy-sequence seq)))
            (t
@@ -613,122 +606,26 @@ PROPLIST is a list of the sort returned by `symbol-plist'."
 
 
 ;;; Hash tables.
+;; This is just kept for compatibility with code byte-compiled by Emacs-20.
 
-(defun cl-make-hash-table (&rest cl-keys)
-  "Make an empty Common Lisp-style hash-table.
-Keywords supported:  :test :size
-The Common Lisp keywords :rehash-size and :rehash-threshold are ignored."
-  (let ((cl-test (or (car (cdr (memq :test cl-keys))) 'eql))
-       (cl-size (or (car (cdr (memq :size cl-keys))) 20)))
-    (make-hash-table :size cl-size :test cl-size)))
-
-(defun cl-hash-table-p (x)
-  "Return t if OBJECT is a hash table."
-  (or (hash-table-p x)
-      (eq (car-safe x) 'cl-hash-table-tag)))
-
+;; No idea if this might still be needed.
 (defun cl-not-hash-table (x &optional y &rest z)
   (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x))))
 
-(defun cl-hash-lookup (key table)
-  (or (eq (car-safe table) 'cl-hash-table-tag) (cl-not-hash-table table))
-  (let* ((array (nth 2 table)) (test (car (cdr table))) (str key) sym)
-    (if (symbolp array) (setq str nil sym (symbol-value array))
-      (while (or (consp str) (and (vectorp str) (> (length str) 0)))
-       (setq str (elt str 0)))
-      (cond ((stringp str) (if (eq test 'equalp) (setq str (downcase str))))
-           ((symbolp str) (setq str (symbol-name str)))
-           ((and (numberp str) (> str -8000000) (< str 8000000))
-            (or (integerp str) (setq str (truncate str)))
-            (setq str (aref ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"
-                             "11" "12" "13" "14" "15"] (logand str 15))))
-           (t (setq str "*")))
-      (setq sym (symbol-value (intern-soft str array))))
-    (list (and sym (cond ((or (eq test 'eq)
-                             (and (eq test 'eql) (not (numberp key))))
-                         (assq key sym))
-                        ((memq test '(eql equal)) (assoc key sym))
-                        (t (assoc* key sym :test test))))
-         sym str)))
-
-;; These variables are just kept for compatibility with code
-;; byte-compiled by Emacs-20.
 (defvar cl-builtin-gethash (symbol-function 'gethash))
 (defvar cl-builtin-remhash (symbol-function 'remhash))
 (defvar cl-builtin-clrhash (symbol-function 'clrhash))
 (defvar cl-builtin-maphash (symbol-function 'maphash))
 
-(defun cl-gethash (key table &optional def)
-  "Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT."
-  (if (consp table)
-      (let ((found (cl-hash-lookup key table)))
-       (if (car found) (cdr (car found)) def))
-    (gethash key table def)))
-
-(defun cl-puthash (key val table)
-  (if (consp table)
-      (let ((found (cl-hash-lookup key table)))
-       (if (car found) (setcdr (car found) val)
-         (if (nth 2 found)
-             (progn
-               (if (> (nth 3 table) (* (length (nth 2 table)) 3))
-                   (let ((new-table (make-vector (nth 3 table) 0)))
-                     (mapatoms (function
-                                (lambda (sym)
-                                  (set (intern (symbol-name sym) new-table)
-                                       (symbol-value sym))))
-                               (nth 2 table))
-                     (setcar (cdr (cdr table)) new-table)))
-               (set (intern (nth 2 found) (nth 2 table))
-                    (cons (cons key val) (nth 1 found))))
-           (set (nth 2 table) (cons (cons key val) (nth 1 found))))
-         (setcar (cdr (cdr (cdr table))) (1+ (nth 3 table)))))
-    (funcall 'puthash key val table)) val)
-
-(defun cl-remhash (key table)
-  "Remove KEY from HASH-TABLE."
-  (if (consp table)
-      (let ((found (cl-hash-lookup key table)))
-       (and (car found)
-            (let ((del (delq (car found) (nth 1 found))))
-              (setcar (cdr (cdr (cdr table))) (1- (nth 3 table)))
-              (if (nth 2 found) (set (intern (nth 2 found) (nth 2 table)) del)
-                (set (nth 2 table) del)) t)))
-    (prog1 (not (eq (gethash key table '--cl--) '--cl--))
-      (remhash key table))))
-
-(defun cl-clrhash (table)
-  "Clear HASH-TABLE."
-  (if (consp table)
-      (progn
-       (or (cl-hash-table-p table) (cl-not-hash-table table))
-       (if (symbolp (nth 2 table)) (set (nth 2 table) nil)
-         (setcar (cdr (cdr table)) (make-vector (length (nth 2 table)) 0)))
-       (setcar (cdr (cdr (cdr table))) 0))
-    (clrhash table))
-  nil)
-
-(defun cl-maphash (cl-func cl-table)
-  "Call FUNCTION on keys and values from HASH-TABLE."
-  (or (cl-hash-table-p cl-table) (cl-not-hash-table cl-table))
-  (if (consp cl-table)
-      (mapatoms (function (lambda (cl-x)
-                           (setq cl-x (symbol-value cl-x))
-                           (while cl-x
-                             (funcall cl-func (car (car cl-x))
-                                      (cdr (car cl-x)))
-                             (setq cl-x (cdr cl-x)))))
-               (if (symbolp (nth 2 cl-table))
-                   (vector (nth 2 cl-table)) (nth 2 cl-table)))
-    (maphash cl-func cl-table)))
-
-(defun cl-hash-table-count (table)
-  "Return the number of entries in HASH-TABLE."
-  (or (cl-hash-table-p table) (cl-not-hash-table table))
-  (if (consp table)
-      (nth 3 table)
-    (hash-table-count table)))
-
+(defalias 'cl-gethash 'gethash)
+(defalias 'cl-puthash 'puthash)
+(defalias 'cl-remhash 'remhash)
+(defalias 'cl-clrhash 'clrhash)
+(defalias 'cl-maphash 'maphash)
+;; These three actually didn't exist in Emacs-20.
+(defalias 'cl-make-hash-table 'make-hash-table)
+(defalias 'cl-hash-table-p 'hash-table-p)
+(defalias 'cl-hash-table-count 'hash-table-count)
 
 ;;; Some debugging aids.
 
@@ -788,7 +685,7 @@ This also does some trivial optimizations to make the form prettier."
             (cl-macroexpand-all (cons 'progn (cddr form)) env)
           (let ((letf nil) (res nil) (lets (cadr form)))
             (while lets
-              (cl-push (if (consp (car lets))
+              (push (if (consp (car lets))
                            (let ((exp (cl-macroexpand-all (caar lets) env)))
                              (or (symbolp exp) (setq letf t))
                              (cons exp (cl-macroexpand-body (cdar lets) env)))
@@ -817,7 +714,7 @@ This also does some trivial optimizations to make the form prettier."
                          (sub (pairlis cl-closure-vars new)) (decls nil))
                     (while (or (stringp (car body))
                                (eq (car-safe (car body)) 'interactive))
-                      (cl-push (list 'quote (cl-pop body)) decls))
+                      (push (list 'quote (pop body)) decls))
                     (put (car (last cl-closure-vars)) 'used t)
                     (append
                      (list 'list '(quote lambda) '(quote (&rest --cl-rest--)))