;;; -*- Mode: Lisp; Package: FSet; Syntax: ANSI-Common-Lisp -*-

(in-package :fset)

;;; File: testing.lisp
;;; Contents: FSet test suite.
;;;
;;; This file is part of FSet.  Copyright (c) 2007 Sympoiesis, Inc.
;;; FSet is licensed under the Lisp Lesser GNU Public License, or LLGPL.
;;; See: http://opensource.franz.com/preamble.html
;;; This license provides NO WARRANTY.


(defstruct (My-Integer
	    (:constructor Make-My-Integer (Value)))
  Value)

(def-tuple-key +K0+)
(def-tuple-key +K1+)
(def-tuple-key +K2+)
(def-tuple-key +K3+)
(def-tuple-key +K4+)
(def-tuple-key +K5+)
(def-tuple-key +K6+)
	

(def-tuple-key +K7+)
(def-tuple-key +K8+)
(def-tuple-key +K9+)

(defclass My-Unhandled-Obj ()
  ((value :initarg :value :initform nil
	  :accessor My-Unhandled-Obj-Value))
  (:documentation "Object on which we have defined no FSET methods."))

(defclass My-Identity-Ordered-Obj (identity-ordering-mixin)
  ((value :initarg :value :initform nil
	  :accessor My-Identity-Ordered-Obj-Value))
  (:documentation "Object that has identity ordering"))

