108 |
(defvar *random-int-form-catch-tags* nil) |
(defvar *random-int-form-catch-tags* nil) |
109 |
(defvar *go-tags* nil) |
(defvar *go-tags* nil) |
110 |
|
|
|
(defvar *maximum-random-int-bits* 36) |
|
|
|
|
111 |
(defvar *random-vals-list-bound* 10) |
(defvar *random-vals-list-bound* 10) |
112 |
|
|
113 |
(defvar *max-compile-time* 0) |
(defvar *max-compile-time* 0) |
239 |
(cons (car form) (mapcan #'fn-symbols-in-form* (cdr form))) |
(cons (car form) (mapcan #'fn-symbols-in-form* (cdr form))) |
240 |
(mapcan #'fn-symbols-in-form* form)))) |
(mapcan #'fn-symbols-in-form* form)))) |
241 |
|
|
|
(defun make-random-integer-range (&optional var) |
|
|
"Generate a list (LO HI) of integers, LO <= HI. This is used |
|
|
for generating integer types." |
|
|
(declare (ignore var)) |
|
|
(rcase |
|
|
(1 (flet ((%r () (let ((r (ash 1 (1+ (random *maximum-random-int-bits*))))) |
|
|
(- (random r) (floor (/ r 2)))))) |
|
|
(let ((x (%r)) |
|
|
(y (%r))) |
|
|
(list (min x y) (max x y))))) |
|
|
(1 (let* ((b (ash 1 (1+ (random *maximum-random-int-bits*)))) |
|
|
(b2 (floor (/ b 2)))) |
|
|
(let ((x (- (random b) b2)) |
|
|
(y (- (random b) b2))) |
|
|
(list (min x y) (max x y))))))) |
|
|
|
|
242 |
(defun fn-arg-name (fn-name arg-index) |
(defun fn-arg-name (fn-name arg-index) |
243 |
(intern (concatenate 'string |
(intern (concatenate 'string |
244 |
(subseq (symbol-name fn-name) 1) |
(subseq (symbol-name fn-name) 1) |
248 |
(declaim (special *flet-names*)) |
(declaim (special *flet-names*)) |
249 |
(defparameter *flet-names* nil) |
(defparameter *flet-names* nil) |
250 |
|
|
251 |
(defun make-random-integer () |
|
|
(let ((r (ash 1 (1+ (random *maximum-random-int-bits*))))) |
|
|
(rcase |
|
|
(6 (- (random r) (floor (/ r 2)))) |
|
|
(1 (- r (random (min 10 r)))) |
|
|
(1 (+ (floor (/ r 2)) (random (min 10 r))))))) |
|
|
|
|
|
(defun make-random-rational () |
|
|
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*)))) |
|
|
(n (random r))) |
|
|
(assert (>= r 2)) |
|
|
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
|
|
(if (coin) (/ n d) (- (/ n d)))))) |
|
|
|
|
|
(defun make-random-nonnegative-rational () |
|
|
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*)))) |
|
|
(n (random r))) |
|
|
(assert (>= r 2)) |
|
|
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
|
|
(/ n d)))) |
|
|
|
|
|
(defun make-random-positive-rational () |
|
|
(let* ((r (ash 1 (1+ (random *maximum-random-int-bits*)))) |
|
|
(n (1+ (random r)))) |
|
|
(assert (>= r 2)) |
|
|
(let ((d (loop for x = (random r) unless (zerop x) do (return x)))) |
|
|
(/ n d)))) |
|
|
|
|
|
(defun make-random-bounded-rational (upper-limit lower-inclusive upper-inclusive) |
|
|
(assert (rationalp upper-limit)) |
|
|
(assert (not (minusp upper-limit))) |
|
|
(cond |
|
|
((= upper-limit 0) 0) |
|
|
((<= upper-limit 1/1000000) |
|
|
(/ (make-random-bounded-rational (* 1000000 upper-limit) lower-inclusive upper-inclusive) |
|
|
1000000)) |
|
|
((>= upper-limit 1000000) |
|
|
(* (random 1000000) |
|
|
(make-random-bounded-rational (/ upper-limit 1000000) lower-inclusive upper-inclusive))) |
|
|
(t |
|
|
(assert (< 1/1000000 upper-limit 1000000)) |
|
|
(let ((x 0)) |
|
|
(loop do (setq x (* upper-limit (rational (random 1.0)))) |
|
|
while (or (and (not lower-inclusive) (zerop x)) |
|
|
(and (not upper-inclusive) (= x upper-limit))) |
|
|
finally (return x)))))) |
|
|
|
|
|
(defun make-random-float () |
|
|
(rcase |
|
|
(1 (random most-positive-short-float)) |
|
|
(1 (random most-positive-single-float)) |
|
|
(1 (random most-positive-double-float)) |
|
|
(1 (random most-positive-long-float)))) |
|
|
|
|
|
(defun make-random-symbol () |
|
|
(rcase |
|
|
(3 (random-from-seq #(a b c d e f g h i j k l m n o p q r s t u v w x y z))) |
|
|
(2 (random-from-seq *cl-symbols-vector*)) |
|
|
(1 (gensym)))) |
|
252 |
|
|
253 |
(defun random-var-desc () |
(defun random-var-desc () |
254 |
(loop |
(loop |
350 |
|
|
351 |
(2 `(isqrt (abs ,(make-random-integer-form (- size 2))))) |
(2 `(isqrt (abs ,(make-random-integer-form (- size 2))))) |
352 |
|
|
|
;; #-armedbear |
|
353 |
(10 `(the integer ,(make-random-integer-form (1- size)))) |
(10 `(the integer ,(make-random-integer-form (1- size)))) |
354 |
|
|
355 |
(1 `(cl:handler-bind nil ,(make-random-integer-form (1- size)))) |
(1 `(cl:handler-bind nil ,(make-random-integer-form (1- size)))) |
472 |
(5 (make-random-tagbody-and-progn size)) |
(5 (make-random-tagbody-and-progn size)) |
473 |
|
|
474 |
;; conditionals |
;; conditionals |
475 |
(30 |
(60 |
476 |
(let* ((cond-size (random (max 1 (floor size 2)))) |
(let* ((cond-size (random (max 1 (floor size 2)))) |
477 |
(then-size (random (- size cond-size))) |
(then-size (random (- size cond-size))) |
478 |
(else-size (- size 1 cond-size then-size)) |
(else-size (- size 1 cond-size then-size)) |
498 |
(50 (make-random-integer-binding-form size)) |
(50 (make-random-integer-binding-form size)) |
499 |
|
|
500 |
;; progv |
;; progv |
501 |
#-(or armedbear ecl) |
#-(or ecl) |
502 |
(4 (make-random-integer-progv-form size)) |
(4 (make-random-integer-progv-form size)) |
503 |
|
|
504 |
(4 `(let () ,(make-random-integer-form (1- size)))) |
(4 `(let () ,(make-random-integer-form (1- size)))) |
991 |
(rcase |
(rcase |
992 |
(1 (if (coin) t nil)) |
(1 (if (coin) t nil)) |
993 |
(3 `(not ,(make-random-pred-form (1- size)))) |
(3 `(not ,(make-random-pred-form (1- size)))) |
994 |
(6 (destructuring-bind (leftsize rightsize) |
(12 (destructuring-bind (leftsize rightsize) |
995 |
(random-partition (1- size) 2) |
(random-partition (1- size) 2) |
996 |
`(,(random-from-seq '(and or)) |
`(,(random-from-seq '(and or)) |
997 |
,(make-random-pred-form leftsize) |
,(make-random-pred-form leftsize) |