Adding fixed test mode and small examples for all diffs

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/.gitignore

@@ -0,0 +1,2 @@
+*.orig
+/*.rktd

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/delim-cont/delim-cont-1.rkt

@@ -950,3 +950,9 @@
     (begin0
       (generate-term abort-lang e #:i-th index)
       (set! index (add1 index)))))
+
+(define fixed
+  (term
+   (;; 1, 2 & 3 [designed for 1]
+    (ccm (MG (flat (λ (x : Num) #t)) key:test "k" "l" "j") Num)
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/delim-cont/delim-cont-2.rkt

@@ -948,3 +948,9 @@
     (begin0
       (generate-term abort-lang e #:i-th index)
       (set! index (add1 index)))))
+
+(define fixed
+  (term
+   (;; 1, 2 & 3 [designed for 1]
+    (ccm (MG (flat (λ (x : Num) #t)) key:test "k" "l" "j") Num)
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/delim-cont/delim-cont-3.rkt

@@ -948,3 +948,9 @@
     (begin0
       (generate-term abort-lang e #:i-th index)
       (set! index (add1 index)))))
+
+(define fixed
+  (term
+   (;; 1, 2 & 3 [designed for 1]
+    (ccm (MG (flat (λ (x : Num) #t)) key:test "k" "l" "j") Num)
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/delim-cont/delim-cont-base.rkt

@@ -945,3 +945,9 @@
     (begin0
       (generate-term abort-lang e #:i-th index)
       (set! index (add1 index)))))
+
+(define fixed
+  (term
+   (;; 1, 2 & 3 [designed for 1]
+    (ccm (MG (flat (λ (x : Num) #t)) key:test "k" "l" "j") Num)
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/list-machine/list-machine-1.rkt

@@ -443,3 +443,11 @@
         (generate-term list-machine-typing (l0 : ι p) #:i-th index)
         (set! index (add1 index))))))
 
+(define fixed
+  (term
+   ;; 1, 2, and 3 [but designed for 3]
+   ((l0 : (begin (cons x y z)
+                 (begin (branch-if-nil z loop)
+                        halt))
+        (loop : (jump loop)
+              end)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/list-machine/list-machine-2.rkt

@@ -443,3 +443,11 @@
         (generate-term list-machine-typing (l0 : ι p) #:i-th index)
         (set! index (add1 index))))))
 
+(define fixed
+  (term
+   ;; 1, 2, and 3 [but designed for 3]
+   ((l0 : (begin (cons x y z)
+                 (begin (branch-if-nil z loop)
+                        halt))
+        (loop : (jump loop)
+              end)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/list-machine/list-machine-3.rkt

@@ -439,3 +439,11 @@
         (generate-term list-machine-typing (l0 : ι p) #:i-th index)
         (set! index (add1 index))))))
 
+(define fixed
+  (term
+   ;; 1, 2, and 3 [but designed for 3]
+   ((l0 : (begin (cons x y z)
+                 (begin (branch-if-nil z loop)
+                        halt))
+        (loop : (jump loop)
+              end)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/list-machine/list-machine-base.rkt

@@ -439,3 +439,11 @@
         (generate-term list-machine-typing (l0 : ι p) #:i-th index)
         (set! index (add1 index))))))
 
+(define fixed
+  (term
+   ;; 1, 2, and 3 [but designed for 3]
+   ((l0 : (begin (cons x y z)
+                 (begin (branch-if-nil z loop)
+                        halt))
+        (loop : (jump loop)
+              end)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-10.rkt

@@ -274,11 +274,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -289,3 +292,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-2.rkt

@@ -272,11 +272,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -287,3 +290,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-3.rkt

@@ -274,11 +274,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -289,3 +292,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-4.rkt

@@ -274,11 +274,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -289,3 +292,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-5.rkt

@@ -274,11 +274,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -289,3 +292,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-6.rkt

@@ -274,11 +274,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -289,3 +292,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-7.rkt

@@ -273,11 +273,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -288,3 +291,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-8.rkt

@@ -274,11 +274,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -289,3 +292,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-9.rkt

@@ -274,11 +274,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -289,3 +292,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/poly-stlc/poly-stlc-base.rkt

@@ -274,11 +274,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term poly-stlc M #:i-th (pick-an-index 0.001)))
@@ -289,3 +292,21 @@
       (begin0
         (generate-term poly-stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    (([cons @ int] 1) nil)
+
+    ;; 3 & 10 [designed for 3]
+    ((λ (x int) [nil @ int]) 1)
+
+    ;; 5, 6, 7, 8 & 9 [designed for 4]
+    ((λ (x int) x)
+     (([cons @ int] 1) [nil @ int]))
+
+    ;; 4
+    ([tl @ int]
+     (([cons @ int] 1) [nil @ int]))
+
+    )))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/rbtrees/rbtrees-1.rkt

@@ -180,34 +180,34 @@
     (rand-rb-tree depth)))
 
 (module+
- test
+    test
- (require rackunit)
+  (require rackunit)
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (ordered?
+               (ordered?
-               (B (R E (s O) E)
+                (B (R E (s O) E)
-                  (s (s (s O)))
+                   (s (s (s O)))
-                  E)
+                   E)
-               n_1 n_2)))
+                n_1 n_2)))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbtree (B (R E (s O) E)
+               (rbtree (B (R E (s O) E)
-                         (s (s (s O)))
+                          (s (s (s O)))
-                         E)
+                          E)
-                      n_1)))
+                       n_1)))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbst (B (R E (s O) E)
+               (rbst (B (R E (s O) E)
-                       (s (s (s O)))
+                        (s (s (s O)))
-                       E))))
+                        E))))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbst (R (B E (s O) E)
+               (rbst (R (B E (s O) E)
-                       (s (s (s O)))
+                        (s (s (s O)))
-                       (B E
+                        (B E
-                          (s (s (s (s (s O)))))
+                           (s (s (s (s (s O)))))
-                          E)))))
+                           E)))))
- (check-false (judgment-holds
+  (check-false (judgment-holds
-               (rbst (R (B E (s (s O)) E)
+                (rbst (R (B E (s (s O)) E)
-                        (s O)
+                         (s O)
-                        (R E O E)))))
+                         (R E O E)))))
- )
+  )
 
 (define (ins-preserves-rb-tree t)
   (or (not (judgment-holds (rb-tree ,t)))
@@ -221,44 +221,44 @@
              (insert (num->n ,n) ,t))))])))
 
 (module+
- test
+    test
- (define (check-rbsts n)
+  (define (check-rbsts n)
-   (for ([_ (in-range n)])
+    (for ([_ (in-range n)])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rbst t)
+                            (rbst t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rbst ,t)
+        [`(rbst ,t)
-        (check-not-false (or (ins-preserves-rb-tree t)
+         (check-not-false (or (ins-preserves-rb-tree t)
-                             (printf "~s\n" t)))])))
+                              (printf "~s\n" t)))])))
 
- (define (check-rbst/rb-tree tries)
+  (define (check-rbst/rb-tree tries)
-   (for ([_ tries])
+    (for ([_ tries])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rbst t)
+                            (rbst t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rbst ,t)
+        [`(rbst ,t)
-        (define res
+         (define res
-          (judgment-holds
+           (judgment-holds
-           (rb-tree ,t)))
+            (rb-tree ,t)))
-        (unless res (displayln t))
+         (unless res (displayln t))
-        (check-not-false res)]))
+         (check-not-false res)]))
-   (for ([_ tries])
+    (for ([_ tries])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rb-tree t)
+                            (rb-tree t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rb-tree ,t)
+        [`(rb-tree ,t)
-        (define res
+         (define res
-          (judgment-holds
+           (judgment-holds
-           (rb-tree ,t)))
+            (rb-tree ,t)))
-        (unless res (displayln t))
+         (unless res (displayln t))
-        (check-not-false res)])))
+         (check-not-false res)])))
- )
+  )
 
 (define (generate-M-term)
   (generate-term rbtrees t 5))
@@ -298,3 +298,22 @@
       (begin0
         (generate-term rbtrees t #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1 and 2
+    (B (R E (num->n 1) E)
+       (num->n 3)
+       E)
+    ;; 3
+    (B
+     ;;; size should be 1, but in 3 it's 0
+     (B 
+      ;; size is 0
+      (R E (num->n 1) E)
+      (num->n 2)
+      ;; size is 0
+      (R E (num->n 3) E))
+     (num->n 5)
+     ;; size is 0
+     (R E (num->n 10) E)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/rbtrees/rbtrees-2.rkt

@@ -178,34 +178,34 @@
     (rand-rb-tree depth)))
 
 (module+
- test
+    test
- (require rackunit)
+  (require rackunit)
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (ordered?
+               (ordered?
-               (B (R E (s O) E)
+                (B (R E (s O) E)
-                  (s (s (s O)))
+                   (s (s (s O)))
-                  E)
+                   E)
-               n_1 n_2)))
+                n_1 n_2)))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbtree (B (R E (s O) E)
+               (rbtree (B (R E (s O) E)
-                         (s (s (s O)))
+                          (s (s (s O)))
-                         E)
+                          E)
-                      n_1)))
+                       n_1)))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbst (B (R E (s O) E)
+               (rbst (B (R E (s O) E)
-                       (s (s (s O)))
+                        (s (s (s O)))
-                       E))))
+                        E))))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbst (R (B E (s O) E)
+               (rbst (R (B E (s O) E)
-                       (s (s (s O)))
+                        (s (s (s O)))
-                       (B E
+                        (B E
-                          (s (s (s (s (s O)))))
+                           (s (s (s (s (s O)))))
-                          E)))))
+                           E)))))
- (check-false (judgment-holds
+  (check-false (judgment-holds
-               (rbst (R (B E (s (s O)) E)
+                (rbst (R (B E (s (s O)) E)
-                        (s O)
+                         (s O)
-                        (R E O E)))))
+                         (R E O E)))))
- )
+  )
 
 (define (ins-preserves-rb-tree t)
   (or (not (judgment-holds (rb-tree ,t)))
@@ -219,44 +219,44 @@
              (insert (num->n ,n) ,t))))])))
 
 (module+
- test
+    test
- (define (check-rbsts n)
+  (define (check-rbsts n)
-   (for ([_ (in-range n)])
+    (for ([_ (in-range n)])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rbst t)
+                            (rbst t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rbst ,t)
+        [`(rbst ,t)
-        (check-not-false (or (ins-preserves-rb-tree t)
+         (check-not-false (or (ins-preserves-rb-tree t)
-                             (printf "~s\n" t)))])))
+                              (printf "~s\n" t)))])))
 
- (define (check-rbst/rb-tree tries)
+  (define (check-rbst/rb-tree tries)
-   (for ([_ tries])
+    (for ([_ tries])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rbst t)
+                            (rbst t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rbst ,t)
+        [`(rbst ,t)
-        (define res
+         (define res
-          (judgment-holds
+           (judgment-holds
-           (rb-tree ,t)))
+            (rb-tree ,t)))
-        (unless res (displayln t))
+         (unless res (displayln t))
-        (check-not-false res)]))
+         (check-not-false res)]))
-   (for ([_ tries])
+    (for ([_ tries])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rb-tree t)
+                            (rb-tree t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rb-tree ,t)
+        [`(rb-tree ,t)
-        (define res
+         (define res
-          (judgment-holds
+           (judgment-holds
-           (rb-tree ,t)))
+            (rb-tree ,t)))
-        (unless res (displayln t))
+         (unless res (displayln t))
-        (check-not-false res)])))
+         (check-not-false res)])))
- )
+  )
 
 (define (generate-M-term)
   (generate-term rbtrees t 5))
@@ -296,3 +296,22 @@
       (begin0
         (generate-term rbtrees t #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1 and 2
+    (B (R E (num->n 1) E)
+       (num->n 3)
+       E)
+    ;; 3
+    (B
+     ;;; size should be 1, but in 3 it's 0
+     (B 
+      ;; size is 0
+      (R E (num->n 1) E)
+      (num->n 2)
+      ;; size is 0
+      (R E (num->n 3) E))
+     (num->n 5)
+     ;; size is 0
+     (R E (num->n 10) E)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/rbtrees/rbtrees-3.rkt

@@ -180,34 +180,34 @@
     (rand-rb-tree depth)))
 
 (module+
- test
+    test
- (require rackunit)
+  (require rackunit)
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (ordered?
+               (ordered?
-               (B (R E (s O) E)
+                (B (R E (s O) E)
-                  (s (s (s O)))
+                   (s (s (s O)))
-                  E)
+                   E)
-               n_1 n_2)))
+                n_1 n_2)))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbtree (B (R E (s O) E)
+               (rbtree (B (R E (s O) E)
-                         (s (s (s O)))
+                          (s (s (s O)))
-                         E)
+                          E)
-                      n_1)))
+                       n_1)))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbst (B (R E (s O) E)
+               (rbst (B (R E (s O) E)
-                       (s (s (s O)))
+                        (s (s (s O)))
-                       E))))
+                        E))))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbst (R (B E (s O) E)
+               (rbst (R (B E (s O) E)
-                       (s (s (s O)))
+                        (s (s (s O)))
-                       (B E
+                        (B E
-                          (s (s (s (s (s O)))))
+                           (s (s (s (s (s O)))))
-                          E)))))
+                           E)))))
- (check-false (judgment-holds
+  (check-false (judgment-holds
-               (rbst (R (B E (s (s O)) E)
+                (rbst (R (B E (s (s O)) E)
-                        (s O)
+                         (s O)
-                        (R E O E)))))
+                         (R E O E)))))
- )
+  )
 
 (define (ins-preserves-rb-tree t)
   (or (not (judgment-holds (rb-tree ,t)))
@@ -221,44 +221,44 @@
              (insert (num->n ,n) ,t))))])))
 
 (module+
- test
+    test
- (define (check-rbsts n)
+  (define (check-rbsts n)
-   (for ([_ (in-range n)])
+    (for ([_ (in-range n)])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rbst t)
+                            (rbst t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rbst ,t)
+        [`(rbst ,t)
-        (check-not-false (or (ins-preserves-rb-tree t)
+         (check-not-false (or (ins-preserves-rb-tree t)
-                             (printf "~s\n" t)))])))
+                              (printf "~s\n" t)))])))
 
- (define (check-rbst/rb-tree tries)
+  (define (check-rbst/rb-tree tries)
-   (for ([_ tries])
+    (for ([_ tries])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rbst t)
+                            (rbst t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rbst ,t)
+        [`(rbst ,t)
-        (define res
+         (define res
-          (judgment-holds
+           (judgment-holds
-           (rb-tree ,t)))
+            (rb-tree ,t)))
-        (unless res (displayln t))
+         (unless res (displayln t))
-        (check-not-false res)]))
+         (check-not-false res)]))
-   (for ([_ tries])
+    (for ([_ tries])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rb-tree t)
+                            (rb-tree t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rb-tree ,t)
+        [`(rb-tree ,t)
-        (define res
+         (define res
-          (judgment-holds
+           (judgment-holds
-           (rb-tree ,t)))
+            (rb-tree ,t)))
-        (unless res (displayln t))
+         (unless res (displayln t))
-        (check-not-false res)])))
+         (check-not-false res)])))
- )
+  )
 
 (define (generate-M-term)
   (generate-term rbtrees t 5))
@@ -298,3 +298,22 @@
       (begin0
         (generate-term rbtrees t #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1 and 2
+    (B (R E (num->n 1) E)
+       (num->n 3)
+       E)
+    ;; 3
+    (B
+     ;;; size should be 1, but in 3 it's 0
+     (B 
+      ;; size is 0
+      (R E (num->n 1) E)
+      (num->n 2)
+      ;; size is 0
+      (R E (num->n 3) E))
+     (num->n 5)
+     ;; size is 0
+     (R E (num->n 10) E)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/rbtrees/rbtrees-base.rkt

@@ -180,34 +180,34 @@
     (rand-rb-tree depth)))
 
 (module+
- test
+    test
- (require rackunit)
+  (require rackunit)
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (ordered?
+               (ordered?
-               (B (R E (s O) E)
+                (B (R E (s O) E)
-                  (s (s (s O)))
+                   (s (s (s O)))
-                  E)
+                   E)
-               n_1 n_2)))
+                n_1 n_2)))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbtree (B (R E (s O) E)
+               (rbtree (B (R E (s O) E)
-                         (s (s (s O)))
+                          (s (s (s O)))
-                         E)
+                          E)
-                      n_1)))
+                       n_1)))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbst (B (R E (s O) E)
+               (rbst (B (R E (s O) E)
-                       (s (s (s O)))
+                        (s (s (s O)))
-                       E))))
+                        E))))
- (check-true (judgment-holds
+  (check-true (judgment-holds
-              (rbst (R (B E (s O) E)
+               (rbst (R (B E (s O) E)
-                       (s (s (s O)))
+                        (s (s (s O)))
-                       (B E
+                        (B E
-                          (s (s (s (s (s O)))))
+                           (s (s (s (s (s O)))))
-                          E)))))
+                           E)))))
- (check-false (judgment-holds
+  (check-false (judgment-holds
-               (rbst (R (B E (s (s O)) E)
+                (rbst (R (B E (s (s O)) E)
-                        (s O)
+                         (s O)
-                        (R E O E)))))
+                         (R E O E)))))
- )
+  )
 
 (define (ins-preserves-rb-tree t)
   (or (not (judgment-holds (rb-tree ,t)))
@@ -221,44 +221,44 @@
              (insert (num->n ,n) ,t))))])))
 
 (module+
- test
+    test
- (define (check-rbsts n)
+  (define (check-rbsts n)
-   (for ([_ (in-range n)])
+    (for ([_ (in-range n)])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rbst t)
+                            (rbst t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rbst ,t)
+        [`(rbst ,t)
-        (check-not-false (or (ins-preserves-rb-tree t)
+         (check-not-false (or (ins-preserves-rb-tree t)
-                             (printf "~s\n" t)))])))
+                              (printf "~s\n" t)))])))
 
- (define (check-rbst/rb-tree tries)
+  (define (check-rbst/rb-tree tries)
-   (for ([_ tries])
+    (for ([_ tries])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rbst t)
+                            (rbst t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rbst ,t)
+        [`(rbst ,t)
-        (define res
+         (define res
-          (judgment-holds
+           (judgment-holds
-           (rb-tree ,t)))
+            (rb-tree ,t)))
-        (unless res (displayln t))
+         (unless res (displayln t))
-        (check-not-false res)]))
+         (check-not-false res)]))
-   (for ([_ tries])
+    (for ([_ tries])
-     (match (generate-term rbtrees
+      (match (generate-term rbtrees
-                           #:satisfying
+                            #:satisfying
-                           (rb-tree t)
+                            (rb-tree t)
-                           8)
+                            8)
-       [#f (void)]
+        [#f (void)]
-       [`(rb-tree ,t)
+        [`(rb-tree ,t)
-        (define res
+         (define res
-          (judgment-holds
+           (judgment-holds
-           (rb-tree ,t)))
+            (rb-tree ,t)))
-        (unless res (displayln t))
+         (unless res (displayln t))
-        (check-not-false res)])))
+         (check-not-false res)])))
- )
+  )
 
 (define (generate-M-term)
   (generate-term rbtrees t 5))
@@ -298,3 +298,22 @@
       (begin0
         (generate-term rbtrees t #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1 and 2
+    (B (R E (num->n 1) E)
+       (num->n 3)
+       E)
+    ;; 3
+    (B
+     ;;; size should be 1, but in 3 it's 0
+     (B 
+      ;; size is 0
+      (R E (num->n 1) E)
+      (num->n 2)
+      ;; size is 0
+      (R E (num->n 3) E))
+     (num->n 5)
+     ;; size is 0
+     (R E (num->n 10) E)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/run-muts.rkt

@@ -33,7 +33,7 @@
    [("-f" "--file") fname "Run tests for a single file"
                     (set! files (list fname))]
    #:multi
-   [("-t" "--type") t "Generation type to run, one of: search, grammar, search-gen, search-gen-ref, search-gen-enum, search-gen-enum-ref, enum, ordered"
+   [("-t" "--type") t "Generation type to run, one of: search, grammar, search-gen, search-gen-ref, search-gen-enum, search-gen-enum-ref, enum, ordered, fixed"
                     (set! gen-types (cons (string->symbol t) gen-types))])
 
 (define-runtime-path here ".")
@@ -67,33 +67,39 @@
      (set! worklist (cdr worklist))
      (semaphore-post work-sem)
      (define path (simplify-path (build-path here file)))
-     (define output-name (string-append (first 
+     (define output-name 
-                                         (regexp-split #rx"\\."
+       (string-append (first 
-                                                       (last (regexp-split #rx"/" file))))
+                       (regexp-split #rx"\\."
-                                        "-"
+                                     (last (regexp-split #rx"/" file))))
-                                        (symbol->string type)
+                      "-"
-                                        "-results.rktd"))
+                      (symbol->string type)
-     (define args (apply string-append 
+                      "-results.rktd"))
-                         (add-between (list (if verbose? "-v" "")
+     (define args 
-                                            (string-append "-m " (number->string minutes))
+       (apply string-append 
-                                            (string-append "-o " output-name)
+              (add-between (list (if verbose? "-v" "")
-                                            (string-append "-t "
+                                 (string-append "-m " (number->string minutes))
-                                                           (symbol->string type))
+                                 (string-append "-o " output-name)
-                                            (if (equal? type 'ordered) "-f" ""))
+                                 (string-append "-t "
-                                      " ")))
+                                                (symbol->string type))
-     (define command (apply string-append 
+                                 (if (equal? type 'ordered) "-f" ""))
-                            (add-between (list "racket" (path->string (build-path here "test-file.rkt"))
+                           " ")))
-                                               args (path->string path)) " ")))
+     (define command 
-     (printf "running: ~s\n" command)
+       (apply string-append 
+              (add-between 
+               (list "racket" (path->string (build-path here "test-file.rkt"))
+                     args (path->string path)) " ")))
+     (when verbose?
+       (printf "running: ~s\n" command))
      (system command)
      (do-next)]))
 
 (define (do-work)
-  (printf "worklist:\n~a\n" (apply string-append
+  (printf "worklist:\n~a\n"
-                                   (add-between (for/list ([w (in-list worklist)])
+          (apply string-append
-                                                  (match-define (work f t) w)
+                 (add-between (for/list ([w (in-list worklist)])
-                                                  (string-append f ": " (symbol->string t)))
+                                (match-define (work f t) w)
-                                                ", ")))
+                                (string-append f ": " (symbol->string t)))
+                              ", ")))
   (for/list ([_ (in-range num-procs)])
     (thread do-next)))
 

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-1.rkt

@@ -269,11 +269,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -284,3 +287,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-2.rkt

@@ -268,11 +268,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -283,3 +286,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-3.rkt

@@ -269,11 +269,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -284,3 +287,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-4.rkt

@@ -267,11 +267,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -282,3 +285,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-5.rkt

@@ -269,11 +269,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -284,3 +287,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-6.rkt

@@ -269,11 +269,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -284,3 +287,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-7.rkt

@@ -269,11 +269,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -284,3 +287,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-8.rkt

@@ -268,11 +268,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -283,3 +286,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-9.rkt

@@ -269,11 +269,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -284,3 +287,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc-sub/stlc-sub-base.rkt

@@ -268,11 +268,14 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx should this also be t-type IMPLIES?
         (and
          (= (length red-res) 1)
-	 (or 
+         (let ([red-t (car red-res)])
-          (equal? (car red-res) "error")
+           (or 
-          (equal? t-type (type-check (car red-res))))))))
+            (equal? red-t "error")
+            (let ([red-type (type-check red-t)])
+              (equal? t-type red-type))))))))
 
 (define (generate-enum-term)
   (generate-term stlc M #:i-th (pick-an-index 0.0001)))
@@ -283,3 +286,36 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 1
+    ((λ (x int) x) 1)
+
+    ;; 9
+    ((λ (x (list int)) (tl x)) ((cons 1) nil))
+
+    ;; 2 -- xxx I don't think this is really an error because the (M
+    ;; N) case does everything that (c M) does since M can equal
+    ;; c. Otherwise the previous test case would work, because (tl x)
+    ;; would not be subst'd and it has no type
+
+    ;; 3
+    ((λ (x int) ((λ (y int) y) x)) 1)
+
+    ;; 4 -- xxx I don't think this is really an error because the
+    ;; normal λ rule always does renaming so this test below works
+    ;; fine and ends up with x1 in both places.
+
+    #;((λ (x int) ((λ (x (list int)) x) ((cons x) nil))) 1)
+
+    ;; 5 & 6 --- xxx These diffs are bogus because they don't actually
+    ;; make a change to any of the program.
+
+    ;; 7
+    ((λ (x int) (hd ((cons x) nil))) 1)
+
+    ;; 8 -- xxx This isn't an error for the same reason 4 isn't.
+    
+    )))
+

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-10.rkt

@@ -244,6 +244,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1)
          (or 
@@ -259,3 +260,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-2.rkt

@@ -244,6 +244,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1)
          (or 
@@ -259,3 +260,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-3.rkt

@@ -245,6 +245,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1)
          (or 
@@ -260,3 +261,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-4.rkt

@@ -245,6 +245,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1)
          (or 
@@ -260,3 +261,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-5.rkt

@@ -244,6 +244,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1)
          (or 
@@ -259,3 +260,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-6.rkt

@@ -244,6 +244,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1)
          (or 
@@ -259,3 +260,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-7.rkt

@@ -243,6 +243,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1)
          (or 
@@ -258,3 +259,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-8.rkt

@@ -244,6 +244,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1)
          (or 
@@ -259,3 +260,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-9.rkt

@@ -244,6 +244,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1)
          (or 
@@ -259,3 +260,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/stlc/stlc-base.rkt

@@ -245,6 +245,7 @@
       (v? term)
       (let ([red-res (apply-reduction-relation red term)]
             [t-type (type-check term)])
+        ;; xxx shouldn't this be t-type IMPLIES this?
         (and
          (= (length red-res) 1) 
          (or 
@@ -260,3 +261,19 @@
       (begin0
         (generate-term stlc M #:i-th index)
         (set! index (add1 index))))))
+
+(define fixed
+  (term
+   (;; 2
+    ((cons 1) 2)
+    ;; 3
+    ((λ (x int) (hd x))
+     7)
+    ;; 10
+    ((λ (x (list int)) (hd x))
+     7)
+    ;; 5, 6, 7, 8, 9
+    ((λ (x int) (hd x))
+     ((cons 1) nil))
+    ;; 4
+    (hd ((cons ((cons 1) nil)) nil)))))

pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/test-file.rkt

@@ -18,7 +18,7 @@
 
 (define all-types '(search grammar search-gen search-gen-ref 
                            search-gen-enum search-gen-enum-ref
-                           enum ordered))
+                           enum ordered fixed))
 (define types '())
 
 (define (set-type! arg)
@@ -40,7 +40,7 @@
    [("-f" "--first-only") "Find the first counterexample only"
                           (set! first-only #t)]
    #:multi
-   [("-t" "--type") t "Generation type to run, one of: search, grammar, search-gen, search-gen-ref, search-gen-enum, search-gen-enum-ref, enum, ordered"
+   [("-t" "--type") t "Generation type to run, one of: search, grammar, search-gen, search-gen-ref, search-gen-enum, search-gen-enum-ref, enum, ordered, fixed"
                     (set-type! t)]
    #:args filenames
    (match filenames
@@ -174,6 +174,7 @@
   (define typed-generator (dynamic-require fpath 'typed-generator))
   (define gen-enum (dynamic-require fpath 'generate-enum-term))
   (define ordered-generator (dynamic-require fpath 'ordered-enum-generator))
+  (define fixed (dynamic-require fpath 'fixed))
   (define err (dynamic-require fpath 'the-error))
   (printf "\n-------------------------------------------------------------------\n")
   (printf "~a has the error: ~a\n\n" fpath err)
@@ -185,6 +186,13 @@
       (and (tc t)
            t)))
   (cond
+    [(equal? gen-type 'fixed)
+     (define some-failed?
+       (for/or ([t (in-list fixed)])
+         (define ok? (check t))
+         (not ok?)))
+     (unless some-failed?
+       (error 'fixed "Expected some term to fail, but didn't find one in ~a" fixed))]
     [(equal? gen-type 'grammar)
      (run/spawn-generations fpath verbose? no-errs? (λ () (gen-and-type gen-term))
                       check seconds gen-type)]