151 |
:index (+ index i) |
:index (+ index i) |
152 |
:file-prefix file-prefix))) |
:file-prefix file-prefix))) |
153 |
(when result |
(when result |
154 |
(let ((*print-readably* t)) |
(let ((*print-readably* nil)) |
155 |
(format t "~%~A~%" (format nil "~S" (car result))) |
(format t "~%~A~%" (format nil "~S" (car result))) |
156 |
(finish-output *standard-output*))) |
(finish-output *standard-output*))) |
157 |
result))) |
result))) |
206 |
(test-int-form form vars var-types vals-list opt-decls-1 opt-decls-2))) |
(test-int-form form vars var-types vals-list opt-decls-1 opt-decls-2))) |
207 |
|
|
208 |
(defun make-random-optimize-settings () |
(defun make-random-optimize-settings () |
209 |
(loop for settings = (cons |
(loop for settings = (list* |
210 |
(list 'speed (1+ (random 3))) |
(list 'speed (random 4)) |
211 |
|
#+sbcl '(sb-c:insert-step-conditions 0) |
212 |
(loop for s in '(space safety debug compilation-speed) |
(loop for s in '(space safety debug compilation-speed) |
213 |
for n = (random 4) |
for n = (random 4) |
214 |
collect (list s n))) |
collect (list s n))) |
215 |
while |
while |
216 |
#+allegro (subsetp '((speed 3) (safety 0)) settings :test 'equal) |
#+allegro (subsetp '((speed 3) (safety 0)) settings :test 'equal) |
217 |
#-allegro nil |
#-allegro nil |
218 |
finally (return settings))) |
finally (return (random-permute settings)))) |
219 |
|
|
220 |
(defun fn-symbols-in-form (form) |
(defun fn-symbols-in-form (form) |
221 |
"Return a list of the distinct standardized lisp function |
"Return a list of the distinct standardized lisp function |
260 |
(let ((r (ash 1 (1+ (random 32))))) |
(let ((r (ash 1 (1+ (random 32))))) |
261 |
(- (random r) (floor (/ r 2))))) |
(- (random r) (floor (/ r 2))))) |
262 |
|
|
263 |
|
(defun make-random-rational () |
264 |
|
(let* ((r (ash 1 (1+ (random 32)))) |
265 |
|
(n (random r)) |
266 |
|
(d (loop for x = (random r) unless (zerop x) do (return x)))) |
267 |
|
(if (coin) (/ n d) (- (/ n d))))) |
268 |
|
|
269 |
|
(defun make-random-float () |
270 |
|
(rcase |
271 |
|
(1 (random most-positive-short-float)) |
272 |
|
(1 (random most-positive-single-float)) |
273 |
|
(1 (random most-positive-double-float)) |
274 |
|
(1 (random most-positive-long-float)))) |
275 |
|
|
276 |
(defun random-var-desc () |
(defun random-var-desc () |
277 |
(loop |
(loop |
278 |
(let* ((pos (random (length *vars*))) |
(let* ((pos (random (length *vars*))) |
415 |
(2 (make-random-integer-eval-form size)) |
(2 (make-random-integer-eval-form size)) |
416 |
|
|
417 |
#-(or cmu allegro) |
#-(or cmu allegro) |
418 |
(2 |
(20 |
419 |
(destructuring-bind (s1 s2) |
(destructuring-bind (s1 s2) |
420 |
(random-partition (- size 2) 2) |
(random-partition (- size 2) 2) |
421 |
`(ash ,(make-random-integer-form s1) |
`(ash ,(make-random-integer-form s1) |
526 |
(*random-int-form-blocks* (adjoin name *random-int-form-blocks*))) |
(*random-int-form-blocks* (adjoin name *random-int-form-blocks*))) |
527 |
`(block ,name ,(make-random-integer-form (1- size))))) |
`(block ,name ,(make-random-integer-form (1- size))))) |
528 |
|
|
529 |
|
#-armedbear |
530 |
(20 |
(20 |
531 |
(let* ((tag (list 'quote (random-from-seq #(ct1 ct2 ct2 ct4 ct5 ct6 ct7 ct8)))) |
(let* ((tag (list 'quote (random-from-seq #(ct1 ct2 ct2 ct4 ct5 ct6 ct7 ct8)))) |
532 |
(*random-int-form-catch-tags* (cons tag *random-int-form-catch-tags*))) |
(*random-int-form-catch-tags* (cons tag *random-int-form-catch-tags*))) |
564 |
;; No blocks -- try again |
;; No blocks -- try again |
565 |
(make-random-integer-form size))) |
(make-random-integer-form size))) |
566 |
|
|
567 |
; #-(or armedbear) |
#-(or armedbear) |
568 |
(20 |
(20 |
569 |
(make-random-flet-form size)) |
(make-random-flet-form size)) |
570 |
|
|
932 |
(form2 (let ((*flet-names* (cons (list fname minargs maxargs keyarg-p) |
(form2 (let ((*flet-names* (cons (list fname minargs maxargs keyarg-p) |
933 |
*flet-names*))) |
*flet-names*))) |
934 |
(make-random-integer-form s2))) |
(make-random-integer-form s2))) |
935 |
(opt-forms (mapcar #'make-random-integer-form opt-sizes))) |
(opt-forms (mapcar #'make-random-integer-form opt-sizes) |
936 |
|
)) |
937 |
(if opt-forms |
(if opt-forms |
938 |
`(,op ((,fname (,@(subseq arg-names 0 minargs) |
`(,op ((,fname (,@(subseq arg-names 0 minargs) |
939 |
&optional |
&optional |
1506 |
((coerce) |
((coerce) |
1507 |
(try 0) |
(try 0) |
1508 |
(try (car args)) |
(try (car args)) |
1509 |
(prune #'(lambda (form) (try `(coerce ,form ,(cadr args)))) |
(prune (car args) #'(lambda (form) (try `(coerce ,form ,(cadr args)))))) |
|
(car args))) |
|
1510 |
|
|
1511 |
|
|
1512 |
((multiple-value-call) |
((multiple-value-call) |