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

fixed src loc propigation for n-ary*->binary

Browse Source
This commit is contained in:
Spencer Florence 2015-08-21 13:57:51 -05:00 committed by Vincent St-Amour
parent 20f3badc98
commit 1d2da49dfb
5 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
typed-racket-lib/typed-racket/optimizer/extflonum.rkt
View File

@ -42,12 +42,12 @@
#:literal-sets (kernel-literals)
(pattern (#%plain-app op:unary-extflonum-op t:opt-expr)
#:do [(log-extfl-opt "unary extflonum")]
#:with opt #'(op.unsafe t.opt))
#:with opt (syntax/loc this-syntax (op.unsafe t.opt)))
(pattern (#%plain-app op:binary-extflonum-op t1:opt-expr t2:opt-expr)
#:do [(log-extfl-opt "binary extflonum")]
#:with opt #'(op.unsafe t1.opt t2.opt))
#:with opt (syntax/loc this-syntax (op.unsafe t1.opt t2.opt)))
(pattern (#%plain-app :fx->extfl-op f:fixnum-expr)
#:do [(log-extfl-opt "fixnum to extflonum conversion")]
#:with opt #'(unsafe-fx->extfl f.opt))
#:with opt (syntax/loc this-syntax (unsafe-fx->extfl f.opt)))
)

6
typed-racket-lib/typed-racket/optimizer/fixnum.rkt
View File

@ -142,13 +142,13 @@
#:with opt #'(op.unsafe n.opt))
(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 #'(ns.opt ...)))
#:with opt (n-ary->binary this-syntax #'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))
(pattern (op:fixnum-binary-comp n1:fixnum-expr n2:fixnum-expr ns:fixnum-expr ...)
#:do [(log-fx-opt "multi fixnum comp")]
#:with opt (n-ary-comp->binary #'op.unsafe #'n1.opt #'n2.opt #'(ns.opt ...)))
#:with opt (n-ary-comp->binary this-syntax #'op.unsafe #'n1.opt #'n2.opt #'(ns.opt ...)))
(pattern (op:nonzero-fixnum-binary-op n1:fixnum-expr n2:nonzero-fixnum-expr)
#:do [(log-fx-opt "binary nonzero fixnum")]
@ -202,7 +202,7 @@
(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 #'(ns.opt ...)))
#:with opt (n-ary->binary this-syntax #'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")]

4
typed-racket-lib/typed-racket/optimizer/float-complex.rkt
View File

@ -145,7 +145,7 @@
#:with (bindings ...)
#`(cs.bindings ... ...
#,@(let ()
(define (fl-sum cs) (n-ary->binary #'unsafe-fl+ cs))
(define (fl-sum cs) (n-ary->binary this-syntax #'unsafe-fl+ cs))
(list
#`((real-binding) #,(fl-sum #'(cs.real-binding ...)))
#`((imag-binding) #,(fl-sum #'(cs.imag-binding ...)))))))
@ -161,7 +161,7 @@
#:with (bindings ...)
#`(cs.bindings ... ...
#,@(let ()
(define (fl-subtract cs) (n-ary->binary #'unsafe-fl- cs))
(define (fl-subtract cs) (n-ary->binary this-syntax #'unsafe-fl- cs))
(list
#`((real-binding) #,(fl-subtract #'(cs.real-binding ...)))
#`((imag-binding) #,(fl-subtract #'(cs.imag-binding ...)))))))

4
typed-racket-lib/typed-racket/optimizer/float.rkt
View File

@ -192,7 +192,7 @@
this-syntax extra-precision-subexprs)))
safe-to-opt?)
#:do [(log-fl-opt "binary float")]
#:with opt (n-ary->binary #'op.unsafe #'(fs.opt ...)))
#:with opt (n-ary->binary this-syntax #'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))
@ -201,7 +201,7 @@
f2:float-expr
fs:float-expr ...)
#:do [(log-fl-opt "multi float comp")]
#:with opt (n-ary-comp->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...)))
#:with opt (n-ary-comp->binary this-syntax #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...)))
(pattern (#%plain-app op:binary-float-comp args:opt-expr ...)
;; some args, but not all (otherwise above would have matched) are floats
;; mixed-type comparisons are slow and block futures

12
typed-racket-lib/typed-racket/optimizer/utils.rkt
View File

@ -51,11 +51,12 @@
;; 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 stx)
(define (n-ary->binary src-stx op stx)
(for/fold ([o (stx-car stx)]) ([e (in-syntax (stx-cdr stx))])
#`(#,op #,o #,e)))
(quasisyntax/loc src-stx
(#,op #,o #,e))))
;; this works on operations that are (A A -> B)
(define (n-ary-comp->binary op arg1 arg2 rest)
(define (n-ary-comp->binary src-stx op arg1 arg2 rest)
;; First, generate temps to bind the result of each arg2 args ...
;; to avoid computing them multiple times.
(define lifted (stx-map (lambda (x) (generate-temporary)) #`(#,arg2 #,@rest)))
@ -69,10 +70,11 @@
(car l)
(cdr l))])))
;; Finally, build the whole thing.
#`(let #,(for/list ([lhs (in-list lifted)]
(quasisyntax/loc src-stx
(let #,(for/list ([lhs (in-list lifted)]
[rhs (in-syntax #`(#,arg2 #,@rest))])
#`(#,lhs #,rhs))
(and #,@tests)))
(and #,@tests))))
;; to avoid mutually recursive syntax classes
;; will be set to the actual optimization function at the entry point