diff --git a/ansi-tests/TODO b/ansi-tests/TODO
index cbd9438dec423b7e762c3d7cab5346e3b0249eaa..b87e5b2f54cabedbd74d2f80b44b273f890688f0 100644
--- a/ansi-tests/TODO
+++ b/ansi-tests/TODO
@@ -110,4 +110,8 @@ Got:      0
 44. Add tests for SPECIAL declarations in MACROLET (requested by piso on #lisp)
   (partially done)
 
-45. Sweep files for missing order-of-execution tests
\ No newline at end of file
+45. Sweep files for missing order-of-execution tests
+
+46. Add tests that class objects are valid class specifiers in method definitions.
+
+47. Test that :import-from in DEFPACKAGE can take a package object.
diff --git a/ansi-tests/misc.lsp b/ansi-tests/misc.lsp
index be99775b6d385e1fff2eb70d7ea6d147d0b61c30..b3e032db73199d1a7fd2740f9a3e72dc24a6a33e 100644
--- a/ansi-tests/misc.lsp
+++ b/ansi-tests/misc.lsp
@@ -11061,3 +11061,18 @@ Broken at C::WT-MAKE-CLOSURE.
 		    (min -63 (rem 0 (min -67 0)))))))))
   
   0)
+
+;;; sbcl 0.9.9.8, x86 linux
+;;; TYPE-ERROR: The value 17549.955 is not of type REAL.
+
+(deftest misc.622
+  (funcall
+   (compile
+    nil
+    '(lambda (p2)
+       (declare (optimize (speed 3) (safety 2) (debug 3) (space 0))
+		(type real p2))
+       (+ 81535869 (the (member 17549.955 #:g35917) p2))))
+   17549.955)
+  #.(+ 81535869 17549.955))
+
diff --git a/ansi-tests/random-aux.lsp b/ansi-tests/random-aux.lsp
index 831ba156c1aec4a842d7da46566de75764274201..1056915a6805d65bdee7fdc78a36d8d21e13cc4c 100644
--- a/ansi-tests/random-aux.lsp
+++ b/ansi-tests/random-aux.lsp
@@ -42,6 +42,26 @@
 		collect `((< ,r ,cw) ,@(cdr case)))
 	(t ,@(cdar (last cases)))))))
 
+(defmacro rselect (cumulative-frequency-array &rest cases)
+  (let ((len (length cases))
+	(a (gensym "A"))
+	(max (gensym "MAX"))
+	(r (gensym "R"))
+	(p (gensym "P"))
+	(done (gensym "DONE")))
+    (assert (> len 0))
+    `(let ((,a ,cumulative-frequency-array))
+       (assert (eql ,len (length ,a)))
+       (let* ((,max (aref ,a ,(1- len)))
+	      (,r (random ,max)))
+	 (block ,done
+	  ,@(loop for i from 0
+		  for c in cases
+		  collect 
+		  `(let ((,p (aref ,a ,i)))
+		     (when (< ,r ,p) (return-from ,done ,c))))
+	  (error "Should not happen!"))))))
+
 (defun make-random-integer-range (&optional var)
   "Generate a list (LO HI) of integers, LO <= HI.  This is used
    for generating integer types."
diff --git a/ansi-tests/random-int-form.lsp b/ansi-tests/random-int-form.lsp
index 8e7eedfb21b86bda49316f58f0e3c09464c2b64c..642b97969f7b6b3a5f8acd320046ce5883376a15 100644
--- a/ansi-tests/random-int-form.lsp
+++ b/ansi-tests/random-int-form.lsp
@@ -41,8 +41,9 @@
 ;;;
 
 (declaim (special *optimized-fn-src* *unoptimized-fn-src* *int-form-vals*
-		  *opt-result* *unopt-result* $x $y $z
-		  *compile-unoptimized-form*))
+                  *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
@@ -50,22 +51,22 @@
 ;;; (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))))
+               (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)))))
+               (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)))))
+                                   (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))))))
@@ -83,6 +84,40 @@
 (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.
 
@@ -95,8 +130,8 @@
    (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*))))
+             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))
@@ -127,12 +162,12 @@
 
 (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)
-	)
+        &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
@@ -143,69 +178,66 @@
   (assert (and (integerp n) (plusp n)))
   (assert (and (integerp n) (plusp size)))
 
-;;;  #+sbcl
-;;;  (loop for x in (reverse sb-ext:*before-gc-hooks*)
-;;;	do (pushnew x sb-ext:*after-gc-hooks*))
-  
   (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)))
+        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)
-		     )
-		 (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)))
+                           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)
+          :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)
+                 '(: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)
@@ -215,15 +247,15 @@
 
 (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))))
+                        (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
@@ -236,14 +268,14 @@
 (defun fn-symbols-in-form* (form)
   (when (consp form)
     (if (symbolp (car form))
-	(cons (car form) (mapcan #'fn-symbols-in-form* (cdr 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)))		       
+                       (subseq (symbol-name fn-name) 1)
+                       (format nil "-~D" arg-index))
+          (symbol-package fn-name)))                       
 
 (declaim (special *flet-names*))
 (defparameter *flet-names* nil)
@@ -253,9 +285,9 @@
 (defun random-var-desc ()
   (loop
    (let* ((pos (random (length *vars*)))
-	  (desc (elt *vars* pos)))
+          (desc (elt *vars* pos)))
      (when (= pos (position (var-desc-name desc) (the list *vars*)
-			    :key #'var-desc-name))
+                            :key #'var-desc-name))
        (return desc)))))
 
 (defun is-zero-rank-integer-array-type (type)
@@ -265,309 +297,281 @@
        (eq (car type) 'array)
        (cddr type)
        (or (eq (cadr type) '*)
-	   (subtypep (cadr type) 'integer))
+           (subtypep (cadr type) 'integer))
        (or (eql (caddr type) 0)
-	   (null (caddr type)))))
+           (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)))
+        (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)
-    (rcase
+    (rselect *make-random-integer-form-cdf*
 
      ;; flet call
-     ;; #-(or armedbear)
-     (10
-      (make-random-integer-flet-call-form size))
-
-     (5 (make-random-aref-form size))
-
+     (make-random-integer-flet-call-form size)
+     (make-random-aref-form size)
      ;; Unary ops
-     (40
-      (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)))))
-
-     (4
-      (make-random-integer-unwind-protect-form size))
-
-     (5 (make-random-integer-mapping-form size))
+     (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
-     (4
-      (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)))
+     (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
-     (2 (let* ((nforms (random 4))
-	       (sizes (random-partition (1- size) (+ nforms 2)))
-	       (args (mapcar #'make-random-integer-form sizes)))
-	  `(prog2 ,@args)))
+     (let* ((nforms (random 4))
+            (sizes (random-partition (1- size) (+ nforms 2)))
+            (args (mapcar #'make-random-integer-form sizes)))
+       `(prog2 ,@args))
      
-     (2 `(isqrt (abs ,(make-random-integer-form (- size 2)))))
+     `(isqrt (abs ,(make-random-integer-form (- size 2))))
 
-     (10 `(the integer ,(make-random-integer-form (1- size))))
+     `(the integer ,(make-random-integer-form (1- size)))
       
-     (1 `(cl:handler-bind nil ,(make-random-integer-form (1- size))))
-     (1 `(restart-bind nil ,(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
-     (1 `(macrolet () ,(make-random-integer-form (1- size))))
+     `(macrolet () ,(make-random-integer-form (1- size)))
      #-armedbear
-     (1 `(symbol-macrolet () ,(make-random-integer-form (1- size))))
+     `(symbol-macrolet () ,(make-random-integer-form (1- size)))
 
      ;; dotimes
      #-allegro
-     (5
-      (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)))
+     (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
-     (5 (make-random-loop-form (1- size)))
+     (make-random-loop-form (1- size))
 
-     (5 (make-random-count-form size))
+     (make-random-count-form size)
 
      #-(or gcl ecl armedbear)
      ;; load-time-value
-     (2
-      (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)))))
+     (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
-     (2 (make-random-integer-eval-form size))
+     (make-random-integer-eval-form size)
       
      #-(or cmu allegro poplog)
-     (20
-      (destructuring-bind (s1 s2)
-	  (random-partition (- size 2) 2)
-	`(ash ,(make-random-integer-form s1)
-	      (min ,(random 100)
-		   ,(make-random-integer-form s2)))))
+     (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
-     (4
-      (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))))))
-	    
+     (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
-     (30
      (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)))))
