Commit 46fc4961 authored by pfdietz's avatar pfdietz

Removed duplicated function name, added new forms to random int form generator

parent 2fbeb6dd
......@@ -5,6 +5,9 @@
(in-package :cl-test)
(eval-when (load eval)
(compile-and-load "random-aux.lsp"))
(defun eqlzt (x y)
"Return T if (eql x y) or if both are zero of the same type."
(cond
......@@ -185,34 +188,6 @@
(or (= m x) (= m y))))
collect (list x y (min x y)))))
(defun random-nonnegative-real ()
(if (coin 3)
(random-case
(/ (random 10000) (1+ (random 1000)))
(/ (random 1000000) (1+ (random 100000)))
(/ (random 100000000) (1+ (random 10000000)))
(/ (random 1000000000000) (1+ (random 10000000))))
(random (random-case
1000
100000
10000000
1000000000
(expt 2.0s0 (random 15))
(expt 2.0f0 (random 32))
(expt 2.0d0 (random 32))
(expt 2.0l0 (random 32))))))
(defun random-real ()
(if (coin) (random-nonnegative-real)
(- (random-nonnegative-real))))
(defun random-fixnum ()
(+ (random (1+ (- most-positive-fixnum most-negative-fixnum)))
most-negative-fixnum))
(defun random-from-interval (upper &optional (lower (- upper)))
(+ (random (- upper lower)) lower))
(defun epsilon (number)
(etypecase number
(short-float short-float-epsilon)
......
......@@ -18,10 +18,33 @@
,@(loop for i from 0 for e in cases collect `(,i ,e))
(t (error "Can't happen?! (in random-case)~%")))))
(defun random-from-interval (lo hi)
"Generate random value from interval [lo,hi)"
(assert (> hi lo))
(+ (random (- hi lo)) lo))
(defun random-nonnegative-real ()
(if (coin 3)
(random-case
(/ (random 10000) (1+ (random 1000)))
(/ (random 1000000) (1+ (random 100000)))
(/ (random 100000000) (1+ (random 10000000)))
(/ (random 1000000000000) (1+ (random 10000000))))
(random (random-case
1000
100000
10000000
1000000000
(expt 2.0s0 (random 15))
(expt 2.0f0 (random 32))
(expt 2.0d0 (random 32))
(expt 2.0l0 (random 32))))))
(defun random-real ()
(if (coin) (random-nonnegative-real)
(- (random-nonnegative-real))))
(defun random-fixnum ()
(+ (random (1+ (- most-positive-fixnum most-negative-fixnum)))
most-negative-fixnum))
(defun random-from-interval (upper &optional (lower (- upper)))
(+ (random (- upper lower)) lower))
(defun coin (&optional (n 2))
"Flip an n-sided coin."
......
......@@ -84,7 +84,7 @@
(mapcar #'(lambda (range)
(let ((lo (car range))
(hi (cadr range)))
(random-from-interval lo (1+ hi))))
(random-from-interval (1+ hi) lo)))
var-ranges)))
(setq *int-form-vals* vals)
(let ((opt-result (apply unoptimized-compiled-fn vals))
......@@ -130,7 +130,7 @@
(- (random r) (floor (/ r 2))))
(random-from-seq vars))
;; (> size 1)
(ecase (random 7)
(ecase (random 9)
;; Unary ops
((0 1)
(let ((op (random-from-seq '(- abs signum 1+ 1- identity
......@@ -141,10 +141,11 @@
(let* ((op (random-from-seq
'(+ - * logand min max ;; gcd lcm
logandc1 logandc2 logeqv logior lognand lognor logorc1
logorc2 logxor)))
(leftsize (random size)))
`(,op ,(make-random-integer-form leftsize vars)
,(make-random-integer-form (- size 1 leftsize) vars))))
logorc2 logxor))))
(destructuring-bind (leftsize rightsize)
(random-partition (1- size) 2)
`(,op ,(make-random-integer-form leftsize vars)
,(make-random-integer-form rightsize vars)))))
;; conditionals
(6
(let* ((cond-size (random (max 1 (floor size 2))))
......@@ -154,6 +155,17 @@
(then-part (make-random-integer-form then-size vars))
(else-part (make-random-integer-form else-size vars)))
`(if ,pred ,then-part ,else-part)))
(7
(destructuring-bind (s1 s2 s3) (random-partition (1- size) 3)
`(,(random-from-seq '(deposit-field dpb))
,(make-random-integer-form s1 vars)
,(make-random-byte-spec-form s2 vars)
,(make-random-integer-form s3 vars))))
(8
(destructuring-bind (s1 s2) (random-partition (1- size) 2)
`(,(random-from-seq '(ldb mask-field))
,(make-random-byte-spec-form s1 vars)
,(make-random-integer-form s2 vars))))
)))
(defun make-random-pred-form (size vars)
......@@ -161,20 +173,20 @@
(ecase (random 3)
(0 (if (coin) t nil))
((1 2)
`(,(random-from-seq '(< <= = > >= /=))
`(,(random-from-seq '(< <= = > >= /= eql equal))
,(make-random-integer-form size vars)
,(make-random-integer-form size vars))))
(ecase (random 5)
(ecase (random 6)
(0 (if (coin) t nil))
(1 `(not ,(make-random-pred-form (1- size) vars)))
(2 (let* ((leftsize (random size))
(rightsize (- size 1 leftsize)))
(2 (destructuring-bind (leftsize rightsize)
(random-partition (1- size) 2)
`(,(random-from-seq '(and or))
,(make-random-pred-form leftsize vars)
,(make-random-pred-form rightsize vars))))
(3 (let* ((leftsize (random size))
(rightsize (- size 1 leftsize)))
`(,(random-from-seq '(< <= > >= = /=))
(3 (destructuring-bind (leftsize rightsize)
(random-partition (1- size) 2)
`(,(random-from-seq '(< <= > >= = /= eql equal))
,(make-random-integer-form leftsize vars)
,(make-random-integer-form rightsize vars))))
(4 (let* ((cond-size (random (max 1 (floor size 2))))
......@@ -184,8 +196,25 @@
(then-part (make-random-pred-form then-size vars))
(else-part (make-random-pred-form else-size vars)))
`(if ,pred ,then-part ,else-part)))
(5 (destructuring-bind (s1 s2)
(random-partition (1- size) 2)
`(ldb-test ,(make-random-byte-spec-form s1 vars)
,(make-random-integer-form s2 vars))))
)))
(defun make-random-byte-spec-form (size vars)
(declare (ignore size vars))
(let* ((pform (random 33))
(sform (random 33)))
`(byte ,sform ,pform)))
(defun random-partition (n p)
"Partition n into p numbers, each >= 1. Return list of numbers."
(assert (<= 1 p))
(cond
((= p 1) (list n))
((< n p) (make-list p :initial-element 1))
(t
(let ((n1 (1+ (random (floor n p)))))
(cons n1 (random-partition (- n n1) (1- p)))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment