Skip to content
Snippets Groups Projects
Commit 71f8c40f authored by pfdietz's avatar pfdietz
Browse files

Collect list of triples, not pairs, in test-random-types3. Also, store the...

Collect list of triples, not pairs, in test-random-types3.  Also, store the types into a variable, and have a catch tag so that if a break occurs we can throw a value to it.
parent 8794d5d4
No related branches found
No related tags found
No related merge requests found
...@@ -9,6 +9,8 @@ ...@@ -9,6 +9,8 @@
(compile-and-load "random-aux.lsp") (compile-and-load "random-aux.lsp")
(compile-and-load "random-int-form.lsp") (compile-and-load "random-int-form.lsp")
(defparameter *random-types* nil)
(defun make-random-type (size) (defun make-random-type (size)
(if (<= size 1) (if (<= size 1)
(rcase (rcase
...@@ -73,6 +75,7 @@ ...@@ -73,6 +75,7 @@
for t2 = (make-random-type size) for t2 = (make-random-type size)
for i from 0 below n for i from 0 below n
;; do (print (list t1 t2)) ;; do (print (list t1 t2))
do (setf *random-types* (list t1 t2))
do (when (and (= (mod i 100) 0) (> i 0)) do (when (and (= (mod i 100) 0) (> i 0))
(format t "~A " i) (finish-output *standard-output*)) (format t "~A " i) (finish-output *standard-output*))
when (test-types t1 t2) when (test-types t1 t2)
...@@ -195,15 +198,16 @@ ...@@ -195,15 +198,16 @@
(defun test-type-triple (t1 t2 t3) (defun test-type-triple (t1 t2 t3)
;; Returns non-nil if a problem is found ;; Returns non-nil if a problem is found
(multiple-value-bind (sub1 success1) (catch 'problem
(subtypep t1 t2) (multiple-value-bind (sub1 success1)
(when success1 (subtypep t1 t2)
(if sub1 (when success1
(append (if sub1
(check-all-subtypep t1 `(or ,t2 ,t3)) (append
(check-all-subtypep `(and ,t1 ,t3) t2)) (check-all-subtypep t1 `(or ,t2 ,t3))
(or (subtypep `(or ,t1 ,t3) t2) (check-all-subtypep `(and ,t1 ,t3) t2))
(subtypep t1 `(and ,t2 ,t3))))))) (or (subtypep `(or ,t1 ,t3) t2)
(subtypep t1 `(and ,t2 ,t3))))))))
(defun test-random-types3 (n size) (defun test-random-types3 (n size)
(loop for t1 = (make-random-type (1+ (random size))) (loop for t1 = (make-random-type (1+ (random size)))
...@@ -211,10 +215,11 @@ ...@@ -211,10 +215,11 @@
for t3 = (make-random-type (1+ (random size))) for t3 = (make-random-type (1+ (random size)))
for i from 1 to n for i from 1 to n
;; do (print (list t1 t2)) ;; do (print (list t1 t2))
do (setf *random-types* (list t1 t2 t3))
do (when (and (= (mod i 100) 0) (> i 0)) do (when (and (= (mod i 100) 0) (> i 0))
(format t "~A " i) (finish-output *standard-output*)) (format t "~A " i) (finish-output *standard-output*))
when (test-type-triple t1 t2 t3) when (test-type-triple t1 t2 t3)
collect (list t1 t2) collect (list t1 t2 t3)
finally (terpri))) finally (terpri)))
(defun prune-type-triple (pair &optional (fn #'test-type-triple)) (defun prune-type-triple (pair &optional (fn #'test-type-triple))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment