--- a/lisp/cl-extra.el	Sat May 29 15:19:54 2010 +0100
+++ b/lisp/cl-extra.el	Sun May 30 13:27:36 2010 +0100
@@ -51,10 +51,6 @@
 (eval-when-compile
   (require 'obsolete))
 
-(or (memq 'cl-19 features)
-    (error "Tried to load `cl-extra' before `cl'!"))
-
-
 ;;; Type coercion.
 
 (defun coerce (x type)
@@ -99,131 +95,7 @@
 	((typep x type) x)
 	(t (error "Can't coerce %s to type %s" x type))))
 
-
-;;;;; Predicates.
-;;
-;;;; I'd actually prefer not to have this inline, the space
-;;;; vs. amount-it's-called trade-off isn't reasonable, but that would
-;;;; introduce bytecode problems with the compiler macro in cl-macs.el.
-;;(defsubst cl-string-vector-equalp (cl-string cl-vector)
-;;  "Helper function for `equalp', which see."
-;;;  (check-argument-type #'stringp cl-string)
-;;;  (check-argument-type #'vector cl-vector)
-;;  (let ((cl-i (length cl-string))
-;;	cl-char cl-other)
-;;    (when (= cl-i (length cl-vector))
-;;      (while (and (>= (setq cl-i (1- cl-i)) 0)
-;;		  (or (eq (setq cl-char (aref cl-string cl-i))
-;;			  (setq cl-other (aref cl-vector cl-i)))
-;;		      (and (characterp cl-other) ; Note we want to call this
-;;						 ; as rarely as possible, it
-;;						 ; doesn't have a bytecode.
-;;			   (eq (downcase cl-char) (downcase cl-other))))))
-;;      (< cl-i 0))))
-;;
-;;;; See comment on cl-string-vector-equalp above.
-;;(defsubst cl-bit-vector-vector-equalp (cl-bit-vector cl-vector)
-;;  "Helper function for `equalp', which see."
-;;;  (check-argument-type #'bit-vector-p cl-bit-vector)
-;;;  (check-argument-type #'vectorp cl-vector)
-;;  (let ((cl-i (length cl-bit-vector))
-;;	cl-other)
-;;    (when (= cl-i (length cl-vector))
-;;      (while (and (>= (setq cl-i (1- cl-i)) 0)
-;;		  (numberp (setq cl-other (aref cl-vector cl-i)))
-;;		  ;; Differs from clisp here.
-;;		  (= (aref cl-bit-vector cl-i) cl-other)))
-;;      (< cl-i 0))))
-;;
-;;;; These two helper functions call equalp recursively, the two above have no
-;;;; need to.
-;;(defsubst cl-vector-array-equalp (cl-vector cl-array)
-;;  "Helper function for `equalp', which see."
-;;;  (check-argument-type #'vector cl-vector)
-;;;  (check-argument-type #'arrayp cl-array)
-;;  (let ((cl-i (length cl-vector)))
-;;    (when (= cl-i (length cl-array))
-;;      (while (and (>= (setq cl-i (1- cl-i)) 0)
-;;		  (equalp (aref cl-vector cl-i) (aref cl-array cl-i))))
-;;      (< cl-i 0))))
-;;
-;;(defsubst cl-hash-table-contents-equalp (cl-hash-table-1 cl-hash-table-2)
-;;  "Helper function for `equalp', which see."
-;;  (symbol-macrolet
-;;      ;; If someone has gone and fished the uninterned symbol out of this
-;;      ;; function's constants vector, and subsequently stored it as a value
-;;      ;; in a hash table, it's their own damn fault when
-;;      ;; `cl-hash-table-contents-equalp' gives the wrong answer.
-;;      ((equalp-default '#:equalp-default))
-;;    (loop
-;;      for x-key being the hash-key in cl-hash-table-1
-;;      using (hash-value x-value)
-;;      with y-value = nil
-;;      always (and (not (eq equalp-default
-;;			   (setq y-value (gethash x-key cl-hash-table-2
-;;						  equalp-default))))
-;;		  (equalp y-value x-value)))))
-;;
-;;(defun equalp (x y)
-;;  "Return t if two Lisp objects have similar structures and contents.
-;;
-;;This is like `equal', except that it accepts numerically equal
-;;numbers of different types (float, integer, bignum, bigfloat), and also
-;;compares strings and characters case-insensitively.
-;;
-;;Arrays (that is, strings, bit-vectors, and vectors) of the same length and
-;;with contents that are `equalp' are themselves `equalp'.
-;;
-;;Two hash tables are `equalp' if they have the same test (see
-;;`hash-table-test'), if they have the same number of entries, and if, for
-;;each entry in one hash table, its key is equivalent to a key in the other
-;;hash table using the hash table test, and its value is `equalp' to the other
-;;hash table's value for that key."
-;;  (cond ((eq x y))
-;;	((stringp x)
-;;	 (if (stringp y)
-;;	     (eq t (compare-strings x nil nil y nil nil t))
-;;	   (if (vectorp y)
-;;	       (cl-string-vector-equalp x y)
-;;	     ;; bit-vectors and strings are only equalp if they're
-;;	     ;; zero-length:
-;;	     (and (equal "" x) (equal #* y)))))
-;;	((numberp x)
-;;	 (and (numberp y) (= x y)))
-;;	((consp x)
-;;	 (while (and (consp x) (consp y) (equalp (car x) (car y)))
-;;	   (setq x (cdr x) y (cdr y)))
-;;	 (and (not (consp x)) (equalp x y)))
-;;	(t
-;;	 ;; From here on, the type tests don't (yet) have bytecodes.
-;;	 (let ((x-type (type-of x)))
-;;	   (cond ((eq 'vector x-type)
-;;		  (if (stringp y)
-;;		      (cl-string-vector-equalp y x)
-;;		    (if (vectorp y)
-;;			(cl-vector-array-equalp x y)
-;;		      (if (bit-vector-p y)
-;;			  (cl-bit-vector-vector-equalp y x)))))
-;;		 ((eq 'character x-type)
-;;		  (and (characterp y)
-;;		       ;; If the characters are actually identical, the
-;;		       ;; first eq test will have caught them above; we only
-;;		       ;; need to check them case-insensitively here.
-;;		       (eq (downcase x) (downcase y))))
-;;		 ((eq 'hash-table x-type)
-;;		  (and (hash-table-p y)
-;;		       (eq (hash-table-test x) (hash-table-test y))
-;;		       (= (hash-table-count x) (hash-table-count y))
-;;		       (cl-hash-table-contents-equalp x y)))
-;;		 ((eq 'bit-vector x-type)
-;;		  (if (bit-vector-p y)
-;;		      (equal x y)
-;;		    (if (vectorp y)
-;;			(cl-bit-vector-vector-equalp x y)
-;;		      ;; bit-vectors and strings are only equalp if they're
-;;		      ;; zero-length:
-;;		      (and (equal "" y) (equal #* x)))))
-;;		 (t (equal x y)))))))
+;; XEmacs; #'equalp is in C.
 
 ;; XEmacs; #'map, #'mapc, #'mapl, #'maplist, #'mapcon, #'some and #'every
 ;; are now in C, together with #'map-into, which was never in this file.
@@ -348,7 +220,6 @@
       (makunbound (car cl-progv-save)))
     (pop cl-progv-save)))
 
-
 ;;; Numbers.
 
 (defun gcd (&rest args)
@@ -381,14 +252,6 @@
 	g)
     (if (eq a 0) 0 (signal 'arith-error nil))))
 
-;; XEmacs addition
-(defun cl-expt (x y)
-  "Return X raised to the power of Y.  Works only for integer arguments."
-  (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) (cl-expt x (- y)) 0))
-    (* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2)))))
-(or (and (fboundp 'expt) (subrp (symbol-function 'expt)))
-    (defalias 'expt 'cl-expt))
-
 ;; We can't use macrolet in this file; whence the literal macro
 ;; definition-and-call:
 ((macro . (lambda (&rest symbols)
@@ -473,15 +336,6 @@
 	(and (numberp res) (/= res (/ res 2)) res))
     (arith-error nil)))
 
-(defvar most-positive-float)
-(defvar most-negative-float)
-(defvar least-positive-float)
-(defvar least-negative-float)
-(defvar least-positive-normalized-float)
-(defvar least-negative-normalized-float)
-(defvar float-epsilon)
-(defvar float-negative-epsilon)
-
 (defun cl-float-limits ()
   (or most-positive-float (not (numberp '2e1))
       (let ((x '2e0) y z)
@@ -516,34 +370,12 @@
 	(setq float-negative-epsilon (* x 2))))
   nil)
 
+;; XEmacs; call cl-float-limits at dump time.
+(cl-float-limits)
 
 ;;; Sequence functions.
 
-;XEmacs -- our built-in is more powerful.
-;(defun subseq (seq start &optional end)
-;  "Return the subsequence of SEQ from START to END.
-;If END is omitted, it defaults to the length of the sequence.
-;If START or END is negative, it counts from the end."
-;  (if (stringp seq) (substring seq start end)
-;    (let (len)
-;      (and end (< end 0) (setq end (+ end (setq len (length seq)))))
-;      (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
-;      (cond ((listp seq)
-;	     (if (> start 0) (setq seq (nthcdr start seq)))
-;	     (if end
-;		 (let ((res nil))
-;		   (while (>= (setq end (1- end)) start)
-;		     (push (pop seq) res))
-;		   (nreverse res))
-;	       (copy-sequence seq)))
-;	    (t
-;	     (or end (setq end (or len (length seq))))
-;	     (let ((res (make-vector (max (- end start) 0) nil))
-;		   (i 0))
-;	       (while (< start end)
-;		 (aset res i (aref seq start))
-;		 (setq i (1+ i) start (1+ start)))
-;	       res))))))
+;; XEmacs; #'subseq is in C.
 
 (defun concatenate (type &rest seqs)
   "Concatenate, into a sequence of type TYPE, the argument SEQUENCES."
@@ -552,7 +384,7 @@
     (vector (apply 'vconcat seqs))
     (string (apply 'concat seqs))
     (list   (apply 'append (append seqs '(nil))))
-    (t (error "Not a sequence type name: %s" type))))
+    (t (error 'invalid-argument "Not a sequence type name" type))))
 
 ;;; List functions.
 
@@ -564,12 +396,12 @@
   "Equivalent to (nconc (nreverse X) Y)."
   (nconc (nreverse x) y))
 
-(defun list-length (x)
-  "Return the length of a list.  Return nil if list is circular."
-  (let ((n 0) (fast x) (slow x))
-    (while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
-      (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow)))
-    (if fast (if (cdr fast) nil (1+ n)) n)))
+(defun list-length (list)
+  "Return the length of LIST.  Return nil if LIST is circular."
+  (if (listp list)
+      (condition-case nil (length list) (circular-list))
+    ;; Error on not-a-list:
+    (car list)))
 
 (defun tailp (sublist list)
   "Return true if SUBLIST is a tail of LIST."
@@ -579,7 +411,6 @@
 
 (defalias 'cl-copy-tree 'copy-tree)
 
-
 ;;; Property lists.
 
 ;; XEmacs: our `get' groks DEFAULT.
@@ -824,8 +655,6 @@
     (prog1 (cl-prettyprint form)
       (message ""))))
 
-
-
 (run-hooks 'cl-extra-load-hook)
 
 ;; XEmacs addition