The optimizer's test harness now makes sure that optimized and

non-optimized versions of the same code evaluate to the same thing.

Unfortunately, this leads to a lot of code duplication. We can't
abstract over optimization like we do for the benchmarks since the
wrapper module would interfere with testing expanded code for
equality.

collects/tests/typed-scheme/optimizer/non-optimized/begin-float.rkt

@@ -0,0 +1,4 @@
+(module begin-float typed/scheme 
+  (require racket/unsafe/ops)
+  (begin (- 2.0 3.0)
+         (* 2.0 3.0)))

collects/tests/typed-scheme/optimizer/non-optimized/binary-fixnum.rkt

@@ -0,0 +1,5 @@
+(module binary-fixnum typed/scheme 
+  (require racket/unsafe/ops)
+  (: f (All (X) ((Vectorof X) -> Natural)))
+  (define (f v)
+    (bitwise-and (vector-length v) 1)))

collects/tests/typed-scheme/optimizer/non-optimized/binary-nonzero-fixnum.rkt

@@ -0,0 +1,3 @@
+(module binary-nonzero-fixnum typed/scheme 
+  (require racket/unsafe/ops)
+  (quotient (vector-length '#(1 2 3)) 2))

collects/tests/typed-scheme/optimizer/non-optimized/cross-module-struct.rkt

@@ -0,0 +1,5 @@
+#lang typed/scheme 
+
+;; will be imported by cross-module-struct2
+(provide (struct-out x))
+(define-struct: x ((x : Integer)))

collects/tests/typed-scheme/optimizer/non-optimized/cross-module-struct2.rkt

@@ -0,0 +1,5 @@
+#lang typed/scheme 
+
+(require (file "cross-module-struct.rkt") racket/unsafe/ops)
+(define a (make-x 1))
+(x-x a)

collects/tests/typed-scheme/optimizer/non-optimized/dead-else.rkt

@@ -0,0 +1,8 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(if (number? 3)
+    (+ 2.0 3.0)
+    (+ 4.0 5.0))
+(if #t
+    (+ 2.0 3.0)
+    (+ 4.0 5.0))

collects/tests/typed-scheme/optimizer/non-optimized/dead-then.rkt

@@ -0,0 +1,8 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(if (number? "eh")
+    (+ 2.0 3.0)
+    (+ 4.0 5.0))
+(if #f
+    (+ 2.0 3.0)
+    (+ 4.0 5.0))

collects/tests/typed-scheme/optimizer/non-optimized/define-begin-float.rkt

@@ -0,0 +1,4 @@
+(module define-begin-float typed/scheme 
+  (require racket/unsafe/ops)
+  (define a (begin (display (- 2.0 3.0))
+                   (* 2.0 3.0))))

collects/tests/typed-scheme/optimizer/non-optimized/define-call-float.rkt

@@ -0,0 +1,3 @@
+(module define-call-float typed/scheme 
+  (require racket/unsafe/ops)
+  (define x (cons (+ 1.0 2.0) 3.0)))

collects/tests/typed-scheme/optimizer/non-optimized/define-float.rkt

@@ -0,0 +1,3 @@
+(module define-float typed/scheme 
+  (require racket/unsafe/ops)
+  (define x (+ 1.0 2.0)))

collects/tests/typed-scheme/optimizer/non-optimized/define-pair.rkt

@@ -0,0 +1,3 @@
+(module define-pair typed/scheme 
+  (require racket/unsafe/ops)
+  (define x (car '(1 3))))

collects/tests/typed-scheme/optimizer/non-optimized/different-langs.rkt

@@ -0,0 +1,4 @@
+;; to see if the harness supports having the 2 versions of a test being
+;; written in different languages
+(module different-langs typed/scheme 
+  (+ 1 2))

collects/tests/typed-scheme/optimizer/non-optimized/double-float.rkt

@@ -0,0 +1,3 @@
+(module double-float typed/scheme 
+  (require racket/unsafe/ops)
+  (+ 2.0 2.0 2.0))

collects/tests/typed-scheme/optimizer/non-optimized/exact-inexact.rkt

@@ -0,0 +1,3 @@
+(module exact-inexact typed/scheme 
+  (require racket/flonum)
+  (exact->inexact (expt 10 100))) ; must not be a fixnum

collects/tests/typed-scheme/optimizer/non-optimized/fixnum-comparison.rkt

@@ -0,0 +1,3 @@
+(module fixnum-comparison typed/scheme 
+  (require racket/unsafe/ops)
+  (< (vector-length '#(1 2 3)) (string-length "asdf")))

collects/tests/typed-scheme/optimizer/non-optimized/float-comp.rkt

@@ -0,0 +1,3 @@
+(module float-comp typed/scheme 
+  (require racket/unsafe/ops)
+  (< 1.0 2.0))

collects/tests/typed-scheme/optimizer/non-optimized/float-fun.rkt

@@ -0,0 +1,5 @@
+(module float-fun typed/scheme 
+  (require racket/unsafe/ops)
+  (: f (Float -> Float))
+  (define (f x)
+    (+ x 1.0)))

collects/tests/typed-scheme/optimizer/non-optimized/float-promotion.rkt

@@ -0,0 +1,4 @@
+(module float-promotion typed/scheme 
+  (require racket/unsafe/ops racket/flonum)
+  (+ 1 2.0)
+  (+ (expt 100 100) 2.0))

collects/tests/typed-scheme/optimizer/non-optimized/flvector-length.rkt

@@ -0,0 +1,3 @@
+(module flvector-length typed/scheme 
+  (require racket/unsafe/ops racket/flonum)
+  (flvector-length (flvector 0.0 1.2)))

collects/tests/typed-scheme/optimizer/non-optimized/fx-fl.rkt

@@ -0,0 +1,3 @@
+(module fx-fl typed/scheme 
+  (require racket/unsafe/ops)
+  (exact->inexact 1))

collects/tests/typed-scheme/optimizer/non-optimized/in-bytes.rkt

@@ -0,0 +1,4 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(for: ((i : Integer #"123"))
+      (display i))

collects/tests/typed-scheme/optimizer/non-optimized/in-list.rkt

@@ -0,0 +1,4 @@
+(module in-list typed/scheme 
+  (require racket/unsafe/ops)
+  (for: ((i : Natural '(1 2 3)))
+    (display i)))

collects/tests/typed-scheme/optimizer/non-optimized/in-string.rkt

@@ -0,0 +1,4 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(for: ((i : Char "123"))
+      (display i))

collects/tests/typed-scheme/optimizer/non-optimized/in-vector.rkt

@@ -0,0 +1,4 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(for: ((i : Integer (vector 1 2 3)))
+      (display i))

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-conjugate-top.rkt

@@ -0,0 +1,3 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(conjugate (+ 1.0+2.0i 2.0+4.0i))

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-conjugate.rkt

@@ -0,0 +1,3 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(+ (conjugate 1.0+2.0i) (conjugate 2.0+4.0i))

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-div.rkt

@@ -0,0 +1,3 @@
+(module inexact-complex-div typed/scheme 
+  (require racket/unsafe/ops)
+  (/ 1.0+2.0i 2.0+4.0i 3.0+6.0i))

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-float-div.rkt

@@ -0,0 +1,7 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(/ 1.0 2.0+4.0i)
+(/ 1.0+2.0i 2.0)
+(/ 1.0 2.0+4.0i 3.0+6.0i)
+(/ 1.0+2.0i 2.0 3.0+6.0i)
+(/ 1.0+2.0i 2.0+4.0i 3.0)

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-float-mul.rkt

@@ -0,0 +1,7 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(* 1.0 2.0+4.0i)
+(* 1.0+2.0i 2.0)
+(* 1.0 2.0+4.0i 3.0+6.0i)
+(* 1.0+2.0i 2.0 3.0+6.0i)
+(* 1.0+2.0i 2.0+4.0i 3.0)

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-float-small.rkt

@@ -0,0 +1,7 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(+ 1.0+2.0i 3.0)
+(+ 1.0 2.0+4.0i)
+(- 1.0+2.0i 3.0)
+(- 1.0 2.0+4.0i)
+(+ 1.0+2.0i (+ 1.0 2.0))

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-float.rkt

@@ -0,0 +1,6 @@
+#lang typed/scheme 
+(require racket/unsafe/ops)
+(+ 1.0+2.0i 2.0 3.0+6.0i)
+(- 1.0 2.0+4.0i 3.0+6.0i)
+(- 1.0+2.0i 2.0 3.0+6.0i)
+(- 1.0+2.0i 2.0+4.0i 3.0)

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-mult.rkt

@@ -0,0 +1,3 @@
+(module inexact-complex-mult typed/scheme 
+  (require racket/unsafe/ops)
+  (* 1.0+2.0i 2.0+4.0i 3.0+6.0i))

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex-parts.rkt

@@ -0,0 +1,5 @@
+(module inexact-complex-parts typed/scheme 
+  (require racket/unsafe/ops)
+  (real-part 1.0+2.0i)
+  (imag-part 1+2.0i)
+  (real-part 1.0+2i))

collects/tests/typed-scheme/optimizer/non-optimized/inexact-complex.rkt

@@ -0,0 +1,4 @@
+(module inexact-complex typed/scheme 
+  (require racket/unsafe/ops)
+  (+ 1.0+2.0i 2.0+4.0i)
+  (- 1.0+2.0i 2.0+4.0i))

collects/tests/typed-scheme/optimizer/non-optimized/invalid-binary-nonzero-fixnum.rkt

@@ -0,0 +1,4 @@
+(module invalid-binary-nonzero-fixnum typed/scheme 
+  (: f ( -> Void))
+  (define (f) ; in a function, to prevent evaluation
+    (display (quotient 4 0)))) ; 2 fixnums, but the second is 0, cannot optimize

collects/tests/typed-scheme/optimizer/non-optimized/invalid-exact-inexact.rkt

@@ -0,0 +1,2 @@
+(module exact-inexact typed/scheme 
+  (exact->inexact 1.0)) ; not an integer, can't optimize

collects/tests/typed-scheme/optimizer/non-optimized/invalid-float-comp.rkt

@@ -0,0 +1,3 @@
+(module float-comp typed/scheme 
+  (require racket/unsafe/ops)
+  (< 1.0 2))

collects/tests/typed-scheme/optimizer/non-optimized/invalid-float-promotion.rkt

@@ -0,0 +1,2 @@
+(module float-promotion typed/scheme 
+  (/ 1 2.0)) ; result is not a float, can't optimize

collects/tests/typed-scheme/optimizer/non-optimized/invalid-inexact-complex-parts.rkt

@@ -0,0 +1,2 @@
+(module invalid-inexact-complex-parts.rkt typed/scheme 
+  (real-part 1+2i))

collects/tests/typed-scheme/optimizer/non-optimized/invalid-make-flrectangular.rkt

@@ -0,0 +1,2 @@
+(module invalid-make-flrectangular typed/scheme 
+  (make-rectangular 1 2))

collects/tests/typed-scheme/optimizer/non-optimized/invalid-sqrt.rkt

@@ -0,0 +1,2 @@
+(module invalid-sqrt typed/scheme 
+  (sqrt -2.0)) ; not a nonnegative flonum, can't optimize

collects/tests/typed-scheme/optimizer/non-optimized/invalid-vector-ref.rkt

@@ -0,0 +1,4 @@
+(module invalid-vector-ref typed/scheme 
+  (: f ((Vectorof Integer) -> Integer))
+  (define (f x)
+    (vector-ref x 0))) ; type is (Vectorof Integer), length is unknown, can't optimize

collects/tests/typed-scheme/optimizer/non-optimized/invalid-vector-set.rkt

@@ -0,0 +1,4 @@
+(module invalid-vector-set typed/scheme 
+  (: f ((Vectorof Integer) -> Void))
+  (define (f x)
+    (vector-set! x 0 2))) ; type is (Vectorof Integer), length is ot known, can't optimize

collects/tests/typed-scheme/optimizer/non-optimized/known-vector-length.rkt

@@ -0,0 +1,3 @@
+(module known-vector-length typed/scheme 
+  (require racket/unsafe/ops)
+  (+ 2 (vector-length (ann (vector 1 2) (Vector Integer Integer)))))

collects/tests/typed-scheme/optimizer/non-optimized/let-float.rkt

@@ -0,0 +1,4 @@
+(module let-float typed/scheme 
+  (require racket/unsafe/ops)
+  (let ((x (+ 3.0 2.0)))
+    (* 9.0 x)))

collects/tests/typed-scheme/optimizer/non-optimized/make-flrectangular.rkt

@@ -0,0 +1,4 @@
+(module make-flrectangular typed/scheme 
+  (require racket/unsafe/ops racket/flonum)
+  (make-rectangular 1.0 2.2)
+  (make-flrectangular 1.0 2.2))

collects/tests/typed-scheme/optimizer/non-optimized/n-ary-float.rkt

@@ -0,0 +1,3 @@
+(module n-ary-float typed/scheme 
+  (require racket/unsafe/ops)
+  (+ 1.0 2.0 3.0))

collects/tests/typed-scheme/optimizer/non-optimized/n-ary-inexact-complex.rkt

@@ -0,0 +1,3 @@
+(module n-ary-inexact-complex typed/scheme 
+  (require racket/unsafe/ops)
+  (+ 1.0+2.0i 2.0+4.0i 3.0+6.0i 4.0+8.0i))

collects/tests/typed-scheme/optimizer/non-optimized/nested-float.rkt

@@ -0,0 +1,3 @@
+(module nested-float typed/scheme 
+  (require racket/unsafe/ops)
+  (+ 2.0 (+ 3.0 4.0)))

collects/tests/typed-scheme/optimizer/non-optimized/nested-float2.rkt

@@ -0,0 +1,3 @@
+(module nested-float typed/scheme 
+  (require racket/unsafe/ops)
+  (+ 2.0 (* 3.0 4.0)))

collects/tests/typed-scheme/optimizer/non-optimized/nested-inexact-complex.rkt

@@ -0,0 +1,3 @@
+(module nested-inexact-complex typed/scheme 
+  (require racket/unsafe/ops)
+  (+ 1.0+2.0i (- 2.0+4.0i 3.0+6.0i)))

collects/tests/typed-scheme/optimizer/non-optimized/nested-pair1.rkt

@@ -0,0 +1,3 @@
+(module nested-pair typed/scheme 
+  (require racket/unsafe/ops)
+  (car (cdr '(1 2))))

collects/tests/typed-scheme/optimizer/non-optimized/nested-pair2.rkt

@@ -0,0 +1,3 @@
+(module nested-pair2 typed/scheme 
+  (require racket/unsafe/ops)
+  (car (cdr (cons 3 (cons (cons 2 '()) 1)))))

collects/tests/typed-scheme/optimizer/non-optimized/pair-fun.rkt

@@ -0,0 +1,7 @@
+(module pair-fun typed/scheme 
+  (require racket/unsafe/ops)
+  (: f ((Listof Integer) -> Integer))
+  (define (f x)
+    (if (null? x)
+        1
+        (car x))))

collects/tests/typed-scheme/optimizer/non-optimized/quote.rkt

@@ -0,0 +1,2 @@
+(module quote typed/scheme 
+  '(+ 1.0 2.0))

collects/tests/typed-scheme/optimizer/non-optimized/simple-float.rkt

@@ -0,0 +1,3 @@
+(module simple-float typed/scheme 
+  (require racket/unsafe/ops)
+  (+ 2.0 3.0))

collects/tests/typed-scheme/optimizer/non-optimized/simple-pair.rkt

@@ -0,0 +1,3 @@
+(module simple-pair typed/scheme 
+  (require racket/unsafe/ops)
+  (car (cons 1 2)))

collects/tests/typed-scheme/optimizer/non-optimized/sqrt.rkt

@@ -0,0 +1,5 @@
+(module sqrt typed/scheme 
+  (require racket/unsafe/ops)
+  (: f (Nonnegative-Float -> Nonnegative-Float))
+  (define (f x)
+    (sqrt x)))

collects/tests/typed-scheme/optimizer/non-optimized/structs.rkt

@@ -0,0 +1,6 @@
+(module structs typed/scheme 
+  (require racket/unsafe/ops)
+  (define-struct: pt ((x : Integer) (y : Integer)) #:mutable)
+  (define a (pt 3 4))
+  (pt-x a)
+  (set-pt-y! a 5))

collects/tests/typed-scheme/optimizer/non-optimized/unary-fixnum-nested.rkt

@@ -0,0 +1,3 @@
+(module unary-fixnum-nested typed/scheme 
+  (require racket/unsafe/ops racket/fixnum)
+  (abs (bitwise-not (length '(1 2 3)))))

collects/tests/typed-scheme/optimizer/non-optimized/unary-fixnum.rkt

@@ -0,0 +1,3 @@
+(module unary-fixnum typed/scheme 
+  (require racket/unsafe/ops)
+  (bitwise-not 4))

collects/tests/typed-scheme/optimizer/non-optimized/unary-float.rkt

@@ -0,0 +1,3 @@
+(module float-unary typed/scheme 
+  (require racket/unsafe/ops)
+  (sin 2.0))

collects/tests/typed-scheme/optimizer/non-optimized/vector-length-nested.rkt

@@ -0,0 +1,7 @@
+(module vector-length typed/scheme 
+  (require racket/unsafe/ops)
+  (vector-length
+   (vector-ref
+    (ann (vector (vector 1 2) 2 3)
+         (Vector (Vectorof Integer) Integer Integer))
+    0)))

collects/tests/typed-scheme/optimizer/non-optimized/vector-length.rkt

@@ -0,0 +1,3 @@
+(module vector-length typed/scheme 
+  (require racket/unsafe/ops)
+  (vector-length (vector 1 2 3)))

collects/tests/typed-scheme/optimizer/non-optimized/vector-ref-set-ref.rkt

@@ -0,0 +1,7 @@
+(module vector-ref-set-ref typed/scheme 
+  (require racket/unsafe/ops)
+  (: x (Vector Integer String))
+  (define x (vector 1 "1"))
+  (vector-ref x 0)
+  (vector-set! x 1 "2")
+  (vector-ref x 1))

collects/tests/typed-scheme/optimizer/non-optimized/vector-ref.rkt

@@ -0,0 +1,3 @@
+(module vector-ref typed/scheme 
+  (require racket/unsafe/ops)
+  (vector-ref (ann (vector 1 2) (Vector Integer Integer)) 0))

collects/tests/typed-scheme/optimizer/non-optimized/vector-ref2.rkt

@@ -0,0 +1,3 @@
+(module vector-ref2 typed/scheme 
+  (require racket/unsafe/ops)
+  (vector-ref (vector 1 2 3) 0))

collects/tests/typed-scheme/optimizer/non-optimized/vector-set-quote.rkt

@@ -0,0 +1,5 @@
+(module vector-set-quote typed/scheme 
+  (require racket/unsafe/ops)
+  (vector-set! (ann (vector '(1 2)) (Vector Any))
+               0
+               '(+ 1.0 2.0))) ; we should not optimize under quote

collects/tests/typed-scheme/optimizer/non-optimized/vector-set.rkt

@@ -0,0 +1,5 @@
+(module vector-set typed/scheme 
+  (require racket/unsafe/ops)
+  (vector-set! (ann (vector 1 2) (Vector Integer Integer))
+               0
+               1))

collects/tests/typed-scheme/optimizer/non-optimized/vector-set2.rkt

@@ -0,0 +1,3 @@
+(module invalid-vector-set typed/scheme 
+  (require racket/unsafe/ops)
+  (vector-set! (vector 1 2) 0 2)) ; type is (Vectorof Integer), length is ot known, can't optimize

collects/tests/typed-scheme/optimizer/run.rkt

@@ -26,12 +26,23 @@
 (define (test gen)
   (let-values (((base name _) (split-path gen)))
     (or (regexp-match ".*~" name) ; we ignore backup files
-        (equal? (parameterize ([current-load-relative-directory
-                                (build-path here "generic")])
-                  (read-and-expand gen))
-                (let ((hand-opt-dir (build-path here "hand-optimized")))
-                  (parameterize ([current-load-relative-directory hand-opt-dir])
-                    (read-and-expand (build-path hand-opt-dir name)))))
+        ;; machine optimized and hand optimized versions must expand to the
+        ;; same code
+        (and (equal? (parameterize ([current-load-relative-directory
+                                     (build-path here "generic")])
+                       (read-and-expand gen))
+                     (let ((hand-opt-dir (build-path here "hand-optimized")))
+                       (parameterize ([current-load-relative-directory hand-opt-dir])
+                         (read-and-expand (build-path hand-opt-dir name)))))
+             ;; optimized and non-optimized versions must evaluate to the
+             ;; same thing
+             (equal? (with-output-to-string
+                       (lambda ()
+                         (dynamic-require gen #f)))
+                     (with-output-to-string
+                       (lambda ()
+                         (let ((non-opt-dir (build-path here "non-optimized")))
+                           (dynamic-require (build-path non-opt-dir name) #f))))))
         (begin (printf "~a failed\n\n" name)
                #f))))