fix let-poly's check function so it always terminates
This commit is contained in:
parent
d33e6e635b
commit
eb1fbc8bcf
|
@ -14,7 +14,7 @@
|
||||||
< (let ([t-type (type-check M)])
|
< (let ([t-type (type-check M)])
|
||||||
< (implies
|
< (implies
|
||||||
< t-type
|
< t-type
|
||||||
< (let loop ([Σ+M `(· ,M)])
|
< (let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
< (define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
< (define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
< (and (consistent-with? t-type new-type)
|
< (and (consistent-with? t-type new-type)
|
||||||
< (or (v? (list-ref Σ+M 1))
|
< (or (v? (list-ref Σ+M 1))
|
||||||
|
@ -22,13 +22,13 @@
|
||||||
< (and (= (length red-res) 1)
|
< (and (= (length red-res) 1)
|
||||||
< (let ([red-t (car red-res)])
|
< (let ([red-t (car red-res)])
|
||||||
< (or (equal? red-t "error")
|
< (or (equal? red-t "error")
|
||||||
< (loop red-t))))))))))))
|
< (zero? n) (loop red-t (- n 1)))))))))))))
|
||||||
---
|
---
|
||||||
> (with-handlers ([exn:fail? (λ (x) #f)])
|
> (with-handlers ([exn:fail? (λ (x) #f)])
|
||||||
> (let ([t-type (type-check M)])
|
> (let ([t-type (type-check M)])
|
||||||
> (implies
|
> (implies
|
||||||
> t-type
|
> t-type
|
||||||
> (let loop ([Σ+M `(· ,M)])
|
> (let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
> (define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
> (define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
> (and (consistent-with? t-type new-type)
|
> (and (consistent-with? t-type new-type)
|
||||||
> (or (v? (list-ref Σ+M 1))
|
> (or (v? (list-ref Σ+M 1))
|
||||||
|
@ -36,7 +36,7 @@
|
||||||
> (and (= (length red-res) 1)
|
> (and (= (length red-res) 1)
|
||||||
> (let ([red-t (car red-res)])
|
> (let ([red-t (car red-res)])
|
||||||
> (or (equal? red-t "error")
|
> (or (equal? red-t "error")
|
||||||
> (loop red-t)))))))))))))
|
> (zero? n) (loop red-t (- n 1))))))))))))))
|
||||||
>
|
>
|
||||||
> (define small-counter-example (term (cons 1)))
|
> (define small-counter-example (term (cons 1)))
|
||||||
> (test-equal (check small-counter-example) #f)
|
> (test-equal (check small-counter-example) #f)
|
||||||
|
|
|
@ -10,7 +10,7 @@
|
||||||
< (let ([t-type (type-check M)])
|
< (let ([t-type (type-check M)])
|
||||||
< (implies
|
< (implies
|
||||||
< t-type
|
< t-type
|
||||||
< (let loop ([Σ+M `(· ,M)])
|
< (let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
< (define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
< (define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
< (and (consistent-with? t-type new-type)
|
< (and (consistent-with? t-type new-type)
|
||||||
< (or (v? (list-ref Σ+M 1))
|
< (or (v? (list-ref Σ+M 1))
|
||||||
|
@ -18,13 +18,13 @@
|
||||||
< (and (= (length red-res) 1)
|
< (and (= (length red-res) 1)
|
||||||
< (let ([red-t (car red-res)])
|
< (let ([red-t (car red-res)])
|
||||||
< (or (equal? red-t "error")
|
< (or (equal? red-t "error")
|
||||||
< (loop red-t))))))))))))
|
< (zero? n) (loop red-t (- n 1)))))))))))))
|
||||||
---
|
---
|
||||||
> (with-handlers ([exn:fail? (λ (x) #f)])
|
> (with-handlers ([exn:fail? (λ (x) #f)])
|
||||||
> (let ([t-type (type-check M)])
|
> (let ([t-type (type-check M)])
|
||||||
> (implies
|
> (implies
|
||||||
> t-type
|
> t-type
|
||||||
> (let loop ([Σ+M `(· ,M)])
|
> (let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
> (define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
> (define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
> (and (consistent-with? t-type new-type)
|
> (and (consistent-with? t-type new-type)
|
||||||
> (or (v? (list-ref Σ+M 1))
|
> (or (v? (list-ref Σ+M 1))
|
||||||
|
@ -32,7 +32,7 @@
|
||||||
> (and (= (length red-res) 1)
|
> (and (= (length red-res) 1)
|
||||||
> (let ([red-t (car red-res)])
|
> (let ([red-t (car red-res)])
|
||||||
> (or (equal? red-t "error")
|
> (or (equal? red-t "error")
|
||||||
> (loop red-t)))))))))))))
|
> (zero? n) (loop red-t (- n 1))))))))))))))
|
||||||
>
|
>
|
||||||
> (define small-counter-example (term ((λ x x) 1)))
|
> (define small-counter-example (term ((λ x x) 1)))
|
||||||
> (test-equal (check small-counter-example) #f)
|
> (test-equal (check small-counter-example) #f)
|
||||||
|
|
|
@ -550,8 +550,8 @@ Generators
|
||||||
#|
|
#|
|
||||||
|
|
||||||
Check to see if a combination of preservation
|
Check to see if a combination of preservation
|
||||||
and progress holds for every single term reachable
|
and progress holds for the first 100 terms
|
||||||
from the given term.
|
reachable from the given term.
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
@ -560,7 +560,7 @@ from the given term.
|
||||||
(let ([t-type (type-check M)])
|
(let ([t-type (type-check M)])
|
||||||
(implies
|
(implies
|
||||||
t-type
|
t-type
|
||||||
(let loop ([Σ+M `(· ,M)])
|
(let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
(and (consistent-with? t-type new-type)
|
(and (consistent-with? t-type new-type)
|
||||||
(or (v? (list-ref Σ+M 1))
|
(or (v? (list-ref Σ+M 1))
|
||||||
|
@ -568,7 +568,7 @@ from the given term.
|
||||||
(and (= (length red-res) 1)
|
(and (= (length red-res) 1)
|
||||||
(let ([red-t (car red-res)])
|
(let ([red-t (car red-res)])
|
||||||
(or (equal? red-t "error")
|
(or (equal? red-t "error")
|
||||||
(loop red-t))))))))))))
|
(zero? n) (loop red-t (- n 1)))))))))))))
|
||||||
|
|
||||||
(define small-counter-example '(hd ((λ x x) 1)))
|
(define small-counter-example '(hd ((λ x x) 1)))
|
||||||
(test-equal (check small-counter-example) #f)
|
(test-equal (check small-counter-example) #f)
|
||||||
|
|
|
@ -545,8 +545,8 @@ Generators
|
||||||
#|
|
#|
|
||||||
|
|
||||||
Check to see if a combination of preservation
|
Check to see if a combination of preservation
|
||||||
and progress holds for every single term reachable
|
and progress holds for the first 100 terms
|
||||||
from the given term.
|
reachable from the given term.
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
@ -555,7 +555,7 @@ from the given term.
|
||||||
(let ([t-type (type-check M)])
|
(let ([t-type (type-check M)])
|
||||||
(implies
|
(implies
|
||||||
t-type
|
t-type
|
||||||
(let loop ([Σ+M `(· ,M)])
|
(let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
(and (consistent-with? t-type new-type)
|
(and (consistent-with? t-type new-type)
|
||||||
(or (v? (list-ref Σ+M 1))
|
(or (v? (list-ref Σ+M 1))
|
||||||
|
@ -563,7 +563,7 @@ from the given term.
|
||||||
(and (= (length red-res) 1)
|
(and (= (length red-res) 1)
|
||||||
(let ([red-t (car red-res)])
|
(let ([red-t (car red-res)])
|
||||||
(or (equal? red-t "error")
|
(or (equal? red-t "error")
|
||||||
(loop red-t))))))))))))
|
(zero? n) (loop red-t (- n 1)))))))))))))
|
||||||
|
|
||||||
(define small-counter-example '(let ([x (new nil)])
|
(define small-counter-example '(let ([x (new nil)])
|
||||||
((λ ignore
|
((λ ignore
|
||||||
|
|
|
@ -550,8 +550,8 @@ Generators
|
||||||
#|
|
#|
|
||||||
|
|
||||||
Check to see if a combination of preservation
|
Check to see if a combination of preservation
|
||||||
and progress holds for every single term reachable
|
and progress holds for the first 100 terms
|
||||||
from the given term.
|
reachable from the given term.
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
@ -560,7 +560,7 @@ from the given term.
|
||||||
(let ([t-type (type-check M)])
|
(let ([t-type (type-check M)])
|
||||||
(implies
|
(implies
|
||||||
t-type
|
t-type
|
||||||
(let loop ([Σ+M `(· ,M)])
|
(let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
(and (consistent-with? t-type new-type)
|
(and (consistent-with? t-type new-type)
|
||||||
(or (v? (list-ref Σ+M 1))
|
(or (v? (list-ref Σ+M 1))
|
||||||
|
@ -568,7 +568,7 @@ from the given term.
|
||||||
(and (= (length red-res) 1)
|
(and (= (length red-res) 1)
|
||||||
(let ([red-t (car red-res)])
|
(let ([red-t (car red-res)])
|
||||||
(or (equal? red-t "error")
|
(or (equal? red-t "error")
|
||||||
(loop red-t))))))))))))
|
(zero? n) (loop red-t (- n 1)))))))))))))
|
||||||
|
|
||||||
(define small-counter-example (term (1 cons)))
|
(define small-counter-example (term (1 cons)))
|
||||||
(test-equal (check small-counter-example) #f)
|
(test-equal (check small-counter-example) #f)
|
||||||
|
|
|
@ -552,8 +552,8 @@ Generators
|
||||||
#|
|
#|
|
||||||
|
|
||||||
Check to see if a combination of preservation
|
Check to see if a combination of preservation
|
||||||
and progress holds for every single term reachable
|
and progress holds for the first 100 terms
|
||||||
from the given term.
|
reachable from the given term.
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
@ -562,7 +562,7 @@ from the given term.
|
||||||
(let ([t-type (type-check M)])
|
(let ([t-type (type-check M)])
|
||||||
(implies
|
(implies
|
||||||
t-type
|
t-type
|
||||||
(let loop ([Σ+M `(· ,M)])
|
(let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
(and (consistent-with? t-type new-type)
|
(and (consistent-with? t-type new-type)
|
||||||
(or (v? (list-ref Σ+M 1))
|
(or (v? (list-ref Σ+M 1))
|
||||||
|
@ -570,7 +570,7 @@ from the given term.
|
||||||
(and (= (length red-res) 1)
|
(and (= (length red-res) 1)
|
||||||
(let ([red-t (car red-res)])
|
(let ([red-t (car red-res)])
|
||||||
(or (equal? red-t "error")
|
(or (equal? red-t "error")
|
||||||
(loop red-t))))))))))))
|
(zero? n) (loop red-t (- n 1)))))))))))))
|
||||||
|
|
||||||
(define small-counter-example (term ((λ x (x x)) hd)))
|
(define small-counter-example (term ((λ x (x x)) hd)))
|
||||||
(test-equal (check small-counter-example) #f)
|
(test-equal (check small-counter-example) #f)
|
||||||
|
|
|
@ -552,8 +552,8 @@ Generators
|
||||||
#|
|
#|
|
||||||
|
|
||||||
Check to see if a combination of preservation
|
Check to see if a combination of preservation
|
||||||
and progress holds for every single term reachable
|
and progress holds for the first 100 terms
|
||||||
from the given term.
|
reachable from the given term.
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
@ -563,7 +563,7 @@ from the given term.
|
||||||
(let ([t-type (type-check M)])
|
(let ([t-type (type-check M)])
|
||||||
(implies
|
(implies
|
||||||
t-type
|
t-type
|
||||||
(let loop ([Σ+M `(· ,M)])
|
(let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
(and (consistent-with? t-type new-type)
|
(and (consistent-with? t-type new-type)
|
||||||
(or (v? (list-ref Σ+M 1))
|
(or (v? (list-ref Σ+M 1))
|
||||||
|
@ -571,7 +571,7 @@ from the given term.
|
||||||
(and (= (length red-res) 1)
|
(and (= (length red-res) 1)
|
||||||
(let ([red-t (car red-res)])
|
(let ([red-t (car red-res)])
|
||||||
(or (equal? red-t "error")
|
(or (equal? red-t "error")
|
||||||
(loop red-t)))))))))))))
|
(zero? n) (loop red-t (- n 1))))))))))))))
|
||||||
|
|
||||||
(define small-counter-example (term (cons 1)))
|
(define small-counter-example (term (cons 1)))
|
||||||
(test-equal (check small-counter-example) #f)
|
(test-equal (check small-counter-example) #f)
|
||||||
|
|
|
@ -550,8 +550,8 @@ Generators
|
||||||
#|
|
#|
|
||||||
|
|
||||||
Check to see if a combination of preservation
|
Check to see if a combination of preservation
|
||||||
and progress holds for every single term reachable
|
and progress holds for the first 100 terms
|
||||||
from the given term.
|
reachable from the given term.
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
@ -561,7 +561,7 @@ from the given term.
|
||||||
(let ([t-type (type-check M)])
|
(let ([t-type (type-check M)])
|
||||||
(implies
|
(implies
|
||||||
t-type
|
t-type
|
||||||
(let loop ([Σ+M `(· ,M)])
|
(let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
(and (consistent-with? t-type new-type)
|
(and (consistent-with? t-type new-type)
|
||||||
(or (v? (list-ref Σ+M 1))
|
(or (v? (list-ref Σ+M 1))
|
||||||
|
@ -569,7 +569,7 @@ from the given term.
|
||||||
(and (= (length red-res) 1)
|
(and (= (length red-res) 1)
|
||||||
(let ([red-t (car red-res)])
|
(let ([red-t (car red-res)])
|
||||||
(or (equal? red-t "error")
|
(or (equal? red-t "error")
|
||||||
(loop red-t)))))))))))))
|
(zero? n) (loop red-t (- n 1))))))))))))))
|
||||||
|
|
||||||
(define small-counter-example (term ((λ x x) 1)))
|
(define small-counter-example (term ((λ x x) 1)))
|
||||||
(test-equal (check small-counter-example) #f)
|
(test-equal (check small-counter-example) #f)
|
||||||
|
|
|
@ -551,8 +551,8 @@ Generators
|
||||||
#|
|
#|
|
||||||
|
|
||||||
Check to see if a combination of preservation
|
Check to see if a combination of preservation
|
||||||
and progress holds for every single term reachable
|
and progress holds for the first 100 terms
|
||||||
from the given term.
|
reachable from the given term.
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
@ -561,7 +561,7 @@ from the given term.
|
||||||
(let ([t-type (type-check M)])
|
(let ([t-type (type-check M)])
|
||||||
(implies
|
(implies
|
||||||
t-type
|
t-type
|
||||||
(let loop ([Σ+M `(· ,M)])
|
(let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
(and (consistent-with? t-type new-type)
|
(and (consistent-with? t-type new-type)
|
||||||
(or (v? (list-ref Σ+M 1))
|
(or (v? (list-ref Σ+M 1))
|
||||||
|
@ -569,7 +569,7 @@ from the given term.
|
||||||
(and (= (length red-res) 1)
|
(and (= (length red-res) 1)
|
||||||
(let ([red-t (car red-res)])
|
(let ([red-t (car red-res)])
|
||||||
(or (equal? red-t "error")
|
(or (equal? red-t "error")
|
||||||
(loop red-t))))))))))))
|
(zero? n) (loop red-t (- n 1)))))))))))))
|
||||||
|
|
||||||
(define small-counter-example (term (let ((x (λ y y))) (x x))))
|
(define small-counter-example (term (let ((x (λ y y))) (x x))))
|
||||||
(test-equal (check small-counter-example) #f)
|
(test-equal (check small-counter-example) #f)
|
||||||
|
|
|
@ -550,8 +550,8 @@ Generators
|
||||||
#|
|
#|
|
||||||
|
|
||||||
Check to see if a combination of preservation
|
Check to see if a combination of preservation
|
||||||
and progress holds for every single term reachable
|
and progress holds for the first 100 terms
|
||||||
from the given term.
|
reachable from the given term.
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
||||||
|
@ -560,7 +560,7 @@ from the given term.
|
||||||
(let ([t-type (type-check M)])
|
(let ([t-type (type-check M)])
|
||||||
(implies
|
(implies
|
||||||
t-type
|
t-type
|
||||||
(let loop ([Σ+M `(· ,M)])
|
(let loop ([Σ+M `(· ,M)] [n 100])
|
||||||
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
(define new-type (type-check (list-ref Σ+M 1) (list-ref Σ+M 0)))
|
||||||
(and (consistent-with? t-type new-type)
|
(and (consistent-with? t-type new-type)
|
||||||
(or (v? (list-ref Σ+M 1))
|
(or (v? (list-ref Σ+M 1))
|
||||||
|
@ -568,4 +568,4 @@ from the given term.
|
||||||
(and (= (length red-res) 1)
|
(and (= (length red-res) 1)
|
||||||
(let ([red-t (car red-res)])
|
(let ([red-t (car red-res)])
|
||||||
(or (equal? red-t "error")
|
(or (equal? red-t "error")
|
||||||
(loop red-t))))))))))))
|
(zero? n) (loop red-t (- n 1)))))))))))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user