+                  '(+ - *  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
-     (4
-      (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)))))	    
+     (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
-     (20
-      (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)))
+     (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
-     (3 `(expt ,(make-random-integer-form (1- size)) ,(random 3)))
+     `(expt ,(make-random-integer-form (1- size)) ,(random 3))
 
      ;; coerce
-     (2 `(coerce ,(make-random-integer-form (1- size)) 'integer))
+     `(coerce ,(make-random-integer-form (1- size)) 'integer)
      
      ;; complex (degenerate case)
-     (2 `(complex ,(make-random-integer-form (1- size)) 0))
+     `(complex ,(make-random-integer-form (1- size)) 0)
 
      ;; quotient (degenerate cases)
-     (1 `(/ ,(make-random-integer-form (1- size)) 1))
-     (1 `(/ ,(make-random-integer-form (1- size)) -1))
+     `(/ ,(make-random-integer-form (1- size)) 1)
+     `(/ ,(make-random-integer-form (1- size)) -1)
 
      ;; tagbody
-     (5 (make-random-tagbody-and-progn size))
+     (make-random-tagbody-and-progn size)
 
      ;; conditionals
-     (60
-      (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)))
+     (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
-     (5
       (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))))
+        `(,(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)
-     (10
       (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))))
+          `(,(random-from-seq '(ldb mask-field))
+            ,(make-random-byte-spec-form s1)
+            ,(make-random-integer-form s2)))
 
-     (50 (make-random-integer-binding-form size))
+     (make-random-integer-binding-form size)
 
      ;; progv
-     #-(or ecl)
-     (4 (make-random-integer-progv-form size))
+     (make-random-integer-progv-form size)
      
-     (4 `(let () ,(make-random-integer-form (1- size))))
+     `(let () ,(make-random-integer-form (1- size)))
 
-     (10
       (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)))))
+             (*random-int-form-blocks* (adjoin name *random-int-form-blocks*)))
+        `(block ,name ,(make-random-integer-form (1- size))))
 
-     (20
       (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)))))
+             (*random-int-form-catch-tags* (cons tag *random-int-form-catch-tags*)))
+        `(catch ,tag ,(make-random-integer-form (1- size))))
      
