1 files changed, 30 insertions, 133 deletions

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index ac206a84afd..aa6b4f9ae48 100644
--- 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--)))