;;; -*- 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+)


(defun run-test-suite (n-iterations &optional random-seed)
  (Test-Misc)
  (let ((*random-state* (make-seeded-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? "x" #(#\x)))
      (test (less-than? #(1) #(#\y)))
      (test (equal? #(1 2) #(1 2)))
      ;; 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 (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)))
      ;; 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 (empty? (set)))
      (test (empty? (map)))
      (test (empty? (bag)))
      (test (empty? (seq)))
      (test (nonempty? (set 1)))
      (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 3) (not val?))))
      (test (let ((rank val? (rank (set 1 2 3 4) 5)))
	      (and (= rank 4) (not val?))))
      (test (let ((rank val? (rank (set) 5)))
	      (and (= rank 0) (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 3) (not val?))))
      (test (let ((rank val? (rank (bag 1 2 3 4) 5)))
	      (and (= rank 4) (not val?))))
      (test (let ((rank val? (rank (bag) 5)))
	      (and (= rank 0) (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 3) (not val?))))
      (test (let ((rank val? (rank (map (1 12) (2 27) (3 39) (4 46)) 5)))
	      (and (= rank 4) (not val?))))
      (test (let ((rank val? (rank (map) 5)))
	      (and (= rank 0) (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-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))
		     (size fs0)
		   (do ((r2 r (1+ r2)))
		       ((contains? fs0 r2)
			(rank fs0 r2)))))
	(error "Set at-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))
		     (size fm0)
		   (do ((r2 r (1+ r2)))
		       ((contains? fm0 r2)
			(rank fm0 r2)))))
	(error "Map at-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))
		     (set-size fb0)
		   (do ((r2 r (1+ r2)))
		       ((contains? fb0 r2)
			(rank fb0 r2)))))
	(error "Bag at-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)))))