suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

new tests for new JIT inlines

Browse Source 
svn: r2193
This commit is contained in:
Matthew Flatt 2006-02-11 05:34:14 +00:00
parent 1096009ed8
commit 17e10b396e
1 changed files with 50 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
collects/tests/mzscheme/optimize.ss
View File

@ -9,7 +9,8 @@
(namespace-require 'mzscheme) (namespace-require 'mzscheme)
(let* ([check-error-message (lambda (name proc) (let* ([check-error-message (lambda (name proc)
(unless (memq name '(eq? not null? pair? (unless (memq name '(eq? not null? pair?
real? number? boolean?)) real? number? boolean?
eof-object?))
(let ([s (with-handlers ([exn? exn-message]) (let ([s (with-handlers ([exn? exn-message])
(proc 'bad))] (proc 'bad))]
[name (symbol->string name)]) [name (symbol->string name)])
@ -30,9 +31,12 @@
(test (if v 'yes 'no) (test (if v 'yes 'no)
name name
((eval `(lambda (x) (if (,op x) 'yes 'no))) arg)))))] ((eval `(lambda (x) (if (,op x) 'yes 'no))) arg)))))]
[un (lambda (v op arg) [un-exact (lambda (v op arg)
(check-error-message op (eval `(lambda (x) (,op x)))) (check-error-message op (eval `(lambda (x) (,op x))))
(un0 v op arg) (un0 v op arg))]
[un (lambda (v op arg)
(un-exact v op arg)
(when (number? arg) (when (number? arg)
(let ([iv (if (number? v) (let ([iv (if (number? v)
(exact->inexact v) (exact->inexact v)
@ -48,9 +52,11 @@
;; (printf " for branch...\n") ;; (printf " for branch...\n")
(test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op x ,arg2) 'yes 'no))) arg1)) (test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op x ,arg2) 'yes 'no))) arg1))
(test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op ,arg1 x) 'yes 'no))) arg2)))))] (test (if v 'yes 'no) name ((eval `(lambda (x) (if (,op ,arg1 x) 'yes 'no))) arg2)))))]
[bin (lambda (v op arg1 arg2) [bin-exact (lambda (v op arg1 arg2)
(check-error-message op (eval `(lambda (x) (,op x ,arg2)))) (check-error-message op (eval `(lambda (x) (,op x ,arg2))))
(bin0 v op arg1 arg2) (bin0 v op arg1 arg2))]
[bin (lambda (v op arg1 arg2)
(bin-exact v op arg1 arg2)
(let ([iv (if (number? v) (let ([iv (if (number? v)
(exact->inexact v) (exact->inexact v)
v)]) v)])
@ -63,6 +69,8 @@
(un #f 'boolean? 0) (un #f 'boolean? 0)
(un #t 'boolean? #t) (un #t 'boolean? #t)
(un #t 'boolean? #f) (un #t 'boolean? #f)
(un #f 'eof-object? #f)
(un #t 'eof-object? eof)
(bin #f 'eq? 0 10) (bin #f 'eq? 0 10)
@ -134,6 +142,43 @@
(bin (- (expt 2 30)) '- (- (expt 2 29)) (expt 2 29)) (bin (- (expt 2 30)) '- (- (expt 2 29)) (expt 2 29))
(bin (- 2 (expt 2 31)) '- (- 1 (expt 2 30)) (sub1 (expt 2 30))) (bin (- 2 (expt 2 31)) '- (- 1 (expt 2 30)) (sub1 (expt 2 30)))
(bin-exact 11 'bitwise-and 11 43)
(bin-exact 0 'bitwise-and 11 32)
(bin-exact 0 'bitwise-and 11 (expt 2 50))
(bin-exact 0 'bitwise-and 0 -32)
(bin-exact 11 'bitwise-and 11 -1)
(bin-exact -11 'bitwise-and -11 -1)
(bin-exact (expt 2 50) 'bitwise-and (expt 2 50) (expt 2 50))
(bin-exact 11 'bitwise-ior 8 3)
(bin-exact 11 'bitwise-ior 11 3)
(bin-exact -1 'bitwise-ior 11 -1)
(bin-exact (sub1 (expt 2 51)) 'bitwise-ior (sub1 (expt 2 50)) (expt 2 50))
(bin-exact (add1 (expt 2 50)) 'bitwise-ior 1 (expt 2 50))
(bin-exact 11 'bitwise-xor 8 3)
(bin-exact 8 'bitwise-xor 11 3)
(bin-exact -2 'bitwise-xor 1 -1)
(bin-exact (sub1 (expt 2 51)) 'bitwise-xor (sub1 (expt 2 50)) (expt 2 50))
(bin-exact (add1 (expt 2 50)) 'bitwise-xor 1 (expt 2 50))
(bin-exact 4 'arithmetic-shift 2 1)
(bin-exact 1 'arithmetic-shift 2 -1)
(bin-exact (expt 2 30) 'arithmetic-shift 2 29)
(bin-exact (expt 2 31) 'arithmetic-shift 2 30)
(bin-exact (expt 2 32) 'arithmetic-shift 2 31)
(bin-exact (expt 2 33) 'arithmetic-shift 2 32)
(bin-exact -2 'arithmetic-shift -1 1)
(bin-exact -1 'arithmetic-shift -1 -1)
(bin-exact 2 'arithmetic-shift (expt 2 33) -32)
(bin-exact 8 'arithmetic-shift (expt 2 33) -30)
(un-exact -1 'bitwise-not 0)
(un-exact 0 'bitwise-not -1)
(un-exact (- -1 (expt 2 30)) 'bitwise-not (expt 2 30))
(un-exact (- (expt 2 30)) 'bitwise-not (sub1 (expt 2 30)))
(un-exact (- -1 (expt 2 32)) 'bitwise-not (expt 2 32))
)) ))
;; For some comparison, ignore the stack-depth ;; For some comparison, ignore the stack-depth