changeset 47662:a6d932b28650

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

--- a/lisp/emacs-lisp/cl-extra.el	Fri Sep 27 22:19:22 2002 +0000
+++ b/lisp/emacs-lisp/cl-extra.el	Fri Sep 27 22:32:48 2002 +0000
@@ -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 @@
 			  (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 @@
       (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 @@
 	    (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 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 @@
 (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 @@
   "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 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 @@
 
 
 ;;; 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 @@
 	     (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 @@
 			  (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--)))