Fix TR tests for new contract error messages.
original commit: 2431f8f70646e00d3c65ef6d9d00fc75459d3ff0
This commit is contained in:
Sam Tobin-Hochstadt
commit
d2424d72fa
|
|
@ -1,5 +1,5 @@
|
|||
#;
|
||||
(exn-pred exn:fail:contract? #rx".*violator.*contract.*\\(-> Number Number\\).*f.*")
|
||||
(exn-pred exn:fail:contract? #rx".*contract violation.*contract.*f.*\\(-> Number Number\\).*")
|
||||
|
||||
#lang scheme/load
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#;
|
||||
(exn-pred 1)
|
||||
(exn-pred 2)
|
||||
#lang typed/scheme
|
||||
|
||||
(define-struct: parent ((x : Integer)))
|
||||
|
|
|
|||
5
collects/tests/typed-scheme/fail/log-not-complex.rkt
Normal file
5
collects/tests/typed-scheme/fail/log-not-complex.rkt
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
#;
|
||||
(exn-pred 1)
|
||||
#lang typed/scheme
|
||||
|
||||
(ann (log 2.0) Inexact-Complex)
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
#;
|
||||
(exn-pred exn:fail:contract? #rx".*U broke the contract.*")
|
||||
(exn-pred exn:fail:contract? #rx".*contract violation.*blaming 'U.*")
|
||||
#lang scheme/load
|
||||
|
||||
(module T typed-scheme
|
||||
|
|
|
|||
9
collects/tests/typed-scheme/fail/safe-letrec.rkt
Normal file
9
collects/tests/typed-scheme/fail/safe-letrec.rkt
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
#;
|
||||
(exn-pred 2)
|
||||
#lang typed/racket
|
||||
|
||||
;; make sure letrec takes into account that some bidings may be undefined
|
||||
|
||||
(+ (letrec: ([x : Float x]) x) 1) ; PR 11511
|
||||
|
||||
(letrec: ([x : Float (+ x 1)]) 0) ; error in rhs
|
||||
2
collects/tests/typed-scheme/fail/tc-error-format.rkt
Normal file
2
collects/tests/typed-scheme/fail/tc-error-format.rkt
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
#lang typed/racket
|
||||
(ann '~s Nothing)
|
||||
7
collects/tests/typed-scheme/fail/unbound-non-reg.rkt
Normal file
7
collects/tests/typed-scheme/fail/unbound-non-reg.rkt
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#;
|
||||
(exn-pred 2)
|
||||
#lang typed/racket
|
||||
|
||||
|
||||
(define-struct: (T) Node ([v : T] [l : (BinTreeof t)] [r : (BinTreeof t)]))
|
||||
(define-type (BinTreeof t) (U 'empty [Node t]))
|
||||
7
collects/tests/typed-scheme/fail/with-asserts.rkt
Normal file
7
collects/tests/typed-scheme/fail/with-asserts.rkt
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#;
|
||||
(exn-pred exn:fail?)
|
||||
#lang typed/racket
|
||||
|
||||
(let ([x 1] [y "2"])
|
||||
(with-asserts ([x string?] [y integer?])
|
||||
x))
|
||||
7
collects/tests/typed-scheme/fail/with-asserts2.rkt
Normal file
7
collects/tests/typed-scheme/fail/with-asserts2.rkt
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#;
|
||||
(exn-pred exn:fail?)
|
||||
#lang typed/racket
|
||||
|
||||
(let ([x 1] [y "2"])
|
||||
(with-asserts ([x string?])
|
||||
x))
|
||||
7
collects/tests/typed-scheme/fail/with-asserts3.rkt
Normal file
7
collects/tests/typed-scheme/fail/with-asserts3.rkt
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
#;
|
||||
(exn-pred exn:fail?)
|
||||
#lang typed/racket
|
||||
|
||||
(let ([x #f])
|
||||
(with-asserts ([x])
|
||||
x))
|
||||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(provide go go/text)
|
||||
|
||||
(require rackunit rackunit/text-ui
|
||||
(require rackunit rackunit/text-ui racket/file
|
||||
mzlib/etc scheme/port
|
||||
compiler/compiler
|
||||
scheme/match mzlib/compile
|
||||
|
|
@ -134,7 +134,9 @@
|
|||
(check-not-exn (λ () (cfile (build-path path p)))))))))
|
||||
(test-suite "compiling"
|
||||
(mk shootout)
|
||||
(mk common)))
|
||||
(delete-directory/files (build-path shootout "compiled"))
|
||||
(mk common)
|
||||
(delete-directory/files (build-path common "compiled"))))
|
||||
|
||||
(provide go go/text just-one compile-benchmarks)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +0,0 @@
|
|||
(module begin-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(begin (- 2.0 3.0)
|
||||
(* 2.0 3.0)))
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
(module binary-fixnum typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(: f (All (X) ((Vectorof X) -> Natural)))
|
||||
(define (f v)
|
||||
(bitwise-and (vector-length v) 1)))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module binary-nonzero-fixnum typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(quotient (vector-length '#(1 2 3)) 2))
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
#lang typed/scheme #:optimize
|
||||
|
||||
(require (file "cross-module-struct.rkt") racket/unsafe/ops)
|
||||
(define a (make-x 1))
|
||||
(x-x a)
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
#lang typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(display (if (number? 3)
|
||||
(+ 2.0 3.0)
|
||||
(+ 4.0 5.0)))
|
||||
(display (if #t
|
||||
(+ 2.0 3.0)
|
||||
(+ 4.0 5.0)))
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
#lang typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(display (if (number? "eh")
|
||||
(+ 2.0 3.0)
|
||||
(+ 4.0 5.0)))
|
||||
(display (if #f
|
||||
(+ 2.0 3.0)
|
||||
(+ 4.0 5.0)))
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
(module define-begin-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(define a (begin (display (- 2.0 3.0))
|
||||
(* 2.0 3.0))))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module define-call-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(define x (cons (+ 1.0 2.0) 3.0)))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module define-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(define x (+ 1.0 2.0)))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module define-pair typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(define x (car '(1 3))))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module double-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(+ 2.0 2.0 2.0))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module exact-inexact typed/scheme #:optimize
|
||||
(require racket/flonum)
|
||||
(exact->inexact (expt 10 100))) ; must not be a fixnum
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module fixnum-comparison typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(< (vector-length '#(1 2 3)) (string-length "asdf")))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module float-comp typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(< 1.0 2.0))
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
(module float-fun typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(: f (Float -> Float))
|
||||
(define (f x)
|
||||
(+ x 1.0)))
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
(module float-promotion typed/scheme #:optimize
|
||||
(require racket/unsafe/ops racket/flonum)
|
||||
(+ 1 2.0)
|
||||
(+ (expt 100 100) 2.0))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module flvector-length typed/scheme #:optimize
|
||||
(require racket/unsafe/ops racket/flonum)
|
||||
(flvector-length (flvector 0.0 1.2)))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module fx-fl typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(exact->inexact 1))
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
#lang typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(for: ((i : Integer #"123"))
|
||||
(display i))
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
(module in-list typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(for: ((i : Natural '(1 2 3)))
|
||||
(display i)))
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
#lang typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(for: ((i : Char "123"))
|
||||
(display i))
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
#lang typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(for: ((i : Integer (vector 1 2 3)))
|
||||
(display i))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
#lang typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(conjugate (+ 1.0+2.0i 2.0+4.0i))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
#lang typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(+ 2 1.0+2.0i 3.0+6.0i)
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
(module invalid-binary-nonzero-fixnum typed/scheme #:optimize
|
||||
(: f ( -> Void))
|
||||
(define (f) ; in a function, to prevent evaluation
|
||||
(display (quotient 4 0)))) ; 2 fixnums, but the second is 0, cannot optimize
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(module exact-inexact typed/scheme #:optimize
|
||||
(exact->inexact 1.0)) ; not an integer, can't optimize
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module float-comp typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(< 1.0 2))
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(module float-promotion typed/scheme #:optimize
|
||||
(/ 1 2.0)) ; result is not a float, can't optimize
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(module invalid-inexact-complex-parts.rkt typed/scheme #:optimize
|
||||
(real-part 1+2i))
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(module invalid-make-flrectangular typed/scheme #:optimize
|
||||
(make-rectangular 1 2))
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(module invalid-sqrt typed/scheme #:optimize
|
||||
(sqrt -2.0)) ; not a nonnegative flonum, can't optimize
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
(module invalid-vector-ref typed/scheme #:optimize
|
||||
(: f ((Vectorof Integer) -> Integer))
|
||||
(define (f x)
|
||||
(vector-ref x 0))) ; type is (Vectorof Integer), length is unknown, can't optimize
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
(module invalid-vector-set typed/scheme #:optimize
|
||||
(: f ((Vectorof Integer) -> Void))
|
||||
(define (f x)
|
||||
(vector-set! x 0 2))) ; type is (Vectorof Integer), length is ot known, can't optimize
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module known-vector-length typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(+ 2 (vector-length (ann (vector 1 2) (Vector Integer Integer)))))
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
(module let-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(let ((x (+ 3.0 2.0)))
|
||||
(* 9.0 x)))
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
(module make-flrectangular typed/scheme #:optimize
|
||||
(require racket/unsafe/ops racket/flonum)
|
||||
(make-rectangular 1.0 2.2)
|
||||
(make-flrectangular 1.0 2.2))
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
#lang typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(: x (MPairof Integer Float))
|
||||
(define x (mcons 1 1.0))
|
||||
(mcar x)
|
||||
(mcdr x)
|
||||
(set-mcar! x (+ 1 2))
|
||||
(set-mcdr! x (+ 1.0 2.0))
|
||||
|
||||
(: f ((MListof Integer) -> Integer))
|
||||
(define (f x)
|
||||
(if (null? x)
|
||||
0
|
||||
(mcar x)))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module n-ary-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(+ 1.0 2.0 3.0))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module nested-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(+ 2.0 (+ 3.0 4.0)))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module nested-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(+ 2.0 (* 3.0 4.0)))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module nested-pair typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(car (cdr '(1 2))))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module nested-pair2 typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(car (cdr (cons 3 (cons (cons 2 '()) 1)))))
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
(module pair-fun typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(: f ((Listof Integer) -> Integer))
|
||||
(define (f x)
|
||||
(if (null? x)
|
||||
1
|
||||
(car x))))
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
(module quote typed/scheme #:optimize
|
||||
'(+ 1.0 2.0))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module simple-float typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(+ 2.0 3.0))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module simple-pair typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(car (cons 1 2)))
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
(module sqrt typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(: f (Nonnegative-Float -> Nonnegative-Float))
|
||||
(define (f x)
|
||||
(sqrt x)))
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
(module structs typed/scheme #:optimize
|
||||
(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))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module unary-fixnum-nested typed/scheme #:optimize
|
||||
(require racket/unsafe/ops racket/fixnum)
|
||||
(abs (bitwise-not (length '(1 2 3)))))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module unary-fixnum typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(bitwise-not 4))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module float-unary typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(sin 2.0))
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
(module vector-length typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(vector-length
|
||||
(vector-ref
|
||||
(ann (vector (vector 1 2) 2 3)
|
||||
(Vector (Vectorof Integer) Integer Integer))
|
||||
0)))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module vector-length typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(vector-length (vector 1 2 3)))
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
(module vector-ref-set-ref typed/scheme #:optimize
|
||||
(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))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module vector-ref typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(vector-ref (ann (vector 1 2) (Vector Integer Integer)) 0))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module vector-ref2 typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(vector-ref (vector 1 2 3) 0))
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
(module vector-set-quote typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(vector-set! (ann (vector '(1 2)) (Vector Any))
|
||||
0
|
||||
'(+ 1.0 2.0))) ; we should not optimize under quote
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
(module vector-set typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(vector-set! (ann (vector 1 2) (Vector Integer Integer))
|
||||
0
|
||||
1))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(module invalid-vector-set typed/scheme #:optimize
|
||||
(require racket/unsafe/ops)
|
||||
(vector-set! (vector 1 2) 0 2)) ; type is (Vectorof Integer), length is ot known, can't optimize
|
||||
|
|
@ -1,62 +1,92 @@
|
|||
#lang racket
|
||||
(require racket/runtime-path)
|
||||
(require racket/runtime-path racket/sandbox)
|
||||
|
||||
;; 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)
|
||||
;; drop the type tables added by typed scheme, since they can be in a
|
||||
;; different order each time, and that would make tests fail when they
|
||||
;; shouldn't
|
||||
(filter
|
||||
;; drop the "module", its name and its language, so that we can write
|
||||
;; the 2 versions of each test in different languages (typed and
|
||||
;; untyped) if need be
|
||||
(match-lambda [(list 'define-values-for-syntax '() _ ...) #f] [_ #t])
|
||||
(cadddr
|
||||
(syntax->datum
|
||||
(parameterize ([current-namespace (make-base-namespace)]
|
||||
[read-accept-reader #t])
|
||||
(with-handlers
|
||||
([exn:fail? (lambda (exn)
|
||||
(printf "~a\n" (exn-message exn))
|
||||
#'(#f #f #f (#f)))]) ; for cadddr
|
||||
(expand (with-input-from-file file read-syntax))))))))
|
||||
(define show-names? (make-parameter #f))
|
||||
|
||||
(define prog-rx
|
||||
(pregexp (string-append "^\\s*"
|
||||
"(#lang typed/(?:scheme|racket)(?:/base)?)"
|
||||
"\\s+"
|
||||
"#:optimize"
|
||||
"\\s+")))
|
||||
|
||||
(define (evaluator file #:optimize [optimize? #f])
|
||||
(call-with-trusted-sandbox-configuration
|
||||
(lambda ()
|
||||
(parameterize ([current-load-relative-directory tests-dir]
|
||||
[sandbox-memory-limit #f] ; TR needs memory
|
||||
[sandbox-output 'string]
|
||||
[sandbox-namespace-specs
|
||||
(list (car (sandbox-namespace-specs))
|
||||
'typed/racket
|
||||
'typed/scheme)])
|
||||
;; drop the expected log
|
||||
(let* ([prog (with-input-from-file file
|
||||
(lambda ()
|
||||
(read-line) ; drop #;
|
||||
(read) ; drop expected log
|
||||
(port->string)))] ; get the actual program
|
||||
[m (or (regexp-match-positions prog-rx prog)
|
||||
(error 'evaluator "bad program contents in ~e" file))]
|
||||
[prog (string-append (substring prog (caadr m) (cdadr m))
|
||||
(if (not optimize?) "\n#:no-optimize\n" "\n")
|
||||
(substring prog (cdar m)))]
|
||||
[evaluator (make-module-evaluator prog)]
|
||||
[out (get-output evaluator)])
|
||||
(kill-evaluator evaluator)
|
||||
out)))))
|
||||
|
||||
(define (generate-opt-log name)
|
||||
(parameterize ([current-load-relative-directory tests-dir]
|
||||
[current-command-line-arguments '#("--log-optimizations")])
|
||||
(let ((log-string
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(dynamic-require (build-path (current-load-relative-directory)
|
||||
name)
|
||||
#f)))))
|
||||
;; have the log as an sexp, since that's what the expected log is
|
||||
(with-input-from-string (string-append "(" log-string ")")
|
||||
read))))
|
||||
|
||||
(define (test gen)
|
||||
(let-values (((base name _) (split-path gen)))
|
||||
(or (regexp-match ".*~" name) ; we ignore backup files
|
||||
;; machine optimized and hand optimized versions must expand to the
|
||||
;; same code
|
||||
(and (or (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)))))
|
||||
(begin (printf "~a failed: expanded code mismatch\n\n" name)
|
||||
(when (show-names?) (displayln name))
|
||||
(or (not (regexp-match ".*rkt$" name)) ; we ignore all but racket files
|
||||
;; we log optimizations and compare to an expected log to make sure
|
||||
;; that all the optimizations we expected did indeed happen
|
||||
(and (or (let ((log (generate-opt-log name))
|
||||
;; expected optimizer log, to see what was optimized
|
||||
(expected
|
||||
(with-input-from-file gen
|
||||
(lambda ()
|
||||
(read-line) ; skip the #;
|
||||
(read))))) ; get the log itself
|
||||
(equal? log expected))
|
||||
(begin (printf "~a failed: optimization log mismatch\n\n" name)
|
||||
#f))
|
||||
;; optimized and non-optimized versions must evaluate to the
|
||||
;; same thing
|
||||
(or (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)))))
|
||||
(or (equal? (evaluator gen) (evaluator gen #:optimize #t))
|
||||
(begin (printf "~a failed: result mismatch\n\n" name)
|
||||
#f))))))
|
||||
|
||||
(define-runtime-path here ".")
|
||||
(define to-run
|
||||
(command-line
|
||||
#:once-each
|
||||
["--show-names" "show the names of tests as they are run" (show-names? #t)]
|
||||
;; we optionally take a test name. if none is given, run everything (#f)
|
||||
#:args maybe-test-to-run
|
||||
(and (not (null? maybe-test-to-run))
|
||||
(car maybe-test-to-run))))
|
||||
|
||||
(define-runtime-path tests-dir "./tests")
|
||||
|
||||
(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)
|
||||
(if to-run
|
||||
(if (test to-run) 0 1)
|
||||
(for/fold ((n-failures 0))
|
||||
((gen (in-directory (build-path here "generic"))))
|
||||
((gen (in-directory tests-dir)))
|
||||
(+ n-failures (if (test gen) 0 1))))))
|
||||
(unless (= n-failures 0)
|
||||
(error (format "~a tests failed." n-failures))))
|
||||
|
|
|
|||
13
collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
Normal file
13
collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
#;
|
||||
(
|
||||
apply-plus.rkt line 12 col 7 - + - apply-map
|
||||
apply-plus.rkt line 13 col 7 - * - apply-map
|
||||
9
|
||||
24
|
||||
)
|
||||
|
||||
#lang typed/racket
|
||||
#:optimize
|
||||
|
||||
(apply + (map add1 (list 1 2 3)))
|
||||
(apply * (map add1 (list 1 2 3)))
|
||||
13
collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
Normal file
13
collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
#;
|
||||
(
|
||||
begin-float.rkt line 12 col 8 - - - binary float
|
||||
begin-float.rkt line 13 col 8 - * - binary float
|
||||
-1.0
|
||||
6.0
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(begin (- 2.0 3.0)
|
||||
(* 2.0 3.0))
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
#;
|
||||
(
|
||||
binary-fixnum.rkt line 12 col 16 - vector-length - vector-length
|
||||
binary-fixnum.rkt line 12 col 3 - bitwise-and - binary fixnum
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(: f (All (X) ((Vectorof X) -> Natural)))
|
||||
(define (f v)
|
||||
(bitwise-and (vector-length v) 1))
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
#;
|
||||
(
|
||||
binary-nonzero-fixnum.rkt line 11 col 9 - vector-length - vector-length
|
||||
binary-nonzero-fixnum.rkt line 11 col 1 - modulo - binary nonzero fixnum
|
||||
1
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(modulo (vector-length '#(1 2 3)) 2)
|
||||
19
collects/tests/typed-scheme/optimizer/tests/box.rkt
Normal file
19
collects/tests/typed-scheme/optimizer/tests/box.rkt
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
#;
|
||||
(
|
||||
box.rkt line 17 col 1 - unbox - box
|
||||
box.rkt line 18 col 1 - set-box! - box
|
||||
box.rkt line 19 col 1 - unbox - box
|
||||
1
|
||||
2
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
|
||||
|
||||
(: x (Boxof Integer))
|
||||
(define x (box 1))
|
||||
(unbox x)
|
||||
(set-box! x 2)
|
||||
(unbox x)
|
||||
|
|
@ -1,3 +1,6 @@
|
|||
#;
|
||||
()
|
||||
|
||||
#lang typed/scheme #:optimize
|
||||
|
||||
;; will be imported by cross-module-struct2
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
#;
|
||||
(
|
||||
cross-module-struct2.rkt line 11 col 1 - x-x - struct ref
|
||||
1
|
||||
)
|
||||
|
||||
#lang typed/scheme #:optimize
|
||||
|
||||
(require (file "cross-module-struct.rkt"))
|
||||
(define a (make-x 1))
|
||||
(x-x a)
|
||||
18
collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
Normal file
18
collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
#;
|
||||
(
|
||||
#f line #f col #f - op - dead else branch
|
||||
dead-else.rkt line 14 col 14 - + - binary float
|
||||
#f line #f col #f - op - dead else branch
|
||||
dead-else.rkt line 17 col 14 - + - binary float
|
||||
5.05.0
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(display (if (number? 3)
|
||||
(+ 2.0 3.0)
|
||||
(+ 4.0 5.0)))
|
||||
(display (if #t
|
||||
(+ 2.0 3.0)
|
||||
(+ 4.0 5.0)))
|
||||
|
|
@ -1,4 +1,11 @@
|
|||
#lang typed/scheme #:optimize
|
||||
#;
|
||||
(
|
||||
1
|
||||
2
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
;; originally from nucleic3
|
||||
;; cond on substructs, branches were considered dead
|
||||
18
collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
Normal file
18
collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
#;
|
||||
(
|
||||
#f line #f col #f - op - dead then branch
|
||||
dead-then.rkt line 15 col 14 - + - binary float
|
||||
#f line #f col #f - op - dead then branch
|
||||
dead-then.rkt line 18 col 14 - + - binary float
|
||||
9.09.0
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(display (if (number? "eh")
|
||||
(+ 2.0 3.0)
|
||||
(+ 4.0 5.0)))
|
||||
(display (if #f
|
||||
(+ 2.0 3.0)
|
||||
(+ 4.0 5.0)))
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
#;
|
||||
(
|
||||
define-begin-float.rkt line 11 col 27 - - - binary float
|
||||
define-begin-float.rkt line 12 col 18 - * - binary float
|
||||
-1.0
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(define a (begin (display (- 2.0 3.0))
|
||||
(* 2.0 3.0)))
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
#;
|
||||
(
|
||||
define-call-float.rkt line 9 col 17 - + - binary float
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(define x (cons (+ 1.0 2.0) 3.0))
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
#;
|
||||
(
|
||||
define-float.rkt line 9 col 11 - + - binary float
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(define x (+ 1.0 2.0))
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
#;
|
||||
(
|
||||
define-pair.rkt line 9 col 11 - car - pair
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(define x (car '(1 3)))
|
||||
30
collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
Normal file
30
collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
#;
|
||||
(
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair.rkt line 27 col 0 - (#%app caar (#%app cons (#%app cons (quote 1) (quote 2)
|
||||
) (quote 3))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair.rkt line 28 col 0 - (#%app cadr (#%app cons (quote 1) (#%app cons (quote 2)
|
||||
(quote 3)))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair.rkt line 29 col 0 - (#%app cdar (#%app cons (#%app cons (quote 1) (quote 2)
|
||||
) (quote 3))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair.rkt line 30 col 0 - (#%app cddr (#%app cons (quote 1) (#%app cons (quote 2)
|
||||
(quote 3)))) - derived pair
|
||||
1
|
||||
2
|
||||
2
|
||||
3
|
||||
)
|
||||
|
||||
#lang typed/racket #:optimize
|
||||
|
||||
(caar (cons (cons 1 2) 3))
|
||||
(cadr (cons 1 (cons 2 3)))
|
||||
(cdar (cons (cons 1 2) 3))
|
||||
(cddr (cons 1 (cons 2 3)))
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
#;
|
||||
(
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair2.rkt line 47 col 0 - (#%app caaar (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair2.rkt line 48 col 0 - (#%app caadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair2.rkt line 49 col 0 - (#%app cadar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair2.rkt line 50 col 0 - (#%app caddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair2.rkt line 51 col 0 - (#%app cdaar (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair2.rkt line 52 col 0 - (#%app cdadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair2.rkt line 53 col 0 - (#%app cddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair2.rkt line 54 col 0 - (#%app cdddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))))) - derived pair
|
||||
1
|
||||
2
|
||||
2
|
||||
3
|
||||
2
|
||||
3
|
||||
3
|
||||
4
|
||||
)
|
||||
|
||||
#lang typed/racket #:optimize
|
||||
|
||||
(caaar (cons (cons (cons 1 2) 3) 4))
|
||||
(caadr (cons 1 (cons (cons 2 3) 4)))
|
||||
(cadar (cons (cons 1 (cons 2 3)) 4))
|
||||
(caddr (cons 1 (cons 2 (cons 3 4))))
|
||||
(cdaar (cons (cons (cons 1 2) 3) 4))
|
||||
(cdadr (cons 1 (cons (cons 2 3) 4)))
|
||||
(cddar (cons (cons 1 (cons 2 3)) 4))
|
||||
(cdddr (cons 1 (cons 2 (cons 3 4))))
|
||||
118
collects/tests/typed-scheme/optimizer/tests/derived-pair3.rkt
Normal file
118
collects/tests/typed-scheme/optimizer/tests/derived-pair3.rkt
Normal file
|
|
@ -0,0 +1,118 @@
|
|||
#;
|
||||
(
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair3.rkt line 103 col 0 - (#%app caaaar (#%app cons (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4)) (quote 5))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair3.rkt line 104 col 0 - (#%app caaadr (#%app cons (quote 1) (#%app cons (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)) (quote 5)))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair3.rkt line 105 col 0 - (#%app caadar (#%app cons (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4))) (quote 5))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair3.rkt line 106 col 0 - (#%app caaddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (#%app cons (quote 3) (quote 4)) (quote 5))))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair3.rkt line 107 col 0 - (#%app cadaar (#%app cons (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4)) (quote 5))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair3.rkt line 108 col 0 - (#%app cadadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))) (quote 5)))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair3.rkt line 109 col 0 - (#%app caddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4)))) (quote 5))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
derived-pair3.rkt line 110 col 0 - (#%app cadddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (#%app cons (quote 4) (quote 5)))))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair3.rkt line 111 col 0 - (#%app cdaaar (#%app cons (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4)) (quote 5))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair3.rkt line 112 col 0 - (#%app cdaadr (#%app cons (quote 1) (#%app cons (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)) (quote 5)))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair3.rkt line 113 col 0 - (#%app cdadar (#%app cons (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4))) (quote 5))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair3.rkt line 114 col 0 - (#%app cdaddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (#%app cons (quote 3) (quote 4)) (quote 5))))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair3.rkt line 115 col 0 - (#%app cddaar (#%app cons (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4)) (quote 5))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair3.rkt line 116 col 0 - (#%app cddadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))) (quote 5)))) - derived pair
|
||||
#f line #f col #f - car - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair3.rkt line 117 col 0 - (#%app cdddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4)))) (quote 5))) - derived pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
#f line #f col #f - cdr - pair
|
||||
derived-pair3.rkt line 118 col 0 - (#%app cddddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (#%app cons (quote 4) (quote 5)))))) - derived pair
|
||||
1
|
||||
2
|
||||
2
|
||||
3
|
||||
2
|
||||
3
|
||||
3
|
||||
4
|
||||
2
|
||||
3
|
||||
3
|
||||
4
|
||||
3
|
||||
4
|
||||
4
|
||||
5
|
||||
)
|
||||
|
||||
#lang typed/racket #:optimize
|
||||
|
||||
(caaaar (cons (cons (cons (cons 1 2) 3) 4) 5))
|
||||
(caaadr (cons 1 (cons (cons (cons 2 3) 4) 5)))
|
||||
(caadar (cons (cons 1 (cons (cons 2 3) 4)) 5))
|
||||
(caaddr (cons 1 (cons 2 (cons (cons 3 4) 5))))
|
||||
(cadaar (cons (cons (cons 1 (cons 2 3)) 4) 5))
|
||||
(cadadr (cons 1 (cons (cons 2 (cons 3 4)) 5)))
|
||||
(caddar (cons (cons 1 (cons 2 (cons 3 4))) 5))
|
||||
(cadddr (cons 1 (cons 2 (cons 3 (cons 4 5)))))
|
||||
(cdaaar (cons (cons (cons (cons 1 2) 3) 4) 5))
|
||||
(cdaadr (cons 1 (cons (cons (cons 2 3) 4) 5)))
|
||||
(cdadar (cons (cons 1 (cons (cons 2 3) 4)) 5))
|
||||
(cdaddr (cons 1 (cons 2 (cons (cons 3 4) 5))))
|
||||
(cddaar (cons (cons (cons 1 (cons 2 3)) 4) 5))
|
||||
(cddadr (cons 1 (cons (cons 2 (cons 3 4)) 5)))
|
||||
(cdddar (cons (cons 1 (cons 2 (cons 3 4))) 5))
|
||||
(cddddr (cons 1 (cons 2 (cons 3 (cons 4 5)))))
|
||||
|
|
@ -1,4 +1,10 @@
|
|||
#;
|
||||
(
|
||||
3
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
;; to see if the harness supports having the 2 versions of a test being
|
||||
;; written in different languages
|
||||
(module different-langs typed/scheme #:optimize
|
||||
(+ 1 2))
|
||||
(+ 1 2)
|
||||
10
collects/tests/typed-scheme/optimizer/tests/double-float.rkt
Normal file
10
collects/tests/typed-scheme/optimizer/tests/double-float.rkt
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
#;
|
||||
(
|
||||
double-float.rkt line 10 col 1 - + - binary float
|
||||
6.0
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(+ 2.0 2.0 2.0)
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
#;
|
||||
(
|
||||
exact-inexact.rkt line 10 col 1 - exact->inexact - int to float
|
||||
1e+100
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(exact->inexact (expt 10 100)) ; must not be a fixnum
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
#;
|
||||
(
|
||||
fixnum-comparison.rkt line 12 col 4 - vector-length - vector-length
|
||||
#f line #f col #f - op - string-length
|
||||
fixnum-comparison.rkt line 12 col 1 - < - binary fixnum
|
||||
#t
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(< (vector-length '#(1 2 3)) (string-length "asdf"))
|
||||
10
collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
Normal file
10
collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
#;
|
||||
(
|
||||
float-comp.rkt line 10 col 1 - < - binary float comp
|
||||
#t
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(< 1.0 2.0)
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
#;
|
||||
(
|
||||
float-complex-conjugate-top.rkt line 14 col 14 - 1.0+2.0i - unboxed literal
|
||||
float-complex-conjugate-top.rkt line 14 col 23 - 2.0+4.0i - unboxed literal
|
||||
float-complex-conjugate-top.rkt line 14 col 12 - + - unboxed binary float complex
|
||||
float-complex-conjugate-top.rkt line 14 col 1 - conjugate - unboxed unary float complex
|
||||
float-complex-conjugate-top.rkt line 14 col 0 - (#%app conjugate (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i))) - unboxed float complex
|
||||
3.0-6.0i
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(conjugate (+ 1.0+2.0i 2.0+4.0i))
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
#;
|
||||
(
|
||||
float-complex-conjugate.rkt line 15 col 14 - 1.0+2.0i - unboxed literal
|
||||
float-complex-conjugate.rkt line 15 col 4 - conjugate - unboxed unary float complex
|
||||
float-complex-conjugate.rkt line 15 col 35 - 2.0+4.0i - unboxed literal
|
||||
float-complex-conjugate.rkt line 15 col 25 - conjugate - unboxed unary float complex
|
||||
float-complex-conjugate.rkt line 15 col 1 - + - unboxed binary float complex
|
||||
float-complex-conjugate.rkt line 15 col 0 - (#%app + (#%app conjugate (quote 1.0+2.0i)) (#%app conjugate (quote 2.0+4.0i))) - unboxed float complex
|
||||
3.0-6.0i
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(+ (conjugate 1.0+2.0i) (conjugate 2.0+4.0i))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
#;
|
||||
(
|
||||
float-complex-div.rkt line 14 col 3 - 1.0+2.0i - unboxed literal
|
||||
float-complex-div.rkt line 14 col 12 - 2.0+4.0i - unboxed literal
|
||||
float-complex-div.rkt line 14 col 21 - 3.0+6.0i - unboxed literal
|
||||
float-complex-div.rkt line 14 col 1 - / - unboxed binary float complex
|
||||
float-complex-div.rkt line 14 col 0 - (#%app / (quote 1.0+2.0i) (quote 2.0+4.0i) (quote 3.0+6.0i)) - unboxed float complex
|
||||
0.03333333333333333-0.06666666666666667i
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(/ 1.0+2.0i 2.0+4.0i 3.0+6.0i)
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
#;
|
||||
(
|
||||
float-complex-fixnum.rkt line 16 col 4 - modulo - binary nonzero fixnum
|
||||
float-complex-fixnum.rkt line 16 col 4 - modulo - binary nonzero fixnum
|
||||
float-complex-fixnum.rkt line 16 col 3 - (#%app modulo (quote 2) (quote 1)) - float-coerce-expr in complex ops
|
||||
float-complex-fixnum.rkt line 16 col 16 - 1.0+2.0i - unboxed literal
|
||||
float-complex-fixnum.rkt line 16 col 25 - 3.0+6.0i - unboxed literal
|
||||
float-complex-fixnum.rkt line 16 col 1 - + - unboxed binary float complex
|
||||
float-complex-fixnum.rkt line 16 col 0 - (#%app + (#%app modulo (quote 2) (quote 1)) (quote 1.0+2.0i) (quote 3.0+6.0i)) - unboxed float complex
|
||||
4.0+8.0i
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(+ (modulo 2 1) 1.0+2.0i 3.0+6.0i)
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
#;
|
||||
(
|
||||
float-complex-float-div.rkt line 47 col 62 - x - unbox float-complex
|
||||
float-complex-float-div.rkt line 47 col 52 - real-part - unboxed float complex
|
||||
float-complex-float-div.rkt line 48 col 62 - x - unbox float-complex
|
||||
float-complex-float-div.rkt line 48 col 52 - imag-part - unboxed float complex
|
||||
float-complex-float-div.rkt line 50 col 9 - (quote 1.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-div.rkt line 50 col 13 - 2.0+4.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 50 col 7 - / - unboxed binary float complex
|
||||
float-complex-float-div.rkt line 50 col 6 - (#%app / (quote 1.0) (quote 2.0+4.0i)) - unboxed float complex
|
||||
float-complex-float-div.rkt line 51 col 9 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 51 col 18 - (quote 2.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-div.rkt line 51 col 7 - / - unboxed binary float complex
|
||||
float-complex-float-div.rkt line 51 col 6 - (#%app / (quote 1.0+2.0i) (quote 2.0)) - unboxed float complex
|
||||
float-complex-float-div.rkt line 52 col 9 - (quote 1.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-div.rkt line 52 col 13 - 2.0+4.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 52 col 22 - 3.0+6.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 52 col 7 - / - unboxed binary float complex
|
||||
float-complex-float-div.rkt line 52 col 6 - (#%app / (quote 1.0) (quote 2.0+4.0i) (quote 3.0+6.0i)) - unboxed float complex
|
||||
float-complex-float-div.rkt line 53 col 9 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 53 col 18 - (quote 2.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-div.rkt line 53 col 22 - 3.0+6.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 53 col 7 - / - unboxed binary float complex
|
||||
float-complex-float-div.rkt line 53 col 6 - (#%app / (quote 1.0+2.0i) (quote 2.0) (quote 3.0+6.0i)) - unboxed float complex
|
||||
float-complex-float-div.rkt line 54 col 9 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 54 col 18 - 2.0+4.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 54 col 27 - (quote 3.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-div.rkt line 54 col 7 - / - unboxed binary float complex
|
||||
float-complex-float-div.rkt line 54 col 6 - (#%app / (quote 1.0+2.0i) (quote 2.0+4.0i) (quote 3.0)) - unboxed float complex
|
||||
float-complex-float-div.rkt line 55 col 9 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 55 col 18 - (quote 2.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-div.rkt line 55 col 22 - (quote 3.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-div.rkt line 55 col 7 - / - unboxed binary float complex
|
||||
float-complex-float-div.rkt line 55 col 6 - (#%app / (quote 1.0+2.0i) (quote 2.0) (quote 3.0)) - unboxed float complex
|
||||
float-complex-float-div.rkt line 56 col 9 - (quote 1.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-div.rkt line 56 col 13 - (quote 2.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-div.rkt line 56 col 17 - 3.0+6.0i - unboxed literal
|
||||
float-complex-float-div.rkt line 56 col 7 - / - unboxed binary float complex
|
||||
float-complex-float-div.rkt line 56 col 6 - (#%app / (quote 1.0) (quote 2.0) (quote 3.0+6.0i)) - unboxed float complex
|
||||
'("0.1000000000-0.2000000000" "0.50000000001.0000000000" "-0.0200000000-0.0266666667" "0.16666666670.0000000000" "0.16666666670.0000000000" "0.16666666670.3333333333" "0.0333333333-0.0666666667")
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(map (lambda: ((x : Inexact-Complex))
|
||||
(string-append (real->decimal-string (real-part x) 10)
|
||||
(real->decimal-string (imag-part x) 10)))
|
||||
(list
|
||||
(/ 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)
|
||||
(/ 1.0+2.0i 2.0 3.0)
|
||||
(/ 1.0 2.0 3.0+6.0i)))
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
#;
|
||||
(
|
||||
float-complex-float-mul.rkt line 42 col 3 - (quote 1.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-mul.rkt line 42 col 7 - 2.0+4.0i - unboxed literal
|
||||
float-complex-float-mul.rkt line 42 col 1 - * - unboxed binary float complex
|
||||
float-complex-float-mul.rkt line 42 col 0 - (#%app * (quote 1.0) (quote 2.0+4.0i)) - unboxed float complex
|
||||
float-complex-float-mul.rkt line 43 col 3 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-mul.rkt line 43 col 12 - (quote 2.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-mul.rkt line 43 col 1 - * - unboxed binary float complex
|
||||
float-complex-float-mul.rkt line 43 col 0 - (#%app * (quote 1.0+2.0i) (quote 2.0)) - unboxed float complex
|
||||
float-complex-float-mul.rkt line 44 col 3 - (quote 1.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-mul.rkt line 44 col 7 - 2.0+4.0i - unboxed literal
|
||||
float-complex-float-mul.rkt line 44 col 16 - 3.0+6.0i - unboxed literal
|
||||
float-complex-float-mul.rkt line 44 col 1 - * - unboxed binary float complex
|
||||
float-complex-float-mul.rkt line 44 col 0 - (#%app * (quote 1.0) (quote 2.0+4.0i) (quote 3.0+6.0i)) - unboxed float complex
|
||||
float-complex-float-mul.rkt line 45 col 3 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-mul.rkt line 45 col 12 - (quote 2.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-mul.rkt line 45 col 16 - 3.0+6.0i - unboxed literal
|
||||
float-complex-float-mul.rkt line 45 col 1 - * - unboxed binary float complex
|
||||
float-complex-float-mul.rkt line 45 col 0 - (#%app * (quote 1.0+2.0i) (quote 2.0) (quote 3.0+6.0i)) - unboxed float complex
|
||||
float-complex-float-mul.rkt line 46 col 3 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-mul.rkt line 46 col 12 - 2.0+4.0i - unboxed literal
|
||||
float-complex-float-mul.rkt line 46 col 21 - (quote 3.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-mul.rkt line 46 col 1 - * - unboxed binary float complex
|
||||
float-complex-float-mul.rkt line 46 col 0 - (#%app * (quote 1.0+2.0i) (quote 2.0+4.0i) (quote 3.0)) - unboxed float complex
|
||||
float-complex-float-mul.rkt line 47 col 3 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-mul.rkt line 47 col 12 - (quote 2.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-mul.rkt line 47 col 16 - (quote 3.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-mul.rkt line 47 col 1 - * - unboxed binary float complex
|
||||
float-complex-float-mul.rkt line 47 col 0 - (#%app * (quote 1.0+2.0i) (quote 2.0) (quote 3.0)) - unboxed float complex
|
||||
2.0+4.0i
|
||||
2.0+4.0i
|
||||
-18.0+24.0i
|
||||
-18.0+24.0i
|
||||
-18.0+24.0i
|
||||
6.0+12.0i
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(* 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)
|
||||
(* 1.0+2.0i 2.0 3.0)
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
#;
|
||||
(
|
||||
float-complex-float-small.rkt line 36 col 3 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-small.rkt line 36 col 12 - (quote 3.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-small.rkt line 36 col 1 - + - unboxed binary float complex
|
||||
float-complex-float-small.rkt line 36 col 0 - (#%app + (quote 1.0+2.0i) (quote 3.0)) - unboxed float complex
|
||||
float-complex-float-small.rkt line 37 col 3 - (quote 1.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-small.rkt line 37 col 7 - 2.0+4.0i - unboxed literal
|
||||
float-complex-float-small.rkt line 37 col 1 - + - unboxed binary float complex
|
||||
float-complex-float-small.rkt line 37 col 0 - (#%app + (quote 1.0) (quote 2.0+4.0i)) - unboxed float complex
|
||||
float-complex-float-small.rkt line 38 col 3 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-small.rkt line 38 col 12 - (quote 3.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-small.rkt line 38 col 1 - - - unboxed binary float complex
|
||||
float-complex-float-small.rkt line 38 col 0 - (#%app - (quote 1.0+2.0i) (quote 3.0)) - unboxed float complex
|
||||
float-complex-float-small.rkt line 39 col 3 - (quote 1.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-small.rkt line 39 col 7 - 2.0+4.0i - unboxed literal
|
||||
float-complex-float-small.rkt line 39 col 1 - - - unboxed binary float complex
|
||||
float-complex-float-small.rkt line 39 col 0 - (#%app - (quote 1.0) (quote 2.0+4.0i)) - unboxed float complex
|
||||
float-complex-float-small.rkt line 40 col 3 - 1.0+2.0i - unboxed literal
|
||||
float-complex-float-small.rkt line 40 col 15 - (quote 1.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-small.rkt line 40 col 19 - (quote 2.0) - float-coerce-expr in complex ops
|
||||
float-complex-float-small.rkt line 40 col 13 - + - binary float
|
||||
float-complex-float-small.rkt line 40 col 12 - (#%app + (quote 1.0) (quote 2.0)) - float-coerce-expr in complex ops
|
||||
float-complex-float-small.rkt line 40 col 1 - + - unboxed binary float complex
|
||||
float-complex-float-small.rkt line 40 col 0 - (#%app + (quote 1.0+2.0i) (#%app + (quote 1.0) (quote 2.0))) - unboxed float complex
|
||||
4.0+2.0i
|
||||
3.0+4.0i
|
||||
-2.0+2.0i
|
||||
-1.0-4.0i
|
||||
4.0+2.0i
|
||||
)
|
||||
|
||||
#lang typed/scheme
|
||||
#:optimize
|
||||
|
||||
(+ 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))
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user