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

Make more code use n-ary->binary.

Browse Source
This commit is contained in:
Eric Dobson 2013-09-09 21:14:22 -07:00
parent 28b07e7a45
commit 692d2ee7ff
3 changed files with 12 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/fixnum.rkt
View File

@ -135,9 +135,9 @@
(pattern (op:fixnum-unary-op n:fixnum-expr)
#:do [(log-fx-opt "unary fixnum")]
#:with opt #'(op.unsafe n.opt))
(pattern (op:fixnum-binary-op n1:fixnum-expr n2:fixnum-expr ns:fixnum-expr ...)
(pattern (op:fixnum-binary-op (~between ns:fixnum-expr 2 +inf.0) ...)
#:do [(log-fx-opt "binary fixnum")]
#:with opt (n-ary->binary #'op.unsafe #'n1.opt #'n2.opt #'(ns.opt ...)))
#:with opt (n-ary->binary #'op.unsafe #'(ns.opt ...)))
(pattern (op:fixnum-binary-comp n1:fixnum-expr n2:fixnum-expr)
#:do [(log-fx-opt "binary fixnum comp")]
#:with opt #'(op.unsafe n1.opt n2.opt))
@ -191,10 +191,10 @@
;; (if they typecheck with return type Fixnum)
(define-syntax-class (inner-checked-fixnum-opt-expr stx)
#:attributes (opt)
(pattern (op:potentially-bounded-fixnum-op n1:fixnum-expr n2:fixnum-expr ns:fixnum-expr ...)
(pattern (op:potentially-bounded-fixnum-op (~between ns:fixnum-expr 2 +inf.0) ...)
#:when (check-if-safe stx)
#:do [(log-fx-opt "fixnum bounded expr")]
#:with opt (n-ary->binary #'op.unsafe #'n1.opt #'n2.opt (syntax->list #'(ns.opt ...))))
#:with opt (n-ary->binary #'op.unsafe #'(ns.opt ...)))
(pattern (op:potentially-bounded-nonzero-fixnum-op n1:fixnum-expr n2:nonzero-fixnum-expr)
#:when (check-if-safe stx)
#:do [(log-fx-opt "nonzero fixnum bounded expr")]

14
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float.rkt
View File

@ -109,9 +109,7 @@
(pattern (#%plain-app op:binary-float-op
;; for now, accept anything that can be coerced to float
;; finer-grained checking is done below
f1:float-arg-expr
f2:float-arg-expr
fs:float-arg-expr ...)
(~between fs:float-arg-expr 2 +inf.0) ...)
#:when (let* ([safe-to-opt?
;; For it to be safe, we need:
;; - the result to be a float, in which case coercing args to floats
@ -125,12 +123,12 @@
;; (Note: could allow for more args, if not next to each other, but
;; probably not worth the trouble (most ops have 2 args anyway))
(and (subtypeof? this-syntax -Flonum)
(for/and ([a (in-syntax #'(f1 f2 fs ...))])
(for/and ([a (in-syntax #'(fs ...))])
;; flonum or provably non-zero
(or (subtypeof? a -Flonum)
(subtypeof? a (Un -PosReal -NegReal))))
(>= 1
(for/sum ([a (in-syntax #'(f1 f2 fs ...))]
(for/sum ([a (in-syntax #'(fs ...))]
#:when (not (subtypeof? a -Flonum)))
1)))]
;; if we don't have a return type of float, or if the return type is
@ -144,7 +142,7 @@
(when missed-optimization?
(log-float-real-missed-opt
this-syntax
(for/list ([x (in-syntax #'(f1 f2 fs ...))]
(for/list ([x (in-syntax #'(fs ...))]
#:unless (subtypeof? x -Flonum))
x)))
;; If an optimization was expected (whether it was safe or not doesn't matter),
@ -159,7 +157,7 @@
(define extra-precision-subexprs
(filter
values
(for/list ([subexpr (in-syntax #'(f1 f2 fs ...))]
(for/list ([subexpr (in-syntax #'(fs ...))]
#:when (or (and (in-real-layer? subexpr)
;; exclude single-flonums
(not (subtypeof? subexpr -InexactReal)))
@ -186,7 +184,7 @@
this-syntax extra-precision-subexprs)))
safe-to-opt?)
#:do [(log-fl-opt "binary float")]
#:with opt (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...)))
#:with opt (n-ary->binary #'op.unsafe #'(fs.opt ...)))
(pattern (#%plain-app op:binary-float-comp f1:float-expr f2:float-expr)
#:do [(log-fl-opt "binary float comp")]
#:with opt #'(op.unsafe f1.opt f2.opt))

5
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/utils.rkt
View File

@ -50,9 +50,8 @@
;; 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 (in-syntax #`(#,arg2 #,@rest))])
(define (n-ary->binary op stx)
(for/fold ([o (stx-car stx)]) ([e (in-syntax (stx-cdr stx))])
#`(#,op #,o #,e)))
;; this works on operations that are (A A -> B)
(define (n-ary-comp->binary op arg1 arg2 rest)