diff --git a/typed-racket-lib/typed-racket/optimizer/extflonum.rkt b/typed-racket-lib/typed-racket/optimizer/extflonum.rkt index 266dbff0..e016a5dc 100644 --- a/typed-racket-lib/typed-racket/optimizer/extflonum.rkt +++ b/typed-racket-lib/typed-racket/optimizer/extflonum.rkt @@ -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))) ) diff --git a/typed-racket-lib/typed-racket/optimizer/fixnum.rkt b/typed-racket-lib/typed-racket/optimizer/fixnum.rkt index c5150bb7..c4136966 100644 --- a/typed-racket-lib/typed-racket/optimizer/fixnum.rkt +++ b/typed-racket-lib/typed-racket/optimizer/fixnum.rkt @@ -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")] diff --git a/typed-racket-lib/typed-racket/optimizer/float-complex.rkt b/typed-racket-lib/typed-racket/optimizer/float-complex.rkt index 1714b18f..d3e97d09 100644 --- a/typed-racket-lib/typed-racket/optimizer/float-complex.rkt +++ b/typed-racket-lib/typed-racket/optimizer/float-complex.rkt @@ -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 ...))))))) diff --git a/typed-racket-lib/typed-racket/optimizer/float.rkt b/typed-racket-lib/typed-racket/optimizer/float.rkt index 599c210b..686ac3eb 100644 --- a/typed-racket-lib/typed-racket/optimizer/float.rkt +++ b/typed-racket-lib/typed-racket/optimizer/float.rkt @@ -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 diff --git a/typed-racket-lib/typed-racket/optimizer/utils.rkt b/typed-racket-lib/typed-racket/optimizer/utils.rkt index ed7e47fb..f0d7f2cd 100644 --- a/typed-racket-lib/typed-racket/optimizer/utils.rkt +++ b/typed-racket-lib/typed-racket/optimizer/utils.rkt @@ -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