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) (pattern (op:fixnum-unary-op n:fixnum-expr)
#:do [(log-fx-opt "unary fixnum")] #:do [(log-fx-opt "unary fixnum")]
#:with opt #'(op.unsafe n.opt)) #: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")] #: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) (pattern (op:fixnum-binary-comp n1:fixnum-expr n2:fixnum-expr)
#:do [(log-fx-opt "binary fixnum comp")] #:do [(log-fx-opt "binary fixnum comp")]
#:with opt #'(op.unsafe n1.opt n2.opt)) #:with opt #'(op.unsafe n1.opt n2.opt))
@ -191,10 +191,10 @@
;; (if they typecheck with return type Fixnum) ;; (if they typecheck with return type Fixnum)
(define-syntax-class (inner-checked-fixnum-opt-expr stx) (define-syntax-class (inner-checked-fixnum-opt-expr stx)
#:attributes (opt) #: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) #:when (check-if-safe stx)
#:do [(log-fx-opt "fixnum bounded expr")] #: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) (pattern (op:potentially-bounded-nonzero-fixnum-op n1:fixnum-expr n2:nonzero-fixnum-expr)
#:when (check-if-safe stx) #:when (check-if-safe stx)
#:do [(log-fx-opt "nonzero fixnum bounded expr")] #: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 (pattern (#%plain-app op:binary-float-op
;; for now, accept anything that can be coerced to float ;; for now, accept anything that can be coerced to float
;; finer-grained checking is done below ;; finer-grained checking is done below
f1:float-arg-expr (~between fs:float-arg-expr 2 +inf.0) ...)
f2:float-arg-expr
fs:float-arg-expr ...)
#:when (let* ([safe-to-opt? #:when (let* ([safe-to-opt?
;; For it to be safe, we need: ;; For it to be safe, we need:
;; - the result to be a float, in which case coercing args to floats ;; - 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 ;; (Note: could allow for more args, if not next to each other, but
;; probably not worth the trouble (most ops have 2 args anyway)) ;; probably not worth the trouble (most ops have 2 args anyway))
(and (subtypeof? this-syntax -Flonum) (and (subtypeof? this-syntax -Flonum)
(for/and ([a (in-syntax #'(f1 f2 fs ...))]) (for/and ([a (in-syntax #'(fs ...))])
;; flonum or provably non-zero ;; flonum or provably non-zero
(or (subtypeof? a -Flonum) (or (subtypeof? a -Flonum)
(subtypeof? a (Un -PosReal -NegReal)))) (subtypeof? a (Un -PosReal -NegReal))))
(>= 1 (>= 1
(for/sum ([a (in-syntax #'(f1 f2 fs ...))] (for/sum ([a (in-syntax #'(fs ...))]
#:when (not (subtypeof? a -Flonum))) #:when (not (subtypeof? a -Flonum)))
1)))] 1)))]
;; if we don't have a return type of float, or if the return type is ;; if we don't have a return type of float, or if the return type is
@ -144,7 +142,7 @@
(when missed-optimization? (when missed-optimization?
(log-float-real-missed-opt (log-float-real-missed-opt
this-syntax this-syntax
(for/list ([x (in-syntax #'(f1 f2 fs ...))] (for/list ([x (in-syntax #'(fs ...))]
#:unless (subtypeof? x -Flonum)) #:unless (subtypeof? x -Flonum))
x))) x)))
;; If an optimization was expected (whether it was safe or not doesn't matter), ;; If an optimization was expected (whether it was safe or not doesn't matter),
@ -159,7 +157,7 @@
(define extra-precision-subexprs (define extra-precision-subexprs
(filter (filter
values values
(for/list ([subexpr (in-syntax #'(f1 f2 fs ...))] (for/list ([subexpr (in-syntax #'(fs ...))]
#:when (or (and (in-real-layer? subexpr) #:when (or (and (in-real-layer? subexpr)
;; exclude single-flonums ;; exclude single-flonums
(not (subtypeof? subexpr -InexactReal))) (not (subtypeof? subexpr -InexactReal)))
@ -186,7 +184,7 @@
this-syntax extra-precision-subexprs))) this-syntax extra-precision-subexprs)))
safe-to-opt?) safe-to-opt?)
#:do [(log-fl-opt "binary float")] #: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) (pattern (#%plain-app op:binary-float-comp f1:float-expr f2:float-expr)
#:do [(log-fl-opt "binary float comp")] #:do [(log-fl-opt "binary float comp")]
#:with opt #'(op.unsafe f1.opt f2.opt)) #: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 ;; unlike their safe counterparts, unsafe binary operators can only take 2 arguments
;; this works on operations that are (A A -> A) ;; this works on operations that are (A A -> A)
(define (n-ary->binary op arg1 arg2 rest) (define (n-ary->binary op stx)
(for/fold ([o arg1]) (for/fold ([o (stx-car stx)]) ([e (in-syntax (stx-cdr stx))])
([e (in-syntax #`(#,arg2 #,@rest))])
#`(#,op #,o #,e))) #`(#,op #,o #,e)))
;; this works on operations that are (A A -> B) ;; this works on operations that are (A A -> B)
(define (n-ary-comp->binary op arg1 arg2 rest) (define (n-ary-comp->binary op arg1 arg2 rest)