From fd987546b3d0293edba097f940c33fbdbf6c3b86 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 23 Jun 2010 16:58:18 -0400 Subject: [PATCH] Wrote a test harness and a couple of tests for Typed Scheme's optimizer. --- .../optimizer/generic/begin-float.rkt | 4 +++ .../optimizer/generic/define-begin-float.rkt | 4 +++ .../optimizer/generic/define-call-float.rkt | 3 ++ .../optimizer/generic/define-float.rkt | 3 ++ .../optimizer/generic/define-pair.rkt | 3 ++ .../optimizer/generic/double-float.rkt | 3 ++ .../optimizer/generic/float-fun.rkt | 5 +++ .../optimizer/generic/float-promotion.rkt | 3 ++ .../generic/invalid-float-promotion.rkt | 3 ++ .../optimizer/generic/let-float.rkt | 4 +++ .../optimizer/generic/nested-float.rkt | 3 ++ .../optimizer/generic/nested-float2.rkt | 3 ++ .../optimizer/generic/nested-pair1.rkt | 3 ++ .../optimizer/generic/nested-pair2.rkt | 3 ++ .../optimizer/generic/pair-fun.rkt | 7 ++++ .../optimizer/generic/simple-float.rkt | 3 ++ .../optimizer/generic/simple-pair.rkt | 3 ++ .../optimizer/generic/unary-float.rkt | 3 ++ .../optimizer/hand-optimized/begin-float.rkt | 4 +++ .../hand-optimized/define-begin-float.rkt | 4 +++ .../hand-optimized/define-call-float.rkt | 3 ++ .../optimizer/hand-optimized/define-float.rkt | 3 ++ .../optimizer/hand-optimized/define-pair.rkt | 3 ++ .../optimizer/hand-optimized/double-float.rkt | 3 ++ .../optimizer/hand-optimized/float-fun.rkt | 5 +++ .../hand-optimized/float-promotion.rkt | 3 ++ .../invalid-float-promotion.rkt | 3 ++ .../optimizer/hand-optimized/let-float.rkt | 4 +++ .../optimizer/hand-optimized/nested-float.rkt | 3 ++ .../hand-optimized/nested-float2.rkt | 3 ++ .../optimizer/hand-optimized/nested-pair1.rkt | 3 ++ .../optimizer/hand-optimized/nested-pair2.rkt | 3 ++ .../optimizer/hand-optimized/pair-fun.rkt | 7 ++++ .../optimizer/hand-optimized/simple-float.rkt | 3 ++ .../optimizer/hand-optimized/simple-pair.rkt | 3 ++ .../optimizer/hand-optimized/unary-float.rkt | 3 ++ collects/tests/typed-scheme/optimizer/run.rkt | 32 +++++++++++++++++++ 37 files changed, 158 insertions(+) create mode 100644 collects/tests/typed-scheme/optimizer/generic/begin-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/define-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/define-pair.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/double-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/float-fun.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/let-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/nested-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/simple-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt create mode 100644 collects/tests/typed-scheme/optimizer/generic/unary-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/begin-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/define-begin-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/define-call-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/define-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/define-pair.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/double-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/float-fun.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/float-promotion.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/invalid-float-promotion.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/let-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/nested-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/nested-float2.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/nested-pair1.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/nested-pair2.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/pair-fun.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/simple-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/simple-pair.rkt create mode 100644 collects/tests/typed-scheme/optimizer/hand-optimized/unary-float.rkt create mode 100644 collects/tests/typed-scheme/optimizer/run.rkt diff --git a/collects/tests/typed-scheme/optimizer/generic/begin-float.rkt b/collects/tests/typed-scheme/optimizer/generic/begin-float.rkt new file mode 100644 index 0000000000..a3bb961e2e --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/begin-float.rkt @@ -0,0 +1,4 @@ +(module begin-float typed/scheme #:optimize + (require racket/unsafe/ops) + (begin (- 2.0 3.0) + (* 2.0 3.0))) diff --git a/collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt b/collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt new file mode 100644 index 0000000000..508bd0e5a0 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt @@ -0,0 +1,4 @@ +(module define-begin-float typed/scheme #:optimize + (require racket/unsafe/ops) + (define a (begin (display (- 2.0 3.0)) + (* 2.0 3.0)))) diff --git a/collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt b/collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt new file mode 100644 index 0000000000..fe2ff165b9 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt @@ -0,0 +1,3 @@ +(module define-call-float typed/scheme #:optimize + (require racket/unsafe/ops) + (define x (cons (+ 1.0 2.0) 3.0))) diff --git a/collects/tests/typed-scheme/optimizer/generic/define-float.rkt b/collects/tests/typed-scheme/optimizer/generic/define-float.rkt new file mode 100644 index 0000000000..9dfeb43100 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/define-float.rkt @@ -0,0 +1,3 @@ +(module define-float typed/scheme #:optimize + (require racket/unsafe/ops) + (define x (+ 1.0 2.0))) diff --git a/collects/tests/typed-scheme/optimizer/generic/define-pair.rkt b/collects/tests/typed-scheme/optimizer/generic/define-pair.rkt new file mode 100644 index 0000000000..ec30e20ce3 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/define-pair.rkt @@ -0,0 +1,3 @@ +(module define-pair typed/scheme #:optimize + (require racket/unsafe/ops) + (define x (car '(1 3)))) diff --git a/collects/tests/typed-scheme/optimizer/generic/double-float.rkt b/collects/tests/typed-scheme/optimizer/generic/double-float.rkt new file mode 100644 index 0000000000..1d6864511b --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/double-float.rkt @@ -0,0 +1,3 @@ +(module double-float typed/scheme #:optimize + (require racket/unsafe/ops) + (+ 2.0 2.0 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/generic/float-fun.rkt b/collects/tests/typed-scheme/optimizer/generic/float-fun.rkt new file mode 100644 index 0000000000..788a2181ef --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/float-fun.rkt @@ -0,0 +1,5 @@ +(module float-fun typed/scheme #:optimize + (require racket/unsafe/ops) + (: f (Float -> Float)) + (define (f x) + (+ x 1.0))) diff --git a/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt b/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt new file mode 100644 index 0000000000..3df6f6846e --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt @@ -0,0 +1,3 @@ +(module float-promotion typed/scheme #:optimize + (require racket/unsafe/ops racket/flonum) + (+ 1 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt new file mode 100644 index 0000000000..ee0f3875b5 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt @@ -0,0 +1,3 @@ +(module float-promotion typed/scheme #:optimize + (require racket/unsafe/ops) + (/ 1 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/generic/let-float.rkt b/collects/tests/typed-scheme/optimizer/generic/let-float.rkt new file mode 100644 index 0000000000..98e6a9fe1a --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/let-float.rkt @@ -0,0 +1,4 @@ +(module let-float typed/scheme #:optimize + (require racket/unsafe/ops) + (let ((x (+ 3.0 2.0))) + (* 9.0 x))) diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-float.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-float.rkt new file mode 100644 index 0000000000..04950423fe --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/nested-float.rkt @@ -0,0 +1,3 @@ +(module nested-float typed/scheme #:optimize + (require racket/unsafe/ops) + (+ 2.0 (+ 3.0 4.0))) diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt new file mode 100644 index 0000000000..ebe30a18cf --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt @@ -0,0 +1,3 @@ +(module nested-float typed/scheme #:optimize + (require racket/unsafe/ops) + (+ 2.0 (* 3.0 4.0))) diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt new file mode 100644 index 0000000000..744d0c8351 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt @@ -0,0 +1,3 @@ +(module nested-pair typed/scheme #:optimize + (require racket/unsafe/ops) + (car (cdr '(1 2)))) diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt new file mode 100644 index 0000000000..a4c429d108 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt @@ -0,0 +1,3 @@ +(module nested-pair2 typed/scheme #:optimize + (require racket/unsafe/ops) + (car (cdr (cons 3 (cons (cons 2 '()) 1))))) diff --git a/collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt b/collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt new file mode 100644 index 0000000000..2fea5497ac --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt @@ -0,0 +1,7 @@ +(module pair-fun typed/scheme #:optimize + (require racket/unsafe/ops) + (: f ((Listof Integer) -> Integer)) + (define (f x) + (if (null? x) + 1 + (car x)))) diff --git a/collects/tests/typed-scheme/optimizer/generic/simple-float.rkt b/collects/tests/typed-scheme/optimizer/generic/simple-float.rkt new file mode 100644 index 0000000000..90676b7a29 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/simple-float.rkt @@ -0,0 +1,3 @@ +(module simple-float typed/scheme #:optimize + (require racket/unsafe/ops) + (+ 2.0 3.0)) diff --git a/collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt b/collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt new file mode 100644 index 0000000000..e5f69f7086 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt @@ -0,0 +1,3 @@ +(module simple-pair typed/scheme #:optimize + (require racket/unsafe/ops) + (car (cons 1 2))) diff --git a/collects/tests/typed-scheme/optimizer/generic/unary-float.rkt b/collects/tests/typed-scheme/optimizer/generic/unary-float.rkt new file mode 100644 index 0000000000..d57f3950f5 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/generic/unary-float.rkt @@ -0,0 +1,3 @@ +(module float-unary typed/scheme #:optimize + (require racket/unsafe/ops) + (sin 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/begin-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/begin-float.rkt new file mode 100644 index 0000000000..6a4d1a9066 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/begin-float.rkt @@ -0,0 +1,4 @@ +(module begin-float typed/scheme #:optimize + (require racket/unsafe/ops) + (begin (unsafe-fl- 2.0 3.0) + (unsafe-fl* 2.0 3.0))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/define-begin-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/define-begin-float.rkt new file mode 100644 index 0000000000..c8110cdb6b --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/define-begin-float.rkt @@ -0,0 +1,4 @@ +(module define-begin-float typed/scheme #:optimize + (require racket/unsafe/ops) + (define a (begin (display (unsafe-fl- 2.0 3.0)) + (unsafe-fl* 2.0 3.0)))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/define-call-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/define-call-float.rkt new file mode 100644 index 0000000000..483c4a199e --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/define-call-float.rkt @@ -0,0 +1,3 @@ +(module define-call-float typed/scheme #:optimize + (require racket/unsafe/ops) + (define x (cons (unsafe-fl+ 1.0 2.0) 3.0))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/define-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/define-float.rkt new file mode 100644 index 0000000000..e1e98f7954 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/define-float.rkt @@ -0,0 +1,3 @@ +(module define-float typed/scheme #:optimize + (require racket/unsafe/ops) + (define x (unsafe-fl+ 1.0 2.0))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/define-pair.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/define-pair.rkt new file mode 100644 index 0000000000..04fe8a1980 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/define-pair.rkt @@ -0,0 +1,3 @@ +(module define-pair typed/scheme #:optimize + (require racket/unsafe/ops) + (define x (unsafe-car '(1 3)))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/double-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/double-float.rkt new file mode 100644 index 0000000000..c6859f124e --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/double-float.rkt @@ -0,0 +1,3 @@ +(module double-float typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-fl+ (unsafe-fl+ 2.0 2.0) 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/float-fun.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/float-fun.rkt new file mode 100644 index 0000000000..b5d2b33a37 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/float-fun.rkt @@ -0,0 +1,5 @@ +(module float-fun typed/scheme #:optimize + (require racket/unsafe/ops) + (: f (Float -> Float)) + (define (f x) + (unsafe-fl+ x 1.0))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/float-promotion.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/float-promotion.rkt new file mode 100644 index 0000000000..353d73af45 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/float-promotion.rkt @@ -0,0 +1,3 @@ +(module float-promotion typed/scheme #:optimize + (require racket/unsafe/ops racket/flonum) + (unsafe-fl+ (->fl 1) 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-float-promotion.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-float-promotion.rkt new file mode 100644 index 0000000000..ee0f3875b5 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/invalid-float-promotion.rkt @@ -0,0 +1,3 @@ +(module float-promotion typed/scheme #:optimize + (require racket/unsafe/ops) + (/ 1 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/let-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/let-float.rkt new file mode 100644 index 0000000000..16777a6fdd --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/let-float.rkt @@ -0,0 +1,4 @@ +(module let-float typed/scheme #:optimize + (require racket/unsafe/ops) + (let ((x (unsafe-fl+ 3.0 2.0))) + (unsafe-fl* 9.0 x))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/nested-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/nested-float.rkt new file mode 100644 index 0000000000..9399c1ba5b --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/nested-float.rkt @@ -0,0 +1,3 @@ +(module nested-float typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-fl+ 2.0 (unsafe-fl+ 3.0 4.0))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/nested-float2.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/nested-float2.rkt new file mode 100644 index 0000000000..0605e701ec --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/nested-float2.rkt @@ -0,0 +1,3 @@ +(module nested-float typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-fl+ 2.0 (unsafe-fl* 3.0 4.0))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/nested-pair1.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/nested-pair1.rkt new file mode 100644 index 0000000000..6cb08b1b4e --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/nested-pair1.rkt @@ -0,0 +1,3 @@ +(module nested-pair typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-car (unsafe-cdr '(1 2)))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/nested-pair2.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/nested-pair2.rkt new file mode 100644 index 0000000000..d0a0447df6 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/nested-pair2.rkt @@ -0,0 +1,3 @@ +(module nested-pair2 typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-car (unsafe-cdr (cons 3 (cons (cons 2 '()) 1))))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/pair-fun.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/pair-fun.rkt new file mode 100644 index 0000000000..855b9baf9c --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/pair-fun.rkt @@ -0,0 +1,7 @@ +(module pair-fun typed/scheme #:optimize + (require racket/unsafe/ops) + (: f ((Listof Integer) -> Integer)) + (define (f x) + (if (null? x) + 1 + (unsafe-car x)))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/simple-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/simple-float.rkt new file mode 100644 index 0000000000..6a6437aa31 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/simple-float.rkt @@ -0,0 +1,3 @@ +(module simple-float typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-fl+ 2.0 3.0)) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/simple-pair.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/simple-pair.rkt new file mode 100644 index 0000000000..73eae801cd --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/simple-pair.rkt @@ -0,0 +1,3 @@ +(module simple-pair typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-car (cons 1 2))) diff --git a/collects/tests/typed-scheme/optimizer/hand-optimized/unary-float.rkt b/collects/tests/typed-scheme/optimizer/hand-optimized/unary-float.rkt new file mode 100644 index 0000000000..c48e78f667 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/hand-optimized/unary-float.rkt @@ -0,0 +1,3 @@ +(module float-unary typed/scheme #:optimize + (require racket/unsafe/ops) + (unsafe-flsin 2.0)) diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt new file mode 100644 index 0000000000..331f371222 --- /dev/null +++ b/collects/tests/typed-scheme/optimizer/run.rkt @@ -0,0 +1,32 @@ +#lang racket + +;; since Typed Scheme's optimizer does source to source transformations, +;; we compare the expansion of automatically optimized and hand optimized +;; modules +(define (read-and-expand file) + (syntax->datum + (parameterize ([current-namespace (make-base-namespace)]) + (with-handlers + ([exn:fail? (lambda (exn) + (printf "~a\n" (exn-message exn)) + #'#f)]) + (expand (with-input-from-file file read-syntax)))))) + +(define (test gen) + (let-values (((base name _) (split-path gen))) + (or (regexp-match ".*~" name) ; we ignore backup files + (equal? (read-and-expand gen) + (read-and-expand (build-path base "../hand-optimized/" name))) + (begin (printf "~a failed\n\n" name) + #f)))) + +(let ((n-failures + (if (> (vector-length (current-command-line-arguments)) 0) + (if (test (format "generic/~a.rkt" + (vector-ref (current-command-line-arguments) 0))) + 0 1) + (for/fold ((n-failures 0)) + ((gen (in-directory "generic"))) + (+ n-failures (if (test gen) 0 1)))))) + (unless (= n-failures 0) + (error (format "~a tests failed." n-failures))))