-     (10 ;; setq and similar
-      (make-random-integer-setq-form size))
+      ;; setq and similar
+      (make-random-integer-setq-form size)
 
-     (10 (make-random-integer-case-form size))
+      (make-random-integer-case-form size)
 
-     (3
       (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)))
+          (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))
 
-     (20
       (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)))
+          (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))
 
-     (5
       (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)))
+          (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)
-     (20
-      (make-random-flet-form size))
+     (make-random-flet-form size)
 
-     (2
       (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)))))))
+             (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))))))
 
-     (2
       (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)))))))
+             (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))))))
 
-     (2
       (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)))))))
+             (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))))))
 
      )))
 
@@ -575,98 +579,98 @@
   (or
    (when *vars*
      (let* ((desc (random-var-desc))
-	    (type (var-desc-type desc))
-	    (name (var-desc-name 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))))
+        ((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))))
+          (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)))))))))
+            (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))))
+             (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)))))
+         (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))))
+               (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))))
+               (sizes (random-partition (1- size) nargs))
+               (args (mapcar #'%arg sizes)))
+          `(eval (values ,@args))))
      )))
 
 (defun make-random-type-for-var (var e1)
@@ -674,28 +678,28 @@
     (values
      (cond
       ((and (find var *random-special-vars*)
-	    (setq desc (find var *vars* :key #'var-desc-name)))
+            (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)))))
+          (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)
@@ -707,362 +711,362 @@
 (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*))))
+                                   (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)))))))
+          (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))
+         (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)))
+          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))
+                                            (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)))
+        `(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))))))
+        (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))))
+        (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))))))
+        (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))))))
+        (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)))
+            (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)))))))
+        (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))))
+             (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)
+        ;; 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))))))))
+             (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))))
+                                  %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)
+        ;; 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))))))))
+             (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))
+         (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)))
+          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)))))
+           (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))))))
+                        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)))
+         (tagbody-size (- size final-size)))
     (let ((final-form (make-random-integer-form final-size))
-	  (tagbody-form (make-random-tagbody tagbody-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))))
+        (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))))
+             (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))))
+                (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)))
+                (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))))
+             (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)))
+               (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)))))))))
+             (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)))
+               (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)))
+             (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*)))
+           (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))))
@@ -1071,7 +1075,7 @@
 (defun make-random-byte-spec-form (size)
   (declare (ignore size))
   (let* ((pform (random 33))
-	 (sform (1+ (random 33))))
+         (sform (1+ (random 33))))
     `(byte ,sform ,pform)))
 
 (defun make-random-element-of-type (type)
@@ -1080,185 +1084,227 @@
    ((consp type)
     (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))
+        (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))
-		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=)))))))
-	
-	((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)))
+		(most-neg (most-negative-float new-type-op))
+		(most-pos (most-positive-float new-type-op)))
 	   (cond
-	    ((consp hi) nil)
-	    ((member hi '(* nil))
-	     (setq hi (most-positive-float type-op))
-	     (setq hi= t))
+	    ((or (and (realp lo) (< lo most-neg))
+		 (and (realp hi) (> hi most-pos)))
+	     ;; try again
+	     (make-random-element-of-type type))
 	    (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)))))))))))
+	     (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 '*)))))))
 	    
-	(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)))))
-	)))
+        ((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)))))
+        )))
    ((typep type 'class)
     (make-random-element-of-type (class-name type)))
    (t
@@ -1268,13 +1314,17 @@
       (symbol (random-from-seq #(nil t a b c :a :b :c |z| foo |foo| car)))
       (keyword (random-from-seq #(:a :b :c :d :e :f :g :h :i :j)))
       (unsigned-byte (random-from-interval
-		      (1+ (ash 1 (random *maximum-random-int-bits*))) 0))
+                      (1+ (ash 1 (random *maximum-random-int-bits*))) 0))
       (signed-byte (random-from-interval
-		    (1+ (ash 1 (random *maximum-random-int-bits*)))
-		    (- (ash 1 (random *maximum-random-int-bits*)))))
+                    (1+ (ash 1 (random *maximum-random-int-bits*)))
+                    (- (ash 1 (random *maximum-random-int-bits*)))))
       (rational (locally (declare (notinline make-random-rational)) (make-random-rational)))
+      (ratio (let ((r 0))
+	       (loop do (setq r (make-random-element-of-type 'rational))
+		     while (integerp r))
+	       r))
       (integer (let ((x (ash 1 (random *maximum-random-int-bits*))))
-		 (random-from-interval (1+ x) (- x))))
+                 (random-from-interval (1+ x) (- x))))
       ((single-float short-float double-float long-float)
        (make-random-element-of-type (list type)))
       ((float)
@@ -1298,9 +1348,9 @@
       ((extended-char) (loop for x = (make-random-character) when (typep x 'extended-char) return x))
       ;; 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)))))
+                   (random-from-seq #(real symbol boolean integer unsigned-byte
+                                           #-ecl complex character
+                                           (string 1) (bit-vector 1)))))
       ((null) nil)
       ((fixnum)
        (random-from-interval (1+ most-positive-fixnum) most-negative-fixnum))
@@ -1310,7 +1360,7 @@
        (make-random-element-of-type '(cons t t)))
       ((list)
        (let ((len (min (random 10) (random 10))))
-	 (loop repeat len collect (make-random-element-of-type t))))
+         (loop repeat len collect (make-random-element-of-type t))))
       ((sequence)
        (make-random-element-of-type '(or list vector)))
       ))))
@@ -1318,11 +1368,11 @@
 (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))))
+         (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 ()
@@ -1340,33 +1390,33 @@
 
 (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)))))))
+                    (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))
+        (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
-		  ))))
+                  :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 '*)
@@ -1374,25 +1424,25 @@
   (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))))
+         (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
-		)))
+                :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
@@ -1401,7 +1451,7 @@
     (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))))
+                most-negative-double-float most-negative-long-float))))
 
 (defun most-positive-float (float-type-symbol)
   (ecase float-type-symbol
@@ -1410,12 +1460,12 @@
     (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))))
+                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)
+               var-types vars)
      (declare (ignorable ,@vars))
      #+cmu (declare (optimize (extensions:inhibit-warnings 3)))
      (declare (optimize ,@opt-decls))
@@ -1446,115 +1496,115 @@
   ;; 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)))
+        (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)
+          *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)
-		 )))))
+            (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)))))))))))
+                                             *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
 
@@ -1564,43 +1614,43 @@
   "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))))
+        (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))))
+        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
@@ -1621,572 +1671,572 @@
       (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))
-	 
-	 )))))
+             (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)
 
@@ -2194,156 +2244,156 @@
   "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))))))
+           (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))))))))
+          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)))
+           (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))))
+             #'(lambda (form)
+                 (try `(,op ,form ,@cases))))
       
       ;; Try individual cases
       (loop for case in cases
-	    do (try (first (last (rest case)))))
+            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)))))
+            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)))))))
+                  #'(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)))
+        (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))))))))))))
+          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)))
+        (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)))))))
+        (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)))))))
+             #'(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)))
+         (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)))))))
+            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)))))
+              #'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))
-	 )
+         (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))))
@@ -2351,95 +2401,95 @@
     ;; Try to simplify (let ((<name> <form>)) ...) to <form>
     #|
     (when (and (>= len 1)
-	       ;; (eql body-len 1)
-	       ;; (eql (caar binding-list) (car body))
-	       )
+               ;; (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))))
+        (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)))))))
+        (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))))
+                #'(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)))))
+               (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))))
+        (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)
-					))))))
+                 (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)))))))
+             #'(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))))))
+            (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))))
+            (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)
@@ -2448,7 +2498,7 @@
    ((funcall pred tree) tree)
    ((consp tree)
     (or (find-if-subtree pred (car tree))
-	(find-if-subtree pred (cdr tree))))
+        (find-if-subtree pred (cdr tree))))
    (t nil)))
 
 (defun prune-flet (form try-fn)
@@ -2456,90 +2506,90 @@
   (declare (type function try-fn))
 
   (let* ((op (car form))
-	 (binding-list (cadr form))
-	 (body (cddr form)))
+         (binding-list (cadr form))
+         (body (cddr form)))
 
     ;; Remove a declaration, if any
     (when (and (consp body)
-	       (consp (car body))
-	       (eq (caar body) 'declare))
+               (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))))
-		       
+                #'(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))))
+                #'(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))))
+        (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))))
-	))
+                 (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)))))))
+             #'(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
@@ -2551,55 +2601,55 @@
   (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)
