diff --git a/array.lsp b/arrays/array.lsp
similarity index 100%
rename from array.lsp
rename to arrays/array.lsp
diff --git a/ansi-aux-macros.lsp b/auxiliary/ansi-aux-macros.lsp
similarity index 100%
rename from ansi-aux-macros.lsp
rename to auxiliary/ansi-aux-macros.lsp
diff --git a/ansi-aux.lsp b/auxiliary/ansi-aux.lsp
similarity index 100%
rename from ansi-aux.lsp
rename to auxiliary/ansi-aux.lsp
diff --git a/array-aux.lsp b/auxiliary/array-aux.lsp
similarity index 100%
rename from array-aux.lsp
rename to auxiliary/array-aux.lsp
diff --git a/backquote-aux.lsp b/auxiliary/backquote-aux.lsp
similarity index 100%
rename from backquote-aux.lsp
rename to auxiliary/backquote-aux.lsp
diff --git a/bit-aux.lsp b/auxiliary/bit-aux.lsp
similarity index 100%
rename from bit-aux.lsp
rename to auxiliary/bit-aux.lsp
diff --git a/ceiling-aux.lsp b/auxiliary/ceiling-aux.lsp
similarity index 100%
rename from ceiling-aux.lsp
rename to auxiliary/ceiling-aux.lsp
diff --git a/char-aux.lsp b/auxiliary/char-aux.lsp
similarity index 100%
rename from char-aux.lsp
rename to auxiliary/char-aux.lsp
diff --git a/cl-symbols-aux.lsp b/auxiliary/cl-symbols-aux.lsp
similarity index 100%
rename from cl-symbols-aux.lsp
rename to auxiliary/cl-symbols-aux.lsp
diff --git a/cons-aux.lsp b/auxiliary/cons-aux.lsp
similarity index 100%
rename from cons-aux.lsp
rename to auxiliary/cons-aux.lsp
diff --git a/defclass-aux.lsp b/auxiliary/defclass-aux.lsp
similarity index 100%
rename from defclass-aux.lsp
rename to auxiliary/defclass-aux.lsp
diff --git a/define-condition-aux.lsp b/auxiliary/define-condition-aux.lsp
similarity index 100%
rename from define-condition-aux.lsp
rename to auxiliary/define-condition-aux.lsp
diff --git a/division-aux.lsp b/auxiliary/division-aux.lsp
similarity index 100%
rename from division-aux.lsp
rename to auxiliary/division-aux.lsp
diff --git a/exp-aux.lsp b/auxiliary/exp-aux.lsp
similarity index 100%
rename from exp-aux.lsp
rename to auxiliary/exp-aux.lsp
diff --git a/fceiling-aux.lsp b/auxiliary/fceiling-aux.lsp
similarity index 100%
rename from fceiling-aux.lsp
rename to auxiliary/fceiling-aux.lsp
diff --git a/ffloor-aux.lsp b/auxiliary/ffloor-aux.lsp
similarity index 100%
rename from ffloor-aux.lsp
rename to auxiliary/ffloor-aux.lsp
diff --git a/floor-aux.lsp b/auxiliary/floor-aux.lsp
similarity index 100%
rename from floor-aux.lsp
rename to auxiliary/floor-aux.lsp
diff --git a/fround-aux.lsp b/auxiliary/fround-aux.lsp
similarity index 100%
rename from fround-aux.lsp
rename to auxiliary/fround-aux.lsp
diff --git a/ftruncate-aux.lsp b/auxiliary/ftruncate-aux.lsp
similarity index 100%
rename from ftruncate-aux.lsp
rename to auxiliary/ftruncate-aux.lsp
diff --git a/gcd-aux.lsp b/auxiliary/gcd-aux.lsp
similarity index 100%
rename from gcd-aux.lsp
rename to auxiliary/gcd-aux.lsp
diff --git a/hash-table-aux.lsp b/auxiliary/hash-table-aux.lsp
similarity index 100%
rename from hash-table-aux.lsp
rename to auxiliary/hash-table-aux.lsp
diff --git a/numbers-aux.lsp b/auxiliary/numbers-aux.lsp
similarity index 100%
rename from numbers-aux.lsp
rename to auxiliary/numbers-aux.lsp
diff --git a/package-aux.lsp b/auxiliary/package-aux.lsp
similarity index 100%
rename from package-aux.lsp
rename to auxiliary/package-aux.lsp
diff --git a/pathnames-aux.lsp b/auxiliary/pathnames-aux.lsp
similarity index 100%
rename from pathnames-aux.lsp
rename to auxiliary/pathnames-aux.lsp
diff --git a/printer-aux.lsp b/auxiliary/printer-aux.lsp
similarity index 100%
rename from printer-aux.lsp
rename to auxiliary/printer-aux.lsp
diff --git a/random-aux.lsp b/auxiliary/random-aux.lsp
similarity index 100%
rename from random-aux.lsp
rename to auxiliary/random-aux.lsp
diff --git a/random-class-aux.lsp b/auxiliary/random-class-aux.lsp
similarity index 100%
rename from random-class-aux.lsp
rename to auxiliary/random-class-aux.lsp
diff --git a/reader-aux.lsp b/auxiliary/reader-aux.lsp
similarity index 100%
rename from reader-aux.lsp
rename to auxiliary/reader-aux.lsp
diff --git a/remove-aux.lsp b/auxiliary/remove-aux.lsp
similarity index 100%
rename from remove-aux.lsp
rename to auxiliary/remove-aux.lsp
diff --git a/remove-duplicates-aux.lsp b/auxiliary/remove-duplicates-aux.lsp
similarity index 100%
rename from remove-duplicates-aux.lsp
rename to auxiliary/remove-duplicates-aux.lsp
diff --git a/round-aux.lsp b/auxiliary/round-aux.lsp
similarity index 100%
rename from round-aux.lsp
rename to auxiliary/round-aux.lsp
diff --git a/search-aux.lsp b/auxiliary/search-aux.lsp
similarity index 100%
rename from search-aux.lsp
rename to auxiliary/search-aux.lsp
diff --git a/sort-aux.lsp b/auxiliary/sort-aux.lsp
similarity index 100%
rename from sort-aux.lsp
rename to auxiliary/sort-aux.lsp
diff --git a/string-aux.lsp b/auxiliary/string-aux.lsp
similarity index 100%
rename from string-aux.lsp
rename to auxiliary/string-aux.lsp
diff --git a/subseq-aux.lsp b/auxiliary/subseq-aux.lsp
similarity index 100%
rename from subseq-aux.lsp
rename to auxiliary/subseq-aux.lsp
diff --git a/times-aux.lsp b/auxiliary/times-aux.lsp
similarity index 100%
rename from times-aux.lsp
rename to auxiliary/times-aux.lsp
diff --git a/truncate-aux.lsp b/auxiliary/truncate-aux.lsp
similarity index 100%
rename from truncate-aux.lsp
rename to auxiliary/truncate-aux.lsp
diff --git a/types-aux.lsp b/auxiliary/types-aux.lsp
similarity index 100%
rename from types-aux.lsp
rename to auxiliary/types-aux.lsp
diff --git a/make-random-element-of.lsp b/make-random-element-of.lsp
deleted file mode 100644
index dcbea8a92ca70f2668e6fd51c6c8b25ebf1cdb05..0000000000000000000000000000000000000000
--- a/make-random-element-of.lsp
+++ /dev/null
@@ -1,274 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Tue Dec 28 20:28:03 2004
-;;;; Contains: Code to make random elements of types
-
-(in-package :cl-test)
-
-(defgeneric make-random-element-of (type)
-  (:documentation
-   "Create a random element of TYPE, or throw an error if it can't figure out how to do it."))
-
-(defgeneric make-random-element-of-compound-type (type args &key &allow-other-keys)
-  (:documentation
-   "Create a random element of (TYPE . ARGS), or throw an error if it can't figure out how to do it."))
-
-(defmethod make-random-element-of ((type cons))
-  (make-random-element-of-compound-type (car type) (cdr type)))
-
-(defmethod make-random-element-of ((type (eql bit))) (random 2))
-
-(defmethod make-random-element-of ((type (eql boolean)))
-  (random-from-seq #(nil t)))
-
-(defmethod make-random-elememt-of ((type (eql symbol)))
-  (random-from-seq #(nil t a b c :a :b :c |z| foo |foo| car)))
-
-(defmethod make-random-element-of ((type (eql unsigned-byte)))
-  (random-from-interval
-   (1+ (ash 1 (random *maximum-random-int-bits*)))))
-
-(defmethod make-random-elememt-of ((type (eql signed-byte)))
-  (random-from-interval
-   (1+ (ash 1 (random *maximum-random-int-bits*)))
-   (- (ash 1 (random *maximum-random-int-bits*)))))
-
-(defmethod make-random-element-of ((type (eql rational)))
-  (let* ((r (ash 1 (1+ (random *maximum-random-int-bits*))))
-         (n (random r))
-         (d (loop for x = (random r) unless (zerop x) do (return x))))
-    (if (coin) (/ n d) (- (/ n d)))))
-
-(defmethod make-random-element-of ((type (eql integer)))
-  (let* ((b (random *maximum-random-int-bits*))
-         (x (ash 1 b)))
-    (rcase
-     (1 (+ x (make-random-element-of 'integer)))
-     (1 (- (make-random-element-of 'integer) x))
-     (6 (random-from-interval (1+ x) (- x))))))
-
-(defmethod make-random-element-of ((type (eql short-float)))
-  (make-random-element-of (list type)))
-
-(defmethod make-random-element-of ((type (eql single-float)))
-  (make-random-element-of (list type)))
-
-(defmethod make-random-element-of ((type (eql double-float)))
-  (make-random-element-of (list type)))
-
-(defmethod make-random-element-of ((type (eql long-float)))
-  (make-random-element-of (list type)))
-
-(defmethod make-random-element-of ((type (eql float)))
-  (make-random-element-of
-   (list (random-from-seq #'(short-float single-float double-float long-float)))))
-
-(defmethod make-random-element-of ((type (eql real)))
-  (make-random-element-of (random-from-seq #(integer rational float))))
-
-(defmethod make-random-element-of ((type (eql ratio)))
-  (loop for x = (make-random-element-of 'rational)
-        unless (integerp x) return x))
-
-(defmethod make-random-element-of ((type complex))
-  (make-random-element-of '(complex real)))
-
-(defmethod make-random-element-of ((type fixnum))
-  (make-random-element-of `(integer ,most-negative-fixnum ,most-positive-fixnum)))
-
-(defmethod make-random-element-of ((type bignum))
-  (make-random-element-of `(or (integer * (,most-negative-fixnum))
-                               (integer (,most-positive-fixnum)))))
-
-(defmethod make-random-element-of ((type (eql number)))
-  (make-random-element-of (random-from-seq #(integer rational float complex))))
-
-(defmethod make-random-element-of ((type (eql character)))
-  (rcase
-   (3 (random-from-seq +standard-chars+))
-   (2 (let ((r (random 256)))
-        (or (code-char r) (make-random-element-of 'character))))
-   (1 (let ((r (random #.(ash 1 16))))
-        (or (code-char r) (make-random-element-of 'character))))
-   (1 (let ((r (random #.(ash 1 24))))
-        (or (code-char r) (make-random-element-of 'character))))))
-
-(defmethod make-random-element-of ((type 'base-char))
-  (random-from-seq +standard-chars+))
-
-(defmethod make-random-element-of ((type 'standard-char))
-  (random-from-seq +standard-chars+))
-
-(defmethod make-random-element-of ((type (eql bit-vector)))
-  (make-random-vector 'bit '*))
-
-(defmethod make-random-element-of ((type (eql simple-bit-vector)))
-  (make-random-vector 'bit '* :simple t))
-
-(defmethod make-random-element-of ((type (eql vector)))
-  (make-random-vector '* '*))
-
-(defmethod make-random-element-of ((type (eql simple-vector)))
-  (make-random-vector 't '* :simple t))
-
-(defmethod make-random-elemnt-of ((type (eql array)))
-  (make-random-array '* '*))
-
-(defmethod make-random-elemnt-of ((type (eql simple-array)))
-  (make-random-array '* '* :simple t))
-
-(defmethod make-random-elememt-of ((type (eql string)))
-  (make-random-string '*))
-
-(defmethod make-random-elememt-of ((type (eql simple-string)))
-  (make-random-string '* :simple t))
-
-(defmethod make-random-element-of ((type (eql base-string)))
-  (make-random-vector 'base-char '*))
-
-(defmethod make-random-element-of ((type (eql simple-base-string)))
-  (make-random-vector 'base-char '* :simple t))
-
-(defmethod make-random-element-of ((type (eql cons)))
-  (make-random-element-of '(cons t t)))
-
-(defmethod make-random-element-of ((type (eql null))) nil)
-
-(defmethod make-random-elememt-of ((type (eql list)))
-  (let ((len (min (random 10) (random 10))))
-    (loop repeat len collect (make-random-element-of-type t))))
-
-(defmethod make-random-element-of ((type (eql sequence)))
-  (make-random-element-of '(or list vector)))
-
-;;;;
-
-(defun make-random-vector (length &key simple (element-type '*))
-  (setq element-type (make-random-array-element-type element-type))
-  (make-random-element-of `(,(if simple 'simple-vector 'vector) ,element-type ,length)))
-
-(defun make-random-array (dimensions &key simple (element-type '*))
-  (setq element-type (make-random-array-element-type element-type))
-  (make-random-element-of `(,(if simple 'simple-array 'array) ,element-type ,length)))
-
-(defun make-random-array-element-type (elememt-type)
-  (if (eq element-type '*)
-    (rcase
-     (1 'bit)
-     (1 `(unsigned-byte (1+ (random *maximum-random-int-bits*))))
-     (1 `(signed-byte (1+ (random *maximum-random-int-bits*))))
-     (2 (random-from-seq #(character base-char standard-char)))
-     ;; Put float, complex types here also
-     (4 t))
-    element-type))
-
-;;;;
-
-(defmethod make-random-element-of-compound-type ((type-op (eql or)) (args cons))
-  (make-random-element-of (random-from-seq args)))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql and)) (args cons))
-  (loop for e = (make-random-element-of (car args))
-        repeat 100
-        when (or (null (cdr args)) (typep e (cons 'and (cdr args))))
-        return x
-        finally (error "Cannot generate a random element of ~A"
-                       (cons 'and args))))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql integer)) (args t))
-  (let ((lo (let ((lo (car args)))
-              (cond
-               ((consp lo) (1+ (car lo)))
-               ((eq lo nil) '*)
-               (t lo))))
-        (hi (let ((hi (cadr args)))
-              (cond
-               ((consp hi) (1- (car hi)))
-               ((eq hi nil) '*)
-               (t hi)))))
-    (if (eq lo '*)
-        (if (eq hi '*)
-            (let ((x (ash 1 (random *maximum-random-int-bits*))))
-              (random-from-interval x (- x)))
-          (random-from-interval (1+ hi)
-                                (- hi (random (ash 1 *maximum-random-int-bits*)))))
-
-      (if (eq hi '*)
-          (random-from-interval (+ lo (random (ash 1 *maximum-random-int-bits*)) 1)
-                                lo)
-        ;; May generalize the next case to increase odds
-        ;; of certain integers (near 0, near endpoints, near
-        ;; powers of 2...)
-        (random-from-interval (1+ hi) lo)))))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql short-float)) (args t))
-  (make-random-element-of-float-type type args))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql single-float)) (args t))
-  (make-random-element-of-float-type type args))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql double-float)) (args t))
-  (make-random-element-of-float-type type args))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql long-float)) (args t))
-  (make-random-element-of-float-type type args))
-
-(defun make-random-element-of-float-type (type-op args)
-  (let ((lo (car args))
-        (hi (cadr args))
-        lo= hi=)
-    (cond
-     ((consp lo) nil)
-     ((member lo '(* nil))
-      (setq lo (most-negative-float type-op))
-      (setq lo= t))
-     (t
-      (assert (typep lo type-op))
-      (setq lo= t)))
-    (cond
-     ((consp hi) nil)
-     ((member hi '(* nil))
-      (setq hi (most-positive-float type-op))
-      (setq hi= t))
-     (t
-      (assert (typep hi type-op))
-      (setq hi= t)))
-    (assert (<= lo hi))
-    (assert (or (< lo hi) (and lo= hi=)))
-    (let ((limit 100000))
-      (cond
-       ((or (<= hi 0)
-            (>= lo 0)
-            (and (<= (- limit) hi limit) (<= (- limit) lo limit)))
-        (loop for x = (+ (random (- hi lo)) lo)
-              do (when (or lo= (/= x lo)) (return x))))
-       (t
-        (rcase
-         (1 (random (min hi (float limit hi))))
-         (1 (- (random (min (float limit lo) (- lo)))))))))))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql mod)) (args cons))
-  (let ((modulus (car args)))
-    (assert (integerp modulus))
-    (assert (plusp modulus))
-    (make-random-element-of `(integer 0 (,modulus)))))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql unsigned-byte)) (args t))
-  (if (null args)
-      (make-random-element-of '(integer 0 *))
-    (let ((bits (car args)))
-      (if (eq bits'*)
-          (make-random-element-of '(integer 0 *))
-        (progn
-          (assert (and (integerp bits) (>= bits 1)))
-          (make-random-element-of `(integer 0 ,(1- (ash 1 bits)))))))))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql eql)) (args cons))
-  (assert (null (cdr args)))
-  (car args))
-
-(defmethod make-random-element-of-compound-type ((type-op (eql member)) (args cons))
-  (random-from-seq args))
-
-
-
diff --git a/random-class.lsp b/random-class.lsp
deleted file mode 100644
index 1453fdd222d03c80d8559212fbc90d643cb74143..0000000000000000000000000000000000000000
--- a/random-class.lsp
+++ /dev/null
@@ -1,9 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Sun Oct 10 07:13:47 2004
-;;;; Contains: Randomized tests on classes
-
-(in-package :cl-test)
-
-(compile-and-load "random-class-aux.lsp")
-
diff --git a/random-int-form.lsp b/random-int-form.lsp
deleted file mode 100644
index 7c18b164891ab851edb6135051f5f5e95d4e584d..0000000000000000000000000000000000000000
--- a/random-int-form.lsp
+++ /dev/null
@@ -1,2971 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Wed Sep 10 18:03:52 2003
-;;;; Contains: Simple randon form generator/tester
-
-(in-package :cl-test)
-
-(compile-and-load "random-aux.lsp")
-
-;;;
-;;; This file contains a routine for generating random legal Common Lisp functions
-;;; for differential testing.
-;;;
-;;; To run the random tests by themselves, start a lisp in the ansi-tests directory
-;;; and do the following:
-;;;   (load "gclload1.lsp")
-;;;   (compile-and-load "random-int-form.lsp")
-;;;   (in-package :cl-test)
-;;;   (let ((*random-state* (make-random-state t)))
-;;;      (test-random-integer-forms 100 4 10000)) ;; or other parameters
-;;;
-;;; If a test breaks during testing the variables *optimized-fn-src*,
-;;; *unoptimized-fn-src*, and *int-form-vals* can be used to get the source
-;;; of the optimized/unoptimized lambda forms being compiled, and the arguments
-;;; on which they are called.
-;;;
-;;; If a difference is found between optimized/unoptimized functions the forms,
-;;; values, and results are collected.  A list of all these discrepancies is returned
-;;; after testing finishes (assuming nothing breaks).
-;;;
-;;; The variable *compile-unoptimized-form* controls whether the low optimization
-;;; form is compiled, or if a form funcalling it is EVALed.  The latter is often
-;;; faster, and may find more problems since an interpreter and compiler may evaluate
-;;; forms in very different ways.
-;;;
-;;; The rctest/ subdirectory contains fragments of a more OO random form generator
-;;; that will eventually replace this preliminary effort.
-;;;
-;;; The file misc.lsp contains tests that were mostly for bugs found by this
-;;; random tester in various Common Lisp implementations.
-;;;
-
-(declaim (special *optimized-fn-src* *unoptimized-fn-src* *int-form-vals*
-                  *opt-result* *unopt-result* $x $y $z
-                  *compile-unoptimized-form*
-                  *make-random-integer-form-cdf*))
-
-;;; Little functions used to run collected tests.
-;;; (f i) runs the ith collected optimized test
-;;; (g i) runs the ith collected unoptimized test
-;;; (p i) prints the ith test (forms, input values, and other information)
-
-(defun f (i) (let ((plist (elt $y i)))
-               (apply (compile nil (getf plist :optimized-lambda-form))
-                      (getf plist :vals))))
-
-(defun g (i) (let ((plist (elt $y i)))
-               (if *compile-unoptimized-form*
-                   (apply (compile nil (getf plist :unoptimized-lambda-form))
-                          (getf plist :vals))
-                 (apply (the function (eval `(function ,(getf plist :unoptimized-lambda-form))))
-                        (getf plist :vals)))))
-
-(defun p (i) (write (elt $y i) :pretty t :escape t) (values))
-
-(defun load-failures (&key (pathname "failures.lsp"))
-  (length (setq $y (with-open-file (s pathname :direction :input)
-                                   (loop for x = (read s nil)
-                                         while x collect x)))))
-
-(defun tn (n &optional (size 100))
-  (length (setq $y (prune-results (setq $x (test-random-integer-forms size 2 n))))))
-
-(declaim (special *s1* *s2* *s3* *s4* *s5* *s6* *s7* *s8* *s9*))
-
-(defparameter *random-special-vars*
-  #(*s1* *s2* *s3* *s4* *s5* *s6* *s7* *s8* *s9*))
-
-(defparameter *loop-random-int-form-period* 2000)
-
-(defmacro cl-handler-bind (&rest args)
-  `(cl:handler-bind ,@args))
-
-(defmacro cl-handler-case (&rest args)
-  `(cl:handler-case ,@args))
-
-(eval-when
- (:compile-toplevel :load-toplevel :execute)
- (defun cumulate (vec)
-   (loop for i from 1 below (length vec)
-         do (incf (aref vec i) (aref vec (1- i))))
-   vec))
-
-(defparameter *default-make-random-integer-form-cdf*
-  (cumulate (copy-seq #(10 5 40 4 5 4 2 2 10 1 1 #-armedbead 1 #-armedbear 1
-                       #-allegro 5 5 5 #-(or gcl ecl armedbear) 2
-                       2 #-(or cmu allegro poplog) 5 4 30
-                       4 20 3 2 2 1 1 5 30 #-poplog 5
-                       #-(or allegro poplog) 10
-                       50 4 4 10 20 10 10 3
-                       20 5 #-(or armedbear) 20
-                       2 2 2))))
-
-(defparameter *make-random-integer-form-cdf*
-  (copy-seq *default-make-random-integer-form-cdf*))
-
-(eval-when
- (:compile-toplevel :load-toplevel :execute)
- (defmacro with-random-integer-form-params (&body forms)
-   (let ((len (gensym "LEN"))
-         (vec (gensym "VEC")))
-     `(let* ((,len (length *default-make-random-integer-form-cdf*))
-             (,vec (make-array ,len)))
-        (loop for i from 0 below ,len do (setf (aref ,vec i)
-                                               (1+ (min (random 100)
-                                                        (random 100)))))
-        (setq ,vec (cumulate ,vec))
-        (let ((*make-random-integer-form-cdf* ,vec))
-          ,@forms)))))
-
-;;; Run the random tester, collecting failures into the special
-;;; variable $y.
-
-(defun loop-random-int-forms (&optional (size 200) (nvars 3))
-  (unless (boundp '$x) (setq $x nil))
-  (unless (boundp '$y) (setq $y nil))
-  (loop
-   for i from 1
-   do
-   (format t "~6D | " i)
-   (finish-output *standard-output*)
-   (let ((x (test-random-integer-forms
-             size nvars *loop-random-int-form-period*
-             :index (* (1- i) *loop-random-int-form-period*))))
-     (when x
-       (setq $x (append $x x))
-       (setq x (prune-results x))
-       (terpri) (print x) (finish-output *standard-output*)
-       (setq $y (append $y x)))
-     (terpri))))
-
-(defvar *random-int-form-blocks* nil)
-(defvar *random-int-form-catch-tags* nil)
-(defvar *go-tags* nil)
-
-(defvar *random-vals-list-bound* 10)
-
-(defvar *max-compile-time* 0)
-(defvar *max-compile-term* nil)
-
-(defvar *print-immediately* nil)
-
-(defvar *compile-unoptimized-form*
-  #+(or allegro sbcl) t
-  #-(or allegro sbcl) nil)
-
-(declaim (special *vars*))
-
-(defstruct var-desc
-  (name nil :type symbol)
-  (type t))
-
-(defun test-random-integer-forms
-  (size nvars n
-        &key ((:random-state *random-state*) (make-random-state t))
-        (file-prefix "b")
-        (index 0)
-        (random-size nil)
-        (random-nvars nil)
-        )
-
-  "Generate random integer forms of size SIZE with NVARS variables.
-   Do this N times, returning all those on which a discrepancy
-   is found between optimized and nonoptimize, notinlined code."
-
-  (assert (integerp nvars))
-  (assert (<= 1 nvars 26))
-  (assert (and (integerp n) (plusp n)))
-  (assert (and (integerp n) (plusp size)))
-
-  (loop for i from 1 to n
-        do (when (= (mod i 100) 0)
-              ;; #+sbcl (print "Do gc...")
-              ;; #+sbcl (sb-ext::gc :full t)
-              ;; #+lispworks-personal-edition (cl-user::normal-gc)
-              (prin1 i) (princ " ") (finish-output *standard-output*))
-         nconc (let ((result (test-random-integer-form
-                              (if random-size (1+ (random size)) size)
-                              (if random-nvars (1+ (random nvars)) nvars)
-                              :index (+ index i)
-                              :file-prefix file-prefix)))
-                 (when result
-                   (let ((*print-readably* nil))
-                     (format t "~%~A~%" (format nil "~S" (car result)))
-                     (finish-output *standard-output*)))
-                 result)))
-
-(defun test-random-integer-form
-  (size nvars &key (index 0) (file-prefix "b"))
-  (let* ((vars (subseq '(a b c d e f g h i j k l m
-                           n o p q r s u v w x y z) 0 nvars))
-         (var-ranges (mapcar #'make-random-integer-range vars))
-         (var-types (mapcar #'(lambda (range)
-                                (let ((lo (car range))
-                                      (hi (cadr range)))
-                                  (assert (>= hi lo))
-                                  `(integer ,lo ,hi)))
-                            var-ranges))
-         (form (let ((*vars* (loop for v in vars
-                                   for tp in var-types
-                                   collect (make-var-desc :name v
-                                                          :type tp)))
-                     (*random-int-form-blocks* nil)
-                     (*random-int-form-catch-tags* nil)
-                     (*go-tags* nil)
-                     )
-                 (with-random-integer-form-params
-                  (make-random-integer-form (1+ (random size))))))
-         (vals-list
-          (loop repeat *random-vals-list-bound*
-                collect
-                (mapcar #'(lambda (range)
-                            (let ((lo (car range))
-                                  (hi (cadr range)))
-                              (random-from-interval (1+ hi) lo)))
-                        var-ranges)))
-         (opt-decls-1 (make-random-optimize-settings))
-         (opt-decls-2 (make-random-optimize-settings)))
-    (when *print-immediately*
-      (with-open-file
-       (s (format nil "~A~A.lsp" file-prefix index)
-          :direction :output :if-exists :error)
-       (print `(defparameter *x*
-                 '(:vars ,vars
-                      :var-types ,var-types
-                      :vals-list ,vals-list
-                      :decls1 ,opt-decls-1
-                      :decls2 ,opt-decls-2
-                      :form ,form))
-              s)
-       (print '(load "c.lsp") s)
-       (finish-output s))
-       ;; (cl-user::gc)
-       ;; (make-list 1000000)
-      )
-    (test-int-form form vars var-types vals-list opt-decls-1 opt-decls-2)))
-
-(defun make-random-optimize-settings ()
-  (loop for settings = (list*
-                        (list 'speed (random 4))
-                        #+sbcl '(sb-c:insert-step-conditions 0)
-                        (loop for s in '(space safety debug compilation-speed)
-                              for n = (random 4)
-                              collect (list s n)))
-        while
-        #+allegro (subsetp '((speed 3) (safety 0)) settings :test 'equal)
-        #-allegro nil
-        finally (return (random-permute settings))))
-
-(defun fn-symbols-in-form (form)
-  "Return a list of the distinct standardized lisp function
-   symbols occuring ing FORM.  These are used to generate a NOTINLINE
-   declaration for the unoptimized form."
-  (intersection
-   (remove-duplicates (fn-symbols-in-form* form) :test #'eq)
-   *cl-function-or-accessor-symbols*))
-
-(defun fn-symbols-in-form* (form)
-  (when (consp form)
-    (if (symbolp (car form))
-        (cons (car form) (mapcan #'fn-symbols-in-form* (cdr form)))
-      (mapcan #'fn-symbols-in-form* form))))
-
-(defun fn-arg-name (fn-name arg-index)
-  (intern (concatenate 'string
-                       (subseq (symbol-name fn-name) 1)
-                       (format nil "-~D" arg-index))
-          (symbol-package fn-name)))
-
-(declaim (special *flet-names*))
-(defparameter *flet-names* nil)
-
-
-
-(defun random-var-desc ()
-  (loop
-   (let* ((pos (random (length *vars*)))
-          (desc (elt *vars* pos)))
-     (when (= pos (position (var-desc-name desc) (the list *vars*)
-                            :key #'var-desc-name))
-       (return desc)))))
-
-(defun is-zero-rank-integer-array-type (type)
-  "This function was introduced because of a bug in ACL 6.2"
-  ; (subtypep type '(array integer 0))
-  (and (consp type)
-       (eq (car type) 'array)
-       (cddr type)
-       (or (eq (cadr type) '*)
-           (subtypep (cadr type) 'integer))
-       (or (eql (caddr type) 0)
-           (null (caddr type)))))
-
-(defun make-random-integer-form (size)
-  "Generate a random legal lisp form of size SIZE (roughly)."
-
-  (if (<= size 1)
-      ;; Leaf node -- generate a variable, constant, or flet function call
-      (loop
-       when
-       (rcase
-        (10 (make-random-integer))
-        (9 (if *vars*
-               (let* ((desc (random-var-desc))
-                      (type (var-desc-type desc))
-                      (name (var-desc-name desc)))
-                 (cond
-                  ((subtypep type 'integer) name)
-                  (; (subtypep type '(array integer 0))
-                   (is-zero-rank-integer-array-type type)
-                   `(aref ,name))
-                  ((subtypep type '(cons integer integer))
-                   (rcase (1 `(car ,name))
-                          (1 `(cdr ,name))))
-                  (t nil)))
-             nil))
-        (1 (if *go-tags* `(go ,(random-from-seq *go-tags*)) nil))
-        (2 (if *flet-names*
-               (let* ((flet-entry (random-from-seq *flet-names*))
-                      (flet-name (car flet-entry))
-                      (flet-minargs (cadr flet-entry))
-                      (flet-maxargs (caddr flet-entry))
-                      (nargs (random-from-interval (1+ flet-maxargs) flet-minargs))
-                      (args (loop repeat nargs
-                                  collect (make-random-integer-form 1))))
-                 `(,flet-name ,@args))
-             nil)))
-       return it)
-    ;; (> size 1)
-    (rselect *make-random-integer-form-cdf*
-
-     ;; flet call
-     (make-random-integer-flet-call-form size)
-     (make-random-aref-form size)
-     ;; Unary ops
-     (let ((op (random-from-seq '(- abs signum 1+ 1- conjugate
-                                     rational rationalize
-                                     numerator denominator
-                                     identity progn floor
-                                     ;; #-(or armedbear)
-                                     ignore-errors
-                                     cl:handler-case
-                                     restart-case
-                                     ceiling truncate round realpart imagpart
-                                     integer-length logcount values
-                                     locally))))
-        `(,op ,(make-random-integer-form (1- size))))
-
-     (make-random-integer-unwind-protect-form size)
-     (make-random-integer-mapping-form size)
-
-     ;; prog1, multiple-value-prog1
-     (let* ((op (random-from-seq #(prog1 multiple-value-prog1)))
-            (nforms (random 4))
-            (sizes (random-partition (1- size) (1+ nforms)))
-            (args (mapcar #'make-random-integer-form sizes)))
-       `(,op ,@args))
-
-     ;; prog2
-     (let* ((nforms (random 4))
-            (sizes (random-partition (1- size) (+ nforms 2)))
-            (args (mapcar #'make-random-integer-form sizes)))
-       `(prog2 ,@args))
-
-     `(isqrt (abs ,(make-random-integer-form (- size 2))))
-
-     `(the integer ,(make-random-integer-form (1- size)))
-
-     `(cl:handler-bind nil ,(make-random-integer-form (1- size)))
-     `(restart-bind nil ,(make-random-integer-form (1- size)))
-     #-armedbear
-     `(macrolet () ,(make-random-integer-form (1- size)))
-     #-armedbear
-     `(symbol-macrolet () ,(make-random-integer-form (1- size)))
-
-     ;; dotimes
-     #-allegro
-     (let* ((var (random-from-seq #(iv1 iv2 iv3 iv4)))
-            (count (random 4))
-            (sizes (random-partition (1- size) 2))
-            (body (let ((*vars* (cons (make-var-desc :name var :type nil)
-                                      *vars*)))
-                    (make-random-integer-form (first sizes))))
-            (ret-form (make-random-integer-form (second sizes))))
-       (unless (consp body) (setq body `(progn ,body)))
-       `(dotimes (,var ,count ,ret-form) ,body))
-
-     ;; loop
-     (make-random-loop-form (1- size))
-
-     (make-random-count-form size)
-
-     #-(or gcl ecl armedbear)
-     ;; load-time-value
-     (let ((arg (let ((*flet-names* nil)
-                      (*vars* nil)
-                      (*random-int-form-blocks* nil)
-                      (*random-int-form-catch-tags* nil)
-                      (*go-tags* nil))
-                  (make-random-integer-form (1- size)))))
-       (rcase
-        (4 `(load-time-value ,arg t))
-        (2 `(load-time-value ,arg))
-        (2 `(load-time-value ,arg nil))))
-
-     ;; eval
-     (make-random-integer-eval-form size)
-
-     #-(or cmu allegro poplog)
-     (destructuring-bind (s1 s2)
-        (random-partition (- size 2) 2)
-        `(ash ,(make-random-integer-form s1)
-              (min ,(random 100)
-                   ,(make-random-integer-form s2))))
-
-     ;; binary floor, ceiling, truncate, round
-     (let ((op (random-from-seq #(floor ceiling truncate round mod rem)))
-           (op2 (random-from-seq #(max min))))
-       (destructuring-bind (s1 s2)
-          (random-partition (- size 2) 2)
-          `(,op  ,(make-random-integer-form s1)
-                 (,op2  ,(if (eq op2 'max)
-                             (1+ (random 100))
-                           (- (1+ (random 100))))
-                        ,(make-random-integer-form s2)))))
-
-     ;; Binary op
-     (let* ((op (random-from-seq
-                  '(+ - *  logand min max gcd
-                      lcm
-                      #-:allegro
-                      logandc1
-                      logandc2 logeqv logior lognand lognor
-                      #-:allegro
-                      logorc1
-                      logorc2
-                      logxor
-                      ))))
-        (destructuring-bind (leftsize rightsize)
-            (random-partition (1- size) 2)
-          (let ((e1 (make-random-integer-form leftsize))
-                (e2 (make-random-integer-form rightsize)))
-            `(,op ,e1 ,e2))))
-
-     ;; boole
-     (let* ((op (random-from-seq
-                  #(boole-1 boole-2 boole-and boole-andc1 boole-andc2
-                    boole-c1 boole-c2 boole-clr boole-eqv boole-ior boole-nand
-                    boole-nor boole-orc1 boole-orc2 boole-set boole-xor))))
-        (destructuring-bind (leftsize rightsize)
-            (random-partition (- size 2) 2)
-          (let ((e1 (make-random-integer-form leftsize))
-                (e2 (make-random-integer-form rightsize)))
-            `(boole ,op ,e1 ,e2))))
-
-     ;; n-ary ops
-     (let* ((op (random-from-seq #(+ - * logand min max
-                                      logior values lcm gcd logxor)))
-             (nmax (case op ((* lcm gcd) 4) (t (1+ (random 40)))))
-             (nargs (1+ (min (random nmax) (random nmax))))
-             (sizes (random-partition (1- size) nargs))
-             (args (mapcar #'make-random-integer-form sizes)))
-        `(,op ,@args))
-
-     ;; expt
-     `(expt ,(make-random-integer-form (1- size)) ,(random 3))
-
-     ;; coerce
-     `(coerce ,(make-random-integer-form (1- size)) 'integer)
-
-     ;; complex (degenerate case)
-     `(complex ,(make-random-integer-form (1- size)) 0)
-
-     ;; quotient (degenerate cases)
-     `(/ ,(make-random-integer-form (1- size)) 1)
-     `(/ ,(make-random-integer-form (1- size)) -1)
-
-     ;; tagbody
-     (make-random-tagbody-and-progn size)
-
-     ;; conditionals
-     (let* ((cond-size (random (max 1 (floor size 2))))
-            (then-size (random (- size cond-size)))
-            (else-size (- size 1 cond-size then-size))
-            (pred (make-random-pred-form cond-size))
-            (then-part (make-random-integer-form then-size))
-            (else-part (make-random-integer-form else-size)))
-       `(if ,pred ,then-part ,else-part))
-     #-poplog
-      (destructuring-bind (s1 s2 s3) (random-partition (1- size) 3)
-        `(,(random-from-seq '(deposit-field dpb))
-          ,(make-random-integer-form s1)
-          ,(make-random-byte-spec-form s2)
-          ,(make-random-integer-form s3)))
-
-     #-(or allegro poplog)
-      (destructuring-bind (s1 s2) (random-partition (1- size) 2)
-          `(,(random-from-seq '(ldb mask-field))
-            ,(make-random-byte-spec-form s1)
-            ,(make-random-integer-form s2)))
-
-     (make-random-integer-binding-form size)
-
-     ;; progv
-     (make-random-integer-progv-form size)
-
-     `(let () ,(make-random-integer-form (1- size)))
-
-      (let* ((name (random-from-seq #(b1 b2 b3 b4 b5 b6 b7 b8)))
-             (*random-int-form-blocks* (adjoin name *random-int-form-blocks*)))
-        `(block ,name ,(make-random-integer-form (1- size))))
-
-      (let* ((tag (list 'quote (random-from-seq #(ct1 ct2 ct2 ct4 ct5 ct6 ct7 ct8))))
-             (*random-int-form-catch-tags* (cons tag *random-int-form-catch-tags*)))
-        `(catch ,tag ,(make-random-integer-form (1- size))))
-
-      ;; setq and similar
-      (make-random-integer-setq-form size)
-
-      (make-random-integer-case-form size)
-
-      (if *random-int-form-blocks*
-          (let ((name (random-from-seq *random-int-form-blocks*))
-                (form (make-random-integer-form (1- size))))
-            `(return-from ,name ,form))
-        ;; No blocks -- try again
-        (make-random-integer-form size))
-
-      (if *random-int-form-catch-tags*
-          (let ((tag (random-from-seq *random-int-form-catch-tags*))
-                (form (make-random-integer-form (1- size))))
-            `(throw ,tag ,form))
-        ;; No catch tags -- try again
-        (make-random-integer-form size))
-
-      (if *random-int-form-blocks*
-          (destructuring-bind (s1 s2 s3) (random-partition (1- size) 3)
-            (let ((name (random-from-seq *random-int-form-blocks*))
-                  (pred (make-random-pred-form s1))
-                  (then (make-random-integer-form s2))
-                  (else (make-random-integer-form s3)))
-              `(if ,pred (return-from ,name ,then) ,else)))
-        ;; No blocks -- try again
-        (make-random-integer-form size))
-
-     #-(or armedbear)
-     (make-random-flet-form size)
-
-      (let* ((nbits (1+ (min (random 20) (random 20))))
-             (bvec (coerce (loop repeat nbits collect (random 2)) 'simple-bit-vector))
-             (op (random-from-seq #(bit sbit))))
-        `(,op ,bvec (min ,(1- nbits) (max 0 ,(make-random-integer-form (- size 3 nbits))))))
-
-      (let* ((nvals (1+ (min (random 20) (random 20))))
-             (lim (ash 1 (+ 3 (random 40))))
-             (vec (coerce (loop repeat nvals collect (random lim)) 'simple-vector))
-             (op (random-from-seq #(aref svref elt))))
-        `(,op ,vec (min ,(1- nvals) (max 0 ,(make-random-integer-form (- size 3 nvals))))))
-
-      (let* ((nvals (1+ (min (random 20) (random 20))))
-             (lim (ash 1 (+ 3 (random 40))))
-             (vals (loop repeat nvals collect (random lim)))
-             (op 'elt))
-        `(,op ',vals (min ,(1- nvals) (max 0 ,(make-random-integer-form (- size 3 nvals))))))
-
-     )))
-
-(defun make-random-aref-form (size)
-  (or
-   (when *vars*
-     (let* ((desc (random-var-desc))
-            (type (var-desc-type desc))
-            (name (var-desc-name desc)))
-       (cond
-        ((null type) nil)
-        ((subtypep type '(array integer (*)))
-         `(aref ,name (min ,(1- (first (third type)))
-                           (max 0 ,(make-random-integer-form (- size 2))))))
-        ((subtypep type '(array integer (* *)))
-         (destructuring-bind (s1 s2) (random-partition (max 2 (- size 2)) 2)
-           `(aref ,name
-                  (min ,(1- (first (third type)))
-                       (max 0 ,(make-random-integer-form s1)))
-                  (min ,(1- (second (third type)))
-                       (max 0 ,(make-random-integer-form s2))))))
-        (t nil))))
-   (make-random-integer-form size)))
-
-(defun make-random-count-form (size)
-  (destructuring-bind (s1 s2)
-      (random-partition (1- size) 2)
-    (let ((arg1 (make-random-integer-form s1))
-          (arg2-args (loop repeat s2 collect (make-random-integer))))
-      (let ((op 'count)
-            (test (random-from-seq #(eql = /= < > <= >=)))
-            (arg2 (rcase
-                   (1 (make-array (list s2) :initial-contents arg2-args))
-                   (1
-                    (let* ((mask (1- (ash 1 (1+ (random 32))))))
-                      (make-array (list s2)
-                                  :initial-contents
-                                  (mapcar #'(lambda (x) (logand x mask)) arg2-args)
-                                  :element-type `(integer 0 ,mask))))
-                   (1 `(quote ,arg2-args)))))
-        `(,op ,arg1 ,arg2 ,@(rcase
-                                    (2 nil)
-                                    (1 (list :test `(quote ,test)))
-                                    (1 (list :test-not `(quote ,test)))))))))
-
-(defun make-random-integer-flet-call-form (size)
-  (if *flet-names*
-      (let* ((flet-entry (random-from-seq *flet-names*))
-             (flet-name (car flet-entry))
-             (flet-minargs (cadr flet-entry))
-             (flet-maxargs (caddr flet-entry))
-             (nargs (random-from-interval (1+ flet-maxargs) flet-minargs))
-             )
-        (cond
-         ((> nargs 0)
-          (let* ((arg-sizes (random-partition (1- size) nargs))
-                 (args (mapcar #'make-random-integer-form arg-sizes)))
-            (rcase
-             (1 `(,flet-name ,@args))
-             (1 `(multiple-value-call #',flet-name (values ,@args)))
-             (1 `(funcall (function ,flet-name) ,@args))
-             (1 (let ((r (random (1+ (length args)))))
-                  `(apply (function ,flet-name)
-                          ,@(subseq args 0 r)
-                          (list ,@(subseq args r))))))))
-         (t (make-random-integer-form size))))
-    (make-random-integer-form size)))
-
-(defun make-random-integer-unwind-protect-form (size)
-  (let* ((op 'unwind-protect)
-         (nforms (random 4))
-         (sizes (random-partition (1- size) (1+ nforms)))
-         (arg (make-random-integer-form (first sizes)))
-         (unwind-forms
-          ;; We have to be careful not to generate code that will
-          ;; illegally transfer control to a dead location
-          (let ((*flet-names* nil)
-                (*go-tags* nil)
-                (*random-int-form-blocks* nil)
-                (*random-int-form-catch-tags* nil))
-            (mapcar #'make-random-integer-form (rest sizes)))))
-    `(,op ,arg ,@unwind-forms)))
-
-(defun make-random-integer-eval-form (size)
-  (flet ((%arg (size)
-               (let ((*flet-names* nil)
-                     (*vars* (remove-if-not #'(lambda (s)
-                                                (find (var-desc-name s)
-                                                      *random-special-vars*))
-                                            *vars*))
-                     (*random-int-form-blocks* nil)
-                     (*go-tags* nil))
-                 (make-random-integer-form size))))
-    (rcase
-     (2 `(eval ',(%arg (1- size))))
-     (2 (let* ((nargs (1+ (random 4)))
-               (sizes (random-partition (1- size) nargs))
-               (args (mapcar #'%arg sizes)))
-          `(eval (values ,@args))))
-     )))
-
-(defun make-random-type-for-var (var e1)
-  (let (desc)
-    (values
-     (cond
-      ((and (find var *random-special-vars*)
-            (setq desc (find var *vars* :key #'var-desc-name)))
-       (var-desc-type desc))
-      (t (rcase
-          (4 '(integer * *))
-          (1 (setq e1 `(make-array nil :initial-element ,e1
-                                   ,@(rcase (1 nil) (1 '(:adjustable t)))))
-             '(array integer nil))
-          (1 (let ((size (1+ (random 10))))
-               (setq e1 `(make-array '(,size):initial-element ,e1
-                                     ,@(rcase (1 nil) (1 '(:adjustable t)))))
-               `(array integer (,size))))
-          #|
-          (1 (let ((size1 (1+ (random 10)))
-                   (size2 (1+ (random 10))))
-               (setq e1 `(make-array '(,size1 ,size2):initial-element ,e1
-                                     ,@(rcase (1 nil) (1 '(:adjustable t)))))
-               `(array integer (,size1 ,size2))))
-          |#
-          (1 (setq e1 `(cons ,e1 ,(make-random-integer-form 1)))
-             '(cons integer integer))
-          (1 (setq e1 `(cons ,(make-random-integer-form 1) ,e1))
-             '(cons integer integer)))))
-     e1)))
-
-(defun random2 (n)
-  (min (random n) (random n)))
-
-(defun random-from-seq2 (seq)
-  (elt seq (random2 (length seq))))
-
-(defun make-random-integer-binding-form (size)
-  (destructuring-bind (s1 s2) (random-partition (1- size) 2)
-    (let* ((var (random-from-seq2 (rcase
-                                   (2 #(v1 v2 v3 v4 v5 v6 v7 v8 v9 v10))
-                                   #-ecl (2 *random-special-vars*)
-                                   )))
-           (e1 (make-random-integer-form s1))
-           (type (multiple-value-bind (type2 e)
-                     (make-random-type-for-var var e1)
-                   (setq e1 e)
-                   type2))
-           (e2 (let ((*vars* (cons (make-var-desc :name var :type type)
-                                   *vars*)))
-                 (make-random-integer-form s2)))
-           (op (random-from-seq #(let let*))))
-      ;; for now, avoid shadowing
-      (if (member var *vars* :key #'var-desc-name)
-          (make-random-integer-form size)
-        (rcase
-         (8 `(,op ((,var ,e1))
-                  ,@(rcase (1 `((declare (dynamic-extent ,var))))
-                           (3 nil))
-                  ,e2))
-         (2 `(multiple-value-bind (,var) ,e1 ,e2)))))))
-
-(defun make-random-integer-progv-form (size)
-  (let* ((num-vars (random 4))
-         (possible-vars *random-special-vars*)
-         (vars nil))
-    (loop repeat num-vars
-          do (loop for r = (elt possible-vars (random (length possible-vars)))
-                   while (member r vars)
-                   finally (push r vars)))
-    (setq vars (remove-if #'(lambda (var) (let ((desc (find var *vars* :key #'var-desc-name)))
-                                            (and desc (not (subtypep (var-desc-type desc) 'integer)))))
-                          vars)
-          num-vars (length vars))
-    (if (null vars)
-        `(progv nil nil ,(make-random-integer-form (1- size)))
-      (destructuring-bind (s1 s2) (random-partition (1- size) 2)
-        (let* ((var-sizes (random-partition s1 num-vars))
-               (var-forms (mapcar #'make-random-integer-form var-sizes))
-               (*vars* (append (loop for v in vars collect
-                                     (make-var-desc :name v :type '(integer * *)))
-                               *vars*))
-               (body-form (make-random-integer-form s2)))
-          `(progv ',vars (list ,@var-forms) ,body-form))))))
-
-(defun make-random-integer-mapping-form (size)
-  ;; reduce
-  (let ((keyargs nil)
-        (nargs (1+ (random (min 10 (max 1 size)))))
-        (sequence-op (random-from-seq '(vector list))))
-    (when (coin 2) (setq keyargs '(:from-end t)))
-    (cond
-     ((coin 2)
-      (let ((start (random nargs)))
-        (setq keyargs `(:start ,start ,@keyargs))
-        (when (coin 2)
-          (let ((end (+ start 1 (random (- nargs start)))))
-            (setq keyargs `(:end ,end ,@keyargs))))))
-     (t
-      (when (coin 2)
-        (let ((end (1+ (random nargs))))
-          (setq keyargs `(:end ,end ,@keyargs))))))
-    (rcase
-     (1
-      (let ((sizes (random-partition (1- size) nargs))
-            (op (random-from-seq #(+ - * logand logxor logior max min))))
-        `(reduce ,(rcase (1 `(function ,op))
-                         (1 `(quote ,op)))
-                 (,sequence-op
-                  ,@(mapcar #'make-random-integer-form sizes))
-                 ,@keyargs)))
-     #-(or armedbear)
-     (1
-      (destructuring-bind (size1 size2) (random-partition (1- size) 2)
-        (let* ((vars '(lmv1 lmv2 lmv3 lmv4 lmv5 lmv6))
-               (var1 (random-from-seq vars))
-               (var2 (random-from-seq (remove var1 vars)))
-               (form (let ((*vars* (list*
-                                    (make-var-desc :name var1 :type '(integer * *))
-                                    (make-var-desc :name var2 :type '(integer * *))
-                                    *vars*)))
-                       (make-random-integer-form size1)))
-               (sizes (random-partition size2 nargs))
-               (args (mapcar #'make-random-integer-form sizes)))
-          `(reduce (function (lambda (,var1 ,var2) ,form))
-                   (,sequence-op ,@args)
-                   ,@keyargs)))))))
-
-(defun make-random-integer-setq-form (size)
-  (if *vars*
-      (let* ((vdesc (random-from-seq *vars*))
-             (var (var-desc-name vdesc))
-             (type (var-desc-type vdesc))
-             (op (random-from-seq #(setq setf shiftf))))
-        (cond
-         ((subtypep '(integer * *) type)
-          (assert (not (member var '(lv1 lv2 lv3 lv4 lv5 lv6 lv7 lv8))))
-          (rcase
-           (1 (when (find var *random-special-vars*)
-                (setq op (random-from-seq #(setf shiftf))
-                      var `(symbol-value ',var))))
-           (1 (setq op 'multiple-value-setq)
-              (setq var (list var)))
-           (5 (setf op (random-from-seq #(setq setf shiftf incf decf)))))
-          `(,op ,var ,(make-random-integer-form (1- size))))
-         ((and (consp type)
-               (eq (car type) 'integer)
-               (integerp (second type))
-               (integerp (third type)))
-          (assert (not (member var '(lv1 lv2 lv3 lv4 lv5 lv6 lv7 lv8))))
-          (rcase
-           (1 (when (find var *random-special-vars*)
-                (setq op (random-from-seq #(setf shiftf))
-                      var `(symbol-value ',var))))
-           (1 (setq op 'multiple-value-setq)
-              (setq var (list var)))
-           (5 nil))
-          `(,op ,var ,(random-from-interval (1+ (third type)) (second type))))
-         ((and type (is-zero-rank-integer-array-type type)) ; (subtypep type '(array integer nil))
-          (assert (not (member var '(lv1 lv2 lv3 lv4 lv5 lv6 lv7 lv8))))
-          (when (eq op 'setq)
-            (setq op (random-from-seq #(setf shiftf))))
-          `(,op (aref ,var) ,(make-random-integer-form (- size 2))))
-         ((and type (subtypep type '(array integer (*))))
-          (when (eq op 'setq)
-            (setq op (random-from-seq #(setf shiftf))))
-          (destructuring-bind (s1 s2) (random-partition (max 2 (- size 2)) 2)
-            `(,op (aref ,var (min ,(1- (first (third type)))
-                                  (max 0
-                                       ,(make-random-integer-form s1))))
-                  ,(make-random-integer-form s2))))
-         ((and type (subtypep type '(array integer (* *))))
-          (when (eq op 'setq)
-            (setq op (random-from-seq #(setf shiftf))))
-          (destructuring-bind (s1 s2 s3) (random-partition (max 3 (- size 3)) 3)
-            `(,op (aref ,var
-                        (min ,(1- (first (third type)))
-                             (max 0
-                                  ,(make-random-integer-form s1)))
-                        (min ,(1- (second (third type)))
-                             (max 0
-                                  ,(make-random-integer-form s2))))
-                  ,(make-random-integer-form s3))))
-         ;; Abort -- can't assign
-         (t (make-random-integer-form size))))
-    (make-random-integer-form size)))
-
-
-(defun make-random-integer-case-form (size)
-  (let ((ncases (1+ (random 10))))
-    (if (< (+ size size) (+ ncases 2))
-        ;; Too small, give up
-        (make-random-integer-form size)
-      (let* ((sizes (random-partition (1- size) (+ ncases 2)))
-             (bound (ash 1 (+ 2 (random 16))))
-             (lower-bound (if (coin 3) 0 (- bound)))
-             (upper-bound (if (and (< lower-bound 0) (coin 3))
-                              1
-                            (1+ bound)))
-             (cases
-              (loop
-               for case-size in (cddr sizes)
-               for vals = (loop repeat (1+ (min (random 10) (random 10)))
-                                collect (random-from-interval
-                                         upper-bound lower-bound))
-               for result = (make-random-integer-form case-size)
-               repeat ncases
-               collect `(,vals ,result)))
-             (expr (make-random-integer-form (first sizes))))
-        `(case ,expr
-           ,@cases
-           (t ,(make-random-integer-form (second sizes))))))))
-
-(defun make-random-flet-form (size)
-  "Generate random flet, labels forms, for now with no arguments
-   and a single binding per form."
-  (let ((fname (random-from-seq #(%f1 %f2 %f3 %f4 %f5 %f6 %f7 %f8 %f9 %f10
-                                  %f11 %f12 %f13 %f14 %f15 %f16 %f17 %f18))))
-    (if (assoc fname *flet-names*)
-        ;; Fail if the name is in use
-        (make-random-integer-form size)
-      (let* ((op (random-from-seq #(flet labels)))
-             (minargs (random 4))
-             (maxargs #+:allegro minargs
-                      #-:allegro
-                      (rcase
-                       (1 minargs)
-                       (1 (+ minargs (random 4)))))
-             (keyarg-p (coin 2))
-             (keyarg-n (if keyarg-p (random 3) 0))
-             (arg-names (loop for i from 1 to maxargs
-                              collect (fn-arg-name fname i)))
-             (key-arg-names (loop for i from 1 to keyarg-n
-                                  collect (intern (format nil "KEY~A" i)
-                                                  (find-package "CL-TEST"))))
-             (allow-other-keys (and keyarg-p (coin 3)))
-             )
-        (let* ((sizes (random-partition (1- size) (+ 2 keyarg-n (- maxargs minargs))))
-               (s1 (car sizes))
-               (s2 (cadr sizes))
-               (opt-sizes (cddr sizes)))
-          (let* ((form1
-                  ;; Allow return-from of the flet/labels function
-                  (let ((*random-int-form-blocks*
-                         (cons fname *random-int-form-blocks*))
-                        (*vars* (nconc (loop for var in (append arg-names key-arg-names)
-                                             collect (make-var-desc :name var
-                                                                    :type '(integer * *)))
-                                       *vars*)))
-                    (make-random-integer-form s1)))
-                 (form2 (let ((*flet-names* (cons (list fname minargs maxargs keyarg-p)
-                                                  *flet-names*)))
-                          (make-random-integer-form s2)))
-                 (opt-forms (mapcar #'make-random-integer-form opt-sizes)
-                            ))
-            (if opt-forms
-                `(,op ((,fname (,@(subseq arg-names 0 minargs)
-                                  &optional
-                                  ,@(mapcar #'list
-                                            (subseq arg-names minargs)
-                                            opt-forms)
-                                  ,@(when keyarg-p
-                                      (append '(&key)
-                                              (mapcar #'list
-                                                      key-arg-names
-                                                      (subseq opt-forms (- maxargs minargs)))
-                                              (when allow-other-keys '(&allow-other-keys))
-                                              )))
-                               ,form1))
-                      ,form2)
-              `(,op ((,fname (,@arg-names
-                              ,@(when keyarg-p
-                                  (append '(&key)
-                                          (mapcar #'list
-                                                  key-arg-names
-                                                  opt-forms )
-                                          (when allow-other-keys '(&allow-other-keys))
-                                          )))
-                             ,form1))
-                    ,form2))))))))
-
-(defun make-random-tagbody (size)
-  (let* ((num-forms (random 6))
-         (tags nil))
-    (loop for i below num-forms
-          do (loop for tag = (rcase
-                              #-allegro (1 (random 8))
-                              (1 (random-from-seq #(tag1 tag2 tag3 tag4
-                                                         tag5 tag6 tag7 tag8))))
-                   while (member tag tags)
-                   finally (push tag tags)))
-    (assert (= (length (remove-duplicates tags)) (length tags)))
-    (let* ((*go-tags* (set-difference *go-tags* tags))
-           (sizes (if (> num-forms 0) (random-partition (1- size) num-forms) nil))
-           (forms
-            (loop for tag-list on tags
-                  for i below num-forms
-                  for size in sizes
-                  collect (let ((*go-tags* (append tag-list *go-tags*)))
-                            (make-random-integer-form size)))))
-      `(tagbody ,@(loop for tag in tags
-                        for form in forms
-                        when (atom form) do (setq form `(progn ,form))
-                        append `(,form ,tag))))))
-
-(defun make-random-tagbody-and-progn (size)
-  (let* ((final-size (random (max 1 (floor size 5))))
-         (tagbody-size (- size final-size)))
-    (let ((final-form (make-random-integer-form final-size))
-          (tagbody-form (make-random-tagbody tagbody-size)))
-      `(progn ,tagbody-form ,final-form))))
-
-(defun make-random-pred-form (size)
-  "Make a random form whose value is to be used as a generalized boolean."
-  (if (<= size 1)
-      (rcase
-        (1 (if (coin) t nil))
-        (2
-         `(,(random-from-seq '(< <= = > >= /= eql equal))
-           ,(make-random-integer-form size)
-           ,(make-random-integer-form size))))
-    (rcase
-      (1 (if (coin) t nil))
-      (3 `(not ,(make-random-pred-form (1- size))))
-      (12 (destructuring-bind (leftsize rightsize)
-             (random-partition (1- size) 2)
-           `(,(random-from-seq '(and or))
-             ,(make-random-pred-form leftsize)
-             ,(make-random-pred-form rightsize))))
-      (1 (let* ((nsizes (+ 1 (random 3)))
-                (sizes (random-partition (1- size) nsizes)))
-           `(,(random-from-seq (if (= nsizes 2) #(< <= > >= = /= eql equal)
-                                 #(< <= > >= = /=)))
-             ,@(mapcar #'make-random-integer-form sizes))))
-      (3 (let* ((cond-size (random (max 1 (floor size 2))))
-                (then-size (random (- size cond-size)))
-                (else-size (- size 1 cond-size then-size))
-                (pred (make-random-pred-form cond-size))
-                (then-part (make-random-pred-form then-size))
-                (else-part (make-random-pred-form else-size)))
-           `(if ,pred ,then-part ,else-part)))
-      #-poplog
-      (1 (destructuring-bind (s1 s2)
-             (random-partition (1- size) 2)
-           `(ldb-test ,(make-random-byte-spec-form s1)
-                      ,(make-random-integer-form s2))))
-      (2 (let ((form (make-random-integer-form (1- size)))
-               (op (random-from-seq #(evenp oddp minusp plusp zerop))))
-           `(,op ,form)))
-      (2 (destructuring-bind (s1 s2)
-             (random-partition (1- size) 2)
-           (let ((arg1 (make-random-integer-form s1))
-                 (arg2-args (loop repeat s2 collect (make-random-integer))))
-             (let ((op (random-from-seq #(find position)))
-                   (test (random-from-seq #(eql = /= < > <= >=)))
-                   (arg2 (rcase
-                          (1 (make-array (list s2) :initial-contents arg2-args))
-                          (1
-                           (let* ((mask (1- (ash 1 (1+ (random 32))))))
-                             (make-array (list s2)
-                                         :initial-contents
-                                         (mapcar #'(lambda (x) (logand x mask)) arg2-args)
-                                        :element-type `(integer 0 ,mask))))
-                          (1 `(quote ,arg2-args)))))
-               `(,op ,arg1 ,arg2 ,@(rcase
-                                    (2 nil)
-                                    (1 (list :test `(quote ,test)))
-                                    (1 (list :test-not `(quote ,test)))))))))
-
-      (1 (let ((index (random (1+ (random *maximum-random-int-bits*))))
-               (form (make-random-integer-form (1- size))))
-           `(logbitp ,index ,form)))
-      (1 ;; typep form
-       (let ((subform (make-random-integer-form (- size 2)))
-             (type
-              (rcase
-               (1 `(real ,@(make-random-integer-range)))
-               (1 `(rational ,@(make-random-integer-range)))
-               (1 `(rational ,(+ 1/2 (make-random-integer))))
-               (1 `(rational * ,(+ 1/2 (make-random-integer))))
-               (1 `(integer ,@(make-random-integer-range)))
-               (1 `(integer ,(make-random-integer)))
-               (1 `(integer * ,(make-random-integer)))
-               (1 'fixnum)
-               (1 'bignum)
-               (1 `(integer)))))
-         `(typep ,subform ',type)))
-      )))
-
-(defun make-random-loop-form (size)
-  (if (<= size 2)
-      (make-random-integer-form size)
-    (let* ((var (random-from-seq #(lv1 lv2 lv3 lv4)))
-           (count (random 4))
-           (*vars* (cons (make-var-desc :name var :type nil)
-                         *vars*)))
-      (rcase
-       (1 `(loop for ,var below ,count count ,(make-random-pred-form (- size 2))))
-       (1 `(loop for ,var below ,count sum ,(make-random-integer-form (- size 2))))
-       ))))
-
-(defun make-random-byte-spec-form (size)
-  (declare (ignore size))
-  (let* ((pform (random 33))
-         (sform (1+ (random 33))))
-    `(byte ,sform ,pform)))
-
-(defgeneric make-random-element-of-type (type)
-  (:documentation "Create a random element of a lisp type."))
-
-(defgeneric make-random-element-of-compound-type (type-op type-args)
-  (:documentation "Create a random element of type `(,TYPE-OP ,@TYPE-ARGS)")
-  (:method ((type-op (eql 'or)) type-args)
-           (assert type-args)
-           (make-random-element-of-type (random-from-seq type-args)))
-  (:method ((type-op (eql 'and)) type-args)
-           (assert type-args)
-           (loop for x = (make-random-element-of-type (car type-args))
-             repeat 100
-             when (typep x (cons 'and (cdr type-args)))
-             return x
-             finally (error "Cannot generate random element of ~A"
-                            (cons type-op type-args))))
-  (:method ((type-op (eql 'not)) type-args)
-           (assert (eql (length type-args) 1))
-           (make-random-element-of-type `(and t (not ,(car type-args)))))
-  (:method ((type-op (eql 'integer)) type-args)
-           (let ((lo (let ((lo (car type-args)))
-                       (cond
-                        ((consp lo) (1+ (car lo)))
-                        ((eq lo nil) '*)
-                        (t lo))))
-                 (hi (let ((hi (cadr type-args)))
-                       (cond
-                        ((consp hi) (1- (car hi)))
-                        ((eq hi nil) '*)
-                        (t hi)))))
-             (if (eq lo '*)
-                 (if (eq hi '*)
-                     (let ((x (ash 1 (random *maximum-random-int-bits*))))
-                       (random-from-interval x (- x)))
-                   (random-from-interval (1+ hi)
-                                         (- hi (random (ash 1 *maximum-random-int-bits*)))))
-
-               (if (eq hi '*)
-                   (random-from-interval (+ lo (random (ash 1 *maximum-random-int-bits*)) 1)
-                                         lo)
-                 ;; May generalize the next case to increase odds
-                 ;; of certain integers (near 0, near endpoints, near
-                 ;; powers of 2...)
-                 (random-from-interval (1+ hi) lo)))))
-  (:method ((type-op (eql 'rational)) type-args)
-           (let ((type (cons type-op type-args)))
-             (or
-              (let ((r (make-random-element-of-type 'rational)))
-                (and (typep r type) r))
-              (let ((lo (car type-args))
-                    (hi (cadr type-args))
-                    lo= hi=)
-                (cond
-                 ((consp lo) nil)
-                 ((member lo '(* nil))
-                  (setq lo nil)
-                  (setq lo= nil))
-                 (t
-                  (assert (typep lo 'rational))
-                  (setq lo= t)))
-                (cond
-                 ((consp hi) nil)
-                 ((member hi '(* nil))
-                  (setq hi nil)
-                  (setq hi= nil))
-                 (t
-                  (assert (typep hi 'rational))
-                  (setq hi= t)))
-                (assert (or (null lo) (null hi) (<= lo hi)))
-                (assert (or (null lo) (null hi) (< lo hi) (and lo= hi=)))
-                (cond
-                 ((null lo)
-                  (cond
-                   ((null hi) (make-random-rational))
-                   (hi= (- hi (make-random-nonnegative-rational)))
-                   (t (- hi (make-random-positive-rational)))))
-                 ((null hi)
-                  (cond
-                   (lo= (+ lo (make-random-nonnegative-rational)))
-                   (t (+ lo (make-random-positive-rational)))))
-                 (t
-                  (+ lo (make-random-bounded-rational (- hi lo) lo= hi=))))))))
-
-  (:method ((type-op (eql 'ratio)) type-args)
-           (let ((r 0))
-             (loop
-              do (setq r (make-random-element-of-compound-type 'rational type-args))
-              while (integerp r))
-             r))
-
-  (:method ((type-op (eql 'real)) type-args)
-           (rcase
-            (1 (let ((lo (and (numberp (car type-args))
-                              (rational (car type-args))))
-                     (hi (and (numberp (cadr type-args))
-                              (rational (cadr type-args)))))
-                 (make-random-element-of-compound-type 'rational
-                                                       `(,(or lo '*)
-                                                         ,(or hi '*)))))
-            (1 (make-random-element-of-compound-type 'float
-                                                     `(,(or (car type-args) '*)
-                                                       ,(or (cadr type-args) '*))))))
-
-  (:method ((type-op (eql 'float)) type-args)
-           (let* ((new-type-op (random-from-seq #(single-float double-float long-float short-float)))
-                  (lo (car type-args))
-                  (hi (cadr type-args))
-                  (most-neg (most-negative-float new-type-op))
-                  (most-pos (most-positive-float new-type-op)))
-             (cond
-              ((or (and (realp lo) (< lo most-neg))
-                   (and (realp hi) (> hi most-pos)))
-               ;; try again
-               (make-random-element-of-compound-type type-op type-args))
-              (t
-               (when (and (realp lo) (not (typep lo new-type-op)))
-                 (cond
-                  ((< lo most-neg) (setq lo '*))
-                  (t (setq lo (coerce lo new-type-op)))))
-               (when (and (realp hi) (not (typep hi new-type-op)))
-                 (cond
-                  ((> hi most-pos) (setq hi '*))
-                  (t (setq hi (coerce hi new-type-op)))))
-               (make-random-element-of-compound-type new-type-op `(,(or lo '*) ,(or hi '*)))))))
-
-  (:method ((type-op (eql 'short-float)) type-args)
-           (assert (<= (length type-args) 2))
-           (apply #'make-random-element-of-float-type type-op type-args))
-  (:method ((type-op (eql 'single-float)) type-args)
-           (assert (<= (length type-args) 2))
-           (apply #'make-random-element-of-float-type type-op type-args))
-  (:method ((type-op (eql 'double-float)) type-args)
-           (assert (<= (length type-args) 2))
-           (apply #'make-random-element-of-float-type type-op type-args))
-  (:method ((type-op (eql 'long-float)) type-args)
-           (assert (<= (length type-args) 2))
-           (apply #'make-random-element-of-float-type type-op type-args))
-
-  (:method ((type-op (eql 'mod)) type-args)
-           (let ((modulus (second type-args)))
-             (assert (integerp modulus))
-             (assert (plusp modulus))
-             (make-random-element-of-compound-type 'integer `(0 (,modulus)))))
-
-  (:method ((type-op (eql 'unsigned-byte)) type-args)
-           (assert (<= (length type-args) 1))
-           (if (null type-args)
-               (make-random-element-of-type '(integer 0 *))
-             (let ((bits (first type-args)))
-               (if (eq bits '*)
-                   (make-random-element-of-type '(integer 0 *))
-                 (progn
-                   (assert (and (integerp bits) (>= bits 1)))
-                   (make-random-element-of-type
-                    `(integer 0 ,(1- (ash 1 bits)))))))))
-
-  (:method ((type-op (eql 'signed-byte)) type-args)
-           (assert (<= (length type-args) 1))
-           (if (null type-args)
-               (make-random-element-of-type 'integer)
-             (let ((bits (car type-args)))
-               (if (eq bits'*)
-                   (make-random-element-of-type 'integer)
-                 (progn
-                   (assert (and (integerp bits) (>= bits 1)))
-                   (make-random-element-of-type
-                    `(integer ,(- (ash 1 (1- bits))) ,(1- (ash 1 (1- bits))))))))))
-
-  (:method ((type-op (eql 'eql)) type-args)
-           (assert (= (length type-args) 1))
-           (car type-args))
-
-  (:method ((type-op (eql 'member)) type-args)
-           (assert type-args)
-           (random-from-seq type-args))
-
-  (:method ((type-op (eql 'vector)) type-args)
-           (assert (<= (length type-args) 2))
-           (let ((etype-spec (if type-args (car type-args) '*))
-                 (size-spec (if (cdr type-args) (cadr type-args) '*)))
-             (make-random-vector etype-spec size-spec)))
-
-  (:method ((type-op (eql 'aimple-vector)) type-args)
-           (assert (<= (length type-args) 1))
-           (let ((size-spec (if type-args (car type-args) '*)))
-             (make-random-vector t size-spec :simple t)))
-
-  (:method ((type-op (eql 'array)) type-args)
-           (assert (<= (length type-args) 2))
-           (let ((etype-spec (if type-args (car type-args) '*))
-                 (size-spec (if (cdr type-args) (cadr type-args) '*)))
-             (make-random-array etype-spec size-spec)))
-
-  (:method ((type-op (eql 'simple-array)) type-args)
-           (assert (<= (length type-args) 2))
-           (let ((etype-spec (if type-args (car type-args) '*))
-                 (size-spec (if (cdr type-args) (cadr type-args) '*)))
-             (make-random-array etype-spec size-spec :simple t)))
-
-  (:method ((type-op (eql 'string)) type-args)
-           (assert (<= (length type-args) 1))
-           (let ((size-spec (if type-args (car type-args) '*)))
-             (make-random-string size-spec)))
-
-  (:method ((type-op (eql 'simple-string)) type-args)
-           (assert (<= (length type-args) 1))
-           (let ((size-spec (if type-args (car type-args) '*)))
-             (make-random-string size-spec :simple t)))
-
-  (:method ((type-op (eql 'base-string)) type-args)
-           (assert (<= (length type-args) 1))
-           (let ((size-spec (if type-args (car type-args) '*)))
-             (make-random-vector 'base-char size-spec)))
-
-  (:method ((type-op (eql 'simple-base-string)) type-args)
-           (assert (<= (length type-args) 1))
-           (let ((size-spec (if type-args (car type-args) '*)))
-             (make-random-vector 'base-char size-spec :simple t)))
-
-  (:method ((type-op (eql 'bit-vector)) type-args)
-           (assert (<= (length type-args) 1))
-           (let ((size-spec (if type-args (car type-args) '*)))
-             (make-random-vector 'bit size-spec)))
-
-  (:method ((type-op (eql 'simple-bit-vector)) type-args)
-           (assert (<= (length type-args) 1))
-           (let ((size-spec (if type-args (car type-args) '*)))
-             (make-random-vector 'bit size-spec :simple t)))
-
-  (:method ((type-op (eql 'cons)) type-args)
-           (assert (<= (length type-args) 2))
-           (cons (make-random-element-of-type (if type-args (car type-args) t))
-                 (make-random-element-of-type (if (cdr type-args) (cadr type-args) t))))
-
-  (:method ((type-op (eql 'complex)) type-args)
-           (cond
-            ((null type-args)
-             (make-random-element-of-type 'complex))
-            (t
-             (assert (null (cdr type-args)))
-             (let ((etype (car type-args)))
-               (loop for v1 = (make-random-element-of-type etype)
-                     for v2 = (make-random-element-of-type etype)
-                     for c = (complex v1 v2)
-                     when (typep c (cons 'complex type-args))
-                     return c)))))
-  )
-
-(defmethod make-random-element-of-type ((type cons))
-  (make-random-element-of-compound-type (car type) (cdr type)))
-
-(defun make-random-element-of-float-type (type-op &optional lo hi)
-  (let (lo= hi=)
-    (cond
-     ((consp lo) nil)
-     ((member lo '(* nil))
-      (setq lo (most-negative-float type-op))
-      (setq lo= t))
-     (t
-      (assert (typep lo type-op))
-      (setq lo= t)))
-    (cond
-     ((consp hi) nil)
-     ((member hi '(* nil))
-      (setq hi (most-positive-float type-op))
-      (setq hi= t))
-     (t
-      (assert (typep hi type-op))
-      (setq hi= t)))
-    (assert (<= lo hi))
-    (assert (or (< lo hi) (and lo= hi=)))
-    (let ((limit 100000))
-      (cond
-       ((or (<= hi 0)
-            (>= lo 0)
-            (and (<= (- limit) hi limit) (<= (- limit) lo limit)))
-        (loop for x = (+ (random (- hi lo)) lo)
-              do (when (or lo= (/= x lo)) (return x))))
-       (t
-        (rcase
-         (1 (random (min hi (float limit hi))))
-         (1 (- (random (min (float limit lo) (- lo)))))))))))
-
-#|
-(defmethod make-random-element-of-type ((type cons))
-  (let ((type-op (first type)))
-    (ecase type-op
-      (or
-       (assert (cdr type))
-       (make-random-element-of-type (random-from-seq (cdr type))))
-      (and
-       (assert (cdr type))
-       (loop for x = (make-random-element-of-type (cadr type))
-             repeat 100
-             when (typep x (cons 'and (cddr type)))
-             return x
-             finally (error "Cannot generate random element of ~A" type)))
-      (not
-       (assert (cdr type))
-       (assert (not (cddr type)))
-       (make-random-element-of-type `(and t ,type)))
-      (integer
-       (let ((lo (let ((lo (cadr type)))
-                   (cond
-                    ((consp lo) (1+ (car lo)))
-                    ((eq lo nil) '*)
-                    (t lo))))
-             (hi (let ((hi (caddr type)))
-                   (cond
-                    ((consp hi) (1- (car hi)))
-                    ((eq hi nil) '*)
-                    (t hi)))))
-         (if (eq lo '*)
-             (if (eq hi '*)
-                 (let ((x (ash 1 (random *maximum-random-int-bits*))))
-                   (random-from-interval x (- x)))
-               (random-from-interval (1+ hi)
-                                     (- hi (random (ash 1 *maximum-random-int-bits*)))))
-
-           (if (eq hi '*)
-               (random-from-interval (+ lo (random (ash 1 *maximum-random-int-bits*)) 1)
-                                     lo)
-             ;; May generalize the next case to increase odds
-             ;; of certain integers (near 0, near endpoints, near
-             ;; powers of 2...)
-             (random-from-interval (1+ hi) lo)))))
-
-      (rational
-       (or
-        (let ((r (make-random-element-of-type 'rational)))
-          (and (typep r type) r))
-        (let ((lo (cadr type))
-              (hi (caddr type))
-              lo= hi=)
-          (cond
-           ((consp lo) nil)
-           ((member lo '(* nil))
-            (setq lo nil)
-            (setq lo= nil))
-           (t
-            (assert (typep lo 'rational))
-            (setq lo= t)))
-          (cond
-           ((consp hi) nil)
-           ((member hi '(* nil))
-            (setq hi nil)
-            (setq hi= nil))
-           (t
-            (assert (typep hi 'rational))
-            (setq hi= t)))
-          (assert (or (null lo) (null hi) (<= lo hi)))
-          (assert (or (null lo) (null hi) (< lo hi) (and lo= hi=)))
-          (cond
-           ((null lo)
-            (cond
-             ((null hi) (make-random-rational))
-             (hi= (- hi (make-random-nonnegative-rational)))
-             (t (- hi (make-random-positive-rational)))))
-           ((null hi)
-            (cond
-             (lo= (+ lo (make-random-nonnegative-rational)))
-             (t (+ lo (make-random-positive-rational)))))
-           (t
-            (+ lo (make-random-bounded-rational (- hi lo) lo= hi=)))))))
-
-      (ratio
-       (let ((r 0))
-         (loop
-          do (setq r (make-random-element-of-type `(rational ,@(cdr type))))
-          while (integerp r))
-         r))
-
-      (real
-       (rcase
-        (1 (let ((lo (and (numberp (cadr type))
-                          (rational (cadr type))))
-                 (hi (and (numberp (caddr type))
-                          (rational (caddr type)))))
-             (make-random-element-of-type `(rational ,(or lo '*)
-                                                     ,(or hi '*)))))
-        (1 (make-random-element-of-type `(float ,(or (cadr type) '*)
-                                                ,(or (caddr type) '*))))))
-
-      ((float)
-       (let* ((new-type-op (random-from-seq #(single-float double-float
-                                                           long-float short-float)))
-              (lo (cadr type))
-              (hi (caddr type))
-              (most-neg (most-negative-float new-type-op))
-              (most-pos (most-positive-float new-type-op)))
-         (cond
-          ((or (and (realp lo) (< lo most-neg))
-               (and (realp hi) (> hi most-pos)))
-           ;; try again
-           (make-random-element-of-type type))
-          (t
-           (when (and (realp lo) (not (typep lo new-type-op)))
-             (cond
-              ((< lo most-neg) (setq lo '*))
-              (t (setq lo (coerce lo new-type-op)))))
-           (when (and (realp hi) (not (typep hi new-type-op)))
-             (cond
-              ((> hi most-pos) (setq hi '*))
-              (t (setq hi (coerce hi new-type-op)))))
-           (make-random-element-of-type
-            `(,new-type-op ,(or lo '*) ,(or hi '*)))))))
-
-      ((single-float double-float long-float short-float)
-       (let ((lo (cadr type))
-             (hi (caddr type))
-             lo= hi=)
-         (cond
-          ((consp lo) nil)
-          ((member lo '(* nil))
-           (setq lo (most-negative-float type-op))
-           (setq lo= t))
-          (t
-           (assert (typep lo type-op))
-           (setq lo= t)))
-         (cond
-          ((consp hi) nil)
-          ((member hi '(* nil))
-           (setq hi (most-positive-float type-op))
-           (setq hi= t))
-          (t
-           (assert (typep hi type-op))
-           (setq hi= t)))
-         (assert (<= lo hi))
-         (assert (or (< lo hi) (and lo= hi=)))
-         (let ((limit 100000))
-           (cond
-            ((or (<= hi 0)
-                 (>= lo 0)
-                 (and (<= (- limit) hi limit) (<= (- limit) lo limit)))
-             (loop for x = (+ (random (- hi lo)) lo)
-                   do (when (or lo= (/= x lo)) (return x))))
-            (t
-             (rcase
-              (1 (random (min hi (float limit hi))))
-              (1 (- (random (min (float limit lo) (- lo)))))))))))
-
-      (mod
-       (let ((modulus (second type)))
-         (assert (and (integerp modulus)
-                      (plusp modulus)))
-         (make-random-element-of-type `(integer 0 (,modulus)))))
-      (unsigned-byte
-       (if (null (cdr type))
-           (make-random-element-of-type '(integer 0 *))
-         (let ((bits (second type)))
-           (if (eq bits'*)
-               (make-random-element-of-type '(integer 0 *))
-             (progn
-               (assert (and (integerp bits) (>= bits 1)))
-               (make-random-element-of-type
-                `(integer 0 ,(1- (ash 1 bits)))))))))
-      (signed-byte
-       (if (null (cdr type))
-           (make-random-element-of-type 'integer)
-         (let ((bits (second type)))
-           (if (eq bits'*)
-               (make-random-element-of-type 'integer)
-             (progn
-               (assert (and (integerp bits) (>= bits 1)))
-               (make-random-element-of-type
-                `(integer ,(- (ash 1 (1- bits))) ,(1- (ash 1 (1- bits))))))))))
-      (eql
-       (assert (= (length type) 2))
-       (cadr type))
-      (member
-       (assert (cdr type))
-       (random-from-seq (cdr type)))
-      ((vector)
-       (let ((etype-spec (if (cdr type) (cadr type) '*))
-             (size-spec (if (cddr type) (caddr type) '*)))
-         (make-random-vector etype-spec size-spec)))
-      ((simple-vector)
-       (let ((size-spec (if (cdr type) (cadr type) '*)))
-         (make-random-vector t size-spec :simple t)))
-      ((array simple-array)
-       (let ((etype-spec (if (cdr type) (cadr type) '*))
-             (size-spec (if (cddr type) (caddr type) '*)))
-         (make-random-array etype-spec size-spec :simple (eql (car type) 'simple-array))))
-      ((string simple-string)
-       (let ((size-spec (if (cdr type) (cadr type) '*)))
-         (make-random-string size-spec :simple (eql (car type) 'simple-string))))
-      ((base-string simple-base-string)
-       (let ((size-spec (if (cdr type) (cadr type) '*)))
-         (make-random-vector 'base-char size-spec :simple (eql (car type) 'simple-base-string))))
-      ((bit-vector simple-bit-vector)
-       (let ((size-spec (if (cdr type) (cadr type) '*)))
-         (make-random-vector 'bit size-spec :simple (eql (car type) 'simple-bit-vector))))
-      ((cons)
-       (cons (make-random-element-of-type (if (cdr type) (cadr type) t))
-             (make-random-element-of-type (if (cddr type) (caddr type) t))))
-      ((complex)
-       (cond
-        ((null (cdr type))
-         (make-random-element-of-type 'complex))
-        (t
-         (assert (null (cddr type)))
-         (let ((etype (cadr type)))
-           (loop for v1 = (make-random-element-of-type etype)
-                 for v2 = (make-random-element-of-type etype)
-                 for c = (complex v1 v2)
-                 when (typep c type)
-                 return c)))))
-      )))
-|#
-
-(defmethod make-random-element-of-type ((type class))
-  (make-random-element-of-type (class-name type)))
-
-(defmethod make-random-element-of-type ((type (eql 'bit))) (random 2))
-(defmethod make-random-element-of-type ((type (eql 'boolean)))
-  (random-from-seq #(nil t)))
-(defmethod make-random-element-of-type ((type (eql 'symbol)))
-  (random-from-seq #(nil t a b c :a :b :c |z| foo |foo| car)))
-(defmethod make-random-element-of-type ((type (eql 'keyword)))
-  (random-from-seq #(:a :b :c :d :e :f :g :h :i :j)))
-(defmethod make-random-element-of-type ((type (eql 'unsigned-byte)))
-  (random-from-interval (1+ (ash 1 (random *maximum-random-int-bits*))) 0))
-(defmethod make-random-element-of-type ((type (eql 'signed-byte)))
-  (random-from-interval
-   (1+ (ash 1 (random *maximum-random-int-bits*)))
-   (- (ash 1 (random *maximum-random-int-bits*)))))
-(defmethod make-random-element-of-type ((type (eql 'rational)))
-  (make-random-rational))
-(defmethod make-random-element-of-type ((type (eql 'ratio)))
-  (let ((r 0))
-    (loop do (setq r (make-random-element-of-type 'rational))
-          while (integerp r))
-    r))
-(defmethod make-random-element-of-type ((type (eql 'integer)))
-  (let ((x (ash 1 (random *maximum-random-int-bits*))))
-    (random-from-interval (1+ x) (- x))))
-(defmethod make-random-element-of-type ((type (eql 'float)))
-  (make-random-element-of-type
-   (random-from-seq #(short-float single-float double-float long-float))))
-(defmethod make-random-element-of-type ((type (eql 'real)))
-  (make-random-element-of-type (random-from-seq #(integer rational float))))
-(defmethod make-random-element-of-type ((type (eql 'number)))
-  (make-random-element-of-type (random-from-seq #(integer rational float #-ecl complex))))
-(defmethod make-random-element-of-type ((type (eql 'bit-vector)))
-  (make-random-vector 'bit '*))
-(defmethod make-random-element-of-type ((type (eql 'simple-bit-vector)))
-  (make-random-vector 'bit '* :simple t))
-(defmethod make-random-element-of-type ((type (eql 'vector)))
-  (make-random-vector '* '*))
-(defmethod make-random-element-of-type ((type (eql 'simple-vector)))
-  (make-random-vector 't '* :simple t))
-(defmethod make-random-element-of-type ((type (eql 'array)))
-  (make-random-array '* '*))
-(defmethod make-random-element-of-type ((type (eql 'simple-array)))
-  (make-random-array '* '* :simple t))
-(defmethod make-random-element-of-type ((type (eql 'string)))
-  (make-random-string '*))
-(defmethod make-random-element-of-type ((type (eql 'simple-string)))
-  (make-random-string '* :simple t))
-(defmethod make-random-element-of-type ((type (eql 'base-string)))
-  (make-random-vector 'base-char '*))
-(defmethod make-random-element-of-type ((type (eql 'simple-base-string)))
-  (make-random-vector 'base-char '* :simple t))
-(defmethod make-random-element-of-type ((type (eql 'character)))
-  (make-random-character))
-(defmethod make-random-element-of-type ((type (eql 'extended-char)))
-  (loop for x = (make-random-character)
-        when (typep x 'extended-char) return x))
-(defmethod make-random-element-of-type ((type (eql 'null))) nil)
-(defmethod make-random-element-of-type ((type (eql 'fixnum)))
-  (random-from-interval (1+ most-positive-fixnum) most-negative-fixnum))
-(defmethod make-random-element-of-type ((type (eql 'complex)))
-  (make-random-element-of-type '(complex real)))
-(defmethod make-random-element-of-type ((type (eql 'cons)))
-  (make-random-element-of-type '(cons t t)))
-(defmethod make-random-element-of-type ((type (eql 'list)))
-  ;; Should modify this to allow non-proper lists?
-  (let ((len (min (random 10) (random 10))))
-    (loop repeat len collect (make-random-element-of-type t))))
-(defmethod make-random-element-of-type ((type (eql 'sequence)))
-  (make-random-element-of-type '(or list vector)))
-(defmethod make-random-element-of-type ((type (eql 'function)))
-  (rcase
-   (5 (symbol-function (random-from-seq *cl-function-symbols*)))
-   (5 (symbol-function (random-from-seq *cl-accessor-symbols*)))
-   (1 #'(lambda (x) (cons x x)))
-   (1 (eval '#'(lambda (x) (cons x x))))))
-
-(defmethod make-random-element-of-type ((type symbol))
-  (case type
-   ((single-float short-float double-float long-float)
-    (make-random-element-of-type (list type)))
-   ((base-char standard-char)
-    (random-from-seq +standard-chars+))
-   ;; Default
-   ((atom t *) (make-random-element-of-type
-                (random-from-seq #(real symbol boolean integer unsigned-byte
-                                        #-ecl complex character
-                                        (string 1) (bit-vector 1)))))
-   (t (call-next-method type))
-   ))
-
-(defun make-random-character ()
-  (loop
-   when (rcase
-         (3 (random-from-seq +standard-chars+))
-         (3 (code-char (random (min 256 char-code-limit))))
-         (1 (code-char (random (min (ash 1 16) char-code-limit))))
-         (1 (code-char (random (min (ash 1 24) char-code-limit))))
-         (1 (code-char (random char-code-limit))))
-   return it))
-
-(defun make-random-array-element-type ()
-  ;; Create random types for array elements
-  (let ((bits 40))
-    (rcase
-     (2 t)
-     (1 'symbol)
-     (1 `(unsigned-byte ,(1+ (random bits))))
-     (1 `(signed-byte ,(1+ (random bits))))
-     (1 'character)
-     (1 'base-char)
-     (1 'bit)
-     (1 (random-from-seq #(short-float single-float double-float long-float))))))
-
-(defun make-random-vector (etype-spec size-spec &key simple)
-  (let* ((etype (if (eql etype-spec '*)
-                    (make-random-array-element-type)
-                  etype-spec))
-         (size (if (eql size-spec '*)
-                   (random (ash 1 (+ 2 (random 8))))
-                 size-spec))
-         (displaced? (and (not simple) (coin 4)))
-         (displaced-size (+ size (random (max 6 size))))
-         (displacement (random (1+ (- displaced-size size))))
-         (adjustable (and (not simple) (coin 3)))
-         (fill-pointer (and (not simple)
-                            (rcase (3 nil) (1 t) (1 (random (1+ size)))))))
-    (assert (<= size 1000000))
-    (if displaced?
-        (let ((displaced-vector (make-array displaced-size :element-type etype
-                                            :initial-contents (loop repeat displaced-size
-                                                                    collect (make-random-element-of-type etype)))))
-          (make-array size :element-type etype :adjustable adjustable
-                      :fill-pointer fill-pointer
-                      :displaced-to displaced-vector
-                      :displaced-index-offset displacement))
-      (make-array size
-                  :element-type etype
-                  :initial-contents (loop repeat size
-                                          collect (make-random-element-of-type etype))
-                  :adjustable adjustable
-                  :fill-pointer fill-pointer
-                  ))))
-
-(defun make-random-array (etype-spec dim-specs &key simple)
-  (when (eql dim-specs '*)
-    (setq dim-specs (random 10)))
-  (when (numberp dim-specs)
-    (setq dim-specs (make-list dim-specs :initial-element '*)))
-  (let* ((etype (if (eql etype-spec '*) t etype-spec))
-         (rank (length dim-specs))
-         (dims (loop for dim in dim-specs
-                     collect (if (eql dim '*)
-                                 (1+ (random (ash 1 (floor 9 rank))))
-                               dim))))
-    (assert (<= (reduce '* dims :initial-value 1) 1000000))
-    (assert (<= (reduce 'max dims :initial-value 1) 1000000))
-    (make-array dims
-                :element-type etype
-                :initial-contents
-                (labels ((%init (dims)
-                                (if (null dims)
-                                    (make-random-element-of-type etype)
-                                  (loop repeat (car dims)
-                                        collect (%init (cdr dims))))))
-                  (%init dims))
-                :adjustable (and (not simple) (coin))
-                ;; Do displacements later
-                )))
-
-(defun most-negative-float (float-type-symbol)
-  (ecase float-type-symbol
-    (short-float most-negative-short-float)
-    (single-float most-negative-single-float)
-    (double-float most-negative-double-float)
-    (long-float most-negative-long-float)
-    (float (min most-negative-short-float most-negative-single-float
-                most-negative-double-float most-negative-long-float))))
-
-(defun most-positive-float (float-type-symbol)
-  (ecase float-type-symbol
-    (short-float most-positive-short-float)
-    (single-float most-positive-single-float)
-    (double-float most-positive-double-float)
-    (long-float most-positive-long-float)
-    (float (max most-positive-short-float most-positive-single-float
-                most-positive-double-float most-positive-long-float))))
-
-(defun make-optimized-lambda-form (form vars var-types opt-decls)
-  `(lambda ,vars
-     ,@(mapcar #'(lambda (tp var) `(declare (type ,tp ,var)))
-               var-types vars)
-     (declare (ignorable ,@vars))
-     #+cmu (declare (optimize (extensions:inhibit-warnings 3)))
-     (declare (optimize ,@opt-decls))
-     ,form))
-
-(defun make-unoptimized-lambda-form (form vars var-types opt-decls)
-  (declare (ignore var-types))
-  `(lambda ,vars
-     (declare (notinline ,@(fn-symbols-in-form form)))
-     #+cmu (declare (optimize (extensions:inhibit-warnings 3)))
-     (declare (optimize ,@opt-decls))
-     ,form))
-
-(defvar *compile-using-defun*
-  #-(or allegro lispworks) nil
-  #+(or allegro lispworks) t)
-
-(defvar *compile-using-defgeneric* nil
-  "If true and *COMPILE-USING-DEFUN* is false, then build a defgeneric form
-   for the function and compile that.")
-
-(defvar *name-to-use-in-optimized-defun* 'dummy-fn-name1)
-(defvar *name-to-use-in-unoptimized-defun* 'dummy-fn-name2)
-
-(defun test-int-form (form vars var-types vals-list opt-decls-1 opt-decls-2)
-  ;; Try to compile FORM with associated VARS, and if it compiles
-  ;; check for equality of the two compiled forms.
-  ;; Return a non-nil list of details if a problem is found,
-  ;; NIL otherwise.
-  (let ((optimized-fn-src (make-optimized-lambda-form form vars var-types opt-decls-1))
-        (unoptimized-fn-src (make-unoptimized-lambda-form form vars var-types opt-decls-2)))
-    (setq *int-form-vals* nil
-          *optimized-fn-src* optimized-fn-src
-          *unoptimized-fn-src* unoptimized-fn-src)
-    (flet ((%compile
-            (lambda-form opt-defun-name)
-            (cl:handler-bind
-             (#+sbcl (sb-ext::compiler-note #'muffle-warning)
-                     (warning #'muffle-warning)
-                     ((or error serious-condition)
-                      #'(lambda (c)
-                                (format t "Compilation failure~%~A~%"
-                                        (format nil "~S" form))
-                                (finish-output *standard-output*)
-                                (return-from test-int-form
-                                  (list (list :vars vars
-                                              :form form
-                                              :var-types var-types
-                                              :vals (first vals-list)
-                                              :lambda-form lambda-form
-                                              :decls1 opt-decls-1
-                                              :decls2 opt-decls-2
-                                              :compiler-condition
-                                              (with-output-to-string
-                                                (s)
-                                                (prin1 c s))))))))
-             (let ((start-time (get-universal-time))
-                   (clf (cdr lambda-form)))
-               (prog1
-                   (cond
-                    (*compile-using-defun*
-                     (fmakunbound opt-defun-name)
-                     (eval `(defun ,opt-defun-name ,@clf))
-                     (compile opt-defun-name)
-                     (symbol-function opt-defun-name))
-                    (*compile-using-defgeneric*
-                     (fmakunbound opt-defun-name)
-                     (eval `(defgeneric ,opt-defun-name ,(car clf)))
-                     (eval `(defmethod ,opt-defun-name,(mapcar #'(lambda (name) `(,name integer)) (car clf))
-                              ,@(cdr clf)))
-                     (compile opt-defun-name)
-                     (symbol-function opt-defun-name))
-                    (t (compile nil lambda-form)))
-                 (let* ((stop-time (get-universal-time))
-                        (total-time (- stop-time start-time)))
-                   (when (> total-time *max-compile-time*)
-                     (setf *max-compile-time* total-time)
-                     (setf *max-compile-term* lambda-form)))
-                 ;; #+:ecl (si:gc t)
-                 )))))
-      (let ((optimized-compiled-fn (%compile optimized-fn-src
-                                             *name-to-use-in-optimized-defun*))
-            (unoptimized-compiled-fn
-             (if *compile-unoptimized-form*
-                 (%compile unoptimized-fn-src *name-to-use-in-unoptimized-defun*)
-               (eval `(function ,unoptimized-fn-src)))))
-        (declare (type function optimized-compiled-fn unoptimized-compiled-fn))
-        (dolist (vals vals-list)
-          (setq *int-form-vals* vals)
-          (flet ((%eval-error
-                  (kind)
-                  (let ((*print-circle* t))
-                    (format t "~A~%" (format nil "~S" form)))
-                  (finish-output *standard-output*)
-                  (return
-                   (list (list :vars vars
-                               :vals vals
-                               :form form
-                               :var-types var-types
-                               :decls1 opt-decls-1
-                               :decls2 opt-decls-2
-                               :optimized-lambda-form optimized-fn-src
-                               :unoptimized-lambda-form unoptimized-fn-src
-                               :kind kind)))))
-
-            (let ((unopt-result
-                   (cl-handler-case
-                    (cl-handler-bind
-                     (#+sbcl (sb-ext::compiler-note #'muffle-warning)
-                             (warning #'muffle-warning))
-                     (identity ;; multiple-value-list
-                      (apply unoptimized-compiled-fn vals)))
-                    ((or error serious-condition)
-                     (c)
-                     (%eval-error (list :unoptimized-form-error
-                                        (with-output-to-string
-                                          (s) (prin1 c s)))))))
-                  (opt-result
-                   (cl-handler-case
-                    (cl-handler-bind
-                     (#+sbcl (sb-ext::compiler-note #'muffle-warning)
-                             (warning #'muffle-warning))
-                     (identity ;; multiple-value-list
-                      (apply optimized-compiled-fn vals)))
-                    ((or error serious-condition)
-                     (c)
-                     (%eval-error (list :optimized-form-error
-                                        (with-output-to-string
-                                          (s) (prin1 c s))))))))
-              (if (equal opt-result unopt-result)
-                  nil
-                (progn
-                  (format t "Different results: ~A, ~A~%"
-                          opt-result unopt-result)
-                  (setq *opt-result* opt-result
-                        *unopt-result* unopt-result)
-                  (%eval-error (list :different-results
-                                     opt-result
-                                     unopt-result)))))))))))
-
-;;; Interface to the form pruner
-
-(declaim (special *prune-table*))
-
-(defun prune-int-form (input-form vars var-types vals-list opt-decls-1 opt-decls-2)
-  "Conduct tests on selected simplified versions of INPUT-FORM.  Return the
-   minimal form that still causes some kind of failure."
-  (loop do
-        (let ((form input-form))
-          (flet ((%try-fn (new-form)
-                          (when (test-int-form new-form vars var-types vals-list
-                                               opt-decls-1 opt-decls-2)
-                            (setf form new-form)
-                            (throw 'success nil))))
-            (let ((*prune-table* (make-hash-table :test #'eq)))
-              (loop
-               (catch 'success
-                 (prune form #'%try-fn)
-                 (return form)))))
-          (when (equal form input-form) (return form))
-          (setq input-form form))))
-
-(defun prune-results (result-list)
-  "Given a list of test results, prune their forms down to a minimal set."
-  (loop for result in result-list
-        collect
-        (let* ((form (getf result :form))
-               (vars (getf result :vars))
-               (var-types (getf result :var-types))
-               (vals-list (list (getf result :vals)))
-               (opt-decl-1 (getf result :decls1))
-               (opt-decl-2 (getf result :decls2))
-               (pruned-form (prune-int-form form vars var-types vals-list opt-decl-1 opt-decl-2))
-               (optimized-lambda-form (make-optimized-lambda-form
-                                       pruned-form vars var-types opt-decl-1))
-               (unoptimized-lambda-form (make-unoptimized-lambda-form
-                                         pruned-form vars var-types opt-decl-2)))
-            `(:vars ,vars
-              :var-types ,var-types
-              :vals ,(first vals-list)
-              :form ,pruned-form
-              :decls1 ,opt-decl-1
-              :decls2 ,opt-decl-2
-              :optimized-lambda-form ,optimized-lambda-form
-              :unoptimized-lambda-form ,unoptimized-lambda-form))))
-
-;;;
-;;; The call (PRUNE form try-fn) attempts to simplify the lisp form
-;;; so that it still satisfies TRY-FN.  The function TRY-FN should
-;;; return if the substitution is a failure.  Otherwise, it should
-;;; transfer control elsewhere via GO, THROW, etc.
-;;;
-;;; The return value of PRUNE should be ignored.
-;;;
-(defun prune (form try-fn)
-  (declare (type function try-fn))
-  (when (gethash form *prune-table*)
-    (return-from prune nil))
-  (flet ((try (x) (funcall try-fn x)))
-    (cond
-     ((keywordp form) nil)
-     ((integerp form)
-      (unless (zerop form) (try 0)))
-     ((consp form)
-      (let* ((op (car form))
-             (args (cdr form))
-             (nargs (length args)))
-        (case op
-
-         ((quote) nil)
-
-         ((go)
-          (try 0))
-
-         ((signum integer-length logcount
-                  logandc1 logandc2 lognand lognor logorc1 logorc2
-                  realpart imagpart)
-          (try 0)
-          (mapc try-fn args)
-          (prune-fn form try-fn))
-
-         ((make-array)
-          (when (and (eq (car args) nil)
-                     (eq (cadr args) ':initial-element)
-                     ; (null (cdddr args))
-                     )
-            (prune (caddr args) #'(lambda (form) (try `(make-array nil :initial-element ,form . ,(cdddr args)))))
-            (when (cdddr args)
-              (try `(make-array nil :initial-element ,(caddr args))))
-            ))
-
-         ((cons)
-          (prune-fn form try-fn))
-
-         ((dotimes)
-          (try 0)
-          (let* ((binding-form (first args))
-                 (body (rest args))
-                 (var (first binding-form))
-                 (count-form (second binding-form))
-                 (result (third binding-form)))
-            (try result)
-            (unless (eql count-form 0)
-              (try `(dotimes (,var 0 ,result) ,@body)))
-            (prune result #'(lambda (form)
-                              (try `(dotimes (,var ,count-form ,form) ,@body))))
-            (when (= (length body) 1)
-              (prune (first body)
-                     #'(lambda (form)
-                         (when (consp form)
-                           (try `(dotimes (,var ,count-form ,result) ,form))))))))
-
-         ((abs 1+ 1-)
-          (try 0)
-          (mapc try-fn args)
-          (prune-fn form try-fn))
-
-         ((identity  ignore-errors cl:handler-case restart-case locally)
-          (unless (and (consp args)
-                       (consp (car args))
-                       (eql (caar args) 'tagbody))
-            (mapc try-fn args))
-          (prune-fn form try-fn))
-
-         ((boole)
-          (try (second args))
-          (try (third args))
-          (prune (second args)
-                 #'(lambda (form) (try `(boole ,(first args) ,form ,(third args)))))
-          (prune (third args)
-                 #'(lambda (form) (try `(boole ,(first args) ,(second args) ,form)))))
-
-         ((unwind-protect prog1 multiple-value-prog1)
-          (try (first args))
-          (let ((val (first args))
-                (rest (rest args)))
-            (when rest
-              (try `(unwind-protect ,val))
-              (when (cdr rest)
-                (loop for i from 0 below (length rest)
-                      do
-                      (try `(unwind-protect ,val
-                              ,@(subseq rest 0 i)
-                              ,@(subseq rest (1+ i))))))))
-          (prune-fn form try-fn))
-
-         ((prog2)
-          (assert (>= (length args) 2))
-          (let ((val1 (first args))
-                (arg2 (second args))
-                (rest (cddr args)))
-            (try arg2)
-            (prune-fn form try-fn)
-            (when rest
-              (try `(prog2 ,val1 ,arg2))
-              (when (cdr rest)
-                (loop for i from 0 below (length rest)
-                      do
-                      (try `(prog2 ,val1 ,arg2
-                              ,@(subseq rest 0 i)
-                              ,@(subseq rest (1+ i)))))))))
-
-         ((typep)
-          (try (car args))
-          (prune (car args)
-                 #'(lambda (form) `(,op ,form ,@(cdr args)))))
-
-         ((load-time-value)
-          (let ((arg (first args)))
-            (try arg)
-            (cond
-             ((cdr args)
-              (try `(load-time-value ,arg))
-              (prune arg
-                     #'(lambda (form)
-                         (try `(load-time-value ,form ,(second args))))))
-             (t
-              (prune arg
-                     #'(lambda (form)
-                         (try `(load-time-value ,form))))))))
-
-         ((eval)
-          (try 0)
-          (let ((arg (first args)))
-            (cond
-             ((consp arg)
-              (cond
-               ((eql (car arg) 'quote)
-                (prune (cadr arg) #'(lambda (form) (try `(eval ',form)))))
-               (t
-                (try arg)
-                (prune arg #'(lambda (form) `(eval ,form))))))
-             (t (try arg)))))
-
-         ((the macrolet cl:handler-bind restart-bind)
-          (assert (= (length args) 2))
-          (try (second args))
-          (prune (second args) try-fn))
-
-         ((not eq eql equal)
-          (when (every #'constantp args)
-            (try (eval form)))
-          (try t)
-          (try nil)
-          (mapc try-fn args)
-          (prune-fn form try-fn)
-          )
-
-         ((and or = < > <= >= /=)
-          (when (every #'constantp args)
-            (try (eval form)))
-          (try t)
-          (try nil)
-          (mapc try-fn args)
-          (prune-nary-fn form try-fn)
-          (prune-fn form try-fn))
-
-         ((- + * min max logand logior logxor logeqv gcd lcm values)
-          (when (every #'constantp args)
-            (try (eval form)))
-          (try 0)
-          (mapc try-fn args)
-          (prune-nary-fn form try-fn)
-          (prune-fn form try-fn))
-
-         ((/)
-          (when (every #'constantp args)
-            (try (eval form)))
-          (try 0)
-          (try (car args))
-          (when (cddr args)
-            (prune (car args) #'(lambda (form) (try `(/ ,form ,(second args)))))))
-
-         ((expt rationalize rational numberator denominator)
-          (try 0)
-          (mapc try-fn args)
-          (prune-fn form try-fn))
-
-         ((coerce)
-          (try 0)
-          (try (car args))
-          (prune (car args) #'(lambda (form) (try `(coerce ,form ,(cadr args))))))
-
-
-         ((multiple-value-call)
-          ;; Simplify usual case
-          (when (= nargs 2)
-            (destructuring-bind (arg1 arg2) args
-              (when (and (consp arg1) (consp arg2)
-                         (eql (first arg1) 'function)
-                         (eql (first arg2) 'values))
-                (mapc try-fn (rest arg2))
-                (let ((fn (second arg1)))
-                  (when (symbolp fn)
-                    (try `(,fn ,@(rest arg2)))))
-                ;; Prune the VALUES form
-                (prune-list (rest arg2)
-                            #'prune
-                            #'(lambda (args)
-                                (try `(multiple-value-call ,arg1 (values ,@args)))))
-                )))
-          (mapc try-fn (rest args)))
-
-         ((bit sbit elt aref svref)
-          (try 0)
-          (when (= (length args) 2)
-            (let ((arg1 (car args))
-                  (arg2 (cadr args)))
-              (when (and (consp arg2)
-                         (eql (car arg2) 'min)
-                         (integerp (cadr arg2)))
-                (let ((arg2.2 (caddr arg2)))
-                  (try arg2.2)
-                  (when (and (consp arg2.2)
-                             (eql (car arg2.2) 'max)
-                             (integerp (cadr arg2.2)))
-                    (prune (caddr arg2.2)
-                           #'(lambda (form)
-                               (try `(,op ,arg1 (min ,(cadr arg2)
-                                                     (max ,(cadr arg2.2) ,form))))))))))))
-
-         ((car cdr)
-          (try 0)
-          (try 1))
-
-         ((if)
-          (let (;; (pred (first args))
-                (then (second args))
-                (else (third args)))
-            (try then)
-            (try else)
-            (when (every #'constantp args)
-              (try (eval form)))
-            (prune-fn form try-fn)))
-
-         ((incf decf)
-          (try 0)
-          (assert (member (length form) '(2 3)))
-          (try (first args))
-          (when (> (length args) 1)
-            (try (second args))
-            (try `(,op ,(first args)))
-            (unless (integerp (second args))
-              (prune (second args)
-                     #'(lambda (form)
-                         (try `(,op ,(first args) ,form)))))))
-
-         ((setq setf shiftf)
-          (try 0)
-          ;; Assumes only one assignment
-          (assert (= (length form) 3))
-          (try (first args))
-          (try (second args))
-          (unless (integerp (second args))
-            (prune (second args)
-                   #'(lambda (form)
-                       (try `(,op ,(first args) ,form))))))
-
-         ((rotatef)
-          (try 0)
-          (mapc try-fn (cdr form)))
-
-         ((multiple-value-setq)
-          (try 0)
-          ;; Assumes only one assignment, and one variable
-          (assert (= (length form) 3))
-          (assert (= (length (first args)) 1))
-          (try `(setq ,(caar args) ,(cadr args)))
-          (unless (integerp (second args))
-            (prune (second args)
-                   #'(lambda (form)
-                       (try `(,op ,(first args) ,form))))))
-
-         ((byte)
-          (prune-fn form try-fn))
-
-         ((deposit-field dpb)
-          (try 0)
-          (destructuring-bind (a1 a2 a3)
-              args
-            (try a1)
-            (try a3)
-            (when (and (integerp a1)
-                       (integerp a3)
-                       (and (consp a2)
-                            (eq (first a2) 'byte)
-                            (integerp (second a2))
-                            (integerp (third a2))))
-              (try (eval form))))
-          (prune-fn form try-fn))
-
-         ((ldb mask-field)
-          (try 0)
-          (try (second args))
-          (when (and (consp (first args))
-                     (eq 'byte (first (first args)))
-                     (every #'numberp (cdr (first args)))
-                     (numberp (second args)))
-            (try (eval form)))
-          (prune-fn form try-fn))
-
-         ((ldb-test)
-          (try t)
-          (try nil)
-          (prune-fn form try-fn))
-
-         ((let let*)
-          (prune-let form try-fn))
-
-         ((multiple-value-bind)
-          (assert (= (length args) 3))
-          (let ((arg1 (first args))
-                (arg2 (second args))
-                (body (caddr args)))
-            (when (= (length arg1) 1)
-              (try `(let ((,(first arg1) ,arg2)) ,body)))
-            (prune arg2 #'(lambda (form)
-                            (try `(multiple-value-bind ,arg1 ,form ,body))))
-            (prune body #'(lambda (form)
-                            (try `(multiple-value-bind ,arg1 ,arg2 ,form))))))
-
-         ((block)
-          (let ((name (second form))
-                (body (cddr form)))
-            (when (and body (null (cdr body)))
-              (let ((form1 (first body)))
-
-                ;; Try removing the block entirely if it is not in use
-                (when (not (find-in-tree name body))
-                  (try form1))
-
-                ;; Try removing the block if its only use is an immediately
-                ;; enclosed return-from: (block <n> (return-from <n> <e>))
-                (when (and (consp form1)
-                           (eq (first form1) 'return-from)
-                           (eq (second form1) name)
-                           (not (find-in-tree name (third form1))))
-                  (try (third form1)))
-
-                ;; Otherwise, try to simplify the subexpression
-                (prune form1
-                       #'(lambda (x)
-                           (try `(block ,name ,x))))))))
-
-         ((catch)
-          (let* ((tag (second form))
-                 (name (if (consp tag) (cadr tag) tag))
-                 (body (cddr form)))
-            (when (and body (null (cdr body)))
-              (let ((form1 (first body)))
-
-                ;; Try removing the catch entirely if it is not in use
-                ;; We make assumptions here about what throws can
-                ;; be present.
-                (when (or (not (find-in-tree 'throw body))
-                          (not (find-in-tree name body)))
-                  (try form1))
-
-                ;; Try removing the block if its only use is an immediately
-                ;; enclosed return-from: (block <n> (return-from <n> <e>))
-                (when (and (consp form1)
-                           (eq (first form1) 'throw)
-                           (equal (second form1) name)
-                           (not (find-in-tree name (third form1))))
-                  (try (third form1)))
-
-                ;; Otherwise, try to simplify the subexpression
-                (prune form1
-                       #'(lambda (x)
-                           (try `(catch ,tag ,x))))))))
-
-         ((throw)
-          (try (second args))
-          (prune (second args)
-                 #'(lambda (x) (try `(throw ,(first args) ,x)))))
-
-         ((flet labels)
-          (try 0)
-          (prune-flet form try-fn))
-
-         ((case)
-          (prune-case form try-fn))
-
-         ((isqrt)
-          (let ((arg (second form)))
-            (assert (null (cddr form)))
-            (assert (consp arg))
-            (assert (eq (first arg) 'abs))
-            (let ((arg2 (second arg)))
-              (try arg2)
-              ;; Try to fold
-              (when (integerp arg2)
-                (try (isqrt (abs arg2))))
-              ;; Otherwise, simplify arg2
-              (prune arg2 #'(lambda (form)
-                              (try `(isqrt (abs ,form))))))))
-
-         ((ash)
-          (try 0)
-          (let ((form1 (second form))
-                (form2 (third form)))
-            (try form1)
-            (try form2)
-            (prune form1
-                   #'(lambda (form)
-                       (try `(ash ,form ,form2))))
-            (when (and (consp form2)
-                       (= (length form2) 3))
-              (when (and (integerp form1)
-                         (eq (first form2) 'min)
-                         (every #'integerp (cdr form2)))
-                (try (eval form)))
-              (let ((form3 (third form2)))
-                (prune form3
-                       #'(lambda (form)
-                           (try
-                            `(ash ,form1 (,(first form2) ,(second form2)
-                                          ,form)))))))))
-
-         ((floor ceiling truncate round mod rem)
-          (try 0)
-          (let ((form1 (second form))
-                (form2 (third form)))
-            (try form1)
-            (when (cddr form) (try form2))
-            (prune form1
-                   (if (cddr form)
-                       #'(lambda (form)
-                           (try `(,op ,form ,form2)))
-                     #'(lambda (form) (try `(,op ,form)))))
-            (when (and (consp form2)
-                       (= (length form2) 3))
-              (when (and (integerp form1)
-                         (member (first form2) '(max min))
-                         (every #'integerp (cdr form2)))
-                (try (eval form)))
-              (let ((form3 (third form2)))
-                (prune form3
-                       #'(lambda (form)
-                           (try
-                            `(,op ,form1 (,(first form2) ,(second form2)
-                                          ,form)))))))))
-
-         ((constantly)
-          (unless (eql (car args) 0)
-            (prune (car args)
-                   #'(lambda (arg) (try `(constantly ,arg))))))
-
-         ((funcall)
-          (try 0)
-          (let ((fn (second form))
-                (fn-args (cddr form)))
-            (mapc try-fn fn-args)
-            (unless (equal fn '(constantly 0))
-              (try `(funcall (constantly 0) ,@fn-args)))
-            (when (and (consp fn)
-                       (eql (car fn) 'function)
-                       (symbolp (cadr fn)))
-              (try `(,(cadr fn) ,@fn-args)))
-            (prune-list fn-args
-                        #'prune
-                        #'(lambda (args)
-                            (try `(funcall ,fn ,@args))))))
-
-         ((reduce)
-          (try 0)
-          (let ((arg1 (car args))
-                (arg2 (cadr args))
-                (rest (cddr args)))
-            (when (and ;; (null (cddr args))
-                       (consp arg1)
-                       (eql (car arg1) 'function))
-              (let ((arg1.2 (cadr arg1)))
-                (when (and (consp arg1.2)
-                           (eql (car arg1.2) 'lambda))
-                  (let ((largs (cadr arg1.2))
-                        (body (cddr arg1.2)))
-                    (when (null (cdr body))
-                      (prune (car body)
-                             #'(lambda (bform)
-                                 (try `(reduce (function (lambda ,largs ,bform))
-                                               ,arg2 ,@rest)))))))))
-            (when (consp arg2)
-              (case (car arg2)
-                ((list vector)
-                 (let ((arg2.rest (cdr arg2)))
-                   (mapc try-fn arg2.rest)
-                   (prune-list arg2.rest
-                               #'prune
-                               #'(lambda (args)
-                                   (try `(reduce ,arg1
-                                                 (,(car arg2) ,@args)
-                                                 ,@rest))))))))))
-
-         ((apply)
-          (try 0)
-          (let ((fn (second form))
-                (fn-args (butlast (cddr form)))
-                (list-arg (car (last form))))
-            (mapc try-fn fn-args)
-            (unless (equal fn '(constantly 0))
-              (try `(apply (constantly 0) ,@(cddr form))))
-            (when (and (consp list-arg)
-                       (eq (car list-arg) 'list))
-              (mapc try-fn (cdr list-arg)))
-            (prune-list fn-args
-                        #'prune
-                        #'(lambda (args)
-                            (try `(apply ,fn ,@args ,list-arg))))
-            (when (and (consp list-arg)
-                       (eq (car list-arg) 'list))
-              (try `(apply ,fn ,@fn-args ,@(cdr list-arg) nil))
-              (prune-list (cdr list-arg)
-                        #'prune
-                        #'(lambda (args)
-                            (try `(apply ,fn ,@fn-args
-                                         (list ,@args))))))))
-
-         ((progv)
-          (try 0)
-          (prune-progv form try-fn))
-
-         ((tagbody)
-          (try 0)
-          (prune-tagbody form try-fn))
-
-         ((progn)
-          (when (null args) (try nil))
-          (try (car (last args)))
-          (loop for i from 0 below (1- (length args))
-                for a in args
-                do (try `(progn ,@(subseq args 0 i)
-                                ,@(subseq args (1+ i))))
-                do (when (and (consp a)
-                              (or
-                               (eq (car a) 'progn)
-                               (and (eq (car a) 'tagbody)
-                                    (every #'consp (cdr a)))))
-                     (try `(progn ,@(subseq args 0 i)
-                                  ,@(copy-list (cdr a))
-                                  ,@(subseq args (1+ i))))))
-          (prune-fn form try-fn))
-
-         ((loop)
-          (try 0)
-          (when (and (eql (length args) 6)
-                     (eql (elt args 0) 'for)
-                     (eql (elt args 2) 'below))
-            (let ((var (elt args 1))
-                  (count (elt args 3))
-                  (form (elt args 5)))
-              (unless (eql count 0) (try count))
-              (case (elt args 4)
-                (sum
-                 (try `(let ((,(elt args 1) 0)) ,(elt args 5)))
-                 (prune form #'(lambda (form)
-                                 (try `(loop for ,var below ,count sum ,form)))))
-                (count
-                 (unless (or (eql form t) (eql form nil))
-                   (try `(loop for ,var below ,count count t))
-                   (try `(loop for ,var below ,count count nil))
-                   (prune form
-                          #'(lambda (form)
-                              (try `(loop for ,var below ,count count ,form))))))
-                ))))
-
-         (otherwise
-          (try 0)
-          (prune-fn form try-fn))
-
-         )))))
-  (setf (gethash form *prune-table*) t)
-  nil)
-
-(defun find-in-tree (value tree)
-  "Return true if VALUE is eql to a node in TREE."
-  (or (eql value tree)
-      (and (consp tree)
-           (or (find-in-tree value (car tree))
-               (find-in-tree value (cdr tree))))))
-
-(defun prune-list (list element-prune-fn list-try-fn)
-  (declare (type function element-prune-fn list-try-fn))
-  "Utility function for pruning in a list."
-    (loop for i from 0
-          for e in list
-          do (funcall element-prune-fn
-                      e
-                      #'(lambda (form)
-                          (funcall list-try-fn
-                                   (append (subseq list 0 i)
-                                           (list form)
-                                           (subseq list (1+ i))))))))
-
-(defun prune-case (form try-fn)
-  (declare (type function try-fn))
-  (flet ((try (e) (funcall try-fn e)))
-    (let* ((op (first form))
-           (expr (second form))
-           (cases (cddr form)))
-
-      ;; Try just the top expression
-      (try expr)
-
-      ;; Try simplifying the expr
-      (prune expr
-             #'(lambda (form)
-                 (try `(,op ,form ,@cases))))
-
-      ;; Try individual cases
-      (loop for case in cases
-            do (try (first (last (rest case)))))
-
-      ;; Try deleting individual cases
-      (loop for i from 0 below (1- (length cases))
-            do (try `(,op ,expr
-                          ,@(subseq cases 0 i)
-                          ,@(subseq cases (1+ i)))))
-
-      ;; Try simplifying the cases
-      ;; Assume each case has a single form
-      (prune-list cases
-                  #'(lambda (case try-fn)
-                      (declare (type function try-fn))
-                      (when (and (listp (car case))
-                                 (> (length (car case)) 1))
-                        ;; try removing constants
-                        (loop for i below (length (car case))
-                              do (funcall try-fn
-                                          `((,@(subseq (car case) 0 i)
-                                             ,@(subseq (car case) (1+ i)))
-                                            ,@(cdr case)))))
-                      (when (eql (length case) 2)
-                        (prune (cadr case)
-                               #'(lambda (form)
-                                   (funcall try-fn
-                                            (list (car case) form))))))
-                  #'(lambda (cases)
-                      (try `(,op ,expr ,@cases)))))))
-
-(defun prune-tagbody (form try-fn)
-  (declare (type function try-fn))
-  (let (;; (op (car form))
-        (body (cdr form)))
-    (loop for i from 0
-          for e in body
-          do
-          (cond
-           ((atom e)
-            ;; A tag
-            (unless (find-in-tree e (subseq body 0 i))
-              (funcall try-fn `(tagbody ,@(subseq body 0 i)
-                                        ,@(subseq body (1+ i))))))
-           (t
-            (funcall try-fn
-                     `(tagbody ,@(subseq body 0 i)
-                               ,@(subseq body (1+ i))))
-            (prune e
-                   #'(lambda (form)
-                       ;; Don't put an atom here.
-                       (when (consp form)
-                         (funcall
-                          try-fn
-                          `(tagbody ,@(subseq body 0 i)
-                                    ,form
-                                    ,@(subseq body (1+ i))))))))))))
-
-(defun prune-progv (form try-fn)
-  (declare (type function try-fn))
-  (let (;; (op (car form))
-        (vars-form (cadr form))
-        (vals-form (caddr form))
-        (body-list (cdddr form)))
-    (when (and (null vars-form) (null vals-form))
-      (funcall try-fn `(let () ,@body-list)))
-    (when (and (consp vals-form) (eql (car vals-form) 'list))
-      (when (and (consp vars-form) (eql (car vars-form) 'quote))
-        (let ((vars (cadr vars-form))
-              (vals (cdr vals-form)))
-          (when (eql (length vars) (length vals))
-            (let ((let-form `(let () ,@body-list)))
-              (mapc #'(lambda (var val)
-                        (setq let-form `(let ((,var ,val)) ,let-form)))
-                    vars vals)
-              (funcall try-fn let-form)))
-          ;; Try simplifying the vals forms
-          (prune-list vals
-                      #'prune
-                      #'(lambda (vals)
-                          (funcall try-fn
-                                   `(progv ,vars-form (list ,@vals) ,@body-list)))))))
-    ;; Try simplifying the body
-    (when (eql (length body-list) 1)
-      (prune (car body-list)
-             #'(lambda (form)
-                 (funcall try-fn
-                          `(progv ,vars-form ,vals-form ,form)))))))
-
-(defun prune-nary-fn (form try-fn)
-  ;; Attempt to reduce the number of arguments to the fn
-  ;; Do not reduce below 1
-  (declare (type function try-fn))
-  (let* ((op (car form))
-         (args (cdr form))
-         (nargs (length args)))
-    (when (> nargs 1)
-      (loop for i from 1 to nargs
-            do (funcall try-fn `(,op ,@(subseq args 0 (1- i))
-                                     ,@(subseq args i)))))))
-
-(defun prune-fn (form try-fn)
-  "Attempt to simplify a function call form.  It is considered
-   acceptable to replace the call by one of its argument forms."
-  (declare (type function try-fn))
-  (prune-list (cdr form)
-              #'prune
-              #'(lambda (args)
-                  (funcall try-fn (cons (car form) args)))))
-
-(defun prune-let (form try-fn)
-  "Attempt to simplify a LET form."
-  (declare (type function try-fn))
-  (let* ((op (car form))
-         (binding-list (cadr form))
-         (body (cddr form))
-         (body-len (length body))
-         (len (length binding-list))
-         )
-
-    (when (> body-len 1)
-      (funcall try-fn `(,op ,binding-list ,@(cdr body))))
-
-    ;; Try to simplify (let ((<name> <form>)) ...) to <form>
-    #|
-    (when (and (>= len 1)
-               ;; (eql body-len 1)
-               ;; (eql (caar binding-list) (car body))
-               )
-      (let ((val-form (cadar binding-list)))
-        (unless (and (consp val-form)
-                     (eql (car val-form) 'make-array))
-          (funcall try-fn val-form))))
-    |#
-
-    (when (>= len 1)
-      (let ((val-form (cadar binding-list)))
-        (when (consp val-form)
-          (case (car val-form)
-            ((make-array)
-             (let ((init (getf (cddr val-form) :initial-element)))
-               (when init
-                 (funcall try-fn init))))
-            ((cons)
-             (funcall try-fn (cadr val-form))
-             (funcall try-fn (caddr val-form)))))))
-
-    ;; Try to simplify the forms in the RHS of the bindings
-    (prune-list binding-list
-                #'(lambda (binding try-fn)
-                    (declare (type function try-fn))
-                    (prune (cadr binding)
-                           #'(lambda (form)
-                               (funcall try-fn
-                                        (list (car binding)
-                                              form)))))
-                #'(lambda (bindings)
-                    (funcall try-fn `(,op ,bindings ,@body))))
-
-    ;; Prune off unused variable
-    (when (and binding-list
-               (not (rest binding-list))
-               (let ((name (caar binding-list)))
-                 (and (symbolp name)
-                      (not (find-if-subtree #'(lambda (x) (eq x name)) body)))))
-      (funcall try-fn `(progn ,@body)))
-
-    ;; Try to simplify the body of the LET form
-    (when body
-      (unless binding-list
-        (funcall try-fn (car (last body))))
-      (when (and (first binding-list)
-                 (not (rest binding-list))
-                 (not (rest body)))
-        (let ((binding (first binding-list)))
-          (unless (or (consp (second binding))
-                      (has-binding-to-var (first binding) body)
-                      (has-assignment-to-var (first binding) body)
-                      )
-            (funcall try-fn `(let ()
-                               ,@(subst (second binding)
-                                        (first binding)
-                                        (remove-if #'(lambda (x) (and (consp x) (eq (car x) 'declare)))
-                                                   body)
-                                        ))))))
-      (prune (car (last body))
-             #'(lambda (form2)
-                 (funcall try-fn
-                          `(,@(butlast form) ,form2)))))))
-
-(defun has-assignment-to-var (var form)
-  (find-if-subtree
-   #'(lambda (form)
-       (and (consp form)
-            (or
-             (and (member (car form) '(setq setf shiftf incf decf) :test #'eq)
-                  (eq (cadr form) var))
-             (and (eql (car form) 'multiple-value-setq)
-                  (member var (cadr form))))))
-   form))
-
-(defun has-binding-to-var (var form)
-  (find-if-subtree
-   #'(lambda (form)
-       (and (consp form)
-            (case (car form)
-              ((let let*)
-               (loop for binding in (cadr form)
-                     thereis (eq (car binding) var)))
-              ((progv)
-               (and (consp (cadr form))
-                    (eq (caadr form) 'quote)
-                    (consp (second (cadr form)))
-                    (member var (second (cadr form)))))
-              (t nil))))
-   form))
-
-(defun find-if-subtree (pred tree)
-  (declare (type function pred))
-  (cond
-   ((funcall pred tree) tree)
-   ((consp tree)
-    (or (find-if-subtree pred (car tree))
-        (find-if-subtree pred (cdr tree))))
-   (t nil)))
-
-(defun prune-flet (form try-fn)
-  "Attempt to simplify a FLET form."
-  (declare (type function try-fn))
-
-  (let* ((op (car form))
-         (binding-list (cadr form))
-         (body (cddr form)))
-
-    ;; Remove a declaration, if any
-    (when (and (consp body)
-               (consp (car body))
-               (eq (caar body) 'declare))
-      (funcall try-fn `(,op ,binding-list ,@(cdr body))))
-
-    ;; Try to prune optional arguments
-    (prune-list binding-list
-                #'(lambda (binding try-fn)
-                    (declare (type function try-fn))
-                    (let* ((name (car binding))
-                           (args (cadr binding))
-                           (body (cddr binding))
-                           (opt-pos (position-if #'(lambda (e) (member e '(&key &optional)))
-                                                 (the list args))))
-                      (when opt-pos
-                        (incf opt-pos)
-                        (let ((normal-args (subseq args 0 (1- opt-pos)))
-                              (optionals (subseq args opt-pos)))
-                          (prune-list optionals
-                                      #'(lambda (opt-lambda-arg try-fn)
-                                          (declare (type function try-fn))
-                                          (when (consp opt-lambda-arg)
-                                            (let ((name (first opt-lambda-arg))
-                                                  (form (second opt-lambda-arg)))
-                                              (prune form
-                                                     #'(lambda (form)
-                                                         (funcall try-fn (list name form)))))))
-                                      #'(lambda (opt-args)
-                                          (funcall try-fn
-                                                   `(,name (,@normal-args
-                                                              &optional
-                                                              ,@opt-args)
-                                                           ,@body))))))))
-                #'(lambda (bindings)
-                    (funcall try-fn `(,op ,bindings ,@body))))
-
-
-    ;; Try to simplify the forms in the RHS of the bindings
-    (prune-list binding-list
-                #'(lambda (binding try-fn)
-                    (declare (type function try-fn))
-
-                    ;; Prune body of a binding
-                    (prune (third binding)
-                           #'(lambda (form)
-                               (funcall try-fn
-                                        (list (first binding)
-                                              (second binding)
-                                              form)))))
-                #'(lambda (bindings)
-                    (funcall try-fn `(,op ,bindings ,@body))))
-
-    ;; ;; Try to simplify the body of the FLET form
-    (when body
-
-      ;; No bindings -- try to simplify to the last form in the body
-      (unless binding-list
-        (funcall try-fn (first (last body))))
-
-      (when (and (consp binding-list)
-                 (null (rest binding-list)))
-        (let ((binding (first binding-list)))
-          ;; One binding -- match on (flet ((<name> () <body>)) (<name>))
-          (when (and (symbolp (first binding))
-                     (not (find-in-tree (first binding) (rest binding)))
-                     (null (second binding))
-                     (equal body (list (list (first binding)))))
-            (funcall try-fn `(,op () ,@(cddr binding))))
-          ;; One binding -- try to remove it if not used
-          (when (and (symbolp (first binding))
-                     (not (find-in-tree (first binding) body)))
-            (funcall try-fn (first (last body))))
-        ))
-
-
-      ;; Try to simplify (the last form in) the body.
-      (prune (first (last body))
-             #'(lambda (form2)
-                 (funcall try-fn
-                          `(,@(butlast form) ,form2)))))))
-
-;;; Routine to walk form, applying a function at each form
-;;; The fn is applied in preorder.  When it returns :stop, do
-;;; not descend into subforms
-
-#|
-(defun walk (form fn)
-  (declare (type function fn))
-  (unless (eq (funcall fn form) :stop)
-    (when (consp form)
-      (let ((op (car form)))
-        (case op
-          ((let let*)
-           (walk-let form fn))
-          ((cond)
-           (dolist (clause (cdr form))
-             (walk-implicit-progn clause fn)))
-          ((multiple-value-bind)
-              (walk (third form) fn)
-              (walk-body (cdddr form) fn))
-          ((function quote declare) nil)
-          ((block the return-from)
-           (walk-implicit-progn (cddr form) fn))
-          ((case typecase)
-           (walk (cadr form) fn)
-           (dolist (clause (cddr form))
-             (walk-implicit-progn (cdr clause) fn)))
-          ((flet labels)
-
-
-
-
-|#
-
-;;;;;;;;;;;;;;;;;;;;;;
-;;; Convert pruned results to test cases
-
-(defun produce-test-cases (instances &key
-                                     (stream *standard-output*)
-                                     (prefix "MISC.")
-                                     (index 1))
-  (dolist (inst instances)
-    (let* (;; (vars (getf inst :vars))
-           (vals (getf inst :vals))
-           (optimized-lambda-form (getf inst :optimized-lambda-form))
-           (unoptimized-lambda-form (getf inst :unoptimized-lambda-form))
-           (name (intern
-                  (concatenate 'string prefix (format nil "~D" index))
-                  "CL-TEST"))
-           (test-form
-            `(deftest ,name
-               (let* ((fn1 ',optimized-lambda-form)
-                      (fn2 ',unoptimized-lambda-form)
-                      (vals ',vals)
-                      (v1 (apply (compile nil fn1) vals))
-                      (v2 (apply (compile nil fn2) vals)))
-                 (if (eql v1 v2)
-                     :good
-                   (list v1 v2)))
-               :good)))
-      (print test-form stream)
-      (terpri stream)
-      (incf index)))
-  (values))
diff --git a/random-intern.lsp b/random-intern.lsp
deleted file mode 100644
index 5041b984197cb1b1b35bf8156def59a176fcce88..0000000000000000000000000000000000000000
--- a/random-intern.lsp
+++ /dev/null
@@ -1,72 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Contains: Code to randomly intern and unintern random strings
-;;;;           in a package.  Exercises package and hash table routines
-
-(in-package :cl-test)
-
-(defconstant +max-len-random-symbol+ 63)
-
-(defun make-random-symbol (package)
-  (declare (optimize (speed 3) (safety 3)))
-  (loop
-   (let* ((len (random (1+ +max-len-random-symbol+)))
-          (str (make-string len)))
-     (declare (type (integer 0 #.+max-len-random-symbol+) len))
-     (loop
-      for i from 0 to (1- len) do
-      (setf (schar str i)
-            (schar +base-chars+
-                   (random +num-base-chars+))))
-     (multiple-value-bind
-      (symbol status)
-      (intern (copy-seq str) package)
-      (unless (equal str (symbol-name symbol))
-              (error "Intern gave bad symbol: ~A, ~A~%" str symbol))
-      (unless status (return symbol))))))
-
-(defun queue-insert (q x)
-  (declare (type cons q))
-  (push x (cdr q)))
-
-(defun queue-remove (q)
-  (declare (type cons q))
-  (when (null (car q))
-        (when (null (cdr q))
-              (error "Attempty to remove from empty queue.~%"))
-        (setf (car q) (nreverse (cdr q)))
-        (setf (cdr q) nil))
-  (pop (car q)))
-
-(defun queue-empty (q)
-  (and (null (car q))
-       (null (cdr q))))
-
-(defun random-intern (n)
-  (declare (fixnum n))
-  (let ((q (list nil))
-        (xp (defpackage "X" (:use))))
-    (declare (type cons q))
-    (loop
-     for i from 1 to n do
-     (if (and
-          (= (random 2) 0)
-          (not (queue-empty q)))
-         (unintern (queue-remove q) xp)
-       (queue-insert q (make-random-symbol xp))))))
-
-(defun fill-intern (n)
-  (declare (fixnum n))
-  (let ((xp (defpackage "X" (:use))))
-    (loop
-     for i from 1 to n do
-     (make-random-symbol xp))))
-
-
-
-
-
-
-
-
-
diff --git a/random-type-prop-tests-01.lsp b/random-type-prop-tests-01.lsp
deleted file mode 100644
index da3a53e44b7e80b2957c6e032fa9886dd224b29a..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-01.lsp
+++ /dev/null
@@ -1,73 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Sun Mar  6 20:36:56 2005
-;;;; Contains: Test that invoke the random type prop infrastructure, part 1
-
-(in-package :cl-test)
-
-(def-type-prop-test special-operator-p 'special-operator-p '(symbol) 1)
-(def-type-prop-test type-of 'type-of '(t) 1)
-(def-type-prop-test typep.1 '(lambda (x y) (typep x (type-of y))) '(t t) 2)
-(def-type-prop-test typep.2 'typep
-  (list t #'(lambda (x)
-              (let ((type (make-random-type-containing x)))
-                `(eql ,type))))
-  2)
-(def-type-prop-test subtypep
-  '(lambda (x y) (subtypep (type-of x) (type-of y))) '(t t) 2)
-(def-type-prop-test fboundp.1 'fboundp '(symbol) 1)
-(def-type-prop-test fboundp.2 'fboundp '((cons (eql setf) (cons symbol null))) 1)
-(def-type-prop-test functionp 'functionp '(t) 1)
-(def-type-prop-test compiled-function-p 'compiled-function-p '(t) 1)
-(def-type-prop-test not 'not '(t) 1)
-(def-type-prop-test eq 'eq (list
-                            '(and t (not number) (not character))
-                            #'(lambda (x) (rcase
-                                           (1 `(eql ,x))
-                                           (1 '(and t (not number) (not character))))))
-  2)
-(def-type-prop-test eql.1 'eql '(t t) 2)
-(def-type-prop-test eql.2 'eql (list t #'(lambda (x) `(eql ,x))) 2)
-(def-type-prop-test equal.1 'equal '(t t) 2)
-(def-type-prop-test equal.2 'equal (list t #'(lambda (x) `(eql ,x))) 2)
-(def-type-prop-test equalp.1 'equalp '(t t) 2)
-(def-type-prop-test equalp.2 'equalp (list t #'(lambda (x) `(eql ,x))) 2)
-(def-type-prop-test identity 'identity '(t) 1)
-(def-type-prop-test complement
- '(lambda (f y) (funcall (complement f) y)) (list `(eql ,#'symbolp) t) 2)
-(def-type-prop-test constantly
-  '(lambda (x) (funcall (constantly x))) '(t) 1)
-(def-type-prop-test and.1 'and '(t) 1)
-(def-type-prop-test and.2 'and '((or null t) t) 2)
-(def-type-prop-test and.3 'and '((or null t) (or null t) t) 3)
-(def-type-prop-test if.1 'if '(boolean t) 2)
-(def-type-prop-test if.2 'if '(boolean t t) 3)
-(def-type-prop-test if.3 '(lambda (p q x y z) (if p (if q x y) z))
-  '(boolean boolean t t t) 5)
-(def-type-prop-test if.4 '(lambda (p q x y z) (if p x (if q y z)))
-  '(boolean boolean t t t) 5)
-(def-type-prop-test if.5 '(lambda (p q x y) (if (or p q) x y))
-  '(boolean boolean t t) 4)
-(def-type-prop-test if.6 '(lambda (p q x y) (if (and p q) x y))
-  '(boolean boolean t t) 4)
-(def-type-prop-test cond.1 '(lambda (p x y) (cond (p x) (t y))) '(boolean t t) 3)
-(def-type-prop-test cond.2 '(lambda (p x y) (cond (p x) (t y))) '((or null t) t t) 3)
-(def-type-prop-test or.1 'or '(t) 1)
-(def-type-prop-test or.2 'or '((or null t) t) 2)
-(def-type-prop-test or.3 'or '((or null null t) (or null t) t) 3)
-(def-type-prop-test when 'when '((or null t) t) 2)
-(def-type-prop-test unless 'unless '((or null t) t) 2)
-(def-type-prop-test slot-exists-p 'slot-exists-p '(t symbol) 2)
-(def-type-prop-test find-class 'find-class '(symbol null) 2)
-(def-type-prop-test class-of 'class-of '(t) 1)
-(def-type-prop-test find-restart 'find-restart '((and symbol (not null))) 1)
-(def-type-prop-test symbolp 'symbolp '(t) 1)
-(def-type-prop-test keywordp 'keywordp '(t) 1)
-(def-type-prop-test make-symbol 'make-symbol '(string) 1
-  :test #'(lambda (x y) (string= (symbol-name x) (symbol-name y))))
-(def-type-prop-test symbol-name 'symbol-name '(symbol) 1)
-(def-type-prop-test symbol-package 'symbol-package '(symbol) 1)
-(def-type-prop-test boundp 'boundp '(symbol) 1)
-(def-type-prop-test find-symbol 'find-symbol '(string) 1)
-(def-type-prop-test find-package 'find-package '((or string symbol character)) 1)
-
diff --git a/random-type-prop-tests-02.lsp b/random-type-prop-tests-02.lsp
deleted file mode 100644
index 458aa8fcd5acbc35556386a6f4d07a6c9c42f8d5..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-02.lsp
+++ /dev/null
@@ -1,115 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Sun Mar  6 20:37:57 2005
-;;;; Contains: Tests that invoke the random type prop infrastructure, part 2
-
-(in-package :cl-test)
-
-(def-type-prop-test =.1 '= '(number number) 2)
-(def-type-prop-test =.2 '= '(number number number) 3)
-(def-type-prop-test =.3 '= nil 4 :maxargs 10 :rest-type 'number)
-(def-type-prop-test =.4 '= '(integer integer) 2)
-(def-type-prop-test =.5 '= (list 'number #'(lambda (x) (if (coin) 'number
-                                                        `(eql ,x)))) 2)
-(def-type-prop-test =.6 '= (list 'number 'number
-                                 #'(lambda (x y) (rcase
-                                                  (2 'number)
-                                                  (1 `(eql ,x))
-                                                  (1 `(eql ,y)))))
-  3)
-(def-type-prop-test /=.1 '/= '(number number) 2)
-(def-type-prop-test /=.2 '/= '(number number number) 3)
-(def-type-prop-test /=.3 '/= nil 4 :maxargs 10 :rest-type 'number)
-(def-type-prop-test /=.4 '/= '(integer integer) 2)
-(def-type-prop-test /=.5 '/= (list 'number #'(lambda (x) (if (coin) 'number
-                                                           `(eql ,x)))) 2)
-(def-type-prop-test /=.6 '/= (list 'number 'number
-                                   #'(lambda (x y) (rcase
-                                                    (2 'number)
-                                                    (1 `(eql ,x))
-                                                    (1 `(eql ,y)))))
-  3)
-(def-type-prop-test <.1 '< '(real real) 2)
-(def-type-prop-test <.2 '< '(real real real) 3)
-(def-type-prop-test <.3 '< nil 4 :maxargs 10 :rest-type 'real)
-(def-type-prop-test <.4 '< '(integer integer) 2)
-(def-type-prop-test <.5 '< (list 'real #'(lambda (x) (if (coin) 'real
-                                                        `(eql ,x)))) 2)
-(def-type-prop-test <.6 '< (list 'real 'real
-                                 #'(lambda (x y) (rcase
-                                                  (2 'real)
-                                                  (1 `(eql ,x))
-                                                  (1 `(eql ,y)))))
-  3)
-(def-type-prop-test >.1 '> '(real real) 2)
-(def-type-prop-test >.2 '> '(real real real) 3)
-(def-type-prop-test >.3 '> nil 4 :maxargs 10 :rest-type 'real)
-(def-type-prop-test >.4 '> '(integer integer) 2)
-(def-type-prop-test >.5 '> (list 'real #'(lambda (x) (if (coin) 'real
-                                                        `(eql ,x)))) 2)
-(def-type-prop-test >.6 '> (list 'real 'real
-                                 #'(lambda (x y) (rcase
-                                                  (2 'real)
-                                                  (1 `(eql ,x))
-                                                  (1 `(eql ,y)))))
-  3)
-(def-type-prop-test <=.1 '<= '(real real) 2)
-(def-type-prop-test <=.2 '<= '(real real real) 3)
-(def-type-prop-test <=.3 '<= nil 4 :maxargs 10 :rest-type 'real)
-(def-type-prop-test <=.4 '<= '(integer integer) 2)
-(def-type-prop-test <=.5 '<= (list 'real #'(lambda (x) (if (coin) 'real
-                                                         `(eql ,x)))) 2)
-(def-type-prop-test <=.6 '<= (list 'real 'real
-                                   #'(lambda (x y) (rcase
-                                                    (2 'real)
-                                                    (1 `(eql ,x))
-                                                    (1 `(eql ,y)))))
-  3)
-(def-type-prop-test >=.1 '>= '(real real) 2)
-(def-type-prop-test >=.2 '>= '(real real real) 3)
-(def-type-prop-test >=.3 '>= nil 4 :maxargs 10 :rest-type 'real)
-(def-type-prop-test >=.4 '>= '(integer integer) 2)
-(def-type-prop-test >=.5 '>= (list 'real #'(lambda (x) (if (coin) 'real
-                                                         `(eql ,x)))) 2)
-(def-type-prop-test >=.6 '>= (list 'real 'real
-                                   #'(lambda (x y) (rcase
-                                                    (2 'real)
-                                                    (1 `(eql ,x))
-                                                    (1 `(eql ,y)))))
-  3)
-
-(def-type-prop-test min.1 'min nil 2 :maxargs 6 :rest-type 'integer)
-(def-type-prop-test min.2 'min nil 2 :maxargs 6 :rest-type 'rational)
-(def-type-prop-test min.3 'min nil 2 :maxargs 6 :rest-type 'real)
-(def-type-prop-test max.1 'max nil 2 :maxargs 6 :rest-type 'integer)
-(def-type-prop-test max.2 'max nil 2 :maxargs 6 :rest-type 'rational)
-(def-type-prop-test max.3 'max nil 2 :maxargs 6 :rest-type 'real)
-
-(def-type-prop-test minusp 'minusp '(real) 1)
-(def-type-prop-test plusp 'plusp '(real) 1)
-(def-type-prop-test zerop 'zerop '(number) 1)
-
-(def-type-prop-test floor.1 'floor '(real) 1)
-(def-type-prop-test floor.2 'floor '(real (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test floor.3 'floor '(real (and real (not (satisfies zerop)))) 2)
-(def-type-prop-test ffloor.1 'ffloor '(real) 1)
-(def-type-prop-test ffloor.2 'ffloor '(real (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test ffloor.3 'ffloor '(real (and real (not (satisfies zerop)))) 2)
-(def-type-prop-test ceiling.1 'ceiling '(real) 1)
-(def-type-prop-test ceiling.2 'ceiling '(real (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test ceiling.3 'ceiling '(real (and real (not (satisfies zerop)))) 2)
-(def-type-prop-test fceiling.1 'fceiling '(real) 1)
-(def-type-prop-test fceiling.2 'fceiling '(real (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test fceiling.3 'fceiling '(real (and real (not (satisfies zerop)))) 2)
-(def-type-prop-test truncate.1 'truncate '(real) 1)
-(def-type-prop-test truncate.2 'truncate '(real (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test truncate.3 'truncate '(real (and real (not (satisfies zerop)))) 2)
-(def-type-prop-test ftruncate.1 'ftruncate '(real) 1)
-(def-type-prop-test ftruncate.2 'ftruncate '(real (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test ftruncate.3 'ftruncate '(real (and real (not (satisfies zerop)))) 2)
-(def-type-prop-test round.1 'round '(real) 1)
-(def-type-prop-test round.2 'round '(real (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test round.3 'round '(real (and real (not (satisfies zerop)))) 2)
-(def-type-prop-test fround.1 'fround '(real) 1)
-(def-type-prop-test fround.2 'fround '(real (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test fround.3 'fround '(real (and real (not (satisfies zerop)))) 2)
diff --git a/random-type-prop-tests-03.lsp b/random-type-prop-tests-03.lsp
deleted file mode 100644
index a564c2149995b22582a99d8466e46819fe08ad2a..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-03.lsp
+++ /dev/null
@@ -1,186 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Sun Mar  6 20:39:10 2005
-;;;; Contains:  Tests that invoke the random type prop infrastructure, part 3
-
-(in-package :cl-test)
-
-;;; trig, hyperbolic functions here
-
-;;; WARNING -- these tests may cause floating point overflow/underflow
-;;; Ignore those failures
-(def-type-prop-test *.1 '* '(integer integer) 2)
-(def-type-prop-test *.2 '* nil 1 :rest-type 'integer :maxargs 4)
-(def-type-prop-test *.3 '* nil 2 :rest-type 'integer :maxargs 10)
-(def-type-prop-test *.4 '* '(real real) 2  :test #'approx=)
-(def-type-prop-test *.5 '* '(number number) 2 :test #'approx=)
-
-(def-type-prop-test \+.1 '+ '(integer integer) 2)
-(def-type-prop-test \+.2 '+ nil 1 :rest-type 'integer :maxargs 4)
-(def-type-prop-test \+.3 '+ nil 2 :rest-type 'integer :maxargs 10)
-(def-type-prop-test \+.4 '+ '(real real) 2 :test #'approx=)
-(def-type-prop-test \+.5 '+ '(number number) 2 :test #'approx=)
-
-(def-type-prop-test \-.1 '- '(integer integer) 2)
-(def-type-prop-test \-.2 '- nil 1 :rest-type 'integer :maxargs 4)
-(def-type-prop-test \-.3 '- nil 2 :rest-type 'integer :maxargs 10)
-(def-type-prop-test \-.4 '- '(real real) 2 :test #'approx=)
-(def-type-prop-test \-.5 '- '(number number) 2 :test #'approx=)
-(def-type-prop-test \-.6 '- '(number) 1)
-
-;;; WARNING -- these tests may cause floating point overflow/underflow
-;;; Ignore those failures
-(def-type-prop-test /.1 '/ '((and integer (not (satisfies zerop)))) 1)
-(def-type-prop-test /.2 '/ '((and rational (not (satisfies zerop)))) 1)
-(def-type-prop-test /.3 '/ '((and real (not (satisfies zerop)))) 1 :ignore 'arithmetic-error)
-(def-type-prop-test /.4 '/ '((and complex (not (satisfies zerop)))) 1 :ignore 'arithmetic-error)
-(def-type-prop-test /.5 '/ '(integer) 2 :maxargs 6 :rest-type '(and integer (not (satisfies zerop))))
-(def-type-prop-test /.6 '/ '(rational) 2 :maxargs 6 :rest-type '(and rational (not (satisfies zerop))))
-(def-type-prop-test /.7 '/ '(real) 2 :maxargs 6 :rest-type '(and real (not (satisfies zerop)))
- :test #'approx= :ignore 'arithmetic-error)
-(def-type-prop-test /.8 '/ '(number) 2 :maxargs 6 :rest-type '(and number (not (satisfies zerop)))
-  :test #'approx= :ignore 'arithmetic-error)
-
-(def-type-prop-test 1+.1 '1+ '(integer) 1)
-(def-type-prop-test 1+.2 '1+ '(rational) 1)
-(def-type-prop-test 1+.3 '1+ '(real) 1)
-(def-type-prop-test 1+.4 '1+ '(number) 1)
-
-(def-type-prop-test 1-.1 '1- '(integer) 1)
-(def-type-prop-test 1-.2 '1- '(rational) 1)
-(def-type-prop-test 1-.3 '1- '(real) 1)
-(def-type-prop-test 1-.4 '1- '(number) 1)
-
-(def-type-prop-test abs.1 'abs '(integer) 1)
-(def-type-prop-test abs.2 'abs '(rational) 1)
-(def-type-prop-test abs.3 'abs '(real) 1)
-(def-type-prop-test abs.4 'abs '(number) 1)
-
-(def-type-prop-test evenp 'evenp '(integer) 1)
-(def-type-prop-test oddp 'oddp '(integer) 1)
-
-;;; exp, expt here
-
-(def-type-prop-test gcd 'gcd nil 1 :maxargs 6 :rest-type 'integer)
-(def-type-prop-test lcm 'lcm nil 1 :maxargs 6 :rest-type 'integer)
-
-(def-type-prop-test log.1 'log '((and real (not (satisfies zerop)))) 1 :test #'approx=)
-(def-type-prop-test log.2 'log '((and number (not (satisfies zerop)))) 1 :test #'approx=)
-
-(def-type-prop-test mod.1 'mod '(integer (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test mod.2 'mod '(real (and real (not (satisfies zerop)))) 2 :test #'approx=)
-(def-type-prop-test rem.1 'rem '(integer (and integer (not (satisfies zerop)))) 2)
-(def-type-prop-test rem.2 'rem '(real (and real (not (satisfies zerop)))) 2 :test #'approx=)
-
-(def-type-prop-test signum.1 'signum '(integer) 1)
-(def-type-prop-test signum.2 'signum '(rational) 1)
-(def-type-prop-test signum.3 'signum '(real) 1)
-(def-type-prop-test signum.4 'signum '(number) 1)
-
-(def-type-prop-test sqrt.1 'sqrt '(integer) 1 :test #'approx=)
-(def-type-prop-test sqrt.2 'sqrt '(rational) 1 :test #'approx=)
-(def-type-prop-test sqrt.3 'sqrt '(real) 1 :test #'approx=)
-(def-type-prop-test sqrt.4 'sqrt '(number) 1 :test #'approx=)
-
-(def-type-prop-test isqrt 'isqrt '((integer 0)) 1)
-
-(def-type-prop-test numberp 'numberp '(t) 1)
-
-(def-type-prop-test complex.1 'complex '(integer) 1)
-(def-type-prop-test complex.2 'complex '(rational) 1)
-(def-type-prop-test complex.3 'complex '(real) 1)
-(def-type-prop-test complex.4 'complex '(rational rational) 2)
-(def-type-prop-test complex.5 'complex '(real real) 2)
-
-(def-type-prop-test complexp 'complexp '(t) 1)
-
-(def-type-prop-test conjugate 'conjugate '(number) 1)
-
-(def-type-prop-test phase.1 'phase '(real) 1)
-(def-type-prop-test phase.2 'phase '(number) 1 :test #'approx=)
-
-(def-type-prop-test realpart.1 'realpart '(real) 1)
-(def-type-prop-test realpart.2 'realpart '(number) 1)
-(def-type-prop-test imagpart.1 'imagpart '(real) 1)
-(def-type-prop-test imagpart.2 'imagpart '(number) 1)
-
-(def-type-prop-test realp 'realp '(t) 1)
-
-(def-type-prop-test numerator 'numerator '(rational) 1)
-(def-type-prop-test denominator 'denominator '(rational) 1)
-
-(def-type-prop-test rational 'rational '(real) 1)
-(def-type-prop-test rationalize 'rationalize '(real) 1)
-
-(def-type-prop-test rationalp 'rationalp '(t) 1)
-
-(def-type-prop-test ash.1 'ash '(integer (integer -32 32)) 2)
-(def-type-prop-test ash.2 'ash '(integer (integer -100 100)) 2)
-
-(def-type-prop-test integer-length 'integer-length '(integer) 1)
-(def-type-prop-test integerp 'integerp '(t) 1)
-
-(def-type-prop-test logand.1 'logand '(integer integer) 2)
-(def-type-prop-test logand.2 'logand nil 2 :rest-type 'integer :maxargs 6)
-
-(def-type-prop-test logandc1 'logandc1 '(integer integer) 2)
-(def-type-prop-test logandc2 'logandc2 '(integer integer) 2)
-
-(def-type-prop-test lognand 'lognand '(integer integer) 2)
-(def-type-prop-test lognor 'lognor '(integer integer) 2)
-
-(def-type-prop-test logeqv.1 'logeqv '(integer integer) 2)
-(def-type-prop-test logeqv.2 'logeqv nil 2 :rest-type 'integer :maxargs 6)
-
-(def-type-prop-test logior.1 'logior '(integer integer) 2)
-(def-type-prop-test logior.2 'logior nil 2 :rest-type 'integer :maxargs 6)
-
-(def-type-prop-test logxor.1 'logxor '(integer integer) 2)
-(def-type-prop-test logxor.2 'logxor nil 2 :rest-type 'integer :maxargs 6)
-
-(def-type-prop-test logorc1 'logorc1 '(integer integer) 2)
-(def-type-prop-test logorc2 'logorc2 '(integer integer) 2)
-
-(def-type-prop-test lognot 'lognot '(integer) 1)
-
-(def-type-prop-test logbitp.1 'logbitp '((integer 0 32) integer) 2)
-(def-type-prop-test logbitp.2 'logbitp '((integer 0 100) integer) 2)
-; (def-type-prop-test logbitp.3 'logbitp '((integer 0) integer) 2)
-
-(def-type-prop-test logcount 'logcount '(integer) 1)
-(def-type-prop-test logtest 'logtest '(integer integer) 2)
-
-(def-type-prop-test decode-float.1 'decode-float '(float) 1)
-(def-type-prop-test decode-float.2 '(lambda (x) (nth-value 1 (decode-float x))) '(float) 1)
-(def-type-prop-test decode-float.3 '(lambda (x) (nth-value 2 (decode-float x))) '(float) 1)
-(def-type-prop-test float-radix 'float-radix '(float) 1)
-(def-type-prop-test scale-float 'scale-float '(float (integer -30 30)) 2 :ignore 'arithmetic-error :test #'approx=)
-(def-type-prop-test float-sign.1 'float-sign '(float) 1)
-(def-type-prop-test float-sign.2 'float-sign '(float float) 2)
-(def-type-prop-test float-digits 'float-digits '(float) 1)
-(def-type-prop-test float-precision 'float-precision '(float) 1)
-(def-type-prop-test integer-decode-float.1 'integer-decode-float '(float) 1)
-(def-type-prop-test integer-decode-float.2 '(lambda (x) (nth-value 1 (integer-decode-float x))) '(float) 1)
-(def-type-prop-test integer-decode-float.3 '(lambda (x) (nth-value 2 (integer-decode-float x))) '(float) 1)
-
-
-(def-type-prop-test float.1 'float '(real) 1)
-(def-type-prop-test float.2 'float '(real float) 2)
-(def-type-prop-test floatp 'floatp '(t) 1)
-
-(defun has-nonzero-length (x) (> (length x) 0))
-
-(def-type-prop-test parse-integer.1 'parse-integer
-  '((and (vector (member #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
-         (satisfies has-nonzero-length)))
-  1)
-
-(def-type-prop-test parse-integer.2 'parse-integer
-  `((and (vector (member #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
-         (satisfies has-nonzero-length))
-    (eql :start)
-    ,#'(lambda (x &rest rest) (declare (ignore rest))
-         `(integer 0 (,(length x)))))
-  3)
-
-(def-type-prop-test sxhash 'sxhash '(t) 1)
diff --git a/random-type-prop-tests-04.lsp b/random-type-prop-tests-04.lsp
deleted file mode 100644
index b12aae407e0e8b6810d371e297df427da2e6060e..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-04.lsp
+++ /dev/null
@@ -1,107 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Sun Mar  6 21:44:41 2005
-;;;; Contains: Test that invoke the random type prop infrastructure, part 4
-
-(in-package :cl-test)
-
-(defun char-or-same (c &rest args)
-  (declare (ignore args))
-  (if (coin) `(eql ,c) 'character))
-
-(eval-when (:load-toplevel :execute) (compile 'char-or-same))
-
-(def-type-prop-test char=.1 'char= nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char=.2 'char= '(character character) 2)
-(def-type-prop-test char=.3 'char= (list 'character #'char-or-same) 2)
-(def-type-prop-test char=.4 'char= (list 'character #'char-or-same #'char-or-same) 3)
-(def-type-prop-test char=.5 'char= '(character) 3 :rest-type #'char-or-same :maxargs 6)
-
-(def-type-prop-test char/=.1 'char/= nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char/=.2 'char/= '(character character) 2)
-(def-type-prop-test char/=.3 'char/= (list 'character #'char-or-same) 2)
-(def-type-prop-test char/=.4 'char/= (list 'character 'character #'char-or-same) 3)
-(def-type-prop-test char/=.5 'char/= nil 2 :rest-type 'character :maxargs 6)
-
-(def-type-prop-test char<=.1 'char<= nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char<=.2 'char<= '(character character) 2)
-(def-type-prop-test char<=.3 'char<= (list 'character #'char-or-same) 2)
-(def-type-prop-test char<=.4 'char<= (list 'character #'char-or-same #'char-or-same) 3)
-(def-type-prop-test char<=.5 'char<= '(character) 3 :rest-type #'char-or-same :maxargs 6)
-
-(def-type-prop-test char>=.1 'char>= nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char>=.2 'char>= '(character character) 2)
-(def-type-prop-test char>=.3 'char>= (list 'character #'char-or-same) 2)
-(def-type-prop-test char>=.4 'char>= (list 'character #'char-or-same #'char-or-same) 3)
-(def-type-prop-test char>=.5 'char>= '(character) 3 :rest-type #'char-or-same :maxargs 6)
-
-(def-type-prop-test char<.1 'char< nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char<.2 'char< '(character character) 2)
-(def-type-prop-test char<.3 'char< (list 'character #'char-or-same) 2)
-(def-type-prop-test char<.4 'char< (list 'character 'character #'char-or-same) 3)
-(def-type-prop-test char<.5 'char< nil 2 :rest-type 'character :maxargs 6)
-
-(def-type-prop-test char>.1 'char> nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char>.2 'char> '(character character) 2)
-(def-type-prop-test char>.3 'char> (list 'character #'char-or-same) 2)
-(def-type-prop-test char>.4 'char> (list 'character 'character #'char-or-same) 3)
-(def-type-prop-test char>.5 'char> nil 2 :rest-type 'character :maxargs 6)
-
-
-(def-type-prop-test char-equal.1 'char-equal nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char-equal.2 'char-equal '(character character) 2)
-(def-type-prop-test char-equal.3 'char-equal (list 'character #'char-or-same) 2)
-(def-type-prop-test char-equal.4 'char-equal (list 'character #'char-or-same #'char-or-same) 3)
-(def-type-prop-test char-equal.5 'char-equal '(character) 3 :rest-type #'char-or-same :maxargs 6)
-
-(def-type-prop-test char-not-equal.1 'char-not-equal nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char-not-equal.2 'char-not-equal '(character character) 2)
-(def-type-prop-test char-not-equal.3 'char-not-equal (list 'character #'char-or-same) 2)
-(def-type-prop-test char-not-equal.4 'char-not-equal (list 'character 'character #'char-or-same) 3)
-(def-type-prop-test char-not-equal.5 'char-not-equal nil 2 :rest-type 'character :maxargs 6)
-
-(def-type-prop-test char-not-greaterp.1 'char-not-greaterp nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char-not-greaterp.2 'char-not-greaterp '(character character) 2)
-(def-type-prop-test char-not-greaterp.3 'char-not-greaterp (list 'character #'char-or-same) 2)
-(def-type-prop-test char-not-greaterp.4 'char-not-greaterp (list 'character #'char-or-same #'char-or-same) 3)
-(def-type-prop-test char-not-greaterp.5 'char-not-greaterp '(character) 3 :rest-type #'char-or-same :maxargs 6)
-
-(def-type-prop-test char-not-lessp.1 'char-not-lessp nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char-not-lessp.2 'char-not-lessp '(character character) 2)
-(def-type-prop-test char-not-lessp.3 'char-not-lessp (list 'character #'char-or-same) 2)
-(def-type-prop-test char-not-lessp.4 'char-not-lessp (list 'character #'char-or-same #'char-or-same) 3)
-(def-type-prop-test char-not-lessp.5 'char-not-lessp '(character) 3 :rest-type #'char-or-same :maxargs 6)
-
-(def-type-prop-test char-lessp.1 'char-lessp nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char-lessp.2 'char-lessp '(character character) 2)
-(def-type-prop-test char-lessp.3 'char-lessp (list 'character #'char-or-same) 2)
-(def-type-prop-test char-lessp.4 'char-lessp (list 'character 'character #'char-or-same) 3)
-(def-type-prop-test char-lessp.5 'char-lessp nil 2 :rest-type 'character :maxargs 6)
-
-(def-type-prop-test char-greaterp.1 'char-greaterp nil 2 :rest-type 'base-char :maxargs 5)
-(def-type-prop-test char-greaterp.2 'char-greaterp '(character character) 2)
-(def-type-prop-test char-greaterp.3 'char-greaterp (list 'character #'char-or-same) 2)
-(def-type-prop-test char-greaterp.4 'char-greaterp (list 'character 'character #'char-or-same) 3)
-(def-type-prop-test char-greaterp.5 'char-greaterp nil 2 :rest-type 'character :maxargs 6)
-
-(defun length1-p (seq) (= (length seq) 1))
-  
-(def-type-prop-test character 'character '((or character (and (string 1) (satisfies length1-p)))) 1)
-(def-type-prop-test characterp 'characterp '(t) 1)
-(def-type-prop-test alpha-char-p 'alpha-char-p '(character) 1)
-(def-type-prop-test alphanumericp 'alphanumericp '(character) 1)
-(def-type-prop-test digit-char 'digit-char '((or (integer 0 36) (integer 0)) (integer 2 36)) 1 :maxargs 2)
-(def-type-prop-test digit-char-p 'digit-char-p '(character) 1)
-(def-type-prop-test graphic-char-p 'graphic-char-p '(character) 1)
-(def-type-prop-test standard-char-p 'standard-char-p '(character) 1)
-(def-type-prop-test char-upcase 'char-upcase '(character) 1)
-(def-type-prop-test char-downcase 'char-downcase '(character) 1)
-(def-type-prop-test upper-case-p 'upper-case-p '(character) 1)
-(def-type-prop-test lower-case-p 'lower-case-p '(character) 1)
-(def-type-prop-test both-case-p 'both-case-p '(character) 1)
-(def-type-prop-test char-code 'char-code '(character) 1)
-(def-type-prop-test char-int 'char-int '(character) 1)
-(def-type-prop-test code-char 'code-char '((integer 0 #.char-code-limit)) 1)
-(def-type-prop-test char-name 'char-name '(character) 1)
-(def-type-prop-test name-char 'name-char '(string) 1)
-
diff --git a/random-type-prop-tests-05.lsp b/random-type-prop-tests-05.lsp
deleted file mode 100644
index 5ef8ee93554a63e4e82e918e8b472f245b188f3c..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-05.lsp
+++ /dev/null
@@ -1,528 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Tue Mar  8 20:31:08 2005
-;;;; Contains: Random type prop tests, part 5 (Cons)
-
-(in-package :cl-test)
-
-(def-type-prop-test list.1 'list nil 1 :rest-type 't :maxargs 10)
-(def-type-prop-test list.2 '(lambda (x) (car (list x))) '(t) 1)
-(def-type-prop-test list.3 '(lambda (x y) (cdr (list x y))) '(t t) 2)
-(def-type-prop-test list.4 '(lambda (x y z) (cadr (list x y z))) '(t t t) 3)
-(def-type-prop-test list.5 '(lambda (x) (let ((z (list x))) (declare (dynamic-extent z)) (car z)))  '(t) 1)
-
-(def-type-prop-test list* 'list* () 1 :rest-type t :maxargs 10)
-
-(def-type-prop-test null 'null '(t) 1)
-(def-type-prop-test cons.1 'cons '(t t) 2)
-(def-type-prop-test cons.2 '(lambda (x y) (car (cons y x))) '(t t) 2)
-(def-type-prop-test cons.3 '(lambda (x y) (cdr (cons x y))) '(t t) 2)
-
-(def-type-prop-test consp 'consp '(t) 1)
-(def-type-prop-test atom 'atom '(t) 1)
-
-(def-type-prop-test rplaca 'rplaca '(cons t) 2 :replicate '(t nil))
-(def-type-prop-test rplacd 'rplacd '(cons t) 2 :replicate '(t nil))
-
-(def-type-prop-test car 'car '((cons t t)) 1)
-(def-type-prop-test first 'first '((cons t t)) 1)
-(def-type-prop-test cdr 'cdr '((cons t t)) 1)
-(def-type-prop-test rest 'rest '((cons t t)) 1)
-(def-type-prop-test caar 'caar '((cons (cons t t) t)) 1)
-(def-type-prop-test cdar 'cdar '((cons (cons t t) t)) 1)
-(def-type-prop-test cadr 'cadr '((cons t (cons t t))) 1)
-(def-type-prop-test second 'second '((cons t (cons t t))) 1)
-(def-type-prop-test cddr 'cddr '((cons t (cons t t))) 1)
-(def-type-prop-test caaar 'caaar '((cons (cons (cons t t) t) t)) 1)
-(def-type-prop-test cdaar 'cdaar '((cons (cons (cons t t) t) t)) 1)
-(def-type-prop-test cadar 'cadar '((cons (cons t (cons t t)) t)) 1)
-(def-type-prop-test cddar 'cddar '((cons (cons t (cons t t)) t)) 1)
-(def-type-prop-test caadr 'caadr '((cons t (cons (cons t t) t))) 1)
-(def-type-prop-test cdadr 'cdadr '((cons t (cons (cons t t) t))) 1)
-(def-type-prop-test caddr 'caddr '((cons t (cons t (cons t t)))) 1)
-(def-type-prop-test third 'third '((cons t (cons t (cons t t)))) 1)
-(def-type-prop-test cdddr 'cdddr '((cons t (cons t (cons t t)))) 1)
-
-(def-type-prop-test caaaar'caaaar '((cons (cons (cons (cons t t) t) t) t)) 1)
-(def-type-prop-test cdaaar 'cdaaar '((cons (cons (cons (cons t t) t) t) t)) 1)
-(def-type-prop-test cadaar 'cadaar '((cons (cons (cons t (cons t t)) t) t)) 1)
-(def-type-prop-test cddaar 'cddaar '((cons (cons (cons t (cons t t)) t) t)) 1)
-(def-type-prop-test caadar 'caadar '((cons (cons t (cons (cons t t) t)) t)) 1)
-(def-type-prop-test cdadar 'cdadar '((cons (cons t (cons (cons t t) t)) t)) 1)
-(def-type-prop-test caddar 'caddar '((cons (cons t (cons t (cons t t))) t)) 1)
-(def-type-prop-test cdddar 'cdddar '((cons (cons t (cons t (cons t t))) t)) 1)
-(def-type-prop-test caaadr 'caaadr '((cons t (cons (cons (cons t t) t) t))) 1)
-(def-type-prop-test cdaadr 'cdaadr '((cons t (cons (cons (cons t t) t) t))) 1)
-(def-type-prop-test cadadr 'cadadr '((cons t (cons (cons t (cons t t)) t))) 1)
-(def-type-prop-test cddadr 'cddadr '((cons t (cons (cons t (cons t t)) t))) 1)
-(def-type-prop-test caaddr 'caaddr '((cons t (cons t (cons (cons t t) t)))) 1)
-(def-type-prop-test cdaddr 'cdaddr '((cons t (cons t (cons (cons t t) t)))) 1)
-(def-type-prop-test cadddr 'cadddr '((cons t (cons t (cons t (cons t t))))) 1)
-(def-type-prop-test fourth 'fourth '((cons t (cons t (cons t (cons t t))))) 1)
-(def-type-prop-test cddddr 'cddddr '((cons t (cons t (cons t (cons t t))))) 1)
-
-(def-type-prop-test fifth 'fifth '((cons t (cons t (cons t (cons t (cons t t)))))) 1)
-(def-type-prop-test sixth 'sixth '((cons t (cons t (cons t (cons t (cons t (cons t t))))))) 1)
-(def-type-prop-test seventh 'seventh '((cons t (cons t (cons t (cons t (cons t (cons t (cons t t)))))))) 1)
-(def-type-prop-test eighth 'eighth
-  '((cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t t)))))))))
-  1)
-(def-type-prop-test ninth 'ninth
-  '((cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t t))))))))))
-  1)
-(def-type-prop-test tenth 'tenth
-  '((cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t t)))))))))))
-  1)
-
-(def-type-prop-test pop '(lambda (x) (list (pop x) x)) '((cons t t)) 1)
-(def-type-prop-test push '(lambda (x y) (list (push x y) x y)) '(t t) 2)
-
-(def-type-prop-test copy-tree.1 'copy-tree '((cons t t)) 1)
-(def-type-prop-test copy-tree.2 'copy-tree '((cons (cons t t) (cons t t))) 1)
-(def-type-prop-test copy-tree.3 'copy-tree '((cons t (cons (cons t (cons t t)) t))) 1)
-(def-type-prop-test copy-tree.4 'copy-tree '(list) 1)
-
-(def-type-prop-test sublis.1 'sublis '((cons (cons symbol t) null) list) 2)
-(def-type-prop-test sublis.2 'sublis '((cons (cons (integer 0 7) t) null) list) 2)
-(def-type-prop-test sublis.3 'sublis '(null list) 2)
-(def-type-prop-test sublis.4 'sublis `((cons (cons boolean t) null) list
-                                       (eql :key)
-                                       (or null (eql not) (eql ,#'not))) 4)
-(def-type-prop-test sublis.5 'sublis `((cons (cons t t) null) list (eql :test) (or (eql equal) (eql ,#'equal))) 4)
-(def-type-prop-test sublis.6 'sublis `((cons (cons t t) null) list (eql :test-not) (or (eql eql) (eql ,#'eql))) 4)
-
-(def-type-prop-test subst.1 'subst '(t t t) 3)
-(def-type-prop-test subst.2 'subst '(t t (cons t t)) 3)
-(def-type-prop-test subst.3 'subst '(t t list) 3)
-(def-type-prop-test subst.4 'subst '(t t (cons (cons t t) (cons t t))) 3)
-(def-type-prop-test subst.5 'subst `(boolean t (cons (cons t t) (cons t t))
-                                             (eql :key)
-                                             (or null (eql not) (eql ,#'not))) 5)
-(def-type-prop-test subst.6 'subst `(t t (cons (cons t t) (cons t t)) (eql :test) (or (eql equal) (eql ,#'equal))) 5)
-(def-type-prop-test subst.7 'subst `(t t (cons (cons t t) (cons t t)) (eql :test-not) (or (eql equal) (eql ,#'equal))) 5)
-(def-type-prop-test subst.8 'subst `(t t (cons (cons t t) (cons t t))
-                                       (eql :key) (or null (eql not) (eql ,#'not))
-                                       (eql :test) (or (eql equal) (eql ,#'equal))) 7)
-
-(def-type-prop-test nsubst.1 'nsubst '(t t t) 3 :replicate '(nil nil t))
-(def-type-prop-test nsubst.2 'nsubst '(t t (cons t t)) 3 :replicate '(nil nil t))
-(def-type-prop-test nsubst.3 'nsubst '(t t list) 3 :replicate '(nil nil t))
-(def-type-prop-test nsubst.4 'nsubst '(t t (cons (cons t t) (cons t t))) 3 :replicate '(nil nil t))
-(def-type-prop-test nsubst.5 'nsubst `(boolean t (cons (cons t t) (cons t t))
-                                               (eql :key)
-                                               (or null (eql not) (eql ,#'not))) 5
-                                               :replicate '(nil nil t nil nil))
-(def-type-prop-test nsubst.6 'nsubst `(t t (cons (cons t t) (cons t t)) (eql :test) (or (eql equal) (eql ,#'equal))) 5 :replicate '(nil nil t nil nil))
-(def-type-prop-test nsubst.7 'nsubst `(t t (cons (cons t t) (cons t t)) (eql :test-not) (or (eql equal) (eql ,#'equal))) 5 :replicate '(nil nil t nil nil))
-(def-type-prop-test nsubst.8 'nsubst `(t t (cons (cons t t) (cons t t))
-                                         (eql :key) (or null (eql not) (eql ,#'not))
-                                         (eql :test) (or (eql equal) (eql ,#'equal))) 7
-                                         :replicate '(nil nil t nil nil nil nil))
-
-
-(def-type-prop-test subst-if.1 'subst-if `(t (or (eql not) (eql ,#'not)) list) 3)
-(def-type-prop-test subst-if.2 'subst-if `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3)
-(def-type-prop-test subst-if.3 'subst-if `(t (eql identity)
-                                             (cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
-                                             (eql :key) (or null (eql not) (eql ,#'not))) 5)
-
-(def-type-prop-test nsubst-if.1 'nsubst-if `(t (or (eql not) (eql ,#'not)) list) 3 :replicate '(nil nil t))
-(def-type-prop-test nsubst-if.2 'nsubst-if `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3 :replicate '(nil nil t))
-(def-type-prop-test nsubst-if.3 'nsubst-if `(t (eql identity)
-                                               (cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
-                                               (eql :key) (or null (eql not) (eql ,#'not))) 5
-                                               :replicate '(nil nil t nil nil))
-
-(def-type-prop-test subst-if-not.1 'subst-if-not `(t (or (eql not) (eql ,#'not)) list) 3)
-(def-type-prop-test subst-if-not.2 'subst-if-not `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3)
-(def-type-prop-test subst-if-not.3 'subst-if-not `(t (eql identity)
-                                                     (cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
-                                                     (eql :key) (or null (eql not) (eql ,#'not))) 5)
-
-(def-type-prop-test nsubst-if-not.1 'nsubst-if-not `(t (or (eql not) (eql ,#'not)) list) 3 :replicate '(nil nil t))
-(def-type-prop-test nsubst-if-not.2 'nsubst-if-not `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3 :replicate '(nil nil t))
-(def-type-prop-test nsubst-if-not.3 'nsubst-if-not `(t (eql identity)
-                                                       (cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
-                                                       (eql :key) (or null (eql not) (eql ,#'not))) 5
-                                                       :replicate '(nil nil t nil nil))
-
-(def-type-prop-test tree-equal.1 'tree-equal (list t #'(lambda (x) `(or t (eql ,(copy-tree x))))) 2)
-(def-type-prop-test tree-equal.2 'tree-equal (list 'list #'(lambda (x) `(or list (eql ,(copy-tree t))))) 2)
-(def-type-prop-test tree-equal.3 'tree-equal (list '(cons t t)
-                                                   #'(lambda (x) `(or (cons t t) (eql ,(copy-tree x))))
-                                                   '(eql :test)
-                                                   `(or (eql equal) (eql ,#'equal)))
-  4)
-(def-type-prop-test tree-equal.4 'tree-equal (list t #'(lambda (x) `(or t (eql ,(copy-tree x))))
-                                                   '(eql :test-not) '(eql eql))
-  4)
-
-(def-type-prop-test copy-list.1 'copy-list '(list) 1)
-(def-type-prop-test copy-list.2 'copy-list '((cons t t)) 1)
-(def-type-prop-test copy-list.3 'copy-list '((cons t (cons t (or t (cons t (or t (cons t t))))))) 1)
-
-(def-type-prop-test list-length.1 'list-length '(list) 1)
-(def-type-prop-test list-length.2 'list-length '((cons t list)) 1)
-
-(def-type-prop-test listp 'listp '(t) 1)
-
-(def-type-prop-test make-list.1 'make-list '((integer 0 100)) 1)
-(def-type-prop-test make-list.2 '(lambda (x) (length (make-list x))) '((integer 0 100)) 1)
-(def-type-prop-test make-list.3 'make-list '((integer 0 100) (eql :initial-element) t) 3)
-
-(def-type-prop-test nth.1 'nth '((integer 0 12) list) 2)
-
-(def-type-prop-test endp.1 'endp '((or null (cons t t))) 1)
-
-(def-type-prop-test append.1 'append nil 1 :maxargs 10 :rest-type 'list)
-(def-type-prop-test append.2 'append '(list t) 2)
-(def-type-prop-test append.3 'append '(list list t) 3)
-(def-type-prop-test append.4 'append '(list list list t) 4)
-
-(def-type-prop-test nconc.1 'nconc '(list) 1)
-(def-type-prop-test nconc.2 'nconc '(list list) 2 :replicate '(t nil))
-(def-type-prop-test nconc.3 'nconc '(list list list) 3 :replicate '(t t nil))
-(def-type-prop-test nconc.4 'nconc '(list list list list) 4 :replicate '(t t t nil))
-
-(def-type-prop-test revappend 'revappend '(list t) 2)
-(def-type-prop-test nreconc 'nreconc '(list t) 2 :replicate '(t nil))
-
-(def-type-prop-test butlast.1 'butlast '(list) 1)
-(def-type-prop-test butlast.2 'butlast '(list (integer 0 20)) 2)
-
-(def-type-prop-test nbutlast.1 'nbutlast '(list) 1 :replicate '(t))
-(def-type-prop-test nbutlast.2 'nbutlast '(list (integer 0 20)) 2 :replicate '(t nil))
-
-(def-type-prop-test last.1 'last '(list) 1)
-(def-type-prop-test last.2 'last '(list (integer 0 15)) 2)
-(def-type-prop-test last.3 'last '((cons t (or t (cons t (or t (cons t t)))))) 1)
-(def-type-prop-test last.4 'last '((cons t (or t (cons t (or t (cons t t))))) (integer 0 5)) 2)
-
-(def-type-prop-test ldiff.1 'ldiff '(list t) 2)
-(def-type-prop-test ldiff.2 'ldiff (list 'list
-                                         #'(lambda (x)
-                                             (if (consp x)
-                                                 `(or t (eql ,(nthcdr (random (length x)) x)))
-                                               t)))
-  2)
-
-(def-type-prop-test tailp.1 'tailp '(t list) 2)
-(def-type-prop-test tailp.2 'tailp (list t #'(lambda (x) (make-list-type (1+ (random 10)) `(eql ,x)))) 2)
-
-(def-type-prop-test nthcdr 'nthcdr '((integer 0 20) list) 2)
-
-(def-type-prop-test member.1 'member '(t list) 2)
-(def-type-prop-test member.2 'member
-  (list t #'(lambda (x) (make-list-type (random 5) `(cons (eql ,x) ,(make-list-type (random 5))))))
-  2)
-(def-type-prop-test member.3 'member `(t list (eql :key) (or (eql not) (eql ,#'not))) 4)
-(def-type-prop-test member.4 'member `(t list (eql :test) (or (eql equalp) (eql ,#'equalp))) 4)
-(def-type-prop-test member.5 'member `(t list (eql :test-not) (or (eql eql) (eql ,#'eql))) 4)
-(def-type-prop-test member.6 'member `(t list (eql :allow-other-keys) (and t (not null)) (eql :foo) t) 6)
-
-(def-type-prop-test member-if.1 'member-if `((or (eql symbolp) (eql ,#'symbolp)) list) 2)
-(def-type-prop-test member-if.2 'member-if
-  (list '(eql zerop) #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10))))
-  2)
-(def-type-prop-test member-if.3 'member-if
-  (list '(eql zerop) #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10)))
-        '(eql :key)`(or (eql 1-) (eql ,#'1-)))
-  4)
-
-(def-type-prop-test member-if-not.1 'member-if-not `((or (eql symbolp) (eql ,#'symbolp)) list) 2)
-(def-type-prop-test member-if-not.2 'member-if-not
-  (list '(eql plusp) #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10))))
-  2)
-(def-type-prop-test member-if-not.3 'member-if-not
-  (list '(eql plusp)
-        #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10)))
-        '(eql :key)
-        `(or (eql 1-) (eql ,#'1-)))
-  4)
-(def-type-prop-test member-if-not.4 'member-if-not
-  `((eql identity) list
-    (eql :allow-other-keys) (and t (not null))
-    (member :foo :bar #:xyz) t)
-  6)
-
-(def-type-prop-test mapc.1 'mapc '((eql list)) 2 :rest-type 'list :maxargs 10)
-(def-type-prop-test mapc.2 'mapc `((eql ,#'values)) 2 :rest-type 'list :maxargs 10)
-
-(def-type-prop-test mapcar.1 'mapcar '((eql list)) 2 :rest-type 'list :maxargs 10)
-(def-type-prop-test mapcar.2 'mapcar `((eql ,#'vector)) 2 :rest-type 'list :maxargs 10)
-
-(def-type-prop-test maplist.1 'maplist '((eql list)) 2 :rest-type 'list :maxargs 10)
-(def-type-prop-test maplist.2 'maplist `((eql ,#'vector)) 2 :rest-type 'list :maxargs 10)
-
-(def-type-prop-test mapl.1 'mapl '((eql list)) 2 :rest-type 'list :maxargs 10)
-(def-type-prop-test mapl.2 'mapl `((eql ,#'vector)) 2 :rest-type 'list :maxargs 10)
-
-(def-type-prop-test mapcan.1 'mapcan '((eql list)) 2 :rest-type 'list :maxargs 10)
-
-(def-type-prop-test mapcon.1 'mapcon '((eql copy-list) list) 2)
-
-(def-type-prop-test acons 'acons
-  (list t t #'(lambda (x y) (make-list-type (random 5) 'null '(or null (cons t t)))))
-  3)
-
-(def-type-prop-test assoc.1 'assoc (list t #'(lambda (x) (make-list-type (random 6) 'null '(or null (cons t t))))) 2)
-(def-type-prop-test assoc.2 'assoc
-  (list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons (eql ,x) t)))))
-  2)
-(def-type-prop-test assoc.3 'assoc
-  (list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons (eql ,x) t))))
-        '(eql :key) `(or (eql not) (eql ,#'not)))
-  4)
-(def-type-prop-test assoc.4 'assoc
-  (list 'real
-        #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons real t) (cons (eql ,x) t))))
-        `(member :test :test-not) `(member <= < = /= > >= ,#'<= ,#'< ,#'= ,#'/= ,#'> ,#'>=))
-  4)
-
-(def-type-prop-test assoc-if.1 'assoc-if
-  (list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
-        (make-list-type (random 8) 'null '(or null (cons t t))))
-  2)
-(def-type-prop-test assoc-if.2 'assoc-if
-  (list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
-        (make-list-type (random 8) 'null '(or null (cons real t)))
-        '(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
-  2)
-
-(def-type-prop-test assoc-if-not.1 'assoc-if-not
-  (list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
-        (make-list-type (random 8) 'null '(or null (cons t t))))
-  2)
-(def-type-prop-test assoc-if-not.2 'assoc-if-not
-  (list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
-        (make-list-type (random 8) 'null '(or null (cons real t)))
-        '(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
-  2)
-
-(def-type-prop-test copy-alist 'copy-alist
-  (list #'(lambda () (make-list-type (random 10) 'null '(or null (cons t t)))))
-  1)
-
-(def-type-prop-test pairlis.1 'pairlis
-  (list 'list #'(lambda (x) (make-list-type (length x) 'null t)))
-  2)
-
-(def-type-prop-test pairlis.2 'pairlis
-  (list 'list #'(lambda (x) (make-list-type (length x) 'null t))
-        #'(lambda (x y) (make-list-type (random 6) 'null '(or null (cons t t)))))
-  3)
-
-(def-type-prop-test rassoc.1 'rassoc (list t #'(lambda (x) (make-list-type (random 6) 'null '(or null (cons t t))))) 2)
-(def-type-prop-test rassoc.2 'rassoc
-  (list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons t (eql ,x))))))
-  2)
-(def-type-prop-test rassoc.3 'rassoc
-  (list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons t (eql ,x)))))
-        '(eql :key) `(or (eql not) (eql ,#'not)))
-  4)
-(def-type-prop-test rassoc.4 'rassoc
-  (list 'real
-        #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t real) (cons t (eql ,x)))))
-        `(member :test :test-not) `(member <= < = /= > >= ,#'<= ,#'< ,#'= ,#'/= ,#'> ,#'>=))
-  4)
-
-(def-type-prop-test rassoc-if.1 'rassoc-if
-  (list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
-        (make-list-type (random 8) 'null '(or null (cons t t))))
-  2)
-(def-type-prop-test rassoc-if.2 'rassoc-if
-  (list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
-        (make-list-type (random 8) 'null '(or null (cons t real)))
-        '(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
-  2)
-
-(def-type-prop-test rassoc-if-not.1 'rassoc-if-not
-  (list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
-        (make-list-type (random 8) 'null '(or null (cons t t))))
-  2)
-(def-type-prop-test rassoc-if-not.2 'rassoc-if-not
-  (list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
-        (make-list-type (random 8) 'null '(or null (cons t real)))
-        '(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
-  2)
-
-;;; We don't use numbers or characters as indicators, since the test is EQ,
-;;; which is not well-behaved on these types.
-
-(def-type-prop-test get-properties.1 'get-properties
-  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character)))) 'list)
-  2)
-(def-type-prop-test get-properties.2 'get-properties
-  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character))))
-        #'(lambda (plist) (let ((len (length plist)))
-                            (if (= len 0) '(cons t null)
-                              (let ((ind (elt plist (* 2 (random (floor len 2))))))
-                                `(cons (eql ,ind) null))))))
-  2)
-
-(def-type-prop-test getf.1 'getf
-  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character)))) t)
-  2)
-(def-type-prop-test getf.2 'getf
-  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character))))
-        #'(lambda (plist) (let ((len (length plist)))
-                            (if (= len 0) t
-                              (let ((ind (elt plist (* 2 (random (floor len 2))))))
-                                `(eql ,ind))))))
-  2)
-(def-type-prop-test getf.3 'getf
-  (list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character))))
-        t t)
-  3)
-
-(def-type-prop-test intersection.1 'intersection '(list list) 2 :test #'same-set-p)
-(def-type-prop-test intersection.2 'intersection '(list list (eql :key) (eql identity))  4 :test #'same-set-p)
-(def-type-prop-test intersection.3 'intersection
-  (list #'(lambda () (make-list-type (random 10) 'null 'integer))
-        #'(lambda (x) (make-list-type (random 10) 'null 'integer))
-        '(eql :key)
-        `(member 1+ ,#'1+))
-  4
-  :test #'same-set-p)
-(def-type-prop-test intersection.4 'intersection
-  (list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
-        #'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
-        '(eql :key)
-        `(member car ,#'car))
-  4
-  :test #'(lambda (x y) (same-set-p x y :key #'car)))
-(def-type-prop-test intersection.5 'intersection
-  (list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
-        #'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
-        '(eql :test)
-        `(member equal ,#'equal))
-  4
-  :test #'(lambda (x y) (same-set-p x y :key #'car)))
-
-(def-type-prop-test nintersection.1 'nintersection '(list list) 2 :test #'same-set-p :replicate '(t t))
-(def-type-prop-test nintersection.2 'nintersection '(list list (eql :key) (eql identity))  4 :test #'same-set-p :replicate '(t t nil nil))
-(def-type-prop-test nintersection.3 'nintersection
-  (list #'(lambda () (make-list-type (random 10) 'null 'integer))
-        #'(lambda (x) (make-list-type (random 10) 'null 'integer))
-        '(eql :key)
-        `(member 1+ ,#'1+))
-  4
-  :test #'same-set-p
-  :replicate '(t t nil nil))
-(def-type-prop-test nintersection.4 'nintersection
-  (list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
-        #'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
-        '(eql :key)
-        `(member car ,#'car))
-  4
-  :test #'(lambda (x y) (same-set-p x y :key #'car))
-  :replicate '(t t nil nil))
-(def-type-prop-test nintersection.5 'nintersection
-  (list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
-        #'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
-        '(eql :test)
-        `(member equal ,#'equal))
-  4
-  :test #'(lambda (x y) (same-set-p x y :key #'car))
-  :replicate '(t t nil nil))
-
-
-(def-type-prop-test adjoin.1 'adjoin '(t list) 2)
-(def-type-prop-test adjoin.2 'adjoin '((integer 0 1) list) 2)
-(def-type-prop-test adjoin.3 'adjoin `((integer 0 10) (cons number (cons number (cons number null)))
-                                       (eql :test) (or (eql =) (eql ,#'=)))
-  4)
-(def-type-prop-test adjoin.4 'adjoin `(number
-                                       (cons number (cons number (cons number (cons number null))))
-                                       (eql :test-not) (or (eql /=) (eql ,#'/=)))
-  4)
-(def-type-prop-test adjoin.5 'adjoin `(number
-                                       (cons number (cons number (cons number (cons number null))))
-                                       (eql :key) (or (member 1+ 1- ,#'1+ ,#'1-)))
-  4)
-
-(def-type-prop-test pushnew.1 '(lambda (x y) (list (pushnew x y) y)) '(t list) 2)
-(def-type-prop-test pushnew.2 '(lambda (x y) (list (pushnew x y) y)) '((integer 0 1) list) 2)
-(def-type-prop-test pushnew.3 '(lambda (x y) (list (pushnew x y :test #'=) y))
-  `((integer 0 10) (cons number (cons number (cons number null))))
-  2)
-(def-type-prop-test pushnew.4 '(lambda (x y) (list (pushnew x y :test-not #'/=) y))
-  `((integer 0 10) (cons number (cons number (cons number null))))
-  2)
-(def-type-prop-test pushnew.5 '(lambda (x y) (list (pushnew x y :key #'1+) y))
-  `(number (cons number (cons number (cons number (cons number null)))))
-  2)
-
-(def-type-prop-test set-difference.1 'set-difference '(list list) 2)
-(def-type-prop-test set-difference.2 'set-difference '((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))
-  2)
-(def-type-prop-test set-difference.3 'set-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (eql :test) (member = ,#'=))
-  4)
-(def-type-prop-test set-difference.4 'set-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (eql :test-not) (member /= ,#'/=))
-  4)
-(def-type-prop-test set-difference.5 'set-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
-                                                       (eql :key) (member evenp oddp ,#'evenp ,#'oddp))
-  4)
-
-(def-type-prop-test nset-difference.1 'nset-difference '(list list) 2 :replicate '(t t))
-(def-type-prop-test nset-difference.2 'nset-difference '((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))
-  2 :replicate '(t t))
-(def-type-prop-test nset-difference.3 'nset-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (eql :test) (member = ,#'=))
-  4 :replicate '(t t nil nil))
-(def-type-prop-test nset-difference.4 'nset-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (eql :test-not) (member /= ,#'/=))
-  4 :replicate '(t t nil nil))
-(def-type-prop-test nset-difference.5 'nset-difference `((cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
-                                                       (eql :key) (member evenp oddp ,#'evenp ,#'oddp))
-  4 :replicate '(t t nil nil))
-
-
-(def-type-prop-test set-exclusive-or.1 'set-exclusive-or '(list list) 2)
-(def-type-prop-test set-exclusive-or.2 'set-exclusive-or '((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))
-  2)
-(def-type-prop-test set-exclusive-or.3 'set-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (eql :test) (member = ,#'=))
-  4)
-(def-type-prop-test set-exclusive-or.4 'set-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (eql :test-not) (member /= ,#'/=))
-  4)
-(def-type-prop-test set-exclusive-or.5 'set-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
-                                                       (eql :key) (member evenp oddp ,#'evenp ,#'oddp))
-  4)
-
-(def-type-prop-test nset-exclusive-or.1 'nset-exclusive-or '(list list) 2 :replicate '(t t))
-(def-type-prop-test nset-exclusive-or.2 'nset-exclusive-or '((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))
-  2 :replicate '(t t))
-(def-type-prop-test nset-exclusive-or.3 'nset-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (eql :test) (member = ,#'=))
-  4 :replicate '(t t nil nil))
-(def-type-prop-test nset-exclusive-or.4 'nset-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))
-                                                       (eql :test-not) (member /= ,#'/=))
-  4 :replicate '(t t nil nil))
-(def-type-prop-test nset-exclusive-or.5 'nset-exclusive-or `((cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
-                                                       (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))
-                                                       (eql :key) (member evenp oddp ,#'evenp ,#'oddp))
-  4 :replicate '(t t nil nil))
-
-(def-type-prop-test subsetp.1 'subsetp '(list list) 2)
-(def-type-prop-test subsetp.2 'subsetp '((cons integer null)
-                                         (cons integer (cons integer (cons integer (cons integer null)))))
-  2)
diff --git a/random-type-prop-tests-06.lsp b/random-type-prop-tests-06.lsp
deleted file mode 100644
index b90f9d05fc4b831e9eafd114e32049fc5b079f3f..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-06.lsp
+++ /dev/null
@@ -1,146 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Sun Mar 13 15:33:55 2005
-;;;; Contains: Random type prop tests, part 6 (arrays)
-
-(in-package :cl-test)
-
-(def-type-prop-test adjustable-array-p 'adjustable-array-p '(array) 1)
-
-(def-type-prop-test aref.0 'aref '((array * nil)) 1)
-(def-type-prop-test aref.1 'aref (list '(array * (*)) (index-type-for-dim 0)) 2)
-(def-type-prop-test aref.2 'aref (list '(array * (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
-(def-type-prop-test aref.3 'aref (list '(array * (* * *))
-                                       (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
-  4)
-
-(def-type-prop-test array-dimension 'array-dimension
-  (list 'array #'(lambda (x) (let ((r (array-rank x))) (and (> r 0) `(integer 0 (,r))))))
-  2)
-(def-type-prop-test array-dimensions 'array-dimensions '(array) 1)
-(def-type-prop-test array-element-type 'array-element-type '(array) 1)
-(def-type-prop-test array-has-fill-pointer-p.1 'array-has-fill-pointer-p '(array) 1)
-(def-type-prop-test array-has-fill-pointer-p.2 'array-has-fill-pointer-p '(vector) 1)
-(def-type-prop-test array-displacement.1 'array-displacement '(array) 1)
-(def-type-prop-test array-displacement.2 'array-displacement '(vector) 1)
-
-(def-type-prop-test array-in-bounds-p.0 'array-in-bounds-p '((array * nil)) 1)
-(def-type-prop-test array-in-bounds-p.1 'array-in-bounds-p (list '(array * (*)) (index-type-for-dim 0)) 2)
-(def-type-prop-test array-in-bounds-p.2 'array-in-bounds-p
-  (list '(array * (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
-(def-type-prop-test array-in-bounds-p.3 'array-in-bounds-p
-  (list '(array * (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
-  4)
-(def-type-prop-test array-in-bounds-p.4 'array-in-bounds-p '((array * (*)) integer) 2)
-(def-type-prop-test array-in-bounds-p.5 'array-in-bounds-p '((array * (* *)) integer integer) 3)
-(def-type-prop-test array-in-bounds-p.6 'array-in-bounds-p '((array * (* * *)) integer integer integer) 4)
-(def-type-prop-test array-rank 'array-rank '(array) 1)
-
-(def-type-prop-test array-row-major-index.0 'array-row-major-index '((array * nil)) 1)
-(def-type-prop-test array-row-major-index.1 'array-row-major-index (list '(array * (*)) (index-type-for-dim 0)) 2)
-(def-type-prop-test array-row-major-index.2 'array-row-major-index
-  (list '(array * (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
-(def-type-prop-test array-row-major-index.3 'array-row-major-index
-  (list '(array * (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
-  4)
-(def-type-prop-test array-total-size 'array-total-size '(array) 1)
-
-(def-type-prop-test arrayp 'arrayp '(t) 1)
-
-(def-type-prop-test fill-pointer '(lambda (x) (and (array-has-fill-pointer-p x) (fill-pointer x))) '(vector) 1)
-
-(def-type-prop-test row-major-aref 'row-major-aref
-  (list 'array #'(lambda (a) (let ((s (array-total-size a))) (and (> s 0) `(integer 0 (,s))))))
-  2)
-
-(def-type-prop-test upgraded-array-element-type 'upgraded-array-element-type
-  (list #'(lambda () (let ((x (make-random-element-of-type t)))
-                       `(eql ,(make-random-type-containing x)))))
-  1)
-
-(def-type-prop-test simple-vector-p.1 'simple-vector-p '(t) 1)
-(def-type-prop-test simple-vector-p.2 'simple-vector-p '(vector) 1)
-
-(def-type-prop-test svref 'svref (list 'simple-vector (index-type-for-dim 0)) 2)
-(def-type-prop-test vector 'vector nil 1 :rest-type t :maxargs 10)
-(def-type-prop-test vectorp.1 'vectorp '(t) 1)
-(def-type-prop-test vectorp.2 'vectorp '(array) 1)
-
-(def-type-prop-test bit.1 'bit (list '(array bit (*)) (index-type-for-dim 0)) 2)
-(def-type-prop-test bit.2 'bit (list '(array bit (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
-(def-type-prop-test bit.3 'bit
-  (list '(array bit (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
-  4)
-
-(def-type-prop-test sbit.1 'sbit (list '(simple-array bit (*)) (index-type-for-dim 0)) 2)
-(def-type-prop-test sbit.2 'sbit (list '(simple-array bit (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
-(def-type-prop-test sbit.3 'sbit
-  (list '(simple-array bit (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
-  4)
-
-
-(def-type-prop-test bit-and.1 'bit-and (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-and.2 'bit-and
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-andc1.1 'bit-andc1 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-andc1.2 'bit-andc1
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-andc2.1 'bit-andc2 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-andc2.2 'bit-andc2
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-ior.1 'bit-ior (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-ior.2 'bit-ior
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-orc1.1 'bit-orc1 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-orc1.2 'bit-orc1
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-orc2.1 'bit-orc2 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-orc2.2 'bit-orc2
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-eqv.1 'bit-eqv (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-eqv.2 'bit-eqv
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-xor.1 'bit-xor (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-xor.2 'bit-xor
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-nand.1 'bit-nand (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-nand.2 'bit-nand
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-nor.1 'bit-nor (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
-                                                                          `(array bit ,dims))))
-  2)
-(def-type-prop-test bit-nor.2 'bit-nor
-  (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
-  3)
-(def-type-prop-test bit-not.1 'bit-not '((array bit)) 1)
-(def-type-prop-test bit-not.2 'bit-not '((array bit) null) 2)
-
-(def-type-prop-test bit-vector-p 'bit-vector-p '(t) 1)
-(def-type-prop-test simple-bit-vector-p 'simple-bit-vector-p '(t) 1)
diff --git a/random-type-prop-tests-07.lsp b/random-type-prop-tests-07.lsp
deleted file mode 100644
index efe6f59b1e92cf91e2f91d854e8f0a436e6e9756..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-07.lsp
+++ /dev/null
@@ -1,121 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Sun Mar 13 17:03:52 2005
-;;;; Contains: Random type prop tests, part 7 (strings)
-
-(in-package :cl-test)
-
-(def-type-prop-test simple-string-p 'simple-string-p '(t) 1)
-(def-type-prop-test char 'char (list 'string (index-type-for-dim 0)) 2)
-(def-type-prop-test schar 'schar (list 'simple-string (index-type-for-dim 0)) 2)
-
-(def-type-prop-test string 'string '((or string symbol character)) 1)
-(def-type-prop-test string-upcase 'string-upcase '(string) 1)
-(def-type-prop-test string-downcase 'string-downcase '(string) 1)
-(def-type-prop-test string-capitalize 'string-capitalize '(string) 1)
-
-(def-type-prop-test string-trim.1 'string-trim '(string string) 2)
-(def-type-prop-test string-trim.2 'string-trim (list #'(lambda () (make-list-type (random 10) 'null 'character))
-                                                     'string)
-  2)
-(def-type-prop-test string-left-trim.1 'string-left-trim '(string string) 2)
-(def-type-prop-test string-left-trim.2 'string-left-trim (list #'(lambda () (make-list-type (random 10) 'null 'character))
-                                                               'string)
-  2)
-(def-type-prop-test string-right-trim.1 'string-right-trim '(string string) 2)
-(def-type-prop-test string-right-trim.2 'string-right-trim
-  (list #'(lambda () (make-list-type (random 10) 'null 'character)) 'string)
-  2)
-
-(defmacro def-string-comparison-type-prop-test (op)
-  (flet ((%makename (n) (intern (format nil "~A.~A" op n) :cl-test)))
-    `(progn
-       (def-type-prop-test ,(%makename 1) ',op '(string string) 2)
-       (def-type-prop-test ,(%makename 2) ',op
-         `(string string (eql :start1) ,#'index-type-for-v1)
-         4)
-       (def-type-prop-test ,(%makename 3) ',op
-         `(string string (eql :start2) ,#'index-type-for-v2)
-         4)
-       (def-type-prop-test ,(%makename 4) ',op
-         `(string string (eql :end1) ,#'end-type-for-v1)
-         4)
-       (def-type-prop-test ,(%makename 5) ',op
-         `(string string (eql :end2) ,#'end-type-for-v2)
-         4)
-       (def-type-prop-test ,(%makename 6) ',op
-         `(string string
-                  (eql :start1) ,#'index-type-for-v1
-                  (eql :end1) ,#'end-type-for-v1)
-         6)
-       (def-type-prop-test ,(%makename 7) ',op
-         `(string string
-                  (eql :start1) ,#'index-type-for-v1
-                  (eql :end2) ,#'end-type-for-v2)
-         6)
-       (def-type-prop-test ,(%makename 8) ',op
-         `(string string
-                  (eql :start2) ,#'index-type-for-v2
-                  (eql :end1) ,#'end-type-for-v1)
-         6)
-       (def-type-prop-test ,(%makename 9) ',op
-         `(string string
-                  (eql :start2) ,#'index-type-for-v2
-                  (eql :end2) ,#'end-type-for-v2)
-         6)
-       (def-type-prop-test ,(%makename 10) ',op
-         `(string string
-                  (eql :start1) ,#'index-type-for-v1
-                  (eql :start2) ,#'index-type-for-v2
-                  (eql :end1) ,#'end-type-for-v1)
-         8)
-       (def-type-prop-test ,(%makename 11) ',op
-         `(string string
-                  (eql :start1) ,#'index-type-for-v1
-                  (eql :start2) ,#'index-type-for-v2
-                  (eql :end2) ,#'end-type-for-v2)
-         8)
-       (def-type-prop-test ,(%makename 12) ',op
-         `(string string
-                  (eql :start1) ,#'index-type-for-v1
-                  (eql :end2) ,#'end-type-for-v2
-                  (eql :end1) ,#'end-type-for-v1)
-         8)
-       (def-type-prop-test ,(%makename 13) ',op
-         `(string string
-                  (eql :start2) ,#'index-type-for-v2
-                  (eql :end2) ,#'end-type-for-v2
-                  (eql :end1) ,#'end-type-for-v1)
-         8)
-       (def-type-prop-test ,(%makename 14) ',op
-         `(string string
-                  (eql :start1) ,#'index-type-for-v1
-                  (eql :start2) ,#'index-type-for-v2
-                  (eql :end2) ,#'end-type-for-v2
-                  (eql :end1) ,#'end-type-for-v1)
-         10)
-       )))
-
-(def-string-comparison-type-prop-test string=)
-(def-string-comparison-type-prop-test string/=)
-(def-string-comparison-type-prop-test string<)
-(def-string-comparison-type-prop-test string<=)
-(def-string-comparison-type-prop-test string>)
-(def-string-comparison-type-prop-test string>=)
-
-(def-string-comparison-type-prop-test string-equal)
-(def-string-comparison-type-prop-test string-not-equal)
-(def-string-comparison-type-prop-test string-lessp)
-(def-string-comparison-type-prop-test string-greaterp)
-(def-string-comparison-type-prop-test string-not-lessp)
-(def-string-comparison-type-prop-test string-not-greaterp)
-
-(def-type-prop-test stringp 'stringp '(t) 1)
-
-(def-type-prop-test make-string.1 'make-string '((integer 0 100) (eql :initial-element) character) 3)
-(def-type-prop-test make-string.2 'make-string `((integer 0 100) (eql :initial-element) character
-                                                 (eql :element-type)
-                                                 ,#'(lambda (&rest args)
-                                                      `(eql (and character
-                                                                 ,(make-random-type-containing (third args))))))
-  5)
diff --git a/random-type-prop-tests-08.lsp b/random-type-prop-tests-08.lsp
deleted file mode 100644
index 9f8c938cd7fbc40bc17f6bb70515fa3d973e6bdc..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-08.lsp
+++ /dev/null
@@ -1,348 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Sun Mar 13 18:31:57 2005
-;;;; Contains: Random type prop tests, part 8 (sequences)
-
-(in-package :cl-test)
-
-(def-type-prop-test copy-seq 'copy-seq '((or vector list)) 1)
-
-(def-type-prop-test elt 'elt (list '(or vector list)
-                                   #'(lambda (x) (let ((len (length x)))
-                                                   (and (> len 0) `(integer 0 (,len))))))
-  2)
-
-(defmacro rfill (x y &rest other-args)
-  `(fill ,y ,x ,@other-args))
-
-(def-type-prop-test fill.1 'rfill
-  (list t #'make-random-sequence-type-containing)
-  2 :replicate '(nil t))
-
-(def-type-prop-test fill.2 'rfill
-  (list 'integer #'make-random-sequence-type-containing)
-  2 :replicate '(nil t))
-
-(def-type-prop-test fill.3 'rfill
-  (list 'character #'make-random-sequence-type-containing)
-  2 :replicate '(nil t))
-
-(def-type-prop-test fill.4 'rfill
-  (list t #'make-random-sequence-type-containing
-        '(eql :start)
-        #'(lambda (v s k1) (declare (ignore v k1))
-            (let ((len (length s)))
-              `(integer 0 ,len))))
-  4 :replicate '(nil t nil nil))
-
-(def-type-prop-test fill.5 'rfill
-  (list t #'make-random-sequence-type-containing
-        '(eql :end)
-        #'(lambda (v s k1) (declare (ignore v k1))
-            (let ((len (length s)))
-              `(integer 0 ,len))))
-  4 :replicate '(nil t nil nil))
-
-(def-type-prop-test fill.6 'rfill
-  (list t #'make-random-sequence-type-containing
-        '(eql :start)
-        #'(lambda (v s k1) (declare (ignore v k1))
-            (let ((len (length s)))
-              `(integer 0 ,len)))
-        '(eql :end)
-        #'(lambda (v s k1 start k2)
-            (declare (ignore v k1 k2))
-            (let ((len (length s)))
-              `(integer ,start ,len))))
-  6 :replicate '(nil t nil nil nil nil))
-
-;;; make-sequence tests here
-
-(def-type-prop-test subseq.1 'subseq
-  (list 'sequence #'(lambda (s) `(integer 0 ,(length s))))
-  2)
-
-(def-type-prop-test subseq.2 'subseq
-  (list 'sequence #'(lambda (s) `(integer 0 ,(length s)))
-        #'(lambda (s start) `(integer ,start ,(length s))))
-  3)
-
-;;; map tests here
-
-(def-type-prop-test map.1 'map
-  (list '(member list vector)
-        '(member list #.#'list)
-        '(or list vector))
-  3)
-
-(def-type-prop-test map.2 'map
-  (list '(member list vector)
-        '(member list #.#'list)
-        '(or list vector)
-        '(or list vector))
-  4)
-
-(def-type-prop-test map.3 'map
-  (list '(member list vector)
-        '(member list #.#'list)
-        '(or list vector)
-        '(or list vector)
-        '(or list vector))
-  5)
-
-(def-type-prop-test map.4 'map
-  (list '(member list vector (vector (unsigned-byte 32)))
-        '(member 1+ #.#'1+)
-        `(or ,@(loop for i from 1 to 31 collect `(vector (unsigned-byte ,i)))))
-  3)
-
-(def-type-prop-test map.5 'map
-  (list `(member ,@(loop for i from 1 to 32 collect `(vector (unsigned-byte ,i))))
-        '(member 1+ #.#'1+)
-        #'(lambda (type fun)
-            (declare (ignore fun))
-            (let ((i (cadadr type)))
-              `(or ,@(loop for j from i to 32 collect `(vector (integer 0 ,(- (ash 1 i) 2))))))))
-  3)
-
-
-
-;;; map-into tests here
-
-(def-type-prop-test map-into.1 'map-into
-  (list '(or list (vector t))
-        '(member list #.#'list)
-        '(or list vector))
-  3 :replicate '(t nil nil))
-
-(def-type-prop-test map-into.2 'map-into
-  (list '(or list (vector t))
-        '(member list #.#'list)
-        '(or list vector)
-        '(or list vector))
-  4 :replicate '(t nil nil nil))
-
-;;; reduce tests here
-
-(def-type-prop-test count.1 'count '(t sequence) 2)
-(def-type-prop-test count.2 'count
-  (list t #'make-random-sequence-type-containing)
-  2)
-(def-type-prop-test count.3 'count
-  (list t #'make-random-sequence-type-containing
-        '(eql :start)
-        #'(lambda (x s k1) (declare (ignore x k1))
-            `(integer 0 ,(length s))))
-  4)
-(def-type-prop-test count.4 'count
-  (list t #'make-random-sequence-type-containing
-        '(eql :end)
-        #'(lambda (x s k1) (declare (ignore x k1))
-            `(integer 0 ,(length s))))
-  4)
-(def-type-prop-test count.5 'count
-  (list t #'make-random-sequence-type-containing
-        '(eql :start)
-        #'(lambda (x s k1) (declare (ignore x k1))
-            `(integer 0 ,(length s)))
-        '(eql :end)
-        #'(lambda (x s k1 start k2) (declare (ignore x k1 k2))
-            `(integer ,start ,(length s))))
-  6)
-
-(def-type-prop-test count.6 'count
-  (list '(or short-float single-float double-float long-float)
-        #'(lambda (f) `(vector (or ,(typecase f
-                                      (short-float 'short-float)
-                                      (single-float 'single-float)
-                                      (double-float 'double-float)
-                                      (long-float 'long-float)
-                                      (t 'float))
-                                   (eql ,f)))))
-  2)
-
-(def-type-prop-test count.7 'count '(bit (vector bit)) 2)
-(def-type-prop-test count.8 'count '((unsigned-byte 2) (vector (unsigned-byte 2))) 2)
-(def-type-prop-test count.9 'count '((unsigned-byte 4) (vector (unsigned-byte 4))) 2)
-(def-type-prop-test count.10 'count '((unsigned-byte 8) (vector (unsigned-byte 8))) 2)
-
-
-;;; count-if tests
-
-(def-type-prop-test count-if.1 'count-if
-  (list (let ((funs '(numberp rationalp realp floatp complexp
-                      symbolp identity null functionp listp consp
-                      arrayp vectorp simple-vector-p
-                      stringp simple-string-p
-                      bit-vector-p simple-bit-vector-p)))
-          `(member ,@funs ,@(mapcar #'symbol-function funs)))
-        '(or list vector))
-  2)
-
-(def-type-prop-test count-if.2 'count-if
-  (list (let ((funs '(numberp rationalp realp floatp complexp
-                      symbolp identity null functionp listp consp
-                      arrayp vectorp simple-vector-p
-                      stringp simple-string-p
-                      bit-vector-p simple-bit-vector-p)))
-          `(member ,@funs ,@(mapcar #'symbol-function funs)))
-        '(or list vector)
-        '(eql :key)
-        (let ((key-funs '(identity not null)))
-          `(member ,@key-funs ,@(mapcar #'symbol-function key-funs))))
-  4)
-
-
-;;; Put count-if-not tests here
-
-
-(def-type-prop-test length.1 'length '(sequence) 1)
-
-(def-type-prop-test reverse.1 'reverse '(sequence) 1)
-(def-type-prop-test nreverse.1 'nreverse '(sequence) 1 :replicate '(t))
-
-(def-type-prop-test sort.1 'sort
-  `((vector bit) (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) 2
-  :replicate '(t nil))
-
-(def-type-prop-test sort.2 'sort
-  `((or (vector (unsigned-byte 2))
-        (vector (unsigned-byte 3))
-        (vector (unsigned-byte 4))
-        (vector (unsigned-byte 5))
-        (vector (unsigned-byte 6))
-        (vector (unsigned-byte 7))
-        (vector (unsigned-byte 8)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test sort.3 'sort
-  `((or (vector (unsigned-byte 10))
-        (vector (unsigned-byte 13))
-        (vector (unsigned-byte 15))
-        (vector (unsigned-byte 16)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test sort.4 'sort
-  `((or (vector (unsigned-byte 20))
-        (vector (unsigned-byte 24))
-        (vector (unsigned-byte 28))
-        (vector (unsigned-byte 31))
-        (vector (unsigned-byte 32)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test sort.5 'sort
-  `((or (vector (signed-byte 2))
-        (vector (signed-byte 3))
-        (vector (signed-byte 4))
-        (vector (signed-byte 5))
-        (vector (signed-byte 6))
-        (vector (signed-byte 7))
-        (vector (signed-byte 8)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test sort.6 'sort
-  `((or (vector (signed-byte 10))
-        (vector (signed-byte 13))
-        (vector (signed-byte 15))
-        (vector (signed-byte 16)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test sort.7 'sort
-  `((or (vector (signed-byte 20))
-        (vector (signed-byte 24))
-        (vector (signed-byte 28))
-        (vector (signed-byte 31))
-        (vector (signed-byte 32)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test sort.8 'sort
-  `((or (vector short-float)
-        (vector single-float)
-        (vector double-float)
-        (vector long-float))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-;;; Stable sort
-
-(def-type-prop-test stable-sort.1 'stable-sort
-  `((vector bit) (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)) 2
-  :replicate '(t nil))
-
-(def-type-prop-test stable-sort.2 'stable-sort
-  `((or (vector (unsigned-byte 2))
-        (vector (unsigned-byte 3))
-        (vector (unsigned-byte 4))
-        (vector (unsigned-byte 5))
-        (vector (unsigned-byte 6))
-        (vector (unsigned-byte 7))
-        (vector (unsigned-byte 8)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test stable-sort.3 'stable-sort
-  `((or (vector (unsigned-byte 10))
-        (vector (unsigned-byte 13))
-        (vector (unsigned-byte 15))
-        (vector (unsigned-byte 16)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test stable-sort.4 'stable-sort
-  `((or (vector (unsigned-byte 20))
-        (vector (unsigned-byte 24))
-        (vector (unsigned-byte 28))
-        (vector (unsigned-byte 31))
-        (vector (unsigned-byte 32)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test stable-sort.5 'stable-sort
-  `((or (vector (signed-byte 2))
-        (vector (signed-byte 3))
-        (vector (signed-byte 4))
-        (vector (signed-byte 5))
-        (vector (signed-byte 6))
-        (vector (signed-byte 7))
-        (vector (signed-byte 8)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test stable-sort.6 'stable-sort
-  `((or (vector (signed-byte 10))
-        (vector (signed-byte 13))
-        (vector (signed-byte 15))
-        (vector (signed-byte 16)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test stable-sort.7 'stable-sort
-  `((or (vector (signed-byte 20))
-        (vector (signed-byte 24))
-        (vector (signed-byte 28))
-        (vector (signed-byte 31))
-        (vector (signed-byte 32)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test stable-sort.8 'stable-sort
-  `((or (vector short-float)
-        (vector single-float)
-        (vector double-float)
-        (vector long-float))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
-  2 :replicate '(t nil))
-
-(def-type-prop-test stable-sort.9 'stable-sort
-  `((vector (cons (integer 0 4) (eql nil)))
-    (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=)
-    (eql :key)
-    (member car ,#'car))
-  4 :replicate '(t nil nil nil)
-  :test #'equalp-and-eql-elements)
diff --git a/random-type-prop-tests-09.lsp b/random-type-prop-tests-09.lsp
deleted file mode 100644
index 46270c318e133c091ca73a0ece40c94eebb6df36..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-09.lsp
+++ /dev/null
@@ -1,717 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Contains: Random type prop tests, part 9 (sequences)
-
-(in-package :cl-test)
-
-;;; FIND
-
-(def-type-prop-test find.1 'find
-  (list t #'make-random-sequence-type-containing)
-  2)
-
-(def-type-prop-test find.2 'find
-  (list 'integer #'make-random-sequence-type-containing)
-  2)
-
-(def-type-prop-test find.3 'find
-  (list 'character #'make-random-sequence-type-containing)
-  2)
-
-(def-type-prop-test find.4 'find
-  (list t
-        #'make-random-sequence-type-containing
-        '(eql :start)
-        #'(lambda (v s k1) (declare (ignore v k1))
-            (let ((len (length s)))
-              `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test find.5 'find
-  (list t
-        #'make-random-sequence-type-containing
-        '(eql :end)
-        #'(lambda (v s k1) (declare (ignore v k1))
-            (let ((len (length s)))
-              `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test find.6 'find
-  (list t #'make-random-sequence-type-containing
-        '(eql :start)
-        #'(lambda (v s k1) (declare (ignore v k1))
-            (let ((len (length s)))
-              `(integer 0 ,len)))
-        '(eql :end)
-        #'(lambda (v s k1 start k2)
-            (declare (ignore v k1 k2))
-            (let ((len (length s)))
-              `(integer ,start ,len))))
-  6)
-
-(def-type-prop-test find.7 'find
-  (list 'integer #'(lambda (x) (declare (ignore x))
-                     (make-sequence-type
-                      (random 10)
-                      (random-from-seq #(bit integer float rational real number))))
-        '(eql :key)
-        '(member 1+ #.#'1+ 1- #.#'1- - #.#'-))
-  4)
-
-(def-type-prop-test find.8 'find
-  (list 'character
-        #'(lambda (x) (declare (ignore x))
-            (make-sequence-type
-             (random 10)
-             (random-from-seq #(character base-char standard-char))))
-        '(eql :key)
-        '(member char-upcase #.#'char-upcase
-                 char-downcase #.#'char-downcase
-                 upper-case-p #.#'upper-case-p
-                 lower-case-p #.#'lower-case-p
-                 both-case-p #.#'both-case-p
-                 char-code #.#'char-code
-                 char-int #.#'char-int
-                 alpha-char-p #.#'alpha-char-p
-                 digit-char-p #.#'digit-char-p
-                 alphanumericp #.#'alphanumericp))
-  4)
-
-(def-type-prop-test find.9 'find
-  (list t #'make-random-sequence-type-containing
-        '(eql :from-end)
-        '(or null t))
-  4)
-
-(def-type-prop-test find.10 'find
-  (list 'real #'(lambda (x) (make-sequence-type
-                             (random 10)
-                             (random-from-seq #(bit integer float rational real))))
-        '(eql :from-end)
-        '(or null t)
-        '(member :test :test-not)
-        (list 'member '< #'< '> #'> '<= #'<= '>= #'>= '= #'= '/= #'/=
-              'equal #'equal 'eql #'eql))
-  6)
-
-;;; FIND-IF
-
-(def-type-prop-test find-if.1 'find-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence)
-  2)
-
-(def-type-prop-test find-if.2 'find-if
-  (list
-   (let ((char-predicates
-          '(alpha-char-p digit-char-p upper-case-p lower-case-p
-            both-case-p alphanumericp graphic-char-p
-            standard-char-p)))
-     (append '(member) char-predicates
-             (mapcar #'symbol-function char-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           '(or standard-char base-char character))))
-  2)
-
-(def-type-prop-test find-if.3 'find-if
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x))))))
-  2)
-
-(def-type-prop-test find-if.4 'find-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test find-if.5 'find-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :end)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test find-if.6 'find-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :end)
-   #'(lambda (f s k1 start k2)
-       (declare (ignore f k1 k2))
-       (let ((len (length s)))
-         `(integer ,start ,len))))
-  6)
-
-(def-type-prop-test find-if.7 'find-if
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x)))))
-   '(eql :key)
-   (list 'member '1+ '1- 'identity '-
-         #'1+ #'1- #'identity #'-))
-  4)
-
-(def-type-prop-test find-if.8 'find-if
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x)))))
-   '(eql :from-end)
-   '(or null t))
-  4)
-
-(def-type-prop-test find-if.9 'find-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :from-end)
-   '(or null t))
-  6)
-
-(def-type-prop-test find-if.10 'find-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :end)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :from-end)
-   '(or null t))
-  6)
-
-;;; FIND-IF-NOT
-
-(def-type-prop-test find-if-not.1 'find-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence)
-  2)
-
-(def-type-prop-test find-if-not.2 'find-if-not
-  (list
-   (let ((char-predicates
-          '(alpha-char-p digit-char-p upper-case-p lower-case-p
-            both-case-p alphanumericp graphic-char-p
-            standard-char-p)))
-     (append '(member) char-predicates
-             (mapcar #'symbol-function char-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           '(or standard-char base-char character))))
-  2)
-
-(def-type-prop-test find-if-not.3 'find-if-not
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x))))))
-  2)
-
-(def-type-prop-test find-if-not.4 'find-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test find-if-not.5 'find-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :end)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test find-if-not.6 'find-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :end)
-   #'(lambda (f s k1 start k2)
-       (declare (ignore f k1 k2))
-       (let ((len (length s)))
-         `(integer ,start ,len))))
-  6)
-
-(def-type-prop-test find-if-not.7 'find-if-not
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x)))))
-   '(eql :key)
-   (list 'member '1+ '1- 'identity '-
-         #'1+ #'1- #'identity #'-))
-  4)
-
-(def-type-prop-test find-if-not.8 'find-if-not
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x)))))
-   '(eql :from-end)
-   '(or null t))
-  4)
-
-(def-type-prop-test find-if-not.9 'find-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :from-end)
-   '(or null t))
-  6)
-
-(def-type-prop-test find-if-not.10 'find-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :end)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :from-end)
-   '(or null t))
-  6)
-
-;;; POSITION
-
-(def-type-prop-test position.1 'position
-  (list t #'make-random-sequence-type-containing)
-  2)
-
-(def-type-prop-test position.2 'position
-  (list 'integer #'make-random-sequence-type-containing)
-  2)
-
-(def-type-prop-test position.3 'position
-  (list 'character #'make-random-sequence-type-containing)
-  2)
-
-(def-type-prop-test position.4 'position
-  (list t
-        #'make-random-sequence-type-containing
-        '(eql :start)
-        #'(lambda (v s k1) (declare (ignore v k1))
-            (let ((len (length s)))
-              `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test position.5 'position
-  (list t
-        #'make-random-sequence-type-containing
-        '(eql :end)
-        #'(lambda (v s k1) (declare (ignore v k1))
-            (let ((len (length s)))
-              `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test position.6 'position
-  (list t #'make-random-sequence-type-containing
-        '(eql :start)
-        #'(lambda (v s k1) (declare (ignore v k1))
-            (let ((len (length s)))
-              `(integer 0 ,len)))
-        '(eql :end)
-        #'(lambda (v s k1 start k2)
-            (declare (ignore v k1 k2))
-            (let ((len (length s)))
-              `(integer ,start ,len))))
-  6)
-
-(def-type-prop-test position.7 'position
-  (list 'integer #'(lambda (x) (declare (ignore x))
-                     (make-sequence-type
-                      (random 10)
-                      (random-from-seq #(bit integer float rational real number))))
-        '(eql :key)
-        '(member 1+ #.#'1+ 1- #.#'1- - #.#'-))
-  4)
-
-(def-type-prop-test position.8 'position
-  (list 'character
-        #'(lambda (x) (declare (ignore x))
-            (make-sequence-type
-             (random 10)
-             (random-from-seq #(character base-char standard-char))))
-        '(eql :key)
-        '(member char-upcase #.#'char-upcase
-                 char-downcase #.#'char-downcase
-                 upper-case-p #.#'upper-case-p
-                 lower-case-p #.#'lower-case-p
-                 both-case-p #.#'both-case-p
-                 char-code #.#'char-code
-                 char-int #.#'char-int
-                 alpha-char-p #.#'alpha-char-p
-                 digit-char-p #.#'digit-char-p
-                 alphanumericp #.#'alphanumericp))
-  4)
-
-(def-type-prop-test position.9 'position
-  (list t #'make-random-sequence-type-containing
-        '(eql :from-end)
-        '(or null t))
-  4)
-
-(def-type-prop-test position.10 'position
-  (list 'real #'(lambda (x) (make-sequence-type
-                             (random 10)
-                             (random-from-seq #(bit integer float rational real))))
-        '(eql :from-end)
-        '(or null t)
-        '(member :test :test-not)
-        (list 'member '< #'< '> #'> '<= #'<= '>= #'>= '= #'= '/= #'/=
-              'equal #'equal 'eql #'eql))
-  6)
-
-;;; POSITION-IF
-
-(def-type-prop-test position-if.1 'position-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence)
-  2)
-
-(def-type-prop-test position-if.2 'position-if
-  (list
-   (let ((char-predicates
-          '(alpha-char-p digit-char-p upper-case-p lower-case-p
-            both-case-p alphanumericp graphic-char-p
-            standard-char-p)))
-     (append '(member) char-predicates
-             (mapcar #'symbol-function char-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           '(or standard-char base-char character))))
-  2)
-
-(def-type-prop-test position-if.3 'position-if
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x))))))
-  2)
-
-(def-type-prop-test position-if.4 'position-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test position-if.5 'position-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :end)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test position-if.6 'position-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :end)
-   #'(lambda (f s k1 start k2)
-       (declare (ignore f k1 k2))
-       (let ((len (length s)))
-         `(integer ,start ,len))))
-  6)
-
-(def-type-prop-test position-if.7 'position-if
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x)))))
-   '(eql :key)
-   (list 'member '1+ '1- 'identity '-
-         #'1+ #'1- #'identity #'-))
-  4)
-
-(def-type-prop-test position-if.8 'position-if
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x)))))
-   '(eql :from-end)
-   '(or null t))
-  4)
-
-(def-type-prop-test position-if.9 'position-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :from-end)
-   '(or null t))
-  6)
-
-(def-type-prop-test position-if.10 'position-if
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :end)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :from-end)
-   '(or null t))
-  6)
-
-;;; POSITION-IF-NOT
-
-(def-type-prop-test position-if-not.1 'position-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence)
-  2)
-
-(def-type-prop-test position-if-not.2 'position-if-not
-  (list
-   (let ((char-predicates
-          '(alpha-char-p digit-char-p upper-case-p lower-case-p
-            both-case-p alphanumericp graphic-char-p
-            standard-char-p)))
-     (append '(member) char-predicates
-             (mapcar #'symbol-function char-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           '(or standard-char base-char character))))
-  2)
-
-(def-type-prop-test position-if-not.3 'position-if-not
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x))))))
-  2)
-
-(def-type-prop-test position-if-not.4 'position-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test position-if-not.5 'position-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :end)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test position-if-not.6 'position-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :end)
-   #'(lambda (f s k1 start k2)
-       (declare (ignore f k1 k2))
-       (let ((len (length s)))
-         `(integer ,start ,len))))
-  6)
-
-(def-type-prop-test position-if-not.7 'position-if-not
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x)))))
-   '(eql :key)
-   (list 'member '1+ '1- 'identity '-
-         #'1+ #'1- #'identity #'-))
-  4)
-
-(def-type-prop-test position-if-not.8 'position-if-not
-  (list
-   (let ((integer-predicates '(zerop plusp minusp evenp oddp)))
-     (append '(member) integer-predicates
-             (mapcar #'symbol-function integer-predicates)))
-   #'(lambda (x) (declare (ignore x))
-       (make-sequence-type (random 10)
-                           `(or bit bit bit bit bit bit bit
-                                ,@(loop for x from 2 to 32
-                                        collect `(unsigned-byte ,x))
-                                ,@(loop for x from 2 to 32
-                                        collect `(signed-byte ,x)))))
-   '(eql :from-end)
-   '(or null t))
-  4)
-
-(def-type-prop-test position-if-not.9 'position-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :start)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :from-end)
-   '(or null t))
-  6)
-
-(def-type-prop-test position-if-not.10 'position-if-not
-  (list
-   (append '(member) *cl-safe-predicates*
-           (mapcar 'symbol-function *cl-safe-predicates*))
-   'sequence
-   '(eql :end)
-   #'(lambda (f s k1) (declare (ignore f k1))
-       (let ((len (length s)))
-         `(integer 0 ,len)))
-   '(eql :from-end)
-   '(or null t))
-  6)
diff --git a/random-type-prop-tests-10.lsp b/random-type-prop-tests-10.lsp
deleted file mode 100644
index 71d23474ad7e02084b378c457ac2b8eb904b7f5e..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-10.lsp
+++ /dev/null
@@ -1,114 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Contains: Random type prop tests, part 10 (sequences, cont.)
-
-(in-package :cl-test)
-
-;;; SEARCH
-
-(def-type-prop-test search.1 'search
-  (list 'sequence 'sequence)
-  2)
-
-(def-type-prop-test search.2 'search
-  (list 'bit-vector 'bit-vector)
-  2)
-
-(def-type-prop-test search.3 'search
-  (list '(vector * 1) 'sequence)
-  2)
-
-(def-type-prop-test search.4 'search
-  (list '(vector * 2) 'sequence '(eql :from-end) '(or null t))
-  4)
-
-(def-type-prop-test search.5 'search
-  (list 'sequence 'sequence '(eql :key)
-        (list 'member 'identity nil #'identity 'not #'not))
-  4)
-
-(def-type-prop-test search.6 'search
-  (list #'(lambda () (make-sequence-type
-                      (random 10)
-                      (let ((i1 (make-random-integer))
-                            (i2 (make-random-integer)))
-                        `(integer ,(min i1 i2) ,(max i1 i2)))))
-        #'(lambda (s)
-            (declare (ignore s))
-            (make-sequence-type
-             (random 10)
-             (let ((i1 (make-random-integer))
-                   (i2 (make-random-integer)))
-               `(integer ,(min i1 i2) ,(max i1 i2))))))
-  2)
-
-(def-type-prop-test search.7 'search
-  (list #'(lambda () (make-sequence-type
-                      (random 10)
-                      (let ((i1 (make-random-integer))
-                            (i2 (make-random-integer)))
-                        `(integer ,(min i1 i2) ,(max i1 i2)))))
-        #'(lambda (s)
-            (declare (ignore s))
-            (make-sequence-type
-             (random 10)
-             (let ((i1 (make-random-integer))
-                   (i2 (make-random-integer)))
-               `(integer ,(min i1 i2) ,(max i1 i2)))))
-        '(eql :test)
-        (list 'member 'eql #'eql 'equal #'equal '= #'=
-              '/= #'/= #'(lambda (x y) (= (logand x 1) (logand y 1)))))
-  4)
-
-(def-type-prop-test search.8 'search
-  (labels ((%random-char-type () (random-from-seq #(base-char standard-char character)))
-           (%random-char-sequence-type (&rest ignored)
-              (declare (ignore ignored))
-              (make-sequence-type (random 10) (%random-char-type))))
-
-          (list #'%random-char-sequence-type
-                #'%random-char-sequence-type
-                '(member :test :test-not)
-                (let ((char-compare-funs
-                       '(char= char/= char< char> char<= char>=
-                         char-equal char-not-equal char-lessp char-greaterp
-                         char-not-lessp char-not-greaterp)))
-                  `(member ,@char-compare-funs
-                           ,@(mapcar #'symbol-function char-compare-funs)))))
-  4)
-
-(def-type-prop-test search.9 'search
-  (list 'sequence 'sequence
-        '(eql :start1)
-        #'(lambda (s1 s2 k)
-            (declare (ignore s2 k))
-            (let ((len (length s1)))
-              `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test search.10 'search
-  (list 'sequence 'sequence
-        '(eql :end1)
-        #'(lambda (s1 s2 k)
-            (declare (ignore s2 k))
-            (let ((len (length s1)))
-              `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test search.11 'search
-  (list 'sequence 'sequence
-        '(eql :start2)
-        #'(lambda (s1 s2 k)
-            (declare (ignore s1 k))
-            (let ((len (length s2)))
-              `(integer 0 ,len))))
-  4)
-
-(def-type-prop-test search.12 'search
-  (list 'sequence 'sequence
-        '(eql :end2)
-        #'(lambda (s1 s2 k)
-            (declare (ignore s1 k))
-            (let ((len (length s2)))
-              `(integer 0 ,len))))
-  4)
diff --git a/random-type-prop-tests-structs.lsp b/random-type-prop-tests-structs.lsp
deleted file mode 100644
index 9a4423ad968c6274baff3fb505d98f4a87c9a611..0000000000000000000000000000000000000000
--- a/random-type-prop-tests-structs.lsp
+++ /dev/null
@@ -1,72 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Contains: Random type prop tests: structures
-
-(in-package :cl-test)
-
-(defstruct rtpt-1 a b)
-
-(defmethod make-random-element-of-type ((type (eql 'rtpt-1)))
-  (make-rtpt-1 :a (make-random-element-of-type t)
-               :b (make-random-element-of-type t)))
-
-(defmethod replicate ((obj rtpt-1))
-  (or (gethash obj *replicate-table*)
-      (let ((x (make-rtpt-1)))
-        (setf (gethash obj *replicate-table*) x)
-        (setf (rtpt-1-a x) (replicate (rtpt-1-a obj)))
-        (setf (rtpt-1-b x) (replicate (rtpt-1-b obj)))
-        x)))
-
-(defmethods make-random-type-containing*
-  (1 ((val rtpt-1)) 'rtpt-1))
-
-(def-type-prop-test structure-ref.1 'rtpt-1-a '(rtpt-1) 1)
-
-(def-type-prop-test copy-structure.1 'copy-structure '(rtpt-1) 1
-  :test #'equalp)
-
-
-(defstruct rtpt-2 a)
-(defstruct (rtpt-2.1 (:include rtpt-2)) c d)
-(defstruct (rtpt-2.2 (:include rtpt-2)) d e)
-
-(defmethod make-random-element-of-type ((type (eql 'rtpt-2)))
-  (rcase
-   (1 (make-rtpt-2 :a (make-random-element-of-type t)))
-   (1 (make-random-element-of-type 'rtpt-2.1))
-   (1 (make-random-element-of-type 'rtpt-2.2))))
-
-(defmethod make-random-element-of-type ((type (eql 'rtpt-2.1)))
-  (make-rtpt-2.1 :a (make-random-element-of-type t)
-                 :c (make-random-element-of-type t)
-                 :d (make-random-element-of-type t)))
-
-(defmethod make-random-element-of-type ((type (eql 'rtpt-2.2)))
-  (make-rtpt-2.2 :a (make-random-element-of-type t)
-                 :d (make-random-element-of-type t)
-                 :e (make-random-element-of-type t)))
-
-(defmethod replicate ((obj rtpt-2))
-  (replicate-with (obj x (make-rtpt-2))
-                  (setf (rtpt-2-a x) (replicate (rtpt-2-a obj)))))
-
-(defmethod replicate ((obj rtpt-2.1))
-  (replicate-with (obj x (make-rtpt-2.1))
-                  (setf (rtpt-2.1-a x) (replicate (rtpt-2.1-a obj)))
-                  (setf (rtpt-2.1-c x) (replicate (rtpt-2.1-c obj)))
-                  (setf (rtpt-2.1-d x) (replicate (rtpt-2.1-d obj)))))
-
-(defmethod replicate ((obj rtpt-2.2))
-  (replicate-with (obj x (make-rtpt-2.2))
-                  (setf (rtpt-2.2-a x) (replicate (rtpt-2.2-a obj)))
-                  (setf (rtpt-2.2-d x) (replicate (rtpt-2.2-d obj)))
-                  (setf (rtpt-2.2-e x) (replicate (rtpt-2.2-e obj)))))
-
-(defmethods make-random-type-containing*
-  (1 ((val rtpt-2)) 'rtpt-2)
-  (1 ((val rtpt-2.1)) 'rtpt-2.1)
-  (1 ((val rtpt-2.2)) 'rtpt-2.2))
-
-(def-type-prop-test structure-ref.2 'rtpt-2-a '(rtpt-2) 1)
-
diff --git a/random-type-prop-tests.lsp b/random-type-prop-tests.lsp
deleted file mode 100644
index 6f86d1c75ed07c5fefb033221637f4ee79255678..0000000000000000000000000000000000000000
--- a/random-type-prop-tests.lsp
+++ /dev/null
@@ -1,22 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Sun Feb 20 11:50:26 2005
-;;;; Contains: Randomized tests of type propagation during compilation
-
-(compile-and-load "random-type-prop.lsp")
-
-(in-package :cl-test)
-
-(load "random-type-prop-tests-01.lsp")
-(load "random-type-prop-tests-02.lsp")
-(load "random-type-prop-tests-03.lsp")
-(load "random-type-prop-tests-04.lsp")
-(load "random-type-prop-tests-05.lsp")
-(load "random-type-prop-tests-06.lsp")
-(load "random-type-prop-tests-07.lsp")
-(load "random-type-prop-tests-08.lsp")
-(load "random-type-prop-tests-09.lsp")
-(load "random-type-prop-tests-10.lsp")
-
-(load "random-type-prop-tests-structs.lsp")
-
diff --git a/random-type-prop.lsp b/random-type-prop.lsp
deleted file mode 100644
index bacb02cf00065a4de6a01f621aa58c95202191ec..0000000000000000000000000000000000000000
--- a/random-type-prop.lsp
+++ /dev/null
@@ -1,664 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Thu Dec 23 20:39:22 2004
-;;;; Contains: Randomized tests of type propagation in the compiler
-
-(in-package :cl-test)
-
-(eval-when (:compile-toplevel :load-toplevel)
-  (compile-and-load "random-aux.lsp")
-  (compile-and-load "random-int-form.lsp"))
-
-(defvar *print-random-type-prop-input* nil)
-(defparameter *random-type-prop-result* nil)
-
-(declaim (special *param-types* *params* *is-var?* *form*))
-(declaim (special *replicate-type*))
-
-(defparameter *default-reps* 1000)
-(defparameter *default-cell* nil)
-(defparameter *default-ignore* 'arithmetic-error)
-(defparameter *default-arg-the* t)
-
-;;;
-;;; The random type prop tester takes three required arguments:
-;;;
-;;;  operator  A lisp operator (either a symbol or a lambda form)
-;;;  arg-types A list consisting either of certain kinds of lisp types
-;;;            (that make-random-element-of-type understands) and/or
-;;;            functions that yield types.
-;;;  minargs   Minimum number of arguments to be given to the operator.
-;;;            Must be a positive integer <= maxargs.
-;;;
-;;; There are also keyword arguments, some with defaults given by special
-;;; variables.
-;;;
-;;; The random type prop tester generates between minargs and maxargs
-;;; (maxargs defaults to minargs) random arguments.  The type of each
-;;; argument is given by the corresponding type in arg-types (or by rest-type,
-;;; if there aren't enough elements of arg-types).  If the element of arg-types
-;;; is a function, the type for the parameter is produced by calling the function
-;;; with the previously generated actual parameters as its arguments.
-;;;
-;;; The list of parameters is stored into the special variable *params*.
-;;;
-;;; The tester evaluates (operator . arguments), and also builds a lambda
-;;; form to be compiled and called on (a subset of) the parameters.  The lambda
-;;; form is stored in the special variable *form*.
-;;;
-;;; The macro def-type-prop-test wraps a call to do-random-type-prop-tests
-;;; in a deftest form.  See random-type-prop-tests.lsp (and subfiles) for examples
-;;; of its use testing CL builtin operators.  To use it:
-;;;
-;;; (load "gclload1.lsp")
-;;; (compile-and-load "random-int-form.lsp") ;; do this on lisps not supporting recursive compiles
-;;; (compile-and-load "random-type-prop.lsp")
-;;; (in-package :cl-test)
-;;; (load "random-type-prop-tests.lsp")
-;;; (let (*catch-errors*) (do-test '<testname>))
-;;; or (let (*catch-errors*) (do-tests))
-;;;
-;;; Running all the tests may take a while, particularly on lisps with slow compilers.
-;;;
-;;;
-;;; Keyword arguments to do-random-type-prop-tests:
-;;;
-;;;  Argument    Default         Meaning
-;;;
-;;;  maxargs     minargs         Maximum number of actual parameters to generate (max 20).
-;;;  rest-type   t               Type of arguments beyond those specified in arg-types
-;;;  reps        *default-reps*  Number of repetitions to try before stopping.
-;;;                              The default is controlled by a special variable that
-;;;                              is initially 1000.
-;;;  enclosing-the nil           If true, with prob 1/2 randomly generate an enclosing
-;;;                              (THE ...) form around the form invoking the operator.
-;;;  arg-the     *default-arg-the*   If true (which is the initial value of the default
-;;;                              special variable), with probability 1/2 randomly generate
-;;;                              a (THE ...) form around each actual parameter.
-;;;  cell        *default-cell*  If true (default is NIL), store the result into a rank-0
-;;;                              array of specialized type.  This enables one to test
-;;;                              forms where the result will be unboxed.  Otherwise, just
-;;;                              return the values.
-;;;  ignore      *default-ignore*  Ignore conditions that are elements of IGNORE.  Default is
-;;;                              ARITHMETIC-ERROR.
-;;;  test        rt::equalp-with-case   The test function used to compare outputs.  It's
-;;;                              also handy to use #'approx= to handle approximate equality
-;;;                              when testing floating point computations, where compiled code
-;;;                              may have different roundoff errors.
-;;;  replicate   nil             Cause arguments to be copied (preserving sharing in conses
-;;;                              and arrays) before applying the operator.  This is used to test
-;;;                              destructive operators.
-;;;
-;;;
-
-(defun do-random-type-prop-tests
-  (operator arg-types minargs
-            &key
-            (maxargs minargs)
-            (rest-type t)
-            (reps *default-reps*)
-            (enclosing-the nil)
-            (arg-the *default-arg-the*)
-            (cell *default-cell*)
-            (ignore *default-ignore*)
-            (test #'regression-test::equalp-with-case)
-            (replicate nil replicate-p))
-  (assert (<= 1 minargs maxargs 20))
-(prog1
-  (dotimes (i reps)
-    again
-    (handler-bind
-     #-lispworks ((error #'(lambda (c) (when (typep c ignore) (go again)))))
-     #+lispworks ()
-    (let* ((param-names
-           '(p1 p2 p3 p4 p5 p6 p7 p8 p9 p10
-             p11 p12 p13 p14 p15 p16 p17 p18 p19 p20))
-          (nargs (+ minargs (random (- maxargs minargs -1))))
-          (types (subseq
-                  (append arg-types
-                          (make-list (max 0 (- nargs (length arg-types)))
-                                     :initial-element rest-type))
-                  0 nargs))
-          (replicate (if replicate-p replicate
-                       (mapcar (constantly nil) types)))
-          ; (vals (mapcar #'make-random-element-of-type types))
-          (vals (setq *params*
-                      (or (make-random-arguments types) (go again))))
-          (vals
-           (if replicate
-               (mapcar #'replicate vals)
-             vals))
-          (is-var? (if (consp replicate)
-                       (progn
-                         (assert (= (length replicate) (length vals)))
-                         (loop for x in replicate collect (or x (coin))))
-                     (loop repeat (length vals) collect (coin))))
-          (*is-var?* is-var?)
-          (params (loop for x in is-var?
-                        for p in param-names
-                        when x collect p))
-          (param-types (mapcar #'make-random-type-containing vals replicate))
-          (*param-types* param-types)
-          (type-decls (loop for x in is-var?
-                            for p in param-names
-                            for tp in param-types
-                            when x
-                            collect `(type ,tp ,p)))
-          (rval (cl:handler-bind
-                 (#+sbcl (sb-ext::compiler-note #'muffle-warning)
-                         (warning #'muffle-warning))
-                 (let* ((vals (if replicate (mapcar #'replicate vals) vals))
-                        (eval-form (cons operator (loop for v in vals
-                                                        collect `(quote ,v)))))
-                   ;; (print eval-form) (terpri)
-                   ;; (dotimes (i 100) (eval eval-form))
-                   (eval eval-form))))
-          (result-type (if (and enclosing-the (integerp rval))
-                           (make-random-type-containing rval)
-                         t))
-          (expr `(,operator ,@(loop for x in is-var?
-                                    for v in vals
-                                    for r in replicate
-                                    for p in param-names
-                                    collect (if x
-                                                (if (and arg-the (coin))
-                                                    (let ((tp (make-random-type-containing v r)))
-                                                      `(the ,tp ,p))
-                                                  p)
-                                              (if (or (consp v)
-                                                      (and (symbolp v) (not (or (keywordp v)
-                                                                                (member v '(nil t))))))
-                                                  `(quote ,v)
-                                                  v)))))
-          (speed (random 4))
-          (space (random 4))
-          (safety #-allegro (random 4)
-                  #+allegro (1+ (random 3)))
-          (debug (random 4))
-          (store-into-cell? (and cell (coin)))
-          (upgraded-result-type (and store-into-cell?
-                                     (upgraded-array-element-type `(eql ,rval))))
-          (form
-           (setq *form*
-                 `(lambda (,@(when store-into-cell? '(r)) ,@params)
-                    (declare (optimize (speed ,speed) (safety ,safety) (debug ,debug) (space ,space))
-                             ,@(when store-into-cell? `((type (simple-array ,upgraded-result-type nil) r)))
-                             ,@ type-decls)
-                    ,(let ((result-form
-                            (if enclosing-the `(the ,result-type ,expr) expr)))
-                       (if store-into-cell?
-                           `(setf (aref r) ,result-form)
-                         result-form)))))
-          )
-     (when *print-random-type-prop-input*
-       (let ((*print-pretty* t)
-             (*print-case* :downcase))
-         (print (list :form form :vals vals))))
-     (finish-output)
-     (let* ((param-vals (loop for x in is-var?
-                              for v in vals
-                              when x collect v))
-            (fn (cl:handler-bind
-                 (#+sbcl (sb-ext::compiler-note #'muffle-warning)
-                         (warning #'muffle-warning))
-                 (compile nil form)))
-            (result
-             (if store-into-cell?
-                 (let ((r (make-array nil :element-type upgraded-result-type)))
-                   (apply fn r param-vals)
-                   (aref r))
-               (apply fn param-vals))))
-       (setq *random-type-prop-result*
-             (list :upgraded-result-type upgraded-result-type
-                   :form form
-                   :vals vals
-                   :result result
-                   :rval rval))
-       (unless (funcall test result rval)
-         (return *random-type-prop-result*))))
-    ;; #+allegro (excl::gc t)
-  ))))
-
-(defun make-random-arguments (types-or-funs)
-  (let ((vals nil))
-    (loop for type-or-fun in types-or-funs
-          for type = (or (typecase type-or-fun
-                           ((and function (not symbol))
-                            (apply type-or-fun vals))
-                           (t type-or-fun))
-                         (return-from make-random-arguments nil) ;; null type
-                         )
-          for val = (make-random-element-of-type type)
-          do (setf vals (nconc vals (list val))))
-    ;; (dolist (v vals) (describe v))
-    vals))
-
-(defmacro defmethods (name &rest bodies)
-  `(progn
-     ,@(mapcar
-        #'(lambda (body) `(defmethod ,name ,@body))
-        bodies)))
-
-(defgeneric make-random-type-containing* (val)
-  (:method-combination randomized)
-  (:documentation "Produce a random type containing VAL.  If the special
-variable *REPLICATE-TYPE* is true, and the value is mutable, then do not
-use the value in MEMBER or EQL type specifiers."))
-
-(defun make-random-type-containing (type &optional *replicate-type*)
-  (declare (special *replicate-type*))
-  (make-random-type-containing* type))
-
-(defmethods make-random-type-containing*
-  (4 ((val t))
-     (declare (special *replicate-type*))
-     (rcase
-      (1 t)
-      (1 (if (consp val) 'cons 'atom))
-      (1 (if *replicate-type* (make-random-type-containing* val)
-           `(eql ,val)))
-      (1
-       (if *replicate-type* (make-random-type-containing* val)
-         (let* ((n1 (random 4))
-                (n2 (random 4))
-                ;; Replace these calls with (make-random-element-of-type t)
-                ;; at some point
-                (l1 (loop repeat n1 collect (random-leaf)))
-                (l2 (loop repeat n2 collect (random-leaf))))
-           `(member ,@l1 ,val ,@l2))))))
-
-  (1 ((val standard-object)) 'standard-object)
-  (1 ((val structure-object)) 'structure-object)
-  (1 ((val class)) 'class)
-  (1 ((val standard-class)) 'standard-class)
-  (1 ((val structure-class)) 'structure-class)
-  (1 ((val number)) 'number)
-  (1 ((val real)) 'real)
-  (1 ((val ratio)) 'ratio)
-
-  (1 ((val integer))
-     (rcase
-      (1 'integer)
-      (1 'signed-byte)
-      (1 (let* ((n1 (random 4))
-                (n2 (random 4))
-                (l1 (loop repeat n1 collect (make-random-integer)))
-                (l2 (loop repeat n2 collect (make-random-integer))))
-           `(member ,@l1 ,val ,@l2)))
-      (1 (let ((lo (abs (make-random-integer))))
-           `(integer ,(- val lo))))
-      (2 (let ((lo (abs (make-random-integer))))
-           `(integer ,(- val lo) *)))
-      (2 (let ((hi (abs (make-random-integer))))
-           `(integer * ,(+ val hi))))
-      (4 (let ((lo (abs (make-random-integer)))
-               (hi (abs (make-random-integer))))
-           `(integer ,(- val lo) ,(+ val hi))))
-      (1 (if (>= val 0) 'unsigned-byte (throw 'fail nil)))))
-
-  (2 ((val character))
-     (rcase
-      (1 'character)
-      (1 (if (typep val 'base-char) 'base-char
-           #-sbcl 'extended-char
-           #+sbcl (throw 'fail nil)
-           ))
-      (1 (if (typep val 'standard-char) 'standard-char (throw 'fail nil)))
-      (1 (let* ((n1 (random 4))
-                (n2 (random 4))
-                (l1 (loop repeat n1 collect (make-random-character)))
-                (l2 (loop repeat n2 collect (make-random-character))))
-           `(member ,@l1 ,val ,@l2)))))
-
-  (1 ((val null)) 'null)
-
-  (2 ((val symbol))
-     (rcase
-      (1 'symbol)
-      (1 (typecase val (boolean 'boolean) (keyword 'keyword) (otherwise (throw 'fail nil))))
-      (1 (let* ((n1 (random 4))
-                (n2 (random 4))
-                (l1 (loop repeat n1 collect (make-random-symbol)))
-                (l2 (loop repeat n2 collect (make-random-symbol))))
-           `(member ,@l1 ,val ,@l2)))))
-
-  (1 ((val rational))
-     (rcase
-      (1 'rational)
-      (1 (let* ((n1 (random 4))
-                (n2 (random 4))
-                (l1 (loop repeat n1 collect (make-random-element-of-type 'rational)))
-                (l2 (loop repeat n2 collect (make-random-element-of-type 'rational))))
-           `(member ,@l1 ,val ,@l2)))
-      (1 `(rational ,val))
-      (1 `(rational * ,val))
-      (1 (let ((v (make-random-element-of-type 'rational)))
-           (if (<= v val)
-               `(rational ,v ,val)
-             `(rational ,val ,v))))))
-
-  (1 ((val float))
-     (rcase
-      (1 (let* ((n1 (random 4))
-                (n2 (random 4))
-                (l1 (loop repeat n1 collect (- 2 (random (float 1.0 val)))))
-                (l2 (loop repeat n2 collect (- 2 (random (float 1.0 val))))))
-           `(member ,@l1 ,val ,@l2)))
-      (1 (let ((names (float-types-containing val)))
-           (random-from-seq names)))
-      (1 (let ((name (random-from-seq (float-types-containing val))))
-           (if (>= val 0)
-               `(,name ,(coerce 0 name) ,val)
-             `(,name ,val ,(coerce 0 name)))))))
-  )
-
-(defun float-types-containing (val)
-  (loop for n in '(short-float single-float double-float long-float float)
-        when (typep val n)
-        collect n))
-
-(defun make-random-array-dimension-spec (array dim-index)
-  (assert (<= 0 dim-index))
-  (assert (< dim-index (array-rank array)))
-  (let ((dim (array-dimension array dim-index)))
-    (rcase (1 '*) (1 dim))))
-
-;;; More methods
-(defmethods make-random-type-containing*
-  (3 ((val bit-vector))
-     (let ((root (if (and (coin)
-                          (typep val 'simple-bit-vector))
-                     'simple-bit-vector
-                   'bit-vector)))
-       (rcase (1 root)
-              (1 `(,root))
-              (3 `(,root ,(make-random-array-dimension-spec val 0))))))
-
-  (3 ((val vector))
-     (let ((root 'vector)
-            (alt-root (if (and (coin) (simple-vector-p val)) 'simple-vector 'vector))
-            (etype (rcase (1 '*)
-                          (1 (array-element-type val))
-                          ;; Add rule for creating new element types?
-                          )))
-        (rcase (1 alt-root)
-               (1 `(,alt-root))
-               (1 `(,root ,etype))
-               (2 (if (and (simple-vector-p val) (coin))
-                      `(simple-vector ,(make-random-array-dimension-spec val 0))
-                    `(,root ,etype ,(make-random-array-dimension-spec val 0)))))))
-
-  (3 ((val array))
-     (let ((root (if (and (coin) (typep val 'simple-array)) 'simple-array 'array))
-        (etype (rcase (1 (array-element-type val)) (1 '*)))
-        (rank (array-rank val)))
-       (rcase
-        (1 root)
-        (1 `(,root))
-        (1 `(,root ,etype))
-        (1 `(,root ,etype ,(loop for i below rank collect (make-random-array-dimension-spec val i))))
-        (1 `(,root ,etype ,(loop for i below rank collect (array-dimension val i))))
-        #-ecl (1 `(,root ,etype ,rank)))))
-
-  (3 ((val string))
-     (let ((root (cond
-                  ((and (coin)
-                        (typep val 'base-string))
-                   (cond
-                    ((and (coin) (typep val 'simple-base-string))
-                     'simple-base-string)
-                    (t 'base-string)))
-                  ((and (coin)
-                        (typep val 'simple-string))
-                   'simple-string)
-                  (t 'string))))
-       (rcase (1 root)
-              (1 `(,root))
-              (3 `(,root ,(make-random-array-dimension-spec val 0))))))
-
-  (1 ((val list)) 'list)
-
-  (1 ((val cons))
-     (rcase
-      (1 'cons)
-      (2 `(cons ,(make-random-type-containing* (car val))
-                ,(make-random-type-containing* (cdr val))))
-      (1 `(cons ,(make-random-type-containing* (car val))
-                ,(random-from-seq #(t *))))
-      (1 `(cons ,(make-random-type-containing* (car val))))
-      (1 `(cons ,(random-from-seq #(t *))
-                ,(make-random-type-containing* (cdr val))
-                ))))
-
-  (1 ((val complex))
-     (rcase
-      (1 'complex)
-      #-gcl
-      (1 (let* ((t1 (type-of (realpart val)))
-                (t2 (type-of (imagpart val)))
-                (part-type
-                 (cond
-                  ((subtypep t1 t2) (upgraded-complex-part-type t2))
-                  ((subtypep t2 t1) (upgraded-complex-part-type t1))
-                  ((and (subtypep t1 'rational)
-                        (subtypep t2 'rational))
-                   'rational)
-                  (t
-                   (upgraded-complex-part-type `(or ,t1 ,t2))))))
-           (if (subtypep 'real part-type)
-               '(complex real)
-             `(complex ,part-type))))))
-
-  (1 ((val generic-function)) 'generic-function)
-  (1 ((val function))
-     (rcase
-      (1 'function)
-      (1 (if (typep val 'compiled-function)
-             'compiled-function
-           'function))))
-  )
-
-;;; Macro for defining random type prop tests
-
-(defmacro def-type-prop-test (name &body args)
-  `(deftest ,(intern (concatenate 'string "RANDOM-TYPE-PROP."
-                                  (string name))
-                     (find-package :cl-test))
-     (do-random-type-prop-tests ,@args)
-     nil))
-
-;;; Function used in constructing list types for some random type prop tests
-
-(defun make-list-type (length &optional (rest-type 'null) (element-type t))
-  (let ((result rest-type))
-    (loop repeat length
-          do (setq result `(cons ,element-type ,result)))
-    result))
-
-(defun make-sequence-type (length &optional (element-type t))
-  (rcase
-   (1 `(vector ,element-type ,length))
-   (1 `(array ,element-type (,length)))
-   (1 `(simple-array ,element-type (,length)))
-   (2 (make-list-type length 'null element-type))))
-
-(defun make-random-sequence-type-containing (element &optional *replicate-type*)
-  (make-sequence-type (random 10) (make-random-type-containing* element)))
-
-(defun same-set-p (set1 set2 &rest args &key key test test-not)
-  (declare (ignorable key test test-not))
-  (and (apply #'subsetp set1 set2 args)
-       (apply #'subsetp set2 set2 args)
-       t))
-
-(defun index-type-for-dim (dim)
-  "Returns a function that computes integer type for valid indices
-   of an array dimension, or NIL if there are none."
-  #'(lambda (array &rest other)
-      (declare (ignore other))
-      (let ((d (array-dimension array dim)))
-        (and (> d 0) `(integer 0 (,d))))))
-
-(defun index-type-for-v1 (v1 &rest other)
-  "Computes integer type for valid indices for the first of two vectors"
-  (declare (ignore other))
-  (let ((d (length v1))) `(integer 0 ,d)))
-
-(defun index-type-for-v2 (v1 v2 &rest other)
-  "Computes integer type for valid indices for the second of two vectors"
-  (declare (ignore v1 other))
-  (let ((d (length v2))) `(integer 0 ,d)))
-
-(defun end-type-for-v1 (v1 v2 &rest other)
-  (declare (ignore v2))
-  (let ((d (length v1))
-        (start1 (or (cadr (member :start1 other)) 0)))
-    `(integer ,start1 ,d)))
-
-(defun end-type-for-v2 (v1 v2 &rest other)
-  (declare (ignore v1))
-  (let ((d (length v2))
-        (start2 (or (cadr (member :start2 other)) 0)))
-    `(integer ,start2 ,d)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defgeneric replicate (obj)
-  (:documentation "Copies the structure of a lisp object recursively, preserving sharing."))
-
-(defmacro replicate-with ((source-obj dest-obj copy-form) &body body)
-  `(or (gethash ,source-obj *replicate-table*)
-       (let ((,dest-obj ,copy-form))
-         (setf (gethash ,source-obj *replicate-table*) ,dest-obj)
-         ,@body
-         ,dest-obj)))
-
-(declaim (special *replicate-table*))
-
-(defmethod replicate :around ((obj t))
-  "Wrapper to create a hash table for structure sharing, if none exists."
-  (if (boundp '*replicate-table*)
-      (call-next-method obj)
-    (let ((*replicate-table* (make-hash-table)))
-      (call-next-method obj))))
-
-(defmethod replicate ((obj cons))
-  (or (gethash obj *replicate-table*)
-      (let ((x (cons nil nil)))
-        (setf (gethash obj *replicate-table*) x)
-        (setf (car x) (replicate (car obj)))
-        (setf (cdr x) (replicate (cdr obj)))
-        x)))
-
-;;; Default method for objects without internal structure
-(defmethod replicate ((obj t)) obj)
-
-(defmethod replicate ((obj array))
-  (multiple-value-bind
-      (new-obj old-leaf new-leaf)
-      (replicate-displaced-array obj)
-    (when new-leaf
-      (loop for i below (array-total-size new-leaf)
-            do (setf (row-major-aref new-leaf i)
-                     (row-major-aref old-leaf i))))
-    new-obj))
-
-(defun replicate-displaced-array (obj)
-  "Replicate the non-terminal (and not already replicated) arrays
-   in a displaced array chain.  Return the new root array, the
-   old leaf array, and the new (but empty) leaf array.  The latter
-   two are NIL if the leaf did not have to be copied again."
-  (or (gethash obj *replicate-table*)
-      (multiple-value-bind
-          (displaced-to displaced-index-offset)
-          (array-displacement obj)
-        (let ((dims (array-dimensions obj))
-              (element-type (array-element-type obj))
-              (fill-pointer (and (array-has-fill-pointer-p obj)
-                                 (fill-pointer obj)))
-              (adj (adjustable-array-p obj)))
-          (if displaced-to
-              ;; The array is displaced
-              ;; Copy recursively
-              (multiple-value-bind
-                  (new-displaced-to old-leaf new-leaf)
-                  (replicate-displaced-array displaced-to)
-                (let ((new-obj (make-array dims :element-type element-type
-                                           :fill-pointer fill-pointer
-                                           :adjustable adj
-                                           :displaced-to new-displaced-to
-                                           :displaced-index-offset displaced-index-offset)))
-                  (setf (gethash obj *replicate-table*) new-obj)
-                  (values new-obj old-leaf new-leaf)))
-            ;; The array is not displaced
-            ;; This is the leaf array
-            (let ((new-obj (make-array dims :element-type element-type
-                                       :fill-pointer fill-pointer
-                                       :adjustable adj)))
-              (setf (gethash obj *replicate-table*) new-obj)
-              (values new-obj obj new-obj)))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declaim (special *isomorphism-table*))
-
-(defun isomorphic-p (obj1 obj2)
-  (let ((*isomorphism-table* (make-hash-table)))
-    (isomorphic-p* obj1 obj2)))
-
-(defgeneric isomorphic-p* (obj1 obj2)
-  (:documentation
-   "Returns true iff obj1 and obj2 are 'isomorphic' (that is, have the same structure,
-    including the same leaf values and the same pattern of sharing).  It should be
-    the case that (isomorphic-p obj (replicate obj)) is true."))
-
-(defmethod isomorphic-p* ((obj1 t) (obj2 t))
-  (eql obj1 obj2))
-
-(defmethod isomorphic-p* ((obj1 cons) (obj2 cons))
-  (let ((previous (gethash obj1 *isomorphism-table*)))
-    (cond
-     (previous
-      ;; If we've already produced a mapping from obj1 to something,
-      ;; isomorphism requires that obj2 be that object
-      (eq previous obj2))
-     ;; Otherwise, assume obj1 will map to obj2 and recurse
-     (t
-      (setf (gethash obj1  *isomorphism-table*) obj2)
-      (and (isomorphic-p* (car obj1) (car obj2))
-           (isomorphic-p* (cdr obj1) (cdr obj2)))))))
-
-(defmethod isomorphic-p* ((obj1 array) (obj2 array))
-  (let ((previous (gethash obj1 *isomorphism-table*)))
-    (cond
-     (previous
-      ;; If we've already produced a mapping from obj1 to something,
-      ;; isomorphism requires that obj2 be that object
-      (eq previous obj2))
-     (t
-      (setf (gethash obj1 *isomorphism-table*) obj2)
-      (and (equal (array-dimensions obj1) (array-dimensions obj2))
-           (equal (array-element-type obj1) (array-element-type obj2))
-           (if (array-has-fill-pointer-p obj1)
-               (and (array-has-fill-pointer-p obj2)
-                    (eql (fill-pointer obj1) (fill-pointer obj2)))
-             (not (array-has-fill-pointer-p obj2)))
-           (let (to-1 (index-1 0) to-2 (index-2 0))
-             (multiple-value-setq (to-1 index-1) (array-displacement obj1))
-             (multiple-value-setq (to-2 index-2) (array-displacement obj2))
-             (if to-1
-                 (and to-2
-                      (eql index-1 index-2)
-                      (isomorphic-p* to-1 to-2))
-               ;; Not displaced -- recurse on elements
-               (let ((total-size (array-total-size obj1)))
-                 (loop for i below total-size
-                       always (isomorphic-p* (row-major-aref obj1 i)
-                                             (row-major-aref obj2 i)))))))))))
-
-;;; Test that sequences have identical elements
-
-(defun equalp-and-eql-elements (s1 s2)
-  (and (equalp s1 s2)
-       (every #'eql s1 s2)))
diff --git a/random-types.lsp b/random-types.lsp
deleted file mode 100644
index fa9b061d3ee3b0f5496b2e504d945321654ba60a..0000000000000000000000000000000000000000
--- a/random-types.lsp
+++ /dev/null
@@ -1,369 +0,0 @@
-;-*- Mode:     Lisp -*-
-;;;; Author:   Paul Dietz
-;;;; Created:  Mon Oct  6 05:04:45 2003
-;;;; Contains: Generating random types and testing relationships on them
-
-(in-package :cl-test)
-
-(compile-and-load "types-aux.lsp")
-(compile-and-load "random-aux.lsp")
-(compile-and-load "random-int-form.lsp")
-
-(defparameter *random-types* nil)
-
-(defun make-random-type (size)
-  (if (<= size 1)
-      (rcase
-       (1 nil)
-       (1 t)
-       (1 `(eql ,(let ((r (ash 1 (random 45))))
-                   (random-from-interval r (- r)))))
-       (1 (random-from-seq #(integer unsigned-byte ratio rational real float
-                             short-float single-float double-float
-                             long-float complex symbol cons function)))
-       (1
-        (let* ((len (random *maximum-random-int-bits*))
-               (r1 (ash 1 len))
-               (r2 (+ r1 r1))
-               (x (- (random r2) r1))
-               (y (- (random r2) r1))
-               (lo (min x y))
-               (hi (max x y)))
-          `(integer ,lo ,hi)))
-       (1 (make-random-real-type))
-       ;; (1 (make-random-complex-type))
-       )
-    (rcase
-     (2 (let* ((op (random-from-seq #(cons cons and or)))
-               (nargs (if (eq op 'cons) 2
-                        (1+ (random (min size 4)))))
-               (sizes (random-partition (1- size) nargs)))
-          `(,op ,@(mapcar #'make-random-type sizes))))
-     (1 `(not ,(make-random-type (1- size))))
-     ; (1 (make-random-function-type size))
-     )))
-
-(defun make-random-real-type ()
-  (rcase
-   (1 (random-from-seq '(integer unsigned-byte short-float single-float
-                                 double-float long-float rational real)))
-   (1 (destructuring-bind (lo hi)
-          (make-random-integer-range)
-        (rcase
-         (4 `(integer ,lo ,hi))
-         (1 `(integer ,lo))
-         (1 `(integer ,lo *))
-         (2 `(integer * ,hi)))))
-   (1 (let ((r1 (random-real))
-            (r2 (random-real)))
-        `(real ,(min r1 r2) ,(max r2 r2))))
-   ;;; Add more cases here
-   ))
-
-(defun make-random-complex-type ()
-  `(complex ,(make-random-real-type)))
-
-(defun make-random-function-type (size)
-  (let* ((sizes (random-partition (1- size) 2))
-         (types (mapcar #'make-random-type sizes)))
-    `(function (,(car types)) ,(cadr types))))
-
-(defun size-of-type (type)
-  (if (consp type)
-      (case (car type)
-        (complex (1+ (size-of-type (cadr type))))
-        ((array simple-array) (1+ (size-of-type (cadr type))))
-        (vector (1+ (size-of-type (cadr type))))
-        (complex (1+ (size-of-type (cadr type))))
-        ((cons or and not) (reduce #'+ (cdr type) :initial-value 1
-                                   :key #'size-of-type))
-        (t 1))
-      1))
-
-(defun mutate-type (type)
-  (let* ((size (size-of-type type))
-         (r (random size)))
-    (flet ((%f ()
-             (rcase
-              (6 (make-random-type (random (1+ size))))
-              (2 `(not ,type))
-              (1 `(and ,(make-random-type 1) ,type))
-              (1 `(and ,type ,(make-random-type 1)))
-              (1 `(or ,(make-random-type 1) ,type))
-              (1 `(or ,type ,(make-random-type 1)))))
-           (%random-int ()
-             (let ((bits (1+ (min (random 20) (random 20)))))
-               (- (ash 1 bits) (random (ash 1 (1+ bits)))))))
-      (if (or (and (= r 0) (coin)) (not (consp type)))
-          (%f)
-          (case (car type)
-            ((and or not cons complex)
-             (let ((sizes (mapcar #'size-of-type (cdr type))))
-               (loop with sum = 0
-                  for e on sizes
-                  for ctype in (cdr type)
-                  for i from 0
-                  do (setf sum (incf (car e) sum))
-                  when (>= sum r)
-                  return (rcase
-                          (1 ctype) ;; replace with component type
-                          (1 (cons (car type)
-                                   (append (subseq (cdr type) 0 i)
-                                           (list (mutate-type ctype))
-                                           (subseq (cdr type) (1+ i)))))))))
-            ((array simple-array vector)
-             (let ((ctype (if (cdr type) (cadr type) t)))
-               (rcase
-                (1 (if (eql ctype *) t ctype))
-                (1 (cons (car type)
-                         (cons (mutate-type ctype)
-                               (cddr type)))))))
-            ((unsigned-byte)
-             (if (integerp (cadr type))
-                 (rcase
-                  (1 'unsigned-byte)
-                  (1 `(unsigned-byte (+ (cadr type) (- 10 (random 20))))))
-                 (%f)))
-
-            ((integer)
-             (let ((lo-delta (%random-int))
-                   (hi-delta (%random-int))
-                   (old-lo (or (cadr type) '*))
-                   (old-hi (or (caddr type) '*)))
-               (flet ((%inc (old delta)
-                        (if (or (coin) (not (integerp old)))
-                            delta
-                            (+ old delta))))
-                 (rcase
-                  (1 `(integer ,old-lo *))
-                  (1 `(integer * ,old-hi))
-                  (1 (let ((new-lo (%inc old-lo lo-delta)))
-                       (if (or (null (cdr type))
-                               (null (cddr type))
-                               (not (integerp old-hi)))
-                           `(integer ,new-lo ,@(cddr type))
-                           ;; caddr is integer
-                           (if (<= new-lo old-hi)
-                               `(integer ,new-lo ,old-hi)
-                               `(integer ,old-hi ,new-lo)))))
-                  (1 (let ((new-hi (%inc old-hi hi-delta)))
-                       (if (or (null (cdr type))
-                               (null (cddr type))
-                               (not (integerp old-lo)))
-                           `(integer ,old-lo ,new-hi)
-                           (if (<= old-lo new-hi)
-                               `(integer ,old-lo ,new-hi)
-                               `(integer ,new-hi ,old-lo)))))
-                  (1 (let ((new-lo (%inc old-lo lo-delta))
-                           (new-hi (%inc old-hi hi-delta)))
-                       (if (<= new-lo new-hi)
-                           `(integer ,new-lo ,new-hi)
-                           `(integer ,new-hi ,new-lo))))))))
-
-            (t (%f)))))))
-
-(defun test-random-types (n size)
-  (loop for t1 = (make-random-type size)
-        for t2 = (make-random-type size)
-        for i from 0 below n
-        ;; do (print (list t1 t2))
-        do (setf *random-types* (list t1 t2))
-        do (when (and (= (mod i 100) 0) (> i 0))
-             (format t "~A " i) (finish-output *standard-output*))
-        when (test-types t1 t2)
-        collect (list t1 t2)
-        finally (terpri)))
-
-(defun test-random-mutated-types (n size &key (reps 1))
-  (loop for t1 = (make-random-type size)
-        for t2 = (let ((x t1)) (loop repeat reps
-                                     do (setq x (mutate-type x))) x)
-        for i from 0 below n
-        ;; do (print (list t1 t2))
-        do (setf *random-types* (list t1 t2))
-        do (when (and (= (mod i 100) 0) (> i 0))
-             (format t "~A " i) (finish-output *standard-output*))
-        when (test-types t1 t2)
-        collect (list t1 t2)
-        finally (terpri)))
-
-(defun test-types (t1 t2)
-  (multiple-value-bind (sub success)
-      (subtypep t1 t2)
-    (when success
-      (if sub
-          (check-all-subtypep t1 t2)
-        (let ((nt1 `(not ,t1))
-              (nt2 `(not ,t2)))
-          (subtypep nt2 nt1))))))
-
-(defun prune-type (tp try-fn)
-  (declare (type function try-fn))
-  (flet ((try (x) (funcall try-fn x)))
-    (cond
-     ((member tp '(nil t)))
-     ((symbolp tp)
-      (try nil)
-      (try t))
-     ((consp tp)
-      (try nil)
-      (try t)
-      (let ((op (first tp))
-            (args (rest tp)))
-        (case op
-          ((cons)
-           (try 'cons)
-           (prune-list args
-                       #'prune-type
-                       #'(lambda (args) (try `(cons ,@args)))))
-          ((integer)
-           (try op)
-           (try '(eql 0))
-           (when (= (length args) 2)
-             (let ((arg1 (first args))
-                   (arg2 (second args)))
-               (when (and (integerp arg1) (integerp arg2))
-                 (try `(eql ,arg1))
-                 (try `(eql ,arg2))
-                 (when (and (< arg1 0) (<= 0 arg2))
-                   (try `(integer 0 ,arg2)))
-                 (when (and (<= arg1 0) (< 0 arg2))
-                   (try `(integer ,arg1 0)))
-                 (when (> (- arg2 arg1) 1)
-                   (try `(integer ,(+ arg1 (floor (- arg2 arg1) 2)) ,arg2))
-                   (try `(integer ,arg1 ,(- arg2 (floor (- arg2 arg1) 2)))))))))
-
-          ((real float ratio single-float double-float short-float long-float)
-           (try op))
-
-          ((or and)
-           (mapc try-fn args)
-           (loop for i from 0 below (length args)
-                 do (try `(,op ,@(subseq args 0 i)
-                               ,@(subseq args (1+ i)))))
-           (prune-list args
-                       #'prune-type
-                       #'(lambda (args) (try (cons op args)))))
-          ((not)
-           (let ((arg (first args)))
-             (try arg)
-             (when (and (consp arg)
-                        (eq (car arg) 'not))
-               (try (second arg)))
-             (prune-type arg #'(lambda (arg) (try `(not ,arg))))))
-
-          ((member)
-           (dolist (arg (cdr tp))
-             (try `(eql ,arg)))
-           (when (cddr tp)
-           (try `(member ,@(cddr tp)))))
-
-          ((eql)
-           (assert (= (length args) 1))
-           (let ((arg (first args)))
-             (unless (= arg 0)
-               (try `(eql 0))
-               (cond
-                ((< arg -1)
-                 (try `(eql ,(ceiling arg 2))))
-                ((> arg 1)
-                 (try `(eql ,(floor arg 2))))))))
-
-          )))))
-  (values))
-
-(defun prune-type-pair (pair &optional (fn #'test-types))
-  (declare (type function fn))
-  (let ((t1 (first pair))
-        (t2 (second pair))
-        changed)
-    (loop
-     do (flet ((%try2 (new-tp)
-                      (when (funcall fn t1 new-tp)
-                        (print "Success in first loop")
-                        (print new-tp)
-                        (setq t2 new-tp
-                              changed t)
-                        (throw 'success nil))))
-          (catch 'success
-            (prune-type t2 #'%try2)))
-     do (flet ((%try1 (new-tp)
-                      (when (funcall fn new-tp t2)
-                        (print "Success in second loop")
-                        (print new-tp)
-                        (setq t1 new-tp
-                              changed t)
-                        (throw 'success nil))))
-          (catch 'success
-            (prune-type t1 #'%try1)))
-     while changed
-     do (setq changed nil))
-    (list t1 t2)))
-
-(defun test-type-triple (t1 t2 t3)
-  ;; Returns non-nil if a problem is found
-  (catch 'problem
-    (multiple-value-bind (sub1 success1)
-        (subtypep t1 t2)
-      (when success1
-        (if sub1
-            (append
-             (check-all-subtypep t1 `(or ,t2 ,t3))
-             (check-all-subtypep `(and ,t1 ,t3) t2))
-            (or (subtypep `(or ,t1 ,t3) t2)
-                (subtypep t1 `(and ,t2 ,t3))))))))
-
-(defun test-random-types3 (n size)
-  (loop for t1 = (make-random-type (1+ (random size)))
-        for t2 = (make-random-type (1+ (random size)))
-        for t3 = (make-random-type (1+ (random size)))
-        for i from 1 to n
-        ;; do (print (list t1 t2))
-        do (setf *random-types* (list t1 t2 t3))
-        do (when (and (= (mod i 100) 0) (> i 0))
-             (format t "~A " i) (finish-output *standard-output*))
-        when (test-type-triple t1 t2 t3)
-        collect (list t1 t2 t3)
-        finally (terpri)))
-
-(defun prune-type-triple (pair &optional (fn #'test-type-triple))
-  (declare (type function fn))
-  (let ((t1 (first pair))
-        (t2 (second pair))
-        (t3 (third pair))
-        changed)
-    (loop
-     do (flet ((%try2 (new-tp)
-                      (when (funcall fn t1 new-tp t3)
-                        (print "Success in first loop")
-                        (print new-tp)
-                        (setq t2 new-tp
-                              changed t)
-                        (throw 'success nil))))
-          (catch 'success
-            (prune-type t2 #'%try2)))
-     do (flet ((%try1 (new-tp)
-                      (when (funcall fn new-tp t2 t3)
-                        (print "Success in second loop")
-                        (print new-tp)
-                        (setq t1 new-tp
-                              changed t)
-                        (throw 'success nil))))
-          (catch 'success
-            (prune-type t1 #'%try1)))
-     do (flet ((%try3 (new-tp)
-                      (when (funcall fn t1 t2 new-tp)
-                        (print "Success in second loop")
-                        (print new-tp)
-                        (setq t3 new-tp
-                              changed t)
-                        (throw 'success nil))))
-          (catch 'success
-            (prune-type t3 #'%try3)))
-     while changed
-     do (setq changed nil))
-    (list t1 t2 t3)))
-
-
-
-