#+sbcl
(progn
  (defclass my-sequence (sequence)
    ((actual :type list :initarg :actual :initform nil
	     :accessor my-sequence-actual))
    (:documentation "An example of an SBCL user-defined sequence class"))
  (defmethod sb-sequence:length ((obj my-sequence))
    (cl:length (my-sequence-actual obj)))
  (defmethod sb-sequence:elt ((obj my-sequence) index)
    (elt (my-sequence-actual obj) index))
  (defmethod (setf sb-sequence:elt) (val (obj my-sequence) index)
    (setf (elt (my-sequence-actual obj) index) val))
  (defmethod sb-sequence:adjust-sequence ((obj my-sequence) len &rest args)
    (setf (my-sequence-actual obj)
	  (apply #'sb-sequence:adjust-sequence (my-sequence-actual obj) len args))
    obj)
  (defmethod sb-sequence:make-sequence-like ((obj my-sequence) len &rest args)
    (let ((new-contents
	   (apply #'sb-sequence:make-sequence-like (my-sequence-actual obj) len args)))
      (make-instance 'my-sequence :actual new-contents)))
  )
   
(defun run-test-suite (n-iterations &optional random-seed)
  (Test-Misc)
  (Test-Reader)
  (Test-Rereader)
  (Test-Compare-Lexicographically)
  (Test-Modify-Macros)
  (Test-Functional-Deep-Update)
  (let ((*random-state* (make-random-state random-seed))) ; for repeatability.
    (dotimes (i n-iterations)
      (Test-Map-Operations i (Test-Set-Operations i))
      (Test-Bag-Operations i)
      (Test-Seq-Operations i)
      (Test-Tuple-Operations i))))


(defun Test-Misc ()
  "Tests some things that don't need extensive random test cases generated."
  (macrolet ((test (form)
	       `(unless ,form
		  (error "Test failed: ~S" ',form))))
    (flet ((equal? (a b)
	     (and (equal? a b)
		  (equal? b a)))
	   (less-than? (a b)
	     (and (less-than? a b)
		  (greater-than? b a)))
	   (unequal? (a b)
	     (and (eq (compare a b) ':unequal)
		  (eq (compare b a) ':unequal))))
      (test (less-than? nil 1))
      (test (less-than? 1 2))
      (test (equal? 11/31 11/31))
      (test (unequal? 3 3.0))
      (test (less-than? 1 #\x))
      (test (less-than? #\x #\y))
      (test (less-than? #\z 'a))
      (test (less-than? 'a 'b))
      (test (less-than? 'x 'ab))
      (test (equal? 'a 'a))
      (test (less-than? 'reduce 'cl:find))
      (test (less-than? '#:a '#:b))
      (test (unequal? '#:foo '#:foo))
      (test (less-than? 'a "A"))
      (test (less-than? "A" "B"))
      (test (less-than? "x" "12"))
      (test (equal? "This is a text." "This is a text."))
      (test (less-than? (make-array '(1)
				    :element-type 'base-char
				    :initial-element #\A
				    :adjustable t)
			"B"))
      (test (less-than? "A"
			(make-array '(1)
				    :element-type 'base-char
				    :initial-element #\B
				    :adjustable t)))
      (test (equal? (make-array '(5)
				:initial-contents '(#\a #\b #\c #\d #\e)
				:element-type 'base-char
				:adjustable t)
		    "abcde"))
      (test (less-than? "x" #(#\x)))
      (test (less-than? #(1) #(#\y)))
      (test (let ((v #(1 2))) (equal? v v)))
      (let ((x #(1 2)))
	(test (equal? x x))
	(test (not (unequal? x x))))
      (test (equal? #(1 2) #(1 2)))
      (test (less-than? #(1) #(1 2)))
      (test (equal? #(1 2) (make-array '(2) :initial-contents '(1 2)
				       :adjustable t)))
      (test (equal? (make-array '(2) :initial-contents '(1 2)
				:adjustable t)
		    (make-array '(2) :initial-contents '(1 2)
				:adjustable t)))
      (test (less-than? (make-array '(1) :initial-contents '(1)
				    :adjustable t)
			(make-array '(2) :initial-contents '(1 2)
				    :adjustable t)))
      (test (less-than? (make-array '(1) :initial-contents '(1)
				    :adjustable t)
			(make-array '(1) :initial-contents '(2)
				    :adjustable t)))
      (test (less-than? (make-my-integer 0) ""))
      (test (less-than? (make-my-integer 0) 0))
      (test (less-than? (make-my-integer 0) #()))
      (test (equal? (make-my-integer 0) (make-my-integer 0)))
      (test (unequal? (make-my-integer 0) (make-my-integer 1)))
      (test (let ((obj (make-instance 'my-unhandled-obj)))
	      (equal? obj obj)))
      (test (unequal? (make-instance 'my-unhandled-obj)
		      (make-instance 'my-unhandled-obj)))
      (test (unequal? (make-array '(2 2) :initial-element nil)
		      (make-array '(2 2) :initial-element nil)))
      (test (unequal? (make-array '(2 2) :initial-element nil)
		      #(nil nil nil nil)))
      (test (unequal? (make-array '(1) :initial-element '#:foo)
		      (make-array '(1) :initial-element '#:foo)))
      (test (unequal? (make-array '(1) :initial-element '#:foo)
		      (make-array '(1) :initial-element '#:foo
				  :adjustable t)))
      (test (less-than? (make-instance 'my-identity-ordered-obj)
			(make-instance 'my-identity-ordered-obj)))
      (test (let ((obj (make-instance 'my-identity-ordered-obj)))
	      (equal? obj obj)))
      ;; Anyone hacking the guts of FSet should be sure they understand the next
      ;; two examples.
      (test (unequal? #(1 2) #(1.0 2)))
      (test (less-than? #(1 2) #(1.0 3)))
      (test (less-than? #(1) '(0)))
      (test (less-than? '(0) '(a)))
      (test (less-than? '(0 1) '(a)))
      (test (unequal? '(1 2) '(1.0 2)))
      (test (less-than? '(1 2) '(1.0 3)))
      (test (let ((v (vector 1))) (equal? v v)))
      (test (less-than? '(x) (find-package :fset)))
      (test (less-than? (find-package :fset) #p"/"))
      (test (equal? #p"/foo/bar" #p"/foo/bar"))
      (test (less-than? #p"/foo/bar" #p"/foo/baz"))
      (test (less-than? #p"/bar" #p"/foo/bar"))
      (test (less-than? #p"/" (set)))

      ;; Test subtle code in compare on renamed packages
      (let ((name1 "FSET-TESTING-PACKAGE-1")
	    (name2 "FSET-TESTING-PACKAGE-2"))
	(flet ((%clean ()
		 (when (find-package name1) (delete-package name1))
		 (when (find-package name2) (delete-package name2))))
	  (%clean)
	  (unwind-protect
	       (let ((p1 (make-package name1 :use nil)))
		 (test (not (equal? p1 (find-package :fset))))
		 (rename-package p1 name2)
		 (let ((p2 (make-package name1 :use nil)))
		   (test (unequal? p1 p2))))
	    (%clean))))

      ;; We use `eval' to force the macro to be expanded during the test.
      (test (equal (convert 'list
			    (eval '(set 1 ($ (set 1 2)) ($ (set 3 4)))))
		   '(1 2 3 4)))
      (test (equalp (convert 'list
			     (set "foo" (find-package :fset) '(a b) 17 #p"/"
				  nil #\x 'car #p"/foo" "bar" 'bike #(1 2) 3
				  #(2 1) '(a . b) #\y))
		    `(nil 3 17 #\x #\y bike car "bar" "foo" #(1 2) #(2 1)
		      (a . b) (a b) ,(find-package :fset) #p"/" #p"/foo")))
      (test (less-than? (set 1 2) (set 1 2 0)))
      (test (unequal? (set 'a 3 'c) (set 'a 3.0 'c)))
      (test (less-than? (set 'a 3 'c) (set 'a 3.0 'd)))
      (test (less-than? (set 1) (bag 1)))
      (test (equal (convert 'list
			    (eval '(bag 1 ($ (bag 3 3)) (% "x" 3) 4
				        ($ (bag (% 7 2) 8 1)))))
		   '(1 1 3 3 4 7 7 8 "x" "x" "x")))
      (test (equal (convert 'list (bag 1 2 1)) '(1 1 2)))
      (test (less-than? (bag 1) (map ('x 1))))
      (test (equal (convert 'list
			    (eval '(map ($ (map ('x 0) ('y 3) ('z 4))) ('x 1)
				        ($ (map ('z 7) ('w 9))))))
		   '((w . 9) (x . 1) (y . 3) (z . 7))))
      (test (equal (convert 'list (map ('x 1) ('y 2))) '((x . 1) (y . 2))))
      (test (less-than? (map ('x 1)) (map ('y 1))))
      (test (less-than? (map ('x 1)) (map ('x 2))))
      (test (unequal? (map ('x 1) ('y 2)) (map ('x 1.0) ('y 2))))
      (test (less-than? (map ('x 1)) (seq "x")))
      (test (equal (convert 'list (eval '(seq 1 ($ (seq 8 'x 7)) 2 4 ($ (seq 'z 3)))))
		   '(1 8 x 7 2 4 z 3)))
      (test (equal (convert 'list (seq 1 'x "u")) '(1 x "u")))
      (test (less-than? (seq "x") (seq "y")))
      (test (unequal? (seq 'a 3 'c) (seq 'a 3.0 'c)))
      (test (less-than? (seq 'a 3 'c) (seq 'a 3.0 'd)))
      (test (less-than? (seq) (tuple)))
      (test (equal (sort (convert 'list (eval '(tuple (+K0+ 1)
						      ($ (tuple (+K1+ 2) (+K2+ 3)))
						      (+K0+ 2)
						      ($ (tuple (+K4+ 7) (+K2+ 8))))))
			 #'< :key (fn (x) (tuple-key-number (car x))))
		   `((,+K0+ . 2) (,+K1+ . 2) (,+K2+ . 8) (,+K4+ . 7))))
      (test (less-than? (tuple (+K0+ 1)) (tuple (+K0+ 2))))
      (test (unequal? (tuple (+K0+ 1.0) (+K1+ 'c)) (tuple (+K0+ 1) (+K1+ 'c))))
      (test (less-than? (tuple (+K0+ 1.0) (+K1+ 'c)) (tuple (+K0+ 1) (+K1+ 'd))))

      (test (equal? (image +K0+ (set)) (set)))
      (test (equal? (image +K0+ (set (tuple))) (set nil)))
      (test (equal? (image +K0+ (set (tuple (+K0+ 1) (+K1+ 2)) (tuple (+K0+ 3) (+K2+ 17))))
		    (set 1 3)))
      (test (equal? (image +K0+ (seq)) (seq)))
      (test (equal? (image +K0+ (seq (tuple) (tuple (+K0+ 1) (+K1+ 2)) (tuple (+K0+ 3) (+K2+ 17))))
		    (seq nil 1 3)))
      (test (equal? (restrict (tuple) (set)) (tuple)))
      (test (equal? (restrict (tuple (+K0+ 1)) (set)) (tuple)))
      (test (equal? (restrict (tuple (+K0+ 1) (+K1+ 2) (+K3+ 5)) (set +K1+)) (tuple (+K1+ 2))))
      (test (equal? (restrict-not (tuple) (set)) (tuple)))
      (test (equal? (restrict-not (tuple (+K0+ 1)) (set)) (tuple (+K0+ 1))))
      (test (equal? (restrict-not (tuple (+K0+ 1) (+K1+ 2) (+K3+ 5)) (set +K1+))
		    (tuple (+K0+ 1) (+K3+ 5))))
      
      (test (empty? (set)))
      (test (empty? (map)))
      (test (empty? (bag)))
      (test (empty? (seq)))
      (test (nonempty? (set 1)))
      (test (locally (declare (notinline nonempty?)) (nonempty? (set 1))))
      (test (member? 1 (set 1)))
      (test (lookup (set 1 2 3 4 5 6 7 8 9 10) 1))
      (test (lookup (set 1 2 3 4 5 6 7 8 9 10) 6))
      (test (lookup (set 1 2 3 4 5 6 7 8 9 10) 10))

      (dolist (n '(2 5 10 20))
	(let* ((objs (loop for i from 1 to n collect (make-instance 'my-unhandled-obj :value i)))
	       (s (set))
	       (singles (loop for o in objs collect (set o))))
	  (dolist (o objs) (setf s (with s o)))
	  (dolist (s1 singles)
	    (test (subset? s1 s))
	    (test (not (subset? s s1))))
	  (test (every (lambda (o) (lookup s o)) objs))))

      (let* ((objs (loop for i from 1 to 3 collect (make-instance 'my-unhandled-obj :value i)))
	     (s (convert 'set objs))
	     (s1 (set (car objs)))
	     (s2 (set (cadr objs)))
	     (s3 (set (caddr objs)))
	     (s12 (set (car objs) (cadr objs)))
	     (s23 (set (cadr objs) (caddr objs))))
	(test (subset? s1 s12))
	(test (subset? s2 s12))
	(test (not (subset? s1 s2)))
	(test (not (subset? s1 s23)))
	(test (equal? (union s1 s23) s))
	(test (equal? (union s12 s23) s))
	(test (subset? s1 s))
	(test (subset? s12 s))
	(test (subset? s23 s))
	(test (subset? s s))

	(test (empty? (intersection s1 s2)))
	(test (empty? (intersection s1 s23)))
	(test (empty? (intersection s12 s3)))
	(test (empty? (intersection (set) s)))
	(test (empty? (intersection s (set)))))

      (test-equivalent-sets)

      (test (subset? (set 1) (set 1 2)))
      (test (subset? (set 2) (set 1 2)))
      (test (not (subset? (set 2) (set 1 3))))

      (test (not (lookup (set 1 7 10) 8)))
      (test (equal? (split #'evenp (set 1 2)) (set 2)))
      (test (equal? (nth-value 1 (split #'evenp (set 1 2))) (set 1)))
      (test (equal (multiple-value-list (split #'evenp '(1 2))) '((2) (1))))
      (test (equal? (filter-pairs (lambda (v c) (declare (ignore v)) (> c 1))
				  (bag 1 2 2 3 3 4 5 5 5 6))
		    (bag 2 2 3 3 5 5 5)))
      (test (equal? (filter-pairs (constantly t) (set 1 2 3)) (set 1 2 3)))
      (test (equal? (image #'1+ '(1 2 3)) '(2 3 4)))
      (test (equal? (image '1+ '(1 2 3)) '(2 3 4)))
      (test (equal? (image (set 1 3) '(1 2 3 4)) '(t nil t nil)))
      (test (equal? (image '1+ (set 0 4 7)) (set 1 5 8)))
      (test (equal? (image #'1+ (set 9 3 17)) (set 4 10 18)))
      (test (equal? (image (map (1 4) (2 8) (3 10) :default 0) (set 1 2 7))
		    (set 0 4 8)))
      (test (equal? (image (map (1 2) (3 4)) '(1 2 3)) '(2 nil 4)))
      (test (equal? (image (set 1) (set 1)) (set t)))
      (test (equal? (image (set 1) (set 2)) (set nil)))
      (test (equal? (image (set 1) (set 1 2)) (set nil t)))
      (test (equal? (image (bag 1) (set 1)) (set t)))
      (test (equal? (image (bag 1) (set 2)) (set nil)))
      (test (equal? (image (bag 1 1 2) (set 1 2 3)) (set nil t)))

      (test (equal? (reduce #'+ (set 1 2 3) :initial-value 0) 6))
      (test (equal? (reduce #'+ (set 1 2 3) :key #'1+ :initial-value 0) 9))
      (test (equal? (reduce '+ (set 1 2 3 5) :initial-value 0) 11))
      (test (equal? (reduce '+ (set 1 2 3 5) :key '1+ :initial-value 0) 15))
      (test (equal (reduce #'cons (set 1 2 3)) '((1 . 2) . 3)))
      (test (equal (reduce 'cons (set 1 2 3)) '((1 . 2) . 3)))
      (test (equal (reduce #'cons (set 1 2 3) :key #'1+) '((2 . 3) . 4)))
      (test (equal (reduce #'list (set)) nil))
      (test (equal (reduce 'list (set)) nil))

      (test (equal? (sort (set 4 2 19 14) #'<) (seq 2 4 14 19)))
      (test (equal? (sort (set 4 2 19 14) #'< :key #'-) (seq 19 14 4 2)))
      (test (equal? (stable-sort (set 4 2 19 14) #'<) (seq 2 4 14 19)))
      (test (equal? (stable-sort (set 4 2 19 14) #'< :key #'-) (seq 19 14 4 2)))

      (test (equal? (convert 'set (set 1 2 4)) (set 1 2 4)))
      (test (equal? (convert 'wb-set (wb-set 5 8 19)) (wb-set 5 8 19)))
      (test (equal? (convert 'bag (wb-set 3 18 24 4)) (bag 3 4 18 24)))
      (test (equal? (convert 'wb-bag (wb-set 3 18 24 4)) (wb-bag 3 4 18 24)))
      (test (equal? (convert 'set (seq 3 10 4 20 7)) (set 3 4 7 10 20)))
      (test (equal? (convert 'wb-set (seq 3 10 4 20 7)) (wb-set 3 4 7 10 20)))
      (test (equal? (convert 'set (vector 3 10 4 20 7)) (set 3 4 7 10 20)))
      (test (equal? (convert 'wb-set (vector 3 10 4 20 7)) (wb-set 3 4 7 10 20)))
      (test (equal? (convert 'set '(1 1)) (set 1)))

      (dolist (n '(0 2 5 7 10))
	(let* ((vals (loop for i from 1 to n collect i))
	       #+sbcl
	       (seq (make-instance 'my-sequence :actual vals))
	       (s (set)))
	  (dolist (i vals) (setf s (with s i)))
	  (test (equal? (convert 'set vals) s))
	  #+sbcl
	  (test (equal? (convert 'set seq) s))
	  ))

      (test (equal (find 0 (set)) nil))
      (test (equal (find 1 (set 1)) 1))
      (test (equal (find 1 (set 1) :test 'equal?) 1))
      (test (equal (find 1 (set 1) :test #'equal?) 1))
      (test (equal (find 1 (set 1 0) :key #'1+) 0))
      (test (equal (find 2 (set 1 0) :key #'1+) 1))
      (test (equal (find 3 (set 1 2 8) :test #'<) 8))
      (test (equal (find 3 (set 1 2 8) :key '1+ :test #'<=) 2))
      (test (equal (find 1 (set) :key #'1+) nil))

      (test (equal (find-if #'evenp (set 1 2 3)) 2))
      (test (equal (find-if 'evenp (set 1 2 3)) 2))
      (test (equal (find-if #'evenp (set 0 1) :key #'1+) 1))
      (test (equal (find-if #'oddp (set 0 1) :key #'1+) 0))
      (test (equal (find-if-not #'evenp (set 2 3 4)) 3))
      (test (equal (find-if-not 'evenp (set 2 3 4)) 3))

      (test (equal (count 5 (set 4 5 6)) 1))
      (test (equal (count 1 (set)) 0))
      (test (equal (count 1 (set) :test 'equal?) 0))
      (test (equal (count 1 (set) :test #'equal?) 0))
      (test (equal (count nil (set 1 2 3 4 5) :key #'evenp) 3))
      (test (equal (count nil (set 1 2 3 4 5) :key 'evenp) 3))
      (test (equal (count 3 (set 1 2 3 4 5 6 7) :test #'<=) 5))
      (test (equal (count 3 (set 1 2 3 4 5 6 7) :test '>) 2))
      (test (equal (count 3 (set 1 2 3 4 5 6 7) :test #'> :key #'1+) 1))

      (test (equal (count-if #'evenp (set 0 1 2 3 4)) 3))
      (test (equal (count-if 'evenp (set 1 2 3 4 5)) 2))
      (test (equal (count-if #'evenp (set 1 2 3 4 5) :key #'1+) 3))
      (test (equal (count-if #'evenp (set 1 2 3 4 5) :key '1+) 3))

      (test (equal (count-if-not #'evenp (set 0 1 2 3 4)) 2))

      (locally (declare (notinline empty-bag empty-wb-bag))
	(test (equal? (size (empty-bag)) 0))
	(test (equal? (empty-bag) (bag)))
	(test (equal? (size (empty-wb-bag)) 0))
	(test (equal? (empty-wb-bag) (wb-bag))))

      (test (equal (multiplicity (set 0 1) 0) 1))
      (test (equal (multiplicity (set 0 1) 2) 0))

      (test (equal? (with (bag 1 2) 1) (bag 1 1 2)))
      (test (equal? (with (bag 1 2) 1 0) (bag 1 2)))
      (test (equal? (with (bag 1 2) 1 2) (bag 1 1 1 2)))
      (test (equal? (with (bag 1 2) 3) (bag 1 2 3)))
      (test (equal? (with (bag 1 2) 3 4) (bag 1 2 3 3 3 3)))

      (test (equal? (less (bag 1 2) 1) (bag 2)))
      (test (equal? (less (bag 1 2) 1 0) (bag 1 2)))
      (test (equal? (less (bag 1 1 2) 1) (bag 1 2)))
      (test (equal? (less (bag 1 1 2) 1 2) (bag 2)))

      (test (equal? (union (set) (bag)) (bag)))
      (test (equal? (union (set 1) (bag 2)) (bag 1 2)))
      (test (equal? (union (set 1) (bag 2 2)) (bag 1 2 2)))
      (test (equal? (union (set 2) (bag 2 2)) (bag 2 2)))

      (test (equal? (union (bag) (set)) (bag)))
      (test (equal? (union (bag 1) (set 2)) (bag 1 2)))
      (test (equal? (union (bag 1 1) (set 2)) (bag 1 1 2)))
      (test (equal? (union (bag 1 1) (set 1 3)) (bag 1 1 3)))

      (test (equal? (bag-sum (set) (bag)) (bag)))
      (test (equal? (bag-sum (set 1) (bag 2)) (bag 1 2)))
      (test (equal? (bag-sum (set 1) (bag 1 2)) (bag 1 1 2)))
      (test (equal? (bag-sum (set 1) (bag 1 1 2)) (bag 1 1 1 2)))
      (test (equal? (bag-sum (set 3) (bag 1 1 2)) (bag 1 1 2 3)))

      (test (equal? (bag-sum (bag) (set)) (bag)))
      (test (equal? (bag-sum (bag 2) (set 1)) (bag 1 2)))
      (test (equal? (bag-sum (bag 1 2) (set 1)) (bag 1 1 2)))
      (test (equal? (bag-sum (bag 1 1 2) (set 1)) (bag 1 1 1 2)))
      (test (equal? (bag-sum (bag 1 1 2) (set 3)) (bag 1 1 2 3)))

      (test (equal? (intersection (set) (bag)) (set)))
      (test (equal? (intersection (set 1) (bag 2)) (set)))
      (test (equal? (intersection (set 1) (bag 1 2)) (set 1)))
      (test (equal? (intersection (set 1) (bag 1 1 2)) (set 1)))
      (test (equal? (intersection (set 3) (bag 1 1 2)) (set)))

      (test (equal? (bag-product (set) (bag)) (bag)))
      (test (equal? (bag-product (set 1) (bag)) (bag)))
      (test (equal? (bag-product (set) (bag 2)) (bag)))
      (test (equal? (bag-product (set 1) (bag 2)) (bag)))
      (test (equal? (bag-product (set 1) (bag 1)) (bag 1)))
      (test (equal? (bag-product (set 1) (bag 1 1 2)) (bag 1 1)))
      (test (equal? (bag-product (set 2) (bag 1 1 2)) (bag 2)))

      (test (equal? (bag-product (bag) (set)) (bag)))
      (test (equal? (bag-product (bag) (set 1)) (bag)))
      (test (equal? (bag-product (bag 2) (set)) (bag)))
      (test (equal? (bag-product (bag 2) (set 1)) (bag)))
      (test (equal? (bag-product (bag 1) (set 1)) (bag 1)))
      (test (equal? (bag-product (bag 1 1 2) (set 1)) (bag 1 1)))
      (test (equal? (bag-product (bag 1 1 2) (set 2)) (bag 2)))

      (test (equal? (bag-difference (set) (bag)) (bag)))
      (test (equal? (bag-difference (set) (bag 1)) (bag)))
      (test (equal? (bag-difference (set 1) (bag)) (bag 1)))
      (test (equal? (bag-difference (set 1) (bag 1)) (bag)))
      (test (equal? (bag-difference (set 1) (bag 1 1)) (bag)))
      (test (equal? (bag-difference (set 1) (bag 2)) (bag 1)))
      (test (equal? (bag-difference (set 1 3) (bag 1 2)) (bag 3)))

      (test (equal? (bag-difference (bag) (set)) (bag)))
      (test (equal? (bag-difference (bag 1) (set)) (bag 1)))
      (test (equal? (bag-difference (bag) (set 1)) (bag)))
      (test (equal? (bag-difference (bag 1) (set 1)) (bag)))
      (test (equal? (bag-difference (bag 1 1) (set 1)) (bag 1)))
      (test (equal? (bag-difference (bag 1 2) (set 1)) (bag 2)))
      (test (equal? (bag-difference (bag 1 1 1 2) (set 1 3)) (bag 1 1 2)))

      (test (subbag? (set) (bag)))
      (test (subbag? (set) (bag 1)))
      (test (subbag? (set 1) (bag 1)))
      (test (subbag? (set 1) (bag 1 1)))
      (test (not (subbag? (set 1) (bag))))
      (test (not (subbag? (set 1 3 5) (bag 1 1 4 7 5))))

      (test (subbag? (bag) (set)))
      (test (subbag? (bag) (set 1)))
      (test (subbag? (bag 1) (set 1)))
      (test (not (subbag? (bag 1) (set 2))))
      (test (not (subbag? (bag 1 1) (set 1))))
      (test (not (subbag? (bag 1 2) (set 1))))
      (test (subbag? (bag 1 4 8 10) (set 0 1 2 3 4 5 6 7 8 9 10 11)))
      (test (not (subbag? (bag 1 4 8 8 10) (set 0 1 2 3 4 5 6 7 8 9 10 11))))

      (test (equal? (filter #'evenp (bag)) (bag)))
      (test (equal? (filter #'evenp (bag 1)) (bag)))
      (test (equal? (filter #'evenp (bag 2)) (bag 2)))
      (test (equal? (filter #'evenp (bag 1 1 2 2)) (bag 2 2)))
      (test (equal? (filter 'evenp (bag 1 1 1 2 2 3)) (bag 2 2)))
      (test (equal? (filter (map (1 t) (3 t)) (bag 0 0 1 1 1 2 3 4 4 4 5))
		    (bag 1 1 1 3)))
      (test (equal? (filter (set 1 3) (bag 0 1 1 1 2 3 4 4 4 5))
		    (bag 1 1 1 3)))
      (test (equal? (filter (bag 1 1 3) (bag 0 1 1 1 2 3 4 4 4 5))
		    (bag 1 1 1 3)))

      (let ((e (lambda (x c) (declare (ignore c)) (evenp x))))
	(test (equal? (filter-pairs e (bag)) (bag)))
	(test (equal? (filter-pairs e (bag 1 2 2 3 4 5)) (bag 2 2 4))))
      (test (equal? (filter-pairs '= (bag 1 1 1 2 2 3)) (bag 2 2)))

      (test (equal? (image #'1+ (bag)) (bag)))
      (test (equal? (image #'1+ (bag 1)) (bag 2)))
      (test (equal? (image #'1+ (bag 1 1)) (bag 2 2)))
      (test (equal? (image #'1+ (bag 0 1 1 3 4 4 4 5)) (bag 1 2 2 4 5 5 5 6)))
      (test (equal? (image '1+ (bag 0 1 2 2 3)) (bag 1 2 3 3 4)))
      (test (equal? (image (map (1 4) (2 5) (3 6) (4 5) :default 0) (bag 0 1 1 2 2 2 3 4 5 6))
		    (bag 0 0 0 4 4 5 5 5 5 6)))
      (test (equal? (image (set 1) (bag 1)) (bag t)))
      (test (equal? (image (set 0) (bag 1)) (bag nil)))
      (test (equal? (image (set 0 3) (bag 0 1 2 3 5)) (bag nil nil nil t t)))
      (test (equal? (image (bag 1 1) (bag 1)) (bag t)))
      (test (equal? (image (bag 0) (bag 1)) (bag nil)))
      (test (equal? (image (bag 0 3) (bag 0 1 1 2 3 5)) (bag nil nil nil nil t t)))

      (test (equal (reduce #'+ (bag 1 2 3) :initial-value 0) 6))
      (test (equal (reduce #'+ (bag 1 2 2 3) :initial-value 0) 8))
      (test (equal (reduce #'+ (bag 1 2 3) :key #'1+ :initial-value 0) 9))
      (test (equal (reduce #'+ (bag 1 2 2 3) :key #'1+ :initial-value 0) 12))
      (test (equal (reduce 'cons (bag 1 2 3)) '((1 . 2) . 3)))
      (test (equal (reduce 'cons (bag 1 2 3) :key #'1+) '((2 . 3) . 4)))
      (test (equal (reduce #'cons (bag 1 2 2 3)) '(((1 . 2) . 2) . 3)))
      (test (equal (reduce 'list (bag)) nil))

      (test (equal? (convert 'bag (bag 0 1 1 2 3 3 4)) (bag 0 1 1 2 3 3 4)))
      (test (equal? (convert 'wb-bag (bag 0 1 1 2 3 3 4)) (wb-bag 0 1 1 2 3 3 4)))
      (test (equal? (convert 'set (bag 0 1 1 2 3 3 4)) (set 0 1 2 3 4)))
      (test (equal? (convert 'wb-set (bag 0 1 1 2 3 3 4)) (wb-set 0 1 2 3 4)))
      (test (equal (convert 'list (bag 0 1 1 2 3 3 4)) '(0 1 1 2 3 3 4)))
      (test (equal? (convert 'seq (bag 0 1 1 2 3 3 4)) (seq 0 1 1 2 3 3 4)))
      (test (equalp (convert 'vector (bag 0 1 1 2 3 3 4)) #(0 1 1 2 3 3 4)))

      (test (equal? (convert 'bag (vector 10 0 8 1 1 2 5 9 9 9))
		    (bag 0 1 1 2 5 8 9 9 9 10)))
      (test (equal? (convert 'wb-bag (vector 10 0 8 1 1 2 5 9 9 9))
		    (bag 0 1 1 2 5 8 9 9 9 10)))

      (test (equal (find 0 (bag)) nil))
      (test (equal (find 1 (bag 1)) 1))
      (test (equal (find 1 (bag 0 1 2)) 1))
      (test (equal (find 1 (bag 0 1 2) :test #'equal?) 1))
      (test (equal (find 1 (bag 0 1 2) :test 'equal?) 1))
      (test (equal (find 1 (bag 0 1 1 2)) 1))
      (test (equal (find 1 (bag 0 0 1 2)) 1))
      (test (equal (find 1 (bag 0 1 2 2)) 1))
      (test (equal (find 1 (bag 0 0 1 1 2 2)) 1))
      (test (equal (find 1 (bag 0 1 2 3) :key #'1-) 2))
      (test (equal (find 1 (bag 0 1 2 3) :test '<) 2))
      (test (equal (find 1 (bag 0 1 2 3) :test '< :key #'1-) 3))

      (test (equal (find-if #'evenp (bag)) nil))
      (test (equal (find-if #'evenp (bag 1)) nil))
      (test (equal (find-if #'evenp (bag 1 1)) nil))
      (test (equal (find-if #'evenp (bag 1 2 3)) 2))
      (test (equal (find-if 'evenp (bag 1 2 3)) 2))
      (test (equal (find-if #'plusp (bag 1 1 2 2 2 3 4) :key (lambda (n) (- n 3))) 4))

      (test (equal (find-if-not #'evenp (bag)) nil))
      (test (equal (find-if-not #'evenp (bag 1)) 1))
      (test (equal (find-if-not #'evenp (bag 2)) nil))
      (test (equal (find-if-not #'evenp (bag 2 2)) nil))
      (test (equal (find-if-not #'evenp (bag 1 1)) 1))
      (test (equal (find-if-not #'evenp (bag 2 3 4)) 3))
      (test (equal (find-if-not 'evenp (bag 2 3 4)) 3))
      (test (equal (find-if-not #'minusp (bag 1 1 2 2 2 3 4) :key (lambda (n) (- n 3))) 3))

      (test (equal (count 1 (bag)) 0))
      (test (equal (count 1 (bag 1)) 1))
      (test (equal (count 1 (bag 1 1)) 2))
      (test (equal (count 1 (bag 2)) 0))
      (test (equal (count 1 (bag 2 2)) 0))
      (test (equal (count 1 (bag 0 1 1 2 2 2) :test 'equal?) 2))
      (test (equal (count 1 (bag 0 1 1 2 2 2) :test #'equal?) 2))
      (test (equal (count 1 (bag 0 1 1 2) :key #'1+) 1))
      (test (equal (count 1 (bag 0 1 1 2) :key '1+) 1))
      (test (equal (count 1 (bag 0 0 1 2 2 2 3) :test #'<) 4))
      (test (equal (count 1 (bag 0 0 1 2 2 2 3) :test '<) 4))
      (test (equal (count 1 (bag 0 0 1 2 2 2 3) :test '< :key #'1+) 5))

      (test (equal (count-if #'evenp (bag)) 0))
      (test (equal (count-if #'evenp (bag 1)) 0))
      (test (equal (count-if #'evenp (bag 2)) 1))
      (test (equal (count-if #'evenp (bag 1 2 3) :key #'1+) 2))
      (test (equal (count-if #'evenp (bag 1 2 3) :key '1+) 2))

      (test (equal (count-if-not #'evenp (bag 1 2 2 3 4)) 2))

      (locally (declare (notinline empty-map empty-wb-map))
	(test (equal (size (empty-map)) 0))
	(test (equal (size (empty-map t)) 0))
	(test (equal (size (empty-wb-map)) 0))
	(test (equal (size (empty-wb-map t)) 0)))
      (test (equal (default (empty-map)) nil))
      (test (equal (default (empty-map 1)) 1))
      (test (empty? (empty-map)))
      (test (empty? (empty-map t)))
      (test (not (empty? (map (1 2)))))

      (let ((m (map (1 3) (2 4))))
	(setf (lookup m 10) 17)
	(test (equal? m (map (1 3) (2 4) (10 17)))))

      (test (equal? (filter #'eql (map (1 2) (2 3) (3 3) (4 5)))
		    (map (3 3))))
      (test (equal? (filter 'eql (map (1 2) (2 3) (3 3) (4 5)))
		    (map (3 3))))
      (test (equal? (filter #'eql (map (1 2) (2 3) (3 3) (4 5) :default t))
		    (map (3 3) :default t)))
      (test (equal? (image #'values (map (1 2) (4 6)))
		    (map (1 2) (4 6))))
      (test (equal? (image 'values (map (1 2) (4 6)))
		    (map (1 2) (4 6))))
      (test (equal? (image #'values (map (1 2) (4 6) :default t))
		    (map (1 2) (4 6) :default t)))
      (test (equal (reduce #'+ (map (1 2) (10 18)) :initial-value 0) 31))
      (test (equal (reduce '+ (map (1 2) (10 18)) :initial-value 1) 32))
      (test (equal (reduce #'+ (map (1 2) (10 18))
			   :key (lambda (x y) (declare (ignore y)) (values x 0))
			   :initial-value 0)
		   11))
      (test (equal (reduce '+ (map (1 2) (10 18))
			   :key (lambda (x y) (declare (ignore x)) (values 0 y))
			   :initial-value 1)
		   21))
      (test (equal? (range (map (1 3) (2 12))) (set 3 12)))
      (test (range-contains? (map (4 8) (3 12) (6 7)) 7))
      (test (not (range-contains? (map (4 8) (3 12) (6 7)) 4)))

      (test (equal? (compose (map (1 2)) (map (2 3)))
		    (map (1 3))))
      (test (equal? (compose (map (1 2) :default 4) (map (4 5) :default 3))
		    (map (1 3) :default 5)))
      (test (equal? (compose (map (1 2) :default 3) #'1+)
		    (map (1 3) :default 4)))
      (test (equal? (compose (map (1 2) :default 3) '1+)
		    (map (1 3) :default 4)))
      (test (equal? (compose (map (0 1) (2 4) :default 3)
			     (seq :a :b :c :d :e :f :g))
		    (map (0 :b) (2 :e) :default :d)))

      (test (equal? (convert 'map (map (1 2) (4 8) :default 0))
		    (map (1 2) (4 8) :default 0)))
      (test (equal? (convert 'wb-map (map (1 2) (4 8) :default 0))
		    (map (1 2) (4 8) :default 0)))
      (test (equal? (convert 'seq (map (1 3) (2 10) :default 17))
		    (seq '(1 . 3) '(2 . 10))))
      (test (equalp (convert 'vector (map (1 3) (2 10) :default 17))
		    #((1 . 3) (2 . 10))))
      (test (equalp (convert 'set (map (1 3) (2 10) :default 17))
		    (set '(1 . 3) '(2 . 10))))
      (test (equal? (convert 'map '((1 . 2) (3 . 4)))
		    (map (1 2) (3 4))))
      (test (equal? (convert 'wb-map '((1 . 2) (3 . 4)))
		    (map (1 2) (3 4))))
      (test (equal? (convert 'map #((1 . 2) (3 . 4)))
		    (map (1 2) (3 4))))
      (test (equal? (convert 'wb-map #((1 . 2) (3 . 4)))
		    (map (1 2) (3 4))))
      (test (equal? (convert 'map (bag 0 2 2 2 3 8 8))
		    (map (0 1) (2 3) (3 1) (8 2))))
      (test (equal? (convert 'wb-map (bag 0 2 2 2 3 8 8))
		    (map (0 1) (2 3) (3 1) (8 2))))
      (test (let ((ht (make-hash-table)))
	      (setf (gethash 1 ht) 2)
	      (setf (gethash 3 ht) 4)
	      (equal? (convert 'map ht) (map (1 2) (3 4)))))
      (test (let ((ht (convert 'hash-table (map (1 2) (3 4)))))
	      (and (eql (gethash 1 ht) 2)
		   (eql (gethash 3 ht) 4)
		   (eql (hash-table-count ht) 2))))

      (test (equal (multiple-value-list (find 1 (map))) '(nil nil)))
      (test (equal (multiple-value-list (find 1 (map (1 3)))) '(1 3)))
      (test (equal (multiple-value-list (find 1 (map (1 3) (2 5)) :test #'<)) '(2 5)))
      (test (equal (multiple-value-list (find 10 (map (1 3) (2 5)) :test #'<)) '(nil)))
      (test (equal (multiple-value-list (find 1 (map (1 3) (2 5)) :key #'1-)) '(2 5)))
      (test (equal (multiple-value-list (find 10 (map (1 3) (2 5)) :key #'1-)) '(nil)))
      (test (equal (multiple-value-list (find 1 (map (1 3) (2 5) (3 6)) :test #'> :key #'1-)) '(1 3)))
      (test (equal (multiple-value-list (find 10 (map (1 3) (2 5) (3 6)) :test #'= :key #'1-)) '(nil)))
      (test (equal (multiple-value-list (find 1 (map (1 3) (2 5) (3 6)) :test #'< :key #'1-)) '(3 6)))

      (test (equal (multiple-value-list (find-if #'evenp (map))) '(nil)))
      (test (equal (multiple-value-list (find-if #'evenp (map (1 2)))) '(nil)))
      (test (equal (multiple-value-list (find-if #'evenp (map (1 2) (2 3)))) '(2 3)))
      (test (equal (multiple-value-list (find-if #'evenp (map (1 2) (2 3)) :key 'identity)) '(2 3)))
      (test (equal (multiple-value-list (find-if #'evenp (map (1 2) (2 3)) :key '1-)) '(1 2)))

      (test (equal (multiple-value-list (find-if-not #'evenp (map))) '(nil)))
      (test (equal (multiple-value-list (find-if-not #'evenp (map (0 3) (1 7)))) '(1 7)))

      (test (equal (count 1 (map)) 0))
      (test (equal (count 2 (map (0 2) (1 3) (2 5) (3 2))) 1))
      (test (equal (count 2 (map (0 2) (1 3) (2 5) (3 2) :default 2)) 1))
      (test (equal (count 2 (map (0 2) (1 3) (2 5) (3 2)) :key (constantly 2)) 4))
      (test (equal (count 2 (map (0 2) (1 3) (2 5) (3 2)) :key (constantly 3)) 0))
      (test (equal (count 2 (map (0 2) (1 3) (2 5) (3 2)) :test #'equal?) 1))
      (test (equal (count 2 (map (0 2) (1 3) (2 5) (3 2)) :test 'equal?) 1))
      (test (equal (count 2 (map (0 2) (1 3) (2 5) (3 2)) :test #'>=) 3))
      (test (equal (count 2 (map (0 2) (1 3) (2 5) (3 2)) :key #'1+ :test #'>=) 2))

      (test (equal (count-if #'evenp (map (1 5) (2 7) (3 9))) 1))
      (test (equal (count-if #'evenp (map (1 5) (2 7) (3 9)) :key #'1+) 2))
      (test (equal (count-if-not #'evenp (map (1 5) (2 7) (3 9))) 2))

      (locally (declare (notinline empty-seq empty-wb-seq))
	(test (equal (size (empty-seq)) 0))
	(test (empty? (empty-seq)))
	(test (equal (size (empty-seq t)) 0))
	(test (empty? (empty-wb-seq)))
	(test (equal (size (empty-wb-seq)) 0)))

      (test (equal (default (empty-seq 1)) 1))
      (test (equal (default (with-default (seq 1 2) 17)) 17))

      (test (equal (multiple-value-list (lookup (seq 1 2) 0)) '(1 t)))
      (test (equal (multiple-value-list (lookup (seq 1 2) 1)) '(2 t)))
      (test (equal (multiple-value-list (lookup (seq 1 2) 2)) '(nil nil)))
      (test (equal (multiple-value-list (lookup (with-default (seq 1 2) 17) 2)) '(17 nil)))
      (test (equal (multiple-value-list (lookup (seq 1 2 3) (1+ most-positive-fixnum)))
		   '(nil nil)))
      (test (equal (multiple-value-list (first (seq))) '(nil nil)))
      (test (equal (multiple-value-list (first (empty-seq 17))) '(17 nil)))
      (test (equal (multiple-value-list (first (seq 1))) '(1 t)))
      (test (equal (multiple-value-list (first (seq 1 2))) '(1 t)))
      (test (equal (multiple-value-list (last (seq))) '(nil nil)))
      (test (equal (multiple-value-list (last (empty-seq 17))) '(17 nil)))
      (test (equal (multiple-value-list (last (seq 1))) '(1 t)))
      (test (equal (multiple-value-list (last (seq 1 2))) '(2 t)))

      (test (equal (find 0 (seq 2 5 0 6 7)) 0))
      (test (equal (find-if #'evenp (seq 1 3 4 7 8)) 4))
      (test (equal (find-if #'evenp (seq 1 3 4 7 8) :from-end t) 8))
      (test (equal (find-if #'evenp (seq 1 3 4 7 8) :start 3) 8))
      (test (equal (find-if #'evenp (seq 1 3 4 7 8) :end 2) nil))
      (test (equal (find-if #'evenp (seq 2 4 5 8 9) :key #'1+) 5))

      (test (equal (find-if-not #'evenp (seq 2 4 5 8 9)) 5))

      (test (equal (count 0 (seq 0 1 2 0 3 0 4 5 4)) 3))
      (test (equal (count 0 (seq 0 1 2 0 3 0 4 5 4) :test #'equal?) 3))
      (test (equal (count 0 (seq 0 1 2 0 3 0 4 5 4) :test 'equal?) 3))
      (test (equal (count 0 (seq 0 1 2 0 3 0 4 5 4)) 3))
      (test (equal (count 0 (seq 0 1 2 0 3 0 4 5 4) :start 1) 2))
      (test (equal (count 0 (seq 0 1 2 0 3 0 4 5 4) :end 4) 2))
      (test (equal (count 0 (seq 0 1 2 0 3 0 4 5 4) :start 1 :end 4) 1))
      (test (equal (count 1 (seq 0 1 2 0 3 0 4 5 4) :key #'1+) 3))
      (test (equal (count 2 (seq 0 1 2 0 3 0 4 5 4) :key #'1+ :test #'<) 5))

      (test (equal (count-if #'evenp (seq 3 2 1 1 5 4 8 9)) 3))
      (test (equal (count-if #'evenp (seq 3 2 1 1 5 4 8 9) :from-end t) 3))
      (test (equal (count-if #'evenp (seq 3 2 1 1 5 4 8 9) :start 2) 2))
      (test (equal (count-if #'evenp (seq 3 2 1 1 5 4 8 9) :end 4) 1))
      (test (equal (count-if #'evenp (seq 3 2 1 1 5 4 8 9) :start 2 :end 4) 0))
      (test (equal (count-if #'evenp (seq 3 2 1 1 5 4 8 9) :key #'1+) 5))

      (test (equal (count-if-not #'evenp (seq 3 2 1 1 5 4 8 9)) 5))

      (test (equal (position 0 (seq)) nil))
      (test (equal (position 1 (seq 1)) 0))
      (test (equal (position 1 (seq 1 1)) 0))
      (test (equal (position 1 (seq 1 1) :from-end t) 1))
      (test (equal (position 1 (seq 0 1 2) :key #'1-) 2))
      (test (equal (position 3 (seq 0 2 5 6) :test #'<) 2))
      (test (equal (position 3 (seq 0 2 5 6) :test #'<= :key #'1+) 1))
      (test (equal (position :x (seq :a :b :x :c) :test 'equal?) 2))
      (test (equal (position :x (seq :a :b :x :c) :test #'equal?) 2))

      (test (eql (first '(1 2)) 1))
      (test (eql (first #(1 2)) 1))
      (test (eql (last '(1 2)) 2))
      (test (eql (last #(1 2)) 2))
      (test (eql (first "abc") #\a))
      (test (eql (last "abc") #\c))
      (test (equal? (subseq '(0 1 2 3) 1 3) '(1 2)))
      (test (equal? (subseq #(0 1 2 3) 1 3) #(1 2)))
      (test (equal? (subseq "abcd" 1 3) "bc"))
      (test (equal? (reverse '(0 1 2 3)) '(3 2 1 0)))
      (test (equal? (reverse #(0 1 2 3)) #(3 2 1 0)))
      (test (equal? (reverse "abcd") "dcba"))
      (let ((x '(3 1 2)))
	(test (equal? (sort x #'<) '(1 2 3)))
	;; fset::sort is nondestructive
	(test (equal? x '(3 1 2))))
      (let ((x '(3 1 2)))
	(test (equal? (stable-sort x #'<) '(1 2 3)))
	;; fset::stable-sort is nondestructive
	(test (equal? x '(3 1 2))))
      (dolist (v (list '(3 5)
		       #(3 5)
		       (make-array '(2) :initial-contents '(3 5)
				   :adjustable t)
		       #+sbcl
		       (make-instance 'my-sequence :actual '(3 5))
		       ))
	(let ((it (iterator v)))
	  (test (equal (mapcar (lambda (v)
				 (multiple-value-bind (x y)
				     (funcall it v)
				   (if (eql v :get) (list x y) (not (not x)))))
			       '(:done? :more? :get :done? :more? :get :done? :more? :get))
		       '(nil t (3 t) nil t (5 t) t nil (nil nil))))))
      (dolist (s (list "ab"
		       (make-array '(2) :element-type 'base-char
				      :adjustable t :initial-contents '(#\a #\b))))
	(let ((it (iterator s)))
	  (test (equal (mapcar (lambda (v)
				 (multiple-value-bind (x y)
				     (funcall it v)
				   (if (eql v :get) (list x y) (not (not x)))))
			       '(:done? :more? :get :done? :more? :get :done? :more? :get))
		       '(nil t (#\a t) nil t (#\b t) t nil (nil nil))))))
      
      (test (equal (find-if #'evenp '(1 2 3)) 2))
      (test (equal (find-if-not #'evenp '(1 2 3)) 1))
      (test (equal (count 1 '(1 2 3 1 4 2 1 0)) 3))
      (test (equal (count-if #'oddp '(1 2 3 4 5)) 3))
      (test (equal (count-if-not #'oddp '(1 2 3 4 5)) 2))
      (test (equal (position :x '(:a :b :x c)) 2))
      (test (equal (position-if #'evenp '(1 3 5 2 0 7 4)) 3))
      (test (equal (position-if-not #'oddp '(1 3 5 2 0 7 4)) 3))
      (test (equal (substitute :y :x '(:a :b :x :c :y :z :x :d))
		   '(:a :b :y :c :y :z :y :d)))
      (test (equal (substitute-if 0 #'evenp  '(1 2 3 3 4 1 6 9))
		   '(1 0 3 3 0 1 0 9)))
      (test (equal (substitute-if-not 0 #'oddp  '(1 2 3 3 4 1 6 9))
		   '(1 0 3 3 0 1 0 9)))
      (test (some #'evenp '(1 2 3)))
      (test (not (notany #'evenp '(1 2 3))))
      (test (notany #'evenp #(1 3 5)))
      (test (some #'evenp (set 1 3 6 5)))
      (test (notany #'evenp (set 1 3 5)))
      (test (notany #'identity (set)))
      (test (notany #'= '(1 1) (set 2)))

      (test (every #'= '(1 2 3) '(1 2 3)))
      (test (not (notevery #'= '(1 2 3) '(1 2 3))))
      (test (every #'= '(1 2) '(1 2 3)))
      (test (every #'= '(1 2 3) '(1 2)))
      (test (every #'= '(1 2) (set)))
      (test (every #'= (set) '(1 2)))
      (test (notevery #'= '(1 2 3) (set 1 2 4)))
      (test (notevery #'= '(1 2 3) '(1 2 4)))

      (test (equal (sort (union '(1 2) '(1 3)) #'<) '(1 2 3)))
      (test (equal (sort (intersection '(0 1 2 3 5) '(6 3 7 1 9 2 8)) #'<) '(1 2 3)))
      (test (equal (sort (set-difference '(1 2 3 4 5) '(4 2 8 0)) #'<) '(1 3 5)))

      (test (equal (concat '(1 2 3) '(4 5 6)) '(1 2 3 4 5 6)))
      (test (equal (convert 'list '(1 2 3)) '(1 2 3)))
      (test (equalp (convert 'vector #(1 2 3)) #(1 2 3)))

      (test (equal (multiple-value-list (partition 'evenp '(1 2 3 4 5)))
		   '((2 4) (1 3 5))))
      (locally (declare (notinline lastcons head tail))
	(let* ((lc (list 3))
	       (l (cons 1 (cons 2 lc))))
	  (test (eq (lastcons l) lc))
	  (test (eql (head l) 1))
	  (test (eq (tail (tail l)) lc))))
      (test (equal? (compose (map (1 2) (2 6)) (lambda (x) (when x (1+ x))))
		    (map (1 3) (2 7))))
      (test (equal? (split-from (set 0 1 2) 1) (set 1 2)))
      (test (equal? (split-from (set 0 2 4) 1) (set 2 4)))
      (test (equal? (split-above (set 0 23 7 4 19) 7) (set 19 23)))
      (test (equal? (split-above (set 0 23 7 4 19) 6) (set 7 19 23)))
      (test (equal? (split-through (set 0 3 5 8 10) 5) (set 0 3 5)))
      (test (equal? (split-through (set 0 3 5 8 10) 6) (set 0 3 5)))
      (test (equal? (split-through (set 0 3 5 8 10) 20) (set 0 3 5 8 10)))
      (test (equal? (split-below (set 7 3 1 2) 4) (set 1 2 3)))
      (test (equal? (split-below (set 7 3 1 2) 3) (set 1 2)))
      (test (equal? (filter 'evenp (set 1 2 3 7 8 12 17)) (set 2 8 12)))
      (test (equal? (filter (map (1 t) (2 nil) (4 t)) (set 0 1 2 3 4 5))
		    (set 1 4)))
      (test (equal? (filter (set) (set)) (set)))
      (test (equal? (filter (set 0 2 4 7) (set 0 1 2 3 5 6 7 8 9 10))
		    (set 0 2 7)))
      (test (equal? (filter (bag) (set)) (set)))
      (test (equal? (filter (bag 0 0 3 5 6 6 7) (set -1 0 2 5 8))
		    (set 0 5)))
      (test (equal? (nth-value 0 (partition 'evenp (set 0 1 2 3 4 5 6 7)))
		    (set 0 2 4 6)))
      (test (equal? (nth-value 1 (partition 'evenp (set 0 1 2 3 4 5 6 7)))
		    (set 1 3 5 7)))
      (test (equal? (nth-value 0 (partition (map (1 nil) :default t) (set 0 1 2 3)))
		    (set 0 2 3)))
      (test (equal? (nth-value 1 (partition (map (1 nil) :default t) (set 0 1 2 3)))
		    (set 1)))

      (test (equal? (with-last (seq 1 2 3) 4) (seq 1 2 3 4)))
      (test (equal? (with (seq 'a 'b 'c) 1 'd) (seq 'a 'd 'c)))
      (test (equal? (with (seq 'a 'b 'c) -1 'd) (seq 'd 'a 'b 'c)))
      (test (equal? (with (seq 'a 'b 'c) 3 'd) (seq 'a 'b 'c 'd)))
      (test (equal? (with (seq 'a 'b 'c) 4 'd) (seq 'a 'b 'c nil 'd)))
      (test (equal? (with (with-default (seq 'a 'b 'c) 'z) 4 'd)
		    (with-default (seq 'a 'b 'c 'z 'd) 'z)))
      (test (equal? (with (with-default (seq 'a 'b 'c) 'z) -2 'd)
		    (with-default (seq 'd 'z 'a 'b 'c) 'z)))

      (test (equal? (splice (seq 'a 'b) -1 (seq 'c 'd)) (seq 'c 'd nil 'a 'b)))
      (test (equal? (splice (seq 'a 'b) 0 (seq 'c)) (seq 'c 'a 'b)))
      (test (equal? (splice (seq 'a 'b) 1 (seq 'c)) (seq 'a 'c 'b)))
      (test (equal? (splice (seq 'a 'b) 1 (seq)) (seq 'a 'b)))
      (test (equal? (splice (seq 'a 'b) 2 (seq 'c 'd)) (seq 'a 'b 'c 'd)))
      (test (equal? (splice (seq 'a 'b) 3 (seq 'c 'd)) (seq 'a 'b nil 'c 'd)))

      (test (equal? (insert (seq) 0 'a) (seq 'a)))
      (test (equal? (insert (seq) 1 'a) (seq nil 'a)))
      (test (equal? (insert (seq) -1 'a) (seq 'a nil)))

      (test (equal? (less (seq) 0) (seq)))
      (test (equal? (less (seq 'a) 0) (seq)))
      (test (equal? (less (seq 'a 'b) -1) (seq 'a 'b)))
      (test (equal? (less (seq 'a 'b) 0) (seq 'b)))
      (test (equal? (less (seq 'a 'b) 1) (seq 'a)))
      (test (equal? (less (seq 'a 'b) 2) (seq 'a 'b)))

      (test (equal? (subseq (seq) 0) (seq)))
      (test (equal? (subseq (seq 'a) 0) (seq 'a)))
      (test (equal? (subseq (seq 'a) 0 0) (seq)))
      (test (equal? (subseq (seq 'a) 0 1) (seq 'a)))
      (test (equal? (subseq (seq 'a 'b) 0 0) (seq)))
      (test (equal? (subseq (seq 'a 'b) 0 1) (seq 'a)))
      (test (equal? (subseq (seq 'a 'b) 0 2) (seq 'a 'b)))
      (test (equal? (subseq (seq 'a 'b) 1 1) (seq)))
      (test (equal? (subseq (seq 'a 'b) 1 2) (seq 'b)))
      (test (equal? (subseq (with-default (seq 'a 'b) 'c) 0 1)
		    (with-default (seq 'a) 'c)))

      (test (equal? (reverse (seq)) (seq)))
      (test (equal? (reverse (with-default (seq) 'z))
		    (with-default (seq) 'z)))
      (test (equal? (reverse (seq 'a)) (seq 'a)))
      (test (equal? (reverse (seq 'a 'b)) (seq 'b 'a)))
      (test (equal? (reverse (with-default (seq 'a 'b) 'z))
		    (with-default (seq 'b 'a) 'z)))
      (let* ((s (seq 1 3 2))
	     (ns (sort s #'<)))
	(test (equal? s (seq 1 3 2)))
	(test (equal? ns (seq 1 2 3))))
      (let* ((s (seq 1 3 2))
	     (ns (stable-sort s #'<)))
	(test (equal? s (seq 1 3 2)))
	(test (equal? ns (seq 1 2 3))))

      (test (equal? (sort-and-group (seq) #'< :key #'identity) (seq)))
      (test (equal? (sort-and-group (seq) #'<) (seq)))
      (test (equal? (sort-and-group (seq 1) #'<) (seq (seq 1))))
      (test (equal? (sort-and-group (seq 1 2) #'<) (seq (seq 1) (seq 2))))
      (test (equal? (sort-and-group (seq 2 1) #'<) (seq (seq 1) (seq 2))))
      (test (equal? (sort-and-group (seq 1 2 2) #'<) (seq (seq 1) (seq 2 2))))
      (test (equal? (sort-and-group (seq 1 2 2) #'< :key #'1+) (seq (seq 1) (seq 2 2))))

      (test (equal? (domain (seq)) (set)))
      (test (equal? (domain (seq 'a)) (set 0)))
      (test (equal? (domain (seq 'a 'b)) (set 0 1)))
      (test (equal? (domain (with-default (seq 'a 'b) 'z)) (set 0 1)))

      (test (equal? (range (seq)) (set)))
      (test (equal? (range (seq 'a)) (set 'a)))
      (test (equal? (range (seq 'a 'a)) (set 'a)))
      (test (equal? (range (seq 'a 'b 'a 'c)) (set 'a 'b 'c)))

      (test (equal? (convert 'wb-seq #(1 2 3)) (wb-seq 1 2 3)))
      (test (equal? (convert 'string (seq #\a #\b #\c)) "abc"))
      (test (equal? (convert 'wb-seq '(1 2 3)) (wb-seq 1 2 3)))
      (test (equal? (convert 'seq (set 1)) (seq 1)))
      (test (equal? (convert 'wb-seq (set 2)) (wb-seq 2)))
      (test (equal? (convert 'wb-seq (bag 1 1)) (wb-seq 1 1)))
      (test (equal? (convert 'wb-seq (map (1 2))) (wb-seq '(1 . 2))))

      (test (domain-contains? (seq 1) 0))
      (test (not (domain-contains? (seq 1) -1)))
      (test (not (domain-contains? (seq 1) 2)))
      (test (not (domain-contains? (seq 1) 'x)))

      (test (not (range-contains? (seq) 0)))
      (test (range-contains? (seq 'a) 'a))      
      (test (range-contains? (seq 'a 'b 'c) 'b))
      (test (not (range-contains? (seq 'a 'b 'c) 'd)))

      (test (equal? (filter #'evenp (seq 1 2 3 4 5)) (seq 2 4)))
      (test (equal? (filter #'evenp (with-default (seq 1 2 3 4 5) 17))
		    (with-default (seq 2 4) 17)))
      (test (equal? (filter 'evenp (seq 1 2 3 4 5)) (seq 2 4)))
      (test (equal? (filter (map (1 t) (3 t)) (seq 1 2 3 4 5)) (seq 1 3)))
      (test (equal? (filter (set 1 3 9) (seq 1 2 3 4 5)) (seq 1 3)))
      (test (equal? (filter (bag 1 1 3 9) (seq 1 2 3 4 5)) (seq 1 3)))

      (test (equal? (multiple-value-list (partition (constantly t) (seq 1 2 3)))
		    (list (seq 1 2 3) (seq))))
      (test (equal? (multiple-value-list (partition 'evenp (seq 1 2 3 4)))
		    (list (seq 2 4) (seq 1 3))))
      (test (equal? (multiple-value-list (partition (map (1 t) (4 t)) (seq 0 1 2 3 4 5 6)))
		    (list (seq 1 4) (seq 0 2 3 5 6))))
      (test (equal? (multiple-value-list (partition (set 1 4) (seq 0 1 2 3 4 5 6)))
		    (list (seq 1 4) (seq 0 2 3 5 6))))
      (test (equal? (multiple-value-list (partition (bag 4 4 1 17) (seq 0 1 2 3 4 5 6)))
		    (list (seq 1 4) (seq 0 2 3 5 6))))

      (test (equal? (image #'1+ (seq 1 7 5)) (seq 2 8 6)))
      (test (equal? (image '1+ (seq 1 7 5)) (seq 2 8 6)))
      (test (equal? (image #'1+ (with-default (seq 1 7 5) 0))
		    (with-default (seq 2 8 6) 0)))
      (test (equal? (image (map (1 8) (3 10)) (seq 0 1 2 3 4 5))
		    (seq nil 8 nil 10 nil nil)))
      (test (equal? (image (set -3 1 3 21) (seq 0 1 2 3 4 5))
		    (seq nil t nil t nil nil)))
      (test (equal? (image (bag 1 3 3 10) (seq 0 1 2 3 4 5))
		    (seq nil t nil t nil nil)))

      (with-standard-io-syntax
	(let ((*package* (find-package :fset))
	      (*readtable* *fset-readtable*)
	      (*print-readably* nil))
	  (test (equal? (prin1-to-string (bag 1)) "#{% 1 %}"))
	  (test (equal? (prin1-to-string (bag 1 2)) "#{% 1 2 %}"))
	  (test (equal? (prin1-to-string (bag 1 1)) "#{% (1 2) %}"))))

      (test (equal? (reduce #'+ (seq)) 0))
      (test (equal? (reduce '+ (seq)) 0))
      (test (equal? (reduce #'+ (seq 1 2 3) :key #'1+) 9))
      (test (equal? (reduce '+ (seq 1 2 3) :key #'1+) 9))
      (test (equal? (reduce #'+ (seq -1 1 2 3 17) :start 1 :end 3 :key #'1+) 5))
      (test (equal? (reduce '+ (seq -1 1 2 3 17) :start 1 :end 3 :key #'1+) 5))

      (test (equal? (reduce #'+ (seq) :initial-value 17) 17))
      (test (equal? (reduce 'cons (seq 'a)) 'a))
      (test (equal (reduce 'cons (seq 'a 'b)) '(a . b)))
      (test (equal (reduce 'cons (seq 'a 'b) :from-end t) '(b . a)))
      (test (equal? (reduce 'cons (seq 'a) :from-end t) 'a))
      (test (equal? (reduce 'cons (seq 'a) :initial-value nil :from-end t) '(nil . a)))
      (test (equal? (reduce #'+ (seq 1 2 5) :start 1 :initial-value 0) 7))
      (test (equal? (reduce '+ (seq 1 2 5) :start 1 :initial-value 0) 7))
      (test (equal? (reduce #'+ (seq 1 2 4) :end 2 :initial-value 0) 3))
      (test (equal? (reduce '+ (seq 1 2 4) :end 2 :initial-value 0) 3))

      (test (not (position-if #'identity (seq))))
      (test (not (position-if #'identity (seq nil))))
      (test (equal? (position-if #'identity (seq 1)) 0))
      (test (not (position-if #'identity (seq 1) :start 1)))
      (test (not (position-if #'identity (seq 1) :end 0)))
      (test (equal? (position-if #'identity (seq t nil t) :start 1) 2))
      (test (not (position-if #'identity (seq t nil t) :start 1 :end 2)))
      (test (equal? (position-if #'evenp (seq 1 2 3 4 5) :from-end t) 3))
      (test (equal? (position-if #'evenp (seq 1 2 3 4 5) :end 2 :from-end t) 1))
      (test (not (position-if #'evenp (seq 1 2 3 4 5) :start 4 :from-end t)))
      (test (equal? (position-if #'evenp (seq 2 3 4 5) :key #'1+) 1))
      (test (equal? (position-if #'evenp (seq 2 3 4 5) :key #'1+ :start 2) 3))
      (test (not (position-if #'evenp (seq 2 3 4 5) :key #'1+ :end 1)))
      (test (equal? (position-if #'evenp (seq 2 3 4 5 6) :key #'1+ :from-end t) 3))

      (test (not (position-if-not #'identity (seq))))
      (test (equal? (position-if-not #'evenp (seq 2 3 4)) 1))
      (test (equal? (position-if-not #'evenp (seq 2 3 4) :key '1+) 0))
      (test (equal? (position-if-not #'evenp (seq 2 3 4) :key '1+ :from-end t) 2))
      (test (equal? (position-if-not #'evenp (seq 2 3 4) :key '1+ :start 1) 2))
      (test (equal? (position-if-not #'evenp (seq 2 3 4) :key '1+ :end 1 :from-end t) 0))

      (test (equal? (remove 1 (seq)) (seq)))
      (test (equal? (remove 1 (seq 0)) (seq 0)))
      (test (equal? (remove 1 (seq 1)) (seq)))
      (test (equal? (remove 1 (seq 1 1)) (seq)))
      (test (equal? (remove 1 (seq 1 1) :count 1) (seq 1)))
      (test (equal? (remove (seq 0) (seq 0 (seq 0))) (seq 0)))
      (test (equal? (remove nil (seq 2 3 4 5) :key #'evenp) (seq 2 4)))
      (test (equal? (remove nil (seq 2 3 4 5) :key #'evenp :count 1) (seq 2 4 5)))
      (test (equal? (remove nil (seq 2 3 4 5) :key #'evenp :count 1 :from-end t) (seq 2 3 4)))
      (test (equal? (remove 3 (seq 2 3 4 5) :test #'<) (seq 2 3)))
      (test (equal? (remove 3 (seq 2 3 4 5) :test #'< :start 3) (seq 2 3 4)))
      (test (equal? (remove 3 (seq 2 3 4 5) :test #'< :end 3) (seq 2 3 5)))

      (test (equal? (remove-if 'null (seq)) (seq)))
      (test (equal? (remove-if 'null (seq nil)) (seq)))
      (test (equal? (remove-if 'null (seq 1 nil 2)) (seq 1 2)))
      (test (equal? (remove-if #'null (seq 1 nil 2)) (seq 1 2)))
      (test (equal? (remove-if #'null (seq 1 nil 2 nil 3) :start 2)
		    (seq 1 nil 2 3)))
      (test (equal? (remove-if #'null (seq 1 nil 2 nil 3) :count 1)
		    (seq 1 2 nil 3)))
      (test (equal? (remove-if #'null (seq 1 nil 2 nil 3) :count 1 :from-end t)
		    (seq 1 nil 2 3)))
      (test (equal? (remove-if #'null (seq 1 nil 2 nil 3) :key #'not)
		    (seq nil nil)))

      (test (equal? (remove-if-not 'identity (seq)) (seq)))
      (test (equal? (remove-if-not 'identity (seq nil)) (seq)))
      (test (equal? (remove-if-not 'identity (seq 1 nil 2)) (seq 1 2)))
      (test (equal? (remove-if-not #'identity (seq 1 nil 2)) (seq 1 2)))
      (test (equal? (remove-if-not #'identity (seq 1 nil 2 nil 3) :start 2)
		    (seq 1 nil 2 3)))
      (test (equal? (remove-if-not #'identity (seq 1 nil 2 nil 3) :count 1)
		    (seq 1 2 nil 3)))
      (test (equal? (remove-if-not #'identity (seq 1 nil 2 nil 3) :count 1 :from-end t)
		    (seq 1 nil 2 3)))
      (test (equal? (remove-if-not #'identity (seq 1 nil 2 nil 3) :key #'not)
		    (seq nil nil)))

      (test (equal? (substitute 1 2 (seq)) (seq)))
      (test (equal? (substitute 1 2 (seq 0 1 2 3)) (seq 0 1 1 3)))
      (test (equal? (substitute (seq 1) (seq 0) (seq 0 (seq 2) (seq 0) (seq 3) (seq 1) 1))
		    (seq 0 (seq 2) (seq 1) (seq 3) (seq 1) 1)))
      (test (equal? (substitute 'x 3 (seq 0 1 2 3 4 5) :test #'<=)
		    (seq 0 1 2 'x 'x 'x)))
      (test (equal? (substitute 'x nil (seq 0 1 2 3 4 5) :key #'evenp)
		    (seq 0 'x 2 'x 4 'x)))
      (test (equal? (substitute 1 0 (seq 1 0 2 0 3)) (seq 1 1 2 1 3)))
      (test (equal? (substitute 1 0 (seq 1 0 2 0 3) :count 1) (seq 1 1 2 0 3)))
      (test (equal? (substitute 1 0 (seq 1 0 2 0 3) :count 1 :from-end t) (seq 1 0 2 1 3)))

      (test (equal? (substitute-if 'x #'evenp (seq)) (seq)))
      (test (equal? (substitute-if 'x 'evenp (seq 1)) (seq 1)))
      (test (equal? (substitute-if 'x #'evenp (seq 2)) (seq 'x)))
      (test (equal? (substitute-if 'x #'evenp (seq 1 2) :key #'1+) (seq 'x 2)))
      (test (equal? (substitute-if 'x #'evenp (seq 1 2 3 4 5) :count 1) (seq 1 'x 3 4 5)))
      (test (equal? (substitute-if 'x #'evenp (seq 1 2 3 4 5) :count 1 :from-end t)
		    (seq 1 2 3 'x 5)))

      (test (equal? (substitute-if-not 'x #'oddp (seq)) (seq)))
      (test (equal? (substitute-if-not 'x #'oddp (seq 1)) (seq 1)))
      (test (equal? (substitute-if-not 'x #'oddp (seq 2)) (seq 'x)))
      (test (equal? (substitute-if-not 'x 'oddp (seq 1 2) :key #'1+) (seq 'x 2)))
      (test (equal? (substitute-if-not 'x #'oddp (seq 1 2 3 4 5) :count 1) (seq 1 'x 3 4 5)))
      (test (equal? (substitute-if-not 'x #'oddp (seq 1 2 3 4 5) :count 1 :from-end t)
		    (seq 1 2 3 'x 5)))

      (test (empty? nil))
      (test (not (empty? '(x))))
      #+sbcl
      (progn
	(test (empty? (make-instance 'my-sequence)))
	(test (equal? (size (make-instance 'my-sequence)) 0))
	(test (equal? (lookup (make-instance 'my-sequence :actual '(a b c)) 1) 'b))
	)
      
      (test (= (size (empty-set)) 0))
      (locally (declare (notinline empty-set))
	(test (= (size (empty-set)) 0)))
      (test (= (size (empty-wb-set)) 0))
      (locally (declare (notinline empty-wb-set))
	(test (= (size (empty-wb-set)) 0)))
      (test (= (size (set 1 2 1 3)) 3))
      (test (= (size (map ('x 1) ('y 2) ('x 3))) 2))
      (test (= (size (bag 1 2 1 3)) 4))
      (test (= (size (seq 1 2 3)) 3))
      (test (= (set-size (set 1 2 1 3)) 3))
      (test (= (set-size (bag 1 2 1 3)) 3))
      (test (let ((val val? (arb (set))))
	      (and (null val) (not val?))))
      (test (let ((s (set 1 4 8))
		  ((val val? (arb s))))
	      (and val? (contains? s val))))
      (test (let ((val mult val? (arb (bag))))
	      (and (null val) (null mult) (not val?))))
      (test (let ((b (bag 1 4 8))
		  ((val mult val? (arb b))))
	      (and val? (contains? b val) (= mult 1))))
      (test (let ((key val pr? (arb (map))))
	      (and (null key) (null val) (not pr?))))
      (test (let ((m (map ('x 0) ('y 1) ('z 3)))
		  ((key val pr? (arb m))))
	      (and pr? (equal? val (lookup m key)))))
      (test (contains? (set 1 2 1) 1))
      (test (contains? (bag 1 2 1) 2))
      (test (domain-contains? (map ('x 0) ('y 1)) 'y))
      (test (domain-contains? (seq 'a 'e 'g 'x) 3))
      (test (= (multiplicity (bag 1 2 1) 1) 2))
      (test (= (multiplicity (bag 1 2 1) 2) 1))
      (test (let ((val val? (least (set 13 7 42))))
	      (and (= val 7) val?)))
      (test (let ((val val? (least (set))))
	      (and (null val) (not val?))))
      (test (let ((val mult val? (least (bag 4 9 13 4 7))))
	      (and (= val 4) (= mult 2) val?)))
      (test (let ((val mult val? (least (bag))))
	      (and (null val) (null mult) (not val?))))
      (test (let ((key val pr? (least (map ('x 4) ('y 7)))))
	      (and (eq key 'x) (= val 4) pr?)))
      (test (let ((key val pr? (least (map))))
	      (and (null key) (null val) (not pr?))))
      (test (let ((val val? (greatest (set 13 7 42))))
	      (and (= val 42) val?)))
      (test (let ((val val? (greatest (set))))
	      (and (null val) (not val?))))
      (test (let ((val mult val? (greatest (bag 4 9 13 4 7))))
	      (and (= val 13) (= mult 1) val?)))
      (test (let ((val mult val? (greatest (bag))))
	      (and (null val) (null mult) (not val?))))
      (test (let ((key val pr? (greatest (map ('x 4) ('y 7)))))
	      (and (eq key 'y) (= val 7) pr?)))
      (test (let ((key val pr? (greatest (map))))
	      (and (null key) (null val) (not pr?))))
      (test (eq (lookup (map ('x 'a) ('y 'b)) 'x) 'a))
      (test (eq (lookup (seq 'a 'b 'c) 1) 'b))
      (test (let ((s0 "x")
		  (s1 "y")
		  ((val canon (lookup (set s0 s1) "x"))))
	      (and val (eq canon s0))))
      (test (let ((s0 "x")
		  (s1 "y")
		  ((val canon (lookup (bag s0 s1) "x"))))
	      (and val (eq canon s0))))
      (test (let ((rank val? (rank (set 1 2 3 4) 2)))
	      (and (= rank 1) val?)))
      (test (let ((rank val? (rank (set 1 2 3 4) 3.5)))
	      (and (= rank 2) (not val?))))
      (test (let ((rank val? (rank (set 1 2 3 4) 5)))
	      (and (= rank 3) (not val?))))
      (test (let ((rank val? (rank (set) 5)))
	      (and (= rank -1) (not val?))))
      (test (let ((rank val? (rank (bag 1 2 3 4) 2)))
	      (and (= rank 1) val?)))
      (test (let ((rank val? (rank (bag 1 2 3 4) 3.5)))
	      (and (= rank 2) (not val?))))
      (test (let ((rank val? (rank (bag 1 2 3 4) 5)))
	      (and (= rank 3) (not val?))))
      (test (let ((rank val? (rank (bag) 5)))
	      (and (= rank -1) (not val?))))
      (test (let ((rank val? (rank (map (1 12) (2 27) (3 39) (4 46)) 2)))
	      (and (= rank 1) val?)))
      (test (let ((rank val? (rank (map (1 12) (2 27) (3 39) (4 46)) 3.5)))
	      (and (= rank 2) (not val?))))
      (test (let ((rank val? (rank (map (1 12) (2 27) (3 39) (4 46)) 5)))
	      (and (= rank 3) (not val?))))
      (test (let ((rank val? (rank (map) 5)))
	      (and (= rank -1) (not val?))))
      (test (eql (at-rank (set 4 8 2 3 6) 3) 6))
      (test (eql (at-rank (bag 4 8 2 4 3 2 6) 3) 6))
      (test (let ((key val (at-rank (map ('a 3) ('d 7) ('c 3) ('g 1) ('e 6)) 3)))
	      (and (eq key 'e) (eql val 6))))
      ;; Good start, but &&& more to do here.
      (test (equal (reduce (lambda (x y) (cons y x)) (seq 3 7 9 13)
			   :initial-value nil :from-end t :start 1 :end 3)
		   '(7 9))))))

(defun Test-Reader ()
  (macrolet ((test (str form)
	       (let ((r (with-standard-io-syntax
			  (let ((*readtable* *fset-readtable*)
				(*package* (find-package :fset)))
			    (read-from-string str)))))
		 `(progn
		    ; (format t "Reader test: ~s, ~s, ~s~%" ,str ',r ',form)
		    (unless (equal? ,r ,form)
		      (error "Reader test failed: ~S, ~S" ,str ',form))))))
    (flet ((error-test (str)
	     (with-standard-io-syntax
	       (let ((*readtable* *fset-readtable*)
		     (*package* (find-package :fset)))
		 (block nil
		   (handler-case
		       (read-from-string str)
		     (error () (return t)))
		   (error "Reading ~s did not cause an error" str))))))
		     
      (test "#[1]" (seq 1))
      (error-test "#[")
      (let ((x (seq 3 4)))
	(test "#[1 #$x]" (seq 1 3 4)))
      (test "#{1 2}" (set 1 2))
      (error-test "#{")
      (let ((x (set 3 5)))
	(test "#{1 2 #$x}" (set 1 2 3 5)))
      (test "#{}" (empty-set))
      (test "#{| (1 2) (3 4) |}" (map (1 2) (3 4)))
      (error-test "#{| |x")
      (error-test "#{|}")
      (test "#{%%}" (bag))
      (error-test "#{%%x}")
      (error-test "#{%%")
      (test "#{% 1 1 2 3 4 4 5 %}" (bag 1 1 2 3 4 4 5))
      (test "#{% #%(1 4) 3 %}" (bag 1 1 1 1 3))
      (error-test "#{% #%x %}")
      (error-test "#{% #%(1) %}")
      (error-test "#{% #%(1 . 2) %}")
      (error-test "#{% #%(1 2 . 3) %}")
      (error-test "#{% #%(1 2 3) %}")
      (let ((x (map (1 2))))
	(test "#{| #$x (3 4) |}" (map (1 2) (3 4))))
      (test "#~< >" (tuple))
      (error-test "#~[")
      (error-test "#~<")
      (test "#~< (+K0+ 1) >" (tuple (+K0+ 1)))
      (let ((x (tuple (+K0+ 1))))
	(test "#~< #$x (+K1+ 3) >" (tuple (+K0+ 1) (+K1+ 3))))
      )))

(defun Test-Rereader ()
  (with-standard-io-syntax
    (let ((*readtable* *fset-rereading-readtable*)
	  (*package* (find-package :fset))
	  (*print-readably* t))
      (loop for x in (list (seq) (set) (seq 1 2 3) (set 'a 'b 2)
			   (map) (tuple) (bag)
			   (map (1 2) (3 4))
			   (with-default (map (1 2) (3 4)) 'x)
			   (tuple (+K0+ 1))
			   (bag 1)
			   (bag 1 2)
			   (bag 1 1)
			   )
	 do (let ((str (prin1-to-string x)))
	      ;; (let ((*print-readably* nil)) (format t "str = ~s~%"str))
	      (let ((y (read-from-string str)))
		(unless (equal? x y)
		  (error "Rereader failure: ~s, ~s, ~s"
			 x str y)))))
      ;; Error cases
      (loop for x in '("#[" "#{|}" "#{| |x" "#{%%" "#{%%x" "#{" "#{%" "#~<" "#~["
		       "#~< 1 >" "#~< (1) >" "#~< ( 1 . 2 ) >" "#~< (1 2 . 3) >"
		       "#~< (1 2 3) >" "#~< #(1 2) >")
	 do (block nil
	      (handler-case (read-from-string x)
		(error () (return nil)))
	      (error "Rereading ~s did not cause an error" x))))))

(defun Test-Compare-Lexicographically ()
  (macrolet ((test (form)
	       `(unless ,form
		  (error "Test failed: ~S" ',form))))
    (flet ((equal? (a b)
	     (and (eql (compare-lexicographically a b) :equal)
		  (eql (compare-lexicographically b a) :equal)))
	   (less-than? (a b)
	     (and (eql (compare-lexicographically a b) :less)
		  (eql (compare-lexicographically b a) :greater)))
	   (unequal? (a b)
	     (and (eql (compare-lexicographically a b) :unequal)
		  (eql (compare-lexicographically b a) :unequal))))
      (test (equal? "a" "a"))
      (test (equal? "a" (make-array '(1) :element-type 'base-char
				    :initial-element #\a)))
      (test (less-than? "a" "b"))
      (test (less-than? "a" "ab"))
      (test (less-than? "ab" "b"))

      (test (equal? "a" (make-array '(1) :element-type 'character
				 :adjustable t :initial-element #\a)))
      (test (less-than? "a" (make-array '(1) :element-type 'character
					:adjustable t :initial-element #\b)))
      (test (less-than? "a" (make-array '(2) :element-type 'character
					:adjustable t
					:initial-contents '(#\a #\b))))
      (test (less-than? "ab" (make-array '(1) :element-type 'character
					 :adjustable t :initial-element #\b)))

      (test (equal? nil nil))
      (test (equal? (list 1) (list 1)))
      (test (less-than? nil '(1)))
      (test (less-than? '(1) '(1 2)))
      (test (less-than? '(1 2) '(3)))
      (test (less-than? '(1 2) '(1 3)))

      (test (equal? #() #()))
      (test (equal? (vector) (vector)))
      (test (equal? (vector 1) (vector 1)))
      (test (less-than? #() #(1)))
      (test (less-than? #(1) #(2)))
      (test (less-than? #(1) #(1 2)))
      (test (less-than? #(1 2) #(3)))
      (test (less-than? #(1 2) #(1 3)))

      (test (less-than? (seq) (seq 1)))
      (test (less-than? (seq 1) (seq 2)))
      (test (less-than? (seq 1) (seq 1 2)))
      (test (less-than? (seq 1 2) (seq 3)))
      (test (less-than? (seq 1 2) (seq 1 3)))

      (test (equal? #() (make-array '(0) :adjustable t)))
      (test (equal? #(1) (make-array '(1) :adjustable t
				     :initial-contents '(1))))
      (test (equal? #(#\a) "a"))
      (test (equal? "a" #(#\a)))
      (test (less-than? "a" #(#\a #\b)))
      (test (less-than? #(#\a) "ab"))
      (test (less-than? "ab" (make-array '(1) :initial-contents '(#\c))))
      (test (less-than? "ab" (make-array '(2) :initial-contents '(#\a #\c))))

      (test (unequal? (list (make-instance 'my-unhandled-obj))
		      (list (make-instance 'my-unhandled-obj))))
      (test (unequal? (vector (make-instance 'my-unhandled-obj))
		      (vector (make-instance 'my-unhandled-obj))))
      (test (unequal?
	     (make-array '(1)
			 :initial-element (make-instance 'my-unhandled-obj)
			 :adjustable t)
	     (vector (make-instance 'my-unhandled-obj))))
      )))

(defun Test-Equivalent-Sets (&optional (size 20) (reps 1000))
  (macrolet ((test (form)
	       `(unless ,form
		  (error "Test in Test-Equivalent-Sets failed: ~S" ',form))))
    (dotimes (i reps)
      (let* ((size (+ 5 (random size)))
	     (objs (loop for i from 1 to size collect (make-instance 'my-unhandled-obj :value i)))
	     (all (convert 'set objs)))
	(flet ((%rset ()
		 (let ((max (random (1+ size))))
		   (convert 'set (loop for x in objs repeat max
				    when (= (random 2) 0) collect x)))))
	  (let* ((o (elt objs (random size)))
		 (s0 (set o))
		 (s1 (%rset))
		 (s2 (%rset))
		 (l1 (convert 'list s1))
		 (l2 (convert 'list s2))
		 (lu (union l1 l2))
		 (li (intersection l1 l2))
		 (su (union s1 s2))
		 (si (intersection s1 s2))
		 (sd1 (set-difference s1 s2))
		 (sd2 (set-difference s2 s1)))
	    (test (member? o s0))
	    (test (member? o (union s0 s1)))
	    (test (member? o (union s0 s2)))
	    (test (equal? (union s0 s1) (with s1 o)))
	    (test (equal? (union s2 s0) (with s2 o)))
	    (test (subset? s1 (with s1 o)))
	    (test (subset? s2 (with s2 o)))
	    (test (= (size (union s0 s1))
		     (if (member? o s1)
			 (size s1)
			 (1+ (size s1)))))
	    (test (= (size li) (size si)))
	    (test (= (size lu) (size su)))
	    (test (equal? (convert 'set li) si))
	    (test (equal? (convert 'set lu) su))
	    (test (subset? s1 su))
	    (test (subset? s2 su))
	    (test (subset? si s1))
	    (test (subset? si s2))
	    (test (subset? si all))
	    (test (subset? su all))
	    (test (subset? sd1 s1))
	    (test (subset? sd2 s2))
	    (test (empty? (intersection sd1 s2)))
	    (test (disjoint? sd1 s2))
	    (test (empty? (intersection sd2 s1)))
	    (test (disjoint? sd2 s1))
	    (test (disjoint? sd1 sd2))
	    (test (equal? (union sd1 sd2)
			  (set-difference su si)))))))))

(defun Test-Modify-Macros ()
  ;; Use EVAL so defmacro bodies can be covered
  (macrolet ((test (form)
	       `(unless ,form
		  (error "Test failed: ~S" ',form))))
    (test (eval '(let ((s (set 1)))
		  (and
		   (equal? (includef s 2) (set 1 2))
		   (equal? s (set 1 2))))))
    (test (eval '(let ((s (set 1 2 3)))
		  (and
		   (equal? (excludef s 2) (set 1 3))
		   (equal? s (set 1 3))))))
    (test (eval '(let ((s1 (set 1 2 3))
		       (s2 (set 3 4 5)))
		  (intersectf s1 s2)
		  (equal? s1 (set 3)))))
    (test (eval '(let ((s (set 1 2 3)))
		  (imagef s #'(lambda (x) (+ x 6)))
		  (equal? s (set 7 8 9)))))
    (test (eval '(let ((s '(1 2 3)))
		  (and (eq (appendf s '(4 5 6)) s)
		   (equal s '(1 2 3 4 5 6))))))
    (test (eval '(let ((s (seq 1 2 3)))
		  (and (eq (appendf s (seq 4 5 6)) s)
		   (equal? s (seq 1 2 3 4 5 6))))))
    (test (eval '(let ((s '(1 2 3)))
		  (and (eq (prependf s '(4 5 6)) s)
		   (equal s '(4 5 6 1 2 3))))))
    (test (eval '(let ((s (seq 1 2 3)))
		  (and (eq (prependf s (seq 4 5 6)) s)
		   (equal? s (seq 4 5 6 1 2 3))))))
    (test (eval '(let ((s (seq 1 2 3)))
		  (and (eql (pop-first s) 1)
		   (equal? s (seq 2 3))))))
    (test (eval '(let ((s (seq 1 2 3)))
		  (and (eql (pop-last s) 3)
		   (equal? s (seq 1 2))))))
    (test (eval '(let ((m (map (1 2) (3 6))))
		  (and (eql (composef m (lambda (x) (when x (1+ x)))) m)
		   (equal? m (map (1 3) (3 7)))))))
    (test (eval '(let ((s (seq 1 2)))
		  (and (eql (push-first s :a) s)
		   (equal? (seq :a 1 2) s)))))
    ))

(defun Test-Functional-Deep-Update ()
  (macrolet ((test (form)
	       `(unless ,form
		  (error "Test failed: ~S" ',form))))
    (let ((s (seq 1 (seq 2 3) 4)))
      (test (and (equal? (update (constantly :a) s 1 1) (seq 1 (seq 2 :a) 4))
		 (equal? s (seq 1 (seq 2 3) 4))))
      (test (and (equal? (update #'(lambda (x) (declare (ignore x)) :a)
				 s 1 1) (seq 1 (seq 2 :a) 4))
		 (equal? s (seq 1 (seq 2 3) 4))))
      ;; This test is failing; see https://github.com/slburson/fset/issues/26
      ;; (test (equal? (update '- s 1 1) (seq 1 (seq 2 -3) 4)))
      )
    ))

(defun Test-Set-Operations (i)
  (declare (optimize (speed 0) (safety 3) (debug 3)))
  (let ((fs0 (empty-set))
	(s0 nil)
	(fs1 (empty-set))
	(s1 nil))
    (dotimes (j 100)
      (let* ((r (Make-My-Integer (random 200)))
	     (tmp (with fs0 r)))
	(pushnew r s0 :test #'equal?)
	(unless (verify tmp)
	  (error "Set verify failed on iteration ~D, adding ~A" i r))
	(unless (= (size tmp) (length s0))
	  (error "Set size or with failed on iteration ~D, adding ~A: ~D, ~D" i r
		 (size tmp) (length s0)))
	(unless (and (subset? fs0 tmp)
		     (or (contains? fs0 r) (not (subset? tmp fs0))))
	  (error "Set subset? failed on iteration ~D" i))
	(setq fs0 tmp)))
    (dotimes (j 100)
      (let* ((r (Make-My-Integer (random 200)))
	     (tmp (with fs1 r)))
	(pushnew r s1 :test #'equal?)
	(unless (verify tmp)
	  (error "Set verify failed on iteration ~D, adding ~A" i r))
	(unless (= (size tmp) (length s1))
	  (error "Set size or with failed on iteration ~D, adding ~A: ~D, ~D" i r
		 (size tmp) (length s1)))
	(unless (and (subset? fs1 tmp)
		     (or (contains? fs1 r) (not (subset? tmp fs1))))
	  (error "Set subset? failed on iteration ~D" i))
	(setq fs1 tmp)
	(unless (eqv (disjoint? fs0 fs1)
		     (disjoint? fs1 fs0)
		     (not (do-set (x fs1 nil)
			    (when (contains? fs0 x)
			      (return t)))))
	  (error "Set disjoint? failed on iteration ~D" i))))
    (dotimes (j 20)
      (let ((r (Make-My-Integer (random 200))))
	(unless (eqv (contains? fs0 r) (member r s0 :test #'equal?))
	  (error "Set contains? failed (fs0) on iteration ~D, ~A" i r))
	(setq s0 (remove r s0 :test #'equal?))
	(let ((tmp (less fs0 r)))
	  (unless (verify tmp)
	    (error "Set verify failed on iteration ~D, removing ~A" i r))
	  (unless (= (size tmp) (length s0))
	    (error "Set size or less failed (fs0) on iteration ~D, removing ~A" i r))
	  (setq fs0 tmp))))
    (dotimes (j 20)
      (let ((r (Make-My-Integer (random 200))))
	(unless (eqv (contains? fs1 r) (member r s1 :test #'equal?))
	  (error "Set contains? failed (fs1) on iteration ~D" i))
	(setq s1 (remove r s1 :test #'equal?))
	(let ((tmp (less fs1 r)))
	  (unless (verify tmp)
	    (error "Set verify failed on iteration ~D, removing ~A" i r))
	  (unless (= (size tmp) (length s1))
	    (error "Set size or less failed (fs1) on iteration ~D, removing ~A" i r))
	  (setq fs1 tmp))))
    (when (= i 0)
      (let ((tmp (with fs0 nil)))
	(unless (verify tmp)
	  (error "Set verify failed adding NIL"))
	(setq tmp (less tmp nil))
	(unless (verify tmp)
	  (error "Set verify failed removing NIL"))))
    (unless (contains? fs0 (arb fs0))
      (error "Set arb/contains? failed (fs0) on iteration ~D" i))
    (unless (contains? fs1 (arb fs1))
      (error "Set arb/contains? failed (fs1) on iteration ~D" i))
    (unless (member (compare (least fs0)
			     (reduce (lambda (mi1 mi2)
				       (if (< (My-Integer-Value mi1)
					      (My-Integer-Value mi2))
					   mi1 mi2))
				     s0))
		    '(:equal :unequal))
      (error "Set least failed on iteration ~D" i))
    (unless (member (compare (greatest fs0)
			     (reduce (lambda (mi1 mi2)
				       (if (> (My-Integer-Value mi1)
					      (My-Integer-Value mi2))
					   mi1 mi2))
				     s0))
		    '(:equal :unequal))
      (error "Set greatest failed on iteration ~D" i))
    (unless (equal? fs0 (convert 'set s0))
      (error "Set equal? failed (fs0) on iteration ~D" i))
    (unless (equal? fs1 (convert 'set s1))
      (error "Set equal? failed (fs1) on iteration ~D" i))
    (unless (equal? (convert 'list fs0) (gmap :list nil (:set fs0)))
      (error "Set iterator failed (fs0) on iteration ~D" i))
    (unless (equal? fs1 (gmap :set nil (:list (convert 'list fs1))))
      (error "Set iterator or accumulator failed (fs1) on iteration ~D" i))
    (let ((fsu (union fs0 fs1))
	  (su (cl:union s0 s1 :test #'equal?)))
      (unless (and (verify fsu) (equal? fsu (convert 'set su)))
	(error "Set union failed on iteration ~D " i)))
    (let ((fsi (intersection fs0 fs1))
	  (si (cl:intersection s0 s1 :test #'equal?)))
      (unless (and (verify fsi) (equal? fsi (convert 'set si)))
	(error "Set intersection failed on iteration ~D " i)))
    (let ((fsd (set-difference fs0 fs1))
	  (sd (cl:set-difference s0 s1 :test #'equal?)))
      (unless (and (verify fsd) (equal? fsd (convert 'set sd)))
	(error "Set-difference failed on iteration ~D " i)))
    (let ((fsd1 fsd2 (set-difference-2 fs0 fs1))
	  (sd1 (cl:set-difference s0 s1 :test #'equal?))
	  (sd2 (cl:set-difference s1 s0 :test #'equal?)))
      (unless (and (verify fsd1) (equal? fsd1 (convert 'set sd1)))
	(error "Set-difference-2 failed (fsd1) on iteration ~D " i))
      (unless (and (verify fsd2) (equal? fsd2 (convert 'set sd2)))
	(error "Set-difference-2 failed (fsd2) on iteration ~D " i)))
    (let ((fs0a (less fs0 (Pick fs0)))
	  (fs0b (less fs0 (Pick fs0))))
      (unless (eq (compare fs0a fs0b)
		  (Set-Compare (convert 'list fs0a) (convert 'list fs0b)))
	(error "Set compare failed (fs0) on iteration ~D: ~A, ~A" i fs0a fs0b)))
    (let ((fs1a (less fs1 (Pick fs1)))
	  (fs1b (less fs1 (Pick fs1))))
      (unless (eq (compare fs1a fs1b)
		  (Set-Compare (convert 'list fs1a) (convert 'list fs1b)))
	(error "Set compare failed (fs1) on iteration ~D" i)))
    (unless (gmap :and (lambda (x i)
			 (and (eql (rank fs0 x) i)
			      (equal? x (at-rank fs0 i))))
		  (:set fs0)
		  (:index 0 (size fs0)))
      (error "Set rank, at-rank, or iterator failed"))
    (let ((r (do ((r (random 200) (random 200)))
		 ((not (contains? fs0 r)) r))))
      (unless (= (rank fs0 r)
		 (if (greater-than? r (greatest fs0))
		     (1- (size fs0))
		   (do ((r2 r (1+ r2)))
		       ((contains? fs0 r2)
			(1- (rank fs0 r2))))))
	(error "Set rank of non-member failed")))
    fs0))


(defun Test-Map-Operations (i a-set)
  (declare (optimize (speed 0) (safety 3) (debug 3)))
  (let ((fm0 (empty-map))
	(m0 nil)
	(fm1 (empty-map))
	(m1 nil))
    (dotimes (j 100)
      (let* ((r (Make-My-Integer (random 100)))
	     (v (random 3))
	     (tmp (with fm0 r v)))
	(setq m0 (Alist-Assign m0 r v))
	(unless (verify tmp)
	  (error "Map verify failed on iteration ~D, adding ~A -> ~A; ~D, ~D"
		 i r v m0 tmp))
	(unless (= (size tmp) (length m0))
	  (error "Map size or with failed on iteration ~D, adding ~A -> ~A; ~D, ~D"
		 i r v m0 tmp))
	(setq fm0 tmp)))
    (dotimes (j 100)
      (let* ((r (Make-My-Integer (random 100)))
	     (v (random 3))
	     (tmp (with fm1 r v)))
	(setq m1 (Alist-Assign m1 r v))
	(unless (verify tmp)
	  (error "Map verify failed on iteration ~D, adding ~A -> ~A; ~D, ~D"
		 i r v m1 tmp))
	(unless (= (size tmp) (length m1))
	  (error "Map size or with failed on iteration ~D, adding ~A -> ~A; ~D, ~D"
		 i r v m1 tmp))
	(setq fm1 tmp)))
    (dotimes (j 20)
      (let ((r (Make-My-Integer (random 100))))
	(unless (eql (lookup fm0 r) (cdr (assoc r m0 :test #'equal?)))
	  (error "Map lookup failed (fm0) on iteration ~D: ~A, ~A, ~A" i fm0 m0 r))
	(let ((tmp (less fm0 r)))
	  (setq m0 (Alist-Remove m0 r))
	  (unless (verify tmp)
	    (error "Map verify failed (fm0) on iteration ~D, removing ~A" i r))
	  (unless (= (size tmp) (length m0))
	    (error "Map size or less failed (fm0) on iteration ~D, removing ~A: ~A, ~A"
		   i r tmp m0))
	  (setq fm0 tmp))))
    (dotimes (j 20)
      (let ((r (Make-My-Integer (random 100))))
	(unless (eql (lookup fm1 r) (cdr (assoc r m1 :test #'equal?)))
	  (error "Map lookup failed (fm1) on iteration ~D: ~A, ~A, ~A" i fm1 m1 r))
	(let ((tmp (less fm1 r)))
	  (setq m1 (Alist-Remove m1 r))
	  (unless (verify tmp)
	    (error "Map verify failed (fm1) on iteration ~D, removing ~A" i r))
	  (unless (= (size tmp) (length m1))
	    (error "Map size or less failed (fm1) on iteration ~D, removing ~A" i r))
	  (setq fm1 tmp))))
    (unless (domain-contains? fm0 (arb fm0))
      (error "Map arb/contains? failed (fm0) on iteration ~D" i))
    (unless (domain-contains? fm1 (arb fm1))
      (error "Map arb/contains? failed (fm1) on iteration ~D" i))
    (unless (member (compare (least fm0)
			     (reduce (lambda (mi1 mi2)
				       (if (< (My-Integer-Value mi1)
					      (My-Integer-Value mi2))
					   mi1 mi2))
				     (mapcar #'car m0)))
		    '(:equal :unequal))
      (error "Map least failed on iteration ~D" i))
    (unless (member (compare (greatest fm0)
			     (reduce (lambda (mi1 mi2)
				       (if (> (My-Integer-Value mi1)
					      (My-Integer-Value mi2))
					   mi1 mi2))
				     (mapcar #'car m0)))
		    '(:equal :unequal))
      (error "Map greatest failed on iteration ~D" i))
    (unless (equal? fm0 (convert 'map m0))
      (error "Map equal? failed (fm0) on iteration ~D" i))
    (unless (equal? fm1 (convert 'map m1))
      (error "Map equal? failed (fm1) on iteration ~D" i))
    (unless (eq (Map-Compare (convert 'list fm0) (gmap :list #'cons (:map fm0)))
		':equal)
      (error "Map iterator failed (fm0) on iteration ~D" i))
    (unless (equal? fm1 (gmap :map nil (:alist (convert 'list fm1))))
      (error "Map iterator/accumulator failed (fm1) on iteration ~D" i))
    (unless (eq (Map-Compare (convert 'list fm0) m0) ':equal)
      (error "Map equal? failed (fm1) on iteration ~D" i))
    (unless (eq (Map-Compare (convert 'list fm1) m1) ':equal)
      (error "Map equal? failed (fm1) on iteration ~D" i))
    (let ((fm0-dom (domain fm0))
	  (fm1-dom (domain fm1)))
      (let ((fm0a (with (less fm0 (Pick fm0-dom)) (Pick fm0-dom) (random 3)))
	    (fm0b (with (less fm0 (Pick fm0-dom)) (Pick fm0-dom) (random 3))))
	(unless (eq (compare fm0a fm0b)
		    (Map-Compare (convert 'list fm0a) (convert 'list fm0b)))
	  (error "Map compare failed (fm0) on iteration ~D" i)))
      (let ((fm1a (with (less fm1 (Pick fm1-dom)) (Pick fm1-dom) (random 3)))
	    (fm1b (with (less fm1 (Pick fm1-dom)) (Pick fm1-dom) (random 3))))
	(unless (eq (compare fm1a fm1b)
		    (Map-Compare (convert 'list fm1a) (convert 'list fm1b)))
	  (error "Map compare failed (fm1) on iteration ~D" i))))
    (let ((fmu (map-union fm0 fm1))
	  (mu m0))
      (dolist (pr m1)
	(setq mu (Alist-Assign mu (car pr) (cdr pr))))
      (unless (and (verify fmu)
		   (equal? fmu (convert 'map mu)))
	(error "Map union failed on iteration ~D: ~A, ~A, ~A, ~A" i mu fmu fm0 fm1))
      (let ((fmd1 fmd2 (map-difference-2 fmu fm1)))
	(unless (and (equal? fmu (map-union (restrict fm1 (domain fmu)) fmd1))
		     (equal? fm1 (map-union (restrict fmu (domain fm1)) fmd2)))
	  (error "Map difference failed on iteration ~D" i))))
    (let ((fmi (map-intersection fm0 fm1))
	  (mi nil))
      (dolist (pr m1)
	(when (assoc (car pr) m0 :test #'equal?)
	  (setq mi (Alist-Assign mi (car pr) (cdr pr)))))
      (unless (and (verify fmi)
		   (equal? fmi (convert 'map mi)))
	(error "Map intersection failed on iteration ~D: ~A, ~A, ~A, ~A"
	       i mi fmi fm0 fm1)))
    (let ((fmr (restrict fm0 a-set))
	  (mr (remove-if-not #'(lambda (pr) (contains? a-set (car pr))) m0)))
      (unless (and (verify fmr)
		   (equal? fmr (convert 'map mr)))
	(error "Map restrict failed on iteration ~D: ~A, ~A" i fmr mr)))
    (let ((fmr (restrict-not fm0 a-set))
	  (mr (remove-if #'(lambda (pr) (contains? a-set (car pr))) m0)))
      (unless (and (verify fmr)
		   (equal? fmr (convert 'map mr)))
	(error "Map restrict-not failed on iteration ~D: ~A, ~A, ~A" i fmr mr fm0)))
    (unless (gmap :and (lambda (x y i)
			 (and (eql (rank fm0 x) i)
			      (let ((rx ry (at-rank fm0 i)))
				(and (equal? x rx)
				     (= y ry)))))
		  (:map fm0)
		  (:index 0 (size fm0)))
      (error "Map rank, at-rank, or iterator failed"))
    (let ((r (do ((r (random 200) (random 200)))
		 ((not (domain-contains? fm0 r)) r))))
      (unless (= (rank fm0 r)
		 (if (greater-than? r (greatest fm0))
		     (1- (size fm0))
		   (do ((r2 r (1+ r2)))
		       ((contains? fm0 r2)
			(1- (rank fm0 r2))))))
	(error "Map rank of non-member failed")))))


(defun Test-Bag-Operations (i)
  (declare (optimize (speed 0) (safety 3) (debug 3)))
  (let ((fb0 (empty-bag))
	(b0 nil)
	(fb1 (empty-bag))
	(b1 nil))
    (dotimes (j 100)
      (let* ((r (Make-My-Integer (random 200)))
	     (tmp (with fb0 r)))
	(setq b0 (Alist-Assign b0 r (1+ (or (cdr (assoc r b0 :test #'equal?)) 0))))
	(unless (verify tmp)
	  (error "Bag verify failed (fb0) on iteration ~D, adding ~A" i r))
	(unless (= (size tmp) (Alist-Bag-Size b0))
	  (error "Bag size or with failed (fb0) on iteration ~D, adding ~A: ~D, ~D" i r
		 (size tmp) (Alist-Bag-Size b0)))
	(unless (= (set-size tmp) (length b0))
	  (error "Bag set-size failed (fb0) on iteration ~D" i))
	(unless (and (subbag? fb0 tmp) (not (subbag? tmp fb0)))
	  (error "Bag subbag? failed (fb0) on iteration ~D" i))
	(setq fb0 tmp)))
    (dotimes (j 100)
      (let* ((r (Make-My-Integer (random 200)))
	     (tmp (with fb1 r)))
	(setq b1 (Alist-Assign b1 r (1+ (or (cdr (assoc r b1 :test #'equal?)) 0))))
	(unless (verify tmp)
	  (error "Bag verify failed (fb1) on iteration ~D, adding ~A" i r))
	(unless (= (size tmp) (Alist-Bag-Size b1))
	  (error "Bag size or with failed (fb1) on iteration ~D, adding ~A: ~D, ~D" i r
		 (size tmp) (Alist-Bag-Size b1)))
	(unless (= (set-size tmp) (length b1))
	  (error "Bag set-size failed (fb1) on iteration ~D" i))
	(unless (and (subbag? fb1 tmp) (not (subbag? tmp fb1)))
	  (error "Bag Subbag? failed (fb1) on iteration ~D" i))
	(setq fb1 tmp)))
    (dotimes (j 20)
      (let ((r (Make-My-Integer (random 200))))
	(unless (eqv (contains? fb0 r) (assoc r b0 :test #'equal?))
	  (error "Bag contains? failed (fb0) on iteration ~D, ~A" i r))
	(setq b0 (Alist-Bag-Remove b0 r))
	(let ((tmp (less fb0 r)))
	  (unless (verify tmp)
	    (error "Bag verify failed on iteration ~D, removing ~A" i r))
	  (unless (= (size tmp) (Alist-Bag-Size b0))
	    (error "Bag size or less failed (fb0) on iteration ~D, removing ~A" i r))
	  (setq fb0 tmp))))
    (dotimes (j 20)
      (let ((r (Make-My-Integer (random 200))))
	(unless (eqv (contains? fb1 r) (assoc r b1 :test #'equal?))
	  (error "Bag contains? failed (fb1) on iteration ~D" i))
	(setq b1 (Alist-Bag-Remove b1 r))
	(let ((tmp (less fb1 r)))
	  (unless (verify tmp)
	    (error "Bag verify failed on iteration ~D, removing ~A" i r))
	  (unless (= (size tmp) (Alist-Bag-Size b1))
	    (error "Bag size or less failed (fb1) on iteration ~D, removing ~A" i r))
	  (setq fb1 tmp))))
    (when (= i 0)
      (let ((tmp (with fb0 nil)))
	(unless (verify tmp)
	  (error "Bag verify failed adding NIL"))
	(setq tmp (less tmp nil))
	(unless (verify tmp)
	  (error "Bag verify failed removing NIL"))))
    (unless (contains? fb0 (arb fb0))
      (error "Bag arb/contains? failed (fb0) on iteration ~D" i))
    (unless (contains? fb1 (arb fb1))
      (error "Bag arb/contains? failed (fb1) on iteration ~D" i))
    (unless (member (compare (least fb0)
			     (reduce (lambda (mi1 mi2)
				       (if (< (My-Integer-Value mi1)
					      (My-Integer-Value mi2))
					   mi1 mi2))
				     (mapcar #'car b0)))
		    '(:equal :unequal))
      (error "Bag least failed on iteration ~D" i))
    (unless (member (compare (greatest fb0)
			     (reduce (lambda (mi1 mi2)
				       (if (> (My-Integer-Value mi1)
					      (My-Integer-Value mi2))
					   mi1 mi2))
				     (mapcar #'car b0)))
		    '(:equal :unequal))
      (error "Bag greatest failed on iteration ~D" i))
    (unless (equal? fb0 (convert 'bag b0 :from-type 'alist))
      (error "Bag equal? failed (fb0) on iteration ~D" i))
    (unless (equal? fb1 (convert 'bag b1 :from-type 'alist))
      (error "Bag equal? failed (fb1) on iteration ~D" i))
    (unless (equal? (convert 'list fb0) (gmap :list nil (:bag fb0)))
      (error "Bag iterator failed (fb0) on iteration ~D" i))
    (unless (equal? fb1 (gmap :bag nil (:list (convert 'list fb1))))
      (error "Bag iterator/accumulator failed (fb1) on iteration ~D" i))
    (unless (eq (Map-Compare (convert 'alist fb0) (gmap :list #'cons (:bag-pairs fb0)))
		':equal)
      (error "Bag pair iterator failed (fb0) on iteration ~D" i))
    (unless (equal? fb1 (gmap :bag-pairs nil (:alist (convert 'alist fb1))))
      (error "Bag pair iterator/accumulator failed (fb1) on iteration ~D" i))
    (let ((fbu (union fb0 fb1))
	  (bu (Alist-Bag-Union b0 b1)))
      (unless (and (verify fbu) (equal? fbu (convert 'bag bu :from-type 'alist)))
	(error "Bag union failed on iteration ~D " i)))
    (let ((fbi (intersection fb0 fb1))
	  (bi (Alist-Bag-Intersection b0 b1)))
      (unless (and (verify fbi) (equal? fbi (convert 'bag bi :from-type 'alist)))
	(error "Bag intersection failed on iteration ~D " i)))
    (let ((fbd (bag-difference fb0 fb1))
	  (bd (Alist-Bag-Difference b0 b1)))
      (unless (and (verify fbd) (equal? fbd (convert 'bag bd :from-type 'alist)))
	(error "Bag-difference failed on iteration ~D " i)))
    (let ((fbs (bag-sum fb0 fb1))
	  (bs (Alist-Bag-Sum b0 b1)))
      (unless (and (verify fbs) (equal? fbs (convert 'bag bs :from-type 'alist)))
	(error "Bag-sum failed on iteration ~D " i)))
    (let ((fbp (bag-product fb0 fb1))
	  (bp (Alist-Bag-Product b0 b1)))
      (unless (and (verify fbp) (equal? fbp (convert 'bag bp :from-type 'alist)))
	(error "Bag-product failed on iteration ~D " i)))
    (let ((fb0a (less fb0 (Pick fb0)))
	  (fb0b (less fb0 (Pick fb0))))
      (unless (eq (compare fb0a fb0b)
		  (Map-Compare (convert 'alist fb0a) (convert 'alist fb0b)))
	(error "Compare failed (fb0) on iteration ~D: ~A, ~A" i fb0a fb0b)))
    (let ((fb1a (less fb1 (Pick fb1)))
	  (fb1b (less fb1 (Pick fb1))))
      (unless (eq (compare fb1a fb1b)
		  (Map-Compare (convert 'alist fb1a) (convert 'alist fb1b)))
	(error "Compare failed (fb1) on iteration ~D" i)))
    (unless (gmap :and (lambda (x n i)
			 (and (eql (rank fb0 x) i)
			      (let ((rx rn (at-rank fb0 i)))
				(and (equal? x rx)
				     (= n rn)))))
		  (:bag-pairs fb0)
		  (:index 0 (size fb0)))
      (error "Bag rank, at-rank, or iterator failed"))
    (let ((r (do ((r (random 200) (random 200)))
		 ((not (contains? fb0 r)) r))))
      (unless (= (rank fb0 r)
		 (if (greater-than? r (greatest fb0))
		     (1- (set-size fb0))
		   (do ((r2 r (1+ r2)))
		       ((contains? fb0 r2)
			(1- (rank fb0 r2))))))
	(error "Bag rank of non-member failed")))
    fb0))


(defun Test-Seq-Operations (i)
  (declare (optimize (debug 3)))
  (let ((fs0 (empty-seq))
	(s0 nil)
	(fs1 (empty-seq))
	(s1 nil))
    ;; &&& There's more stuff to test here, like conversion to/from vectors, and
    ;; the special treatment of sequences of characters (particularly in implementations
    ;; with extended characters).  That code has been lightly hand-exercised, but that's
    ;; all.
    (dotimes (j 100)
      (let ((rand (random 100))
	    ((r (if (< rand 8) (Make-My-Integer rand)
		  #+FSet-Ext-Strings (make-char (+ rand 16) (random 3))
		  #-FSet-Ext-Strings (code-char rand))))
	    (pos (if (null s0) 0 (random (length s0))))
	    (which (random 6))
	    (tmp nil))
	(cond ((and (= which 0) s0)
	       (when (= pos (length s0))
		 (decf pos))
	       (unless (equal? (lookup fs0 pos) (nth pos s0))
		 (error "Seq indexing failed (fs0) on iteration ~D" i))
	       (setq tmp (with fs0 pos r))
	       (List-Set-Elt s0 pos r)
	       (unless (equal? s0 (convert 'list tmp))
		 (error "Seq with failed (fs0) on iteration ~D" i)))
	      ((and (= which 1) s0)
	       (setq tmp (less fs0 pos))
	       (setq s0 (List-Remove s0 pos))
	       (unless (equal? s0 (convert 'list tmp))
		 (error "Seq remove failed (fs0) on iteration ~D" i)))
	      (t
	       (setq tmp (insert fs0 pos r))
	       (setq s0 (List-Insert s0 pos r))
	       (unless (equal? s0 (convert 'list tmp))
		 (error "Seq insert failed (fs0) on iteration ~D" i))))
	(unless (verify tmp)
	  (error "Seq verify (fs0) failed on iteration ~D (~A ~D ~D)"
		 i (case which (0 "update") (1 "delete") (t "insert")) pos r))
	(setq fs0 tmp)))
    (dotimes (j 100)
      (let ((r (Make-My-Integer (random 200)))
	    (pos (if (null s1) 0 (random (length s1))))
	    (which (random 5))
	    (tmp nil))
	(cond ((and (= which 0) s1)
	       (unless (equal? (lookup fs1 pos) (nth pos s1))
		 (error "Seq indexing failed (fs1) on iteration ~D" i))
	       (setq tmp (with fs1 pos r))
	       (List-Set-Elt s1 pos r))
	      ((and (= which 1) s1)
	       (setq tmp (less fs1 pos))
	       (setq s1 (List-Remove s1 pos)))
	      (t
	       (setq tmp (insert fs1 pos r))
	       (setq s1 (List-Insert s1 pos r))))
	(unless (verify tmp)
	  (error "Seq verify (fs1) failed on iteration ~D (~A ~D ~D)"
		 i (case which (0 "update") (1 "delete") (t "insert")) pos r))
	(setq fs1 tmp)))
    (Test-CL-Generic-Sequence-Ops i fs0 s0 fs1 s1)
    (unless (equal? (convert 'list fs0) s0)
      (error "Seq equality failed (fs0, A), on iteration ~D" i))
    (unless (equal? fs0 (convert 'seq s0))
      (error "Seq equality failed (fs0, B), on iteration ~D" i))
    (unless (gmap :and #'equal? (:seq fs0) (:list s0))
      (error "Seq iterator failed on iteration ~D" i))
    (unless (gmap :and #'equal? (:seq fs0) (:sequence s0))
      (error "Seq or list iterator failed on iteration ~D" i))
    (unless (gmap :and #'equal? (:seq fs0) (:sequence (coerce s0 'simple-vector)))
      (error "Seq or simple-vector iterator failed on iteration ~D" i))
    (unless (equal? (convert 'vector fs1) (coerce s1 'vector))
      (error "Seq equality failed (fs1, A), on iteration ~D" i))
    (unless (equal? fs1 (convert 'seq (coerce s1 'vector)))
      (error "Seq equality failed (fs1, B), on iteration ~D" i))
    (unless (equal? (convert 'list fs0) (gmap :list nil (:seq fs0)))
      (error "Seq iterator failed (fs0) on iteration ~D" i))
    (unless (equal? fs1 (gmap :seq nil (:list (convert 'list fs1))))
      (error "Seq iterator/accumulator failed (fs1) on iteration ~D" i))
    (let ((fsc (concat fs0 fs1))
	  (sc (cl:append s0 s1)))
      (unless (equal? (convert 'list fsc) sc)
	(error "Seq concat failed on iteration ~D" i)))
    (let* ((lo (random (size fs0)))
	   (hi (+ lo (random (- (size fs0) lo))))
	   (fss (subseq fs0 lo hi))
	   (ss (cl:subseq s0 lo hi)))
      (unless (equal? (convert 'list fss) ss)
	(error "Seq subseq failed on iteration ~D" i)))
    (let* ((delpos (random (size fs0)))
	   (fs0a (less fs0 delpos))
	   (s0a (List-Remove s0 delpos)))
      (unless (equal? (convert 'list fs0a) s0a)
	(error "Seq remove failed on iteration ~D" i))
      (let ((fs0b (less fs0 (random (size fs0)))))
	(unless (eq (compare fs0a fs0b)
		    (Seq-Compare (convert 'list fs0a) (convert 'list fs0b)))
	  (error "Seq compare failed on iteration ~D" i))))))

(defun Test-CL-Generic-Sequence-Ops (i fs0 s0 fs1 s1)
  (declare (ignore fs0 s0))		; for now
  (dotimes (j 20)
    (let ((r (Make-My-Integer (random 200)))
	  (s (random (size fs1)))
	  ((e (+ s (random (- (size fs1) s))))))
      ;; The use of `eql' checks that we find the correct instance.
      (unless (and (eql (find r s1 :start s :end e :test #'equal? :from-end t)
			(find r fs1 :start s :end e :from-end t))
		   (eql (find (My-Integer-Value r) s1
			      :start s :end e :key #'My-Integer-Value)
			(find (My-Integer-Value r) fs1
			      :start s :end e :key #'My-Integer-Value))
		   (eql (find r s1 :start s :end e :test #'less-than?)
			(find r fs1 :start s :end e :test #'less-than?))
		   (eql (find (My-Integer-Value r) s1
			      :start s :end e :key #'My-Integer-Value :test #'>)
			(find (My-Integer-Value r) fs1
			      :start s :end e :key #'My-Integer-Value :test #'>)))
	(error "Find failed on iteration ~D" i)))))


(deflex Tuple-Keys (vector +K0+ +K1+ +K2+ +K3+ +K4+ +K5+ +K6+ +K7+ +K8+ +K9+))

(defun Test-Tuple-Operations (i)
  (let ((tup (tuple))
	(m (map))
	(nkeys (length Tuple-Keys)))
    (dotimes (j 100)
      (let ((key (svref Tuple-Keys (random nkeys)))
	    (val (Make-My-Integer (random 8))))
	(setq tup (with tup key val))
	(setq m (with m key val))
	(unless (equal? m (convert 'map tup))
	  (error "Tuple `with' failed on iteration ~D" i))
	(do-map (k v m)
	  (unless (equal? v (lookup tup k))
	    (error "Tuple `lookup' failed on iteration ~D" i)))))))


;;; ================================================================================
;;; Internals

(defun Set-Compare (s1 s2)
  (let ((len1 (length s1))
	(len2 (length s2)))
    (cond ((< len1 len2) ':less)
	  ((> len1 len2) ':greater)
	  (t
	   (setq s1 (cl:sort (mapcar #'My-Integer-Value s1) #'<))
	   (setq s2 (cl:sort (mapcar #'My-Integer-Value s2) #'<))
	   (do ((ts1 s1 (cdr ts1))
		(ts2 s2 (cdr ts2)))
	       ((null ts1)
		(if (equal s1 s2)
		    ':equal
		  ':unequal))
	     (let* ((e1 (car ts1))
		    (e2 (car ts2))
		    (e12 (ash e1 -1))
		    (e22 (ash e2 -1)))
	       (cond ((< e12 e22) (return ':less))
		     ((> e12 e22) (return ':greater)))))))))

(defun Map-Compare (m1 m2)
  ;; Rather too hairy to be a good reference implementation.  Seems to be
  ;; correct, though.
  (let ((len1 (length m1))
	(len2 (length m2))
	(result ':equal))
    (cond ((< len1 len2) ':less)
	  ((> len1 len2) ':greater)
	  (t
	   (setq m1 (Map-Sort-And-Group m1))
	   (setq m2 (Map-Sort-And-Group m2))
	   (do ((tm1 m1 (cdr tm1))
		(tm2 m2 (cdr tm2)))
	       ((null tm1)
		result)
	     (let* ((g1 (car tm1))
		    (g2 (car tm2))
		    (pr1 (car g1))
		    (pr2 (car g2))
		    (k1 (car pr1))
		    (k2 (car pr2))
		    (k12 (ash k1 -1))
		    (k22 (ash k2 -1)))
	       (cond ((< k12 k22) (return ':less))
		     ((> k12 k22) (return ':greater))
		     ((and (null (cdr g1)) (null (cdr g2)))
		      (let ((comp (compare (cdr pr1) (cdr pr2))))
			(unless (eq comp ':equal)
			  (return comp)))
		      (unless (= k1 k2)
			(setq result ':unequal)))
		     ((< (length g1) (length g2)) (return ':greater))
		     ((> (length g1) (length g2)) (return ':less))
		     ((cl:notevery #'(lambda (pr1)
				       (let ((pr2 (assoc (car pr1) g2)))
					 (and pr2 (= (cdr pr1) (cdr pr2)))))
				   g1)
		      (let ((vals1 (reduce #'with (mapcar #'cdr g1)
					   :initial-value (empty-set)))
			    (vals2 (reduce #'with (mapcar #'cdr g2)
					   :initial-value (empty-set)))
			    ((comp (compare vals1 vals2))))
			(if (eq comp ':equal)
			    (setq result ':unequal)
			  (return comp)))))))))))

(defun Map-Sort-And-Group (m)
  (let ((m (cl:sort (mapcar #'(lambda (pr) (cons (My-Integer-Value (car pr)) (cdr pr)))
			    m)
		    #'< :key #'car))
	(g nil)
	(grouped nil))
    (dolist (pr m)
      (when (and g (/= (ash (car pr) -1) (ash (caar g) -1)))
	(push g grouped)
	(setq g nil))
      (push pr g))
    (push g grouped)
    (nreverse grouped)))

(defun Alist-Assign (al r v)
  (cons (cons r v) (Alist-Remove al r)))

(defun Alist-Remove (al r)
  (remove r al :key #'car :test #'equal?))

(defun Alist-Bag-Remove (al r)
  (let ((pr (assoc r al :test #'equal?)))
    (cond ((null pr) al)
	  ((= (cdr pr) 1) (remove pr al))
	  (t
	   (cons (cons (car pr) (1- (cdr pr)))
		 (remove pr al))))))

(defun Alist-Bag-Size (al)
  (gmap :sum #'cdr (:list al)))

(defun Alist-Bag-Union (al1 al2)
  (Alist-Bag-Combine al1 al2 #'max))

(defun Alist-Bag-Intersection (al1 al2)
  (Alist-Bag-Combine al1 al2 #'min))

(defun Alist-Bag-Difference (al1 al2)
  (Alist-Bag-Combine al1 al2 #'-))

(defun Alist-Bag-Sum (al1 al2)
  (Alist-Bag-Combine al1 al2 #'+))

(defun Alist-Bag-Product (al1 al2)
  (Alist-Bag-Combine al1 al2 #'*))

(defun Alist-Bag-Combine (al1 al2 fn)
  (let ((result nil)
	(al2 (copy-list al2)))
    (dolist (pr1 al1)
      (let ((pr2 (assoc (car pr1) al2 :test #'equal?))
	    ((new-count (funcall fn (cdr pr1) (if pr2 (cdr pr2) 0)))))
	(when pr2 (setq al2 (delete pr2 al2 :test #'eq)))
	(unless (<= new-count 0)
	  (push (cons (car pr1) new-count) result))))
    (dolist (pr2 al2)
      (let ((new-count (funcall fn 0 (cdr pr2))))
	(unless (<= new-count 0)
	  (push (cons (car pr2) new-count) result))))
    result))

(defun List-Set-Elt (s pos val)
  (setf (car (nthcdr pos s)) val))

(defun List-Remove (s pos)
  (cl:append (cl:subseq s 0 pos) (cl:subseq s (1+ pos))))

(defun List-Insert (s pos r)
  (cl:append (cl:subseq s 0 pos) (cons r (cl:subseq s pos))))

(defun Seq-Position (x s)
  (let ((i 0))
    (do-seq (y s :value nil)
      (when (equal? y x)
	(return i))
      (incf i))))

(defun Seq-Compare (s1 s2)
  (let ((len1 (length s1))
	(len2 (length s2)))
    (cond ((< len1 len2) ':less)
	  ((> len1 len2) ':greater)
	  (t
	   (do ((ts1 s1 (cdr ts1))
		(ts2 s2 (cdr ts2))
		(unequal? nil))
	       ((null ts1)
		(if unequal? ':unequal ':equal))
	     (case (compare (car ts1) (car ts2))
	       (:less (return ':less))
	       (:greater (return ':greater))
	       (:unequal (setq unequal? t))))))))

(defun Test-Type-Dispatch-Speed (n)
  (let ((stuff '(nil 3 #\a foo "bar" #(zot) '(quux))))
    (dolist (x stuff)
      (dolist (y stuff)
	(time (progn
		(format t "~&~S vs. ~S~%" x y)
		(dotimes (i n) (compare x y))))))))

(defun Pick (fs)
  (if (empty? fs)
      (error "`Pick' on empty set")
    (do ((r (Make-My-Integer (random 200)) (Make-My-Integer (random 200))))
	((contains? fs r)
	 r))))


(defmethod compare ((x My-Integer) (y My-Integer))
  (let ((xv (My-Integer-Value x))
	(yv (My-Integer-Value y)))
    (if (= xv yv) ':equal
      (let ((x2 (floor xv 2))
	    (y2 (floor yv 2)))
	(cond ((< x2 y2) ':less)
	      ((> x2 y2) ':greater)
	      (t ':unequal))))))

(defun Random-Test (n)
  (dotimes (i n)
    (let ((s0 (empty-set))
	  (s1 (empty-set)))
      (dotimes (i 200)
	(let* ((mi (Make-My-Integer (random 200)))
	       (tmp (with s0 mi)))
	  ;;(unless (Verify tmp)
	  ;;  (break "Verify failed adding ~A to ~S~% getting ~S"
	  ;;	   mi s0 tmp))
	  (setq s0 tmp)))
      (dotimes (i 200)
	(let* ((mi (Make-My-Integer (random 200)))
	       (tmp (with s1 mi)))
	  ;;(unless (Verify tmp)
	  ;;  (break "Verify failed adding ~A to ~S~% getting ~S"
	  ;;	   mi s1 tmp))
	  (setq s1 tmp)))
      (dotimes (i 20)
	(let* ((mi (Make-My-Integer (random 200)))
	       (tmp (less s0 mi)))
	  ;;(unless (Verify tmp)
	  ;;  (break "Verify failed removing ~A from ~S~% getting ~S"
	  ;;	   mi s0 tmp))
	  (setq s0 tmp)))
      (dotimes (i 20)
	(let* ((mi (Make-My-Integer (random 200)))
	       (tmp (less s1 mi)))
	  ;;(unless (Verify tmp)
	  ;;  (break "Verify failed removing ~A from ~S~% getting ~S"
	  ;;	   mi s1 tmp))
	  (setq s1 tmp)))
      (union s0 s1)
      (intersection s0 s1)
      (set-difference s0 s1))))


;;; Internal.
(defgeneric verify (coll))

(defmethod verify ((s wb-set))
  (WB-Set-Tree-Verify (wb-set-contents s)))

(defmethod verify ((b wb-bag))
  (WB-Bag-Tree-Verify (wb-bag-contents b)))

(defmethod verify ((m wb-map))
  (WB-Map-Tree-Verify (wb-map-contents m)))

(defmethod verify ((s wb-seq))
  (WB-Seq-Tree-Verify (wb-seq-contents s)))


(defun eqv (a b &rest more)
  (and (or (eq a b) (and a b))
       (gmap :and #'eqv (:constant a) (:list more))))


(defun Time-Seq-Iter (seq n)
  (time (dotimes (i n)
	  (gmap nil nil (:seq seq)))))

(defun Time-Index (seq n)
  (time (dotimes (i n)
	  (dotimes (j (size seq))
	    (WB-Seq-Tree-Subscript (wb-seq-contents seq) i)))))