-	   
-	  
-	      
-	  
+        (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))
+                                     (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)))
+           (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)))
diff --git a/ansi-tests/random-type-prop-tests-08.lsp b/ansi-tests/random-type-prop-tests-08.lsp
index e2d4d708e0e6f8428ef0868e865c68d010e5db55..3b2c38c99f25eb3987cd8d048e6d3bbe8ae4c8f1 100644
--- a/ansi-tests/random-type-prop-tests-08.lsp
+++ b/ansi-tests/random-type-prop-tests-08.lsp
@@ -187,14 +187,12 @@
 		      bit-vector-p simple-bit-vector-p)))
 	  `(member ,@funs ,@(mapcar #'symbol-function funs)))
 	'(or list vector)
-	'(eql :test)
-	(let ((test-funs '(eq eql equal equalp)))
-	  `(member ,@test-funs ,@(mapcar #'symbol-function test-funs))))
+	'(eql :key)
+	(let ((key-funs '(identity not null))) 
+	  `(member ,@key-funs ,@(mapcar #'symbol-function key-funs))))
   4)
 
 
-
-
 ;;; Put count-if-not tests here
 	
 
@@ -270,4 +268,3 @@
 	(vector long-float))
     (member < <= > >= ,#'< ,#'<= ,#'> ,#'>=))
   2 :replicate '(t nil))
-
diff --git a/ansi-tests/random-type-prop.lsp b/ansi-tests/random-type-prop.lsp
index 815341a263c2adc0f0b176495e79e321b0840e75..918f0f1d33e3807323382d28a2a2b52ae5b8e39d 100644
--- a/ansi-tests/random-type-prop.lsp
+++ b/ansi-tests/random-type-prop.lsp
@@ -12,11 +12,8 @@
 (defvar *print-random-type-prop-input* nil)
 (defparameter *random-type-prop-result* nil)
 
-(defgeneric make-random-type-containing (val)
-  (:method-combination randomized)
-  (:documentation "Given a value, generate a random type that contains that value."))
-
 (declaim (special *param-types* *params* *is-var?* *form*))
+(declaim (special *replicate-type*))
 
 (defparameter *default-reps* 1000)
 (defparameter *default-cell* nil)
@@ -105,7 +102,7 @@
 	    (cell *default-cell*)
 	    (ignore *default-ignore*)
 	    (test #'regression-test::equalp-with-case)
-	    (replicate nil))
+	    (replicate nil replicate-p))
   (assert (<= 1 minargs maxargs 20))
 (prog1
   (dotimes (i reps)
@@ -122,6 +119,8 @@
 			  (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))))
@@ -138,7 +137,7 @@
 	  (params (loop for x in is-var?
 			for p in param-names
 			when x collect p))
-	  (param-types (mapcar #'make-random-type-containing vals))
+	  (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
@@ -159,10 +158,11 @@
 			 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)))
+						    (let ((tp (make-random-type-containing v r)))
 						      `(the ,tp ,p))
 						  p)
 					      (if (or (consp v)
@@ -239,19 +239,33 @@
 	#'(lambda (body) `(defmethod ,name ,@body))
 	bodies)))
 
-(defmethods make-random-type-containing 
+(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 `(eql ,val))
-      (1 (let* ((n1 (random 4))
+      (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)))))
+	   `(member ,@l1 ,val ,@l2))))))
 
   (1 ((val standard-object)) 'standard-object)
   (1 ((val class)) 'class)
@@ -349,7 +363,7 @@
     (rcase (1 '*) (1 dim))))
 
 ;;; More methods
-(defmethods make-random-type-containing
+(defmethods make-random-type-containing*
   (3 ((val bit-vector))
      (let ((root (if (and (coin)
 			  (typep val 'simple-bit-vector))
@@ -406,13 +420,13 @@
   (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))
+      (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 ,(make-random-type-containing* (car val))))
       (1 `(cons ,(random-from-seq #(t *))
-		,(make-random-type-containing (cdr val))
+		,(make-random-type-containing* (cdr val))
 		))))
 
   (1 ((val complex))
@@ -465,8 +479,8 @@
    (1 `(vector ,element-type ,length))
    (1 (make-list-type length 'null element-type))))
 
-(defun make-random-sequence-type-containing (element)
-  (make-sequence-type (random 10) (make-random-type-containing element)))
+(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))
diff --git a/ansi-tests/random-types.lsp b/ansi-tests/random-types.lsp
index b1d6b8231fe4ff53242db6e2152edbd06280252b..d8f25e842ac03201c8414a3d45b89df717b25261 100644
--- a/ansi-tests/random-types.lsp
+++ b/ansi-tests/random-types.lsp
@@ -174,9 +174,10 @@
 	collect (list t1 t2)
 	finally (terpri)))
 
-(defun test-random-mutated-types (n size)
+(defun test-random-mutated-types (n size &key (reps 1))
   (loop for t1 = (make-random-type size)
-	for t2 = (mutate-type t1)
+	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))
@@ -184,7 +185,7 @@
 	     (format t "~A " i) (finish-output *standard-output*))
 	when (test-types t1 t2)
 	collect (list t1 t2)
-	finally (terpri)))  
+	finally (terpri)))
 
 (defun test-types (t1 t2)
   (multiple-value-bind (sub success)