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

Optimize n-ary fixnum comparisons (correctly).

Browse Source 
original commit: 87887b7a18eab764bba8bcc61b605bd90f4b57dc
This commit is contained in:
Vincent St-Amour 2012-02-01 16:23:25 -05:00
parent ca115092ff
commit ddf090781a
4 changed files with 32 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/tests/typed-racket/optimizer/tests/ternary-equality.rkt
View File

@ -1,5 +1,6 @@
#;
(
TR opt: ternary-equality.rkt 12:0 (= 1 1 1) -- multi fixnum comp
#t
)

8
collects/typed-racket/optimizer/fixnum.rkt
View File

@ -115,6 +115,14 @@
#:with opt
(begin (log-optimization "binary fixnum comp" fixnum-opt-msg this-syntax)
#'(op.unsafe n1.opt n2.opt)))
(pattern (#%plain-app (~var op (fixnum-op binary-fixnum-comps))
n1:fixnum-expr
n2:fixnum-expr
ns:fixnum-expr ...)
#:with opt
(begin (log-optimization "multi fixnum comp" fixnum-opt-msg this-syntax)
(n-ary-comp->binary #'op.unsafe #'n1.opt #'n2.opt #'(ns.opt ...))))
(pattern (#%plain-app op:nonzero-fixnum-binary-op
n1:fixnum-expr
n2:nonzero-fixnum-expr)

18
collects/typed-racket/optimizer/float.rkt
View File

@ -168,23 +168,7 @@
fs:float-expr ...)
#:with opt
(begin (log-optimization "multi float comp" float-opt-msg this-syntax)
;; First, generate temps to bind the result of each f2 fs ...
;; to avoid computing them multiple times.
(define lifted (map (lambda (x) (unboxed-gensym)) (syntax->list #'(f2 fs ...))))
;; Second, build the list ((op f1 tmp2) (op tmp2 tmp3) ...)
(define tests
(let loop ([res (list #`(op.unsafe f1.opt #,(car lifted)))]
[prev (car lifted)]
[l (cdr lifted)])
(cond [(null? l) (reverse res)]
[else (loop (cons #`(op.unsafe #,prev #,(car l)) res)
(car l)
(cdr l))])))
;; Finally, build the whole thing.
#`(let #,(for/list ([lhs (in-list lifted)]
[rhs (in-list (syntax->list #'(f2.opt fs.opt ...)))])
#`(#,lhs #,rhs))
(and #,@tests))))
(n-ary-comp->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))
(pattern (#%plain-app (~and op (~literal -)) f:float-expr)
#:with opt

23
collects/typed-racket/optimizer/utils.rkt
View File

@ -10,7 +10,7 @@
(provide *show-optimized-code*
subtypeof? isoftype?
mk-unsafe-tbl
n-ary->binary
n-ary->binary n-ary-comp->binary
unboxed-gensym reset-unboxed-gensym
optimize
print-res
@ -41,10 +41,31 @@
(dict-set (dict-set h g u) f u))))
;; unlike their safe counterparts, unsafe binary operators can only take 2 arguments
;; this works on operations that are (A A -> A)
(define (n-ary->binary op arg1 arg2 rest)
(for/fold ([o arg1])
([e (syntax->list #`(#,arg2 #,@rest))])
#`(#,op #,o #,e)))
;; this works on operations that are (A A -> B)
(define (n-ary-comp->binary op arg1 arg2 rest)
;; First, generate temps to bind the result of each arg2 args ...
;; to avoid computing them multiple times.
(define lifted (map (lambda (x) (unboxed-gensym))
(syntax->list #`(#,arg2 #,@rest))))
;; Second, build the list ((op arg1 tmp2) (op tmp2 tmp3) ...)
(define tests
(let loop ([res (list #`(#,op #,arg1 #,(car lifted)))]
[prev (car lifted)]
[l (cdr lifted)])
(cond [(null? l) (reverse res)]
[else (loop (cons #`(#,op #,prev #,(car l)) res)
(car l)
(cdr l))])))
;; Finally, build the whole thing.
#`(let #,(for/list ([lhs (in-list lifted)]
[rhs (in-list (syntax->list #`(#,arg2 #,@rest)))])
#`(#,lhs #,rhs))
(and #,@tests)))
;; to generate temporary symbols in a predictable manner
;; these identifiers are unique within a sequence of unboxed operations