Remove reset-unboxed-bindings and unboxed-gensym.
original commit: 4c88924ef598a98ff817771b96b3d1269365edde
This commit is contained in:
Eric Dobson
parent
124f1f78d0
commit
aaa4581151
|
|
@ -1,5 +1,5 @@
|
|||
#lang racket/base
|
||||
(require syntax/parse
|
||||
(require syntax/parse racket/syntax
|
||||
(for-template racket/unsafe/ops racket/base (prefix-in k: '#%kernel))
|
||||
"../utils/utils.rkt"
|
||||
(utils tc-utils)
|
||||
|
|
@ -18,21 +18,19 @@
|
|||
#:literals (k:apply map #%plain-app #%app)
|
||||
(pattern ((~and kw #%plain-app) (~and appl k:apply) op:apply-op
|
||||
((~and kw2 #%plain-app) (~and m map) f l))
|
||||
#:with opt
|
||||
(begin (reset-unboxed-gensym)
|
||||
(with-syntax ([(f* lp v lst) (map unboxed-gensym '(f* loop v lst))]
|
||||
[l ((optimize) #'l)]
|
||||
[f ((optimize) #'f)])
|
||||
(log-optimization "apply-map" "apply-map deforestation."
|
||||
this-syntax)
|
||||
(add-disappeared-use #'appl)
|
||||
(add-disappeared-use #'kw2)
|
||||
(add-disappeared-use #'m)
|
||||
(syntax/loc/origin
|
||||
this-syntax #'kw
|
||||
(let ([f* f])
|
||||
(let lp ([v op.identity] [lst l])
|
||||
(if (null? lst)
|
||||
v
|
||||
(lp (op v (f* (unsafe-car lst)))
|
||||
(unsafe-cdr lst))))))))))
|
||||
#:with opt (with-syntax ([(f* lp v lst) (map generate-temporary '(f* loop v lst))]
|
||||
[l ((optimize) #'l)]
|
||||
[f ((optimize) #'f)])
|
||||
(log-optimization "apply-map" "apply-map deforestation."
|
||||
this-syntax)
|
||||
(add-disappeared-use #'appl)
|
||||
(add-disappeared-use #'kw2)
|
||||
(add-disappeared-use #'m)
|
||||
(syntax/loc/origin
|
||||
this-syntax #'kw
|
||||
(let ([f* f])
|
||||
(let lp ([v op.identity] [lst l])
|
||||
(if (null? lst)
|
||||
v
|
||||
(lp (op v (f* (unsafe-car lst)))
|
||||
(unsafe-cdr lst)))))))))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(require syntax/parse syntax/stx syntax/id-table racket/dict
|
||||
unstable/syntax racket/match
|
||||
unstable/syntax racket/match racket/syntax
|
||||
"../utils/utils.rkt" racket/unsafe/ops unstable/sequence
|
||||
(for-template racket/base racket/math racket/flonum racket/unsafe/ops)
|
||||
(utils tc-utils)
|
||||
|
|
@ -89,8 +89,8 @@
|
|||
c2:unboxed-float-complex-opt-expr
|
||||
cs:unboxed-float-complex-opt-expr ...)
|
||||
#:when (subtypeof? this-syntax -FloatComplex)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed binary float complex"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -117,8 +117,8 @@
|
|||
c2:unboxed-float-complex-opt-expr
|
||||
cs:unboxed-float-complex-opt-expr ...)
|
||||
#:when (subtypeof? this-syntax -FloatComplex)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed binary float complex"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -143,8 +143,8 @@
|
|||
#`((imag-binding) #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))))))))
|
||||
(pattern (#%plain-app (~and op (~literal -)) c1:unboxed-float-complex-opt-expr) ; unary -
|
||||
#:when (subtypeof? this-syntax -FloatComplex)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed unary float complex"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -159,8 +159,8 @@
|
|||
c2:unboxed-float-complex-opt-expr
|
||||
cs:unboxed-float-complex-opt-expr ...)
|
||||
#:when (or (subtypeof? this-syntax -FloatComplex) (subtypeof? this-syntax -Number))
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed binary float complex"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -177,10 +177,10 @@
|
|||
[o2 (car li)]
|
||||
[e1 (cdr lr)]
|
||||
[e2 (cdr li)]
|
||||
[rs (append (stx-map (lambda (x) (unboxed-gensym "unboxed-real-"))
|
||||
[rs (append (stx-map (lambda (x) (generate-temporary "unboxed-real-"))
|
||||
#'(cs.real-binding ...))
|
||||
(list #'real-binding))]
|
||||
[is (append (stx-map (lambda (x) (unboxed-gensym "unboxed-imag-"))
|
||||
[is (append (stx-map (lambda (x) (generate-temporary "unboxed-imag-"))
|
||||
#'(cs.imag-binding ...))
|
||||
(list #'imag-binding))]
|
||||
[res '()])
|
||||
|
|
@ -211,8 +211,8 @@
|
|||
c2:unboxed-float-complex-opt-expr
|
||||
cs:unboxed-float-complex-opt-expr ...)
|
||||
#:when (subtypeof? this-syntax -FloatComplex)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with reals (stx-map get-part-or-0.0
|
||||
#'(c1.real-binding c2.real-binding cs.real-binding ...))
|
||||
#:with imags (stx-map get-part-or-0.0
|
||||
|
|
@ -229,10 +229,10 @@
|
|||
[b (stx-car #'imags)]
|
||||
[e1 (cdr (syntax->list #'reals))]
|
||||
[e2 (cdr (syntax->list #'imags))]
|
||||
[rs (append (stx-map (lambda (x) (unboxed-gensym "unboxed-real-"))
|
||||
[rs (append (stx-map (lambda (x) (generate-temporary "unboxed-real-"))
|
||||
#'(cs.real-binding ...))
|
||||
(list #'real-binding))]
|
||||
[is (append (stx-map (lambda (x) (unboxed-gensym "unboxed-imag-"))
|
||||
[is (append (stx-map (lambda (x) (generate-temporary "unboxed-imag-"))
|
||||
#'(cs.imag-binding ...))
|
||||
(list #'imag-binding))]
|
||||
[res '()])
|
||||
|
|
@ -243,8 +243,8 @@
|
|||
res)))))))
|
||||
(pattern (#%plain-app (~and op (~literal /)) c1:unboxed-float-complex-opt-expr) ; unary /
|
||||
#:when (subtypeof? this-syntax -FloatComplex)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed unary float complex"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -257,7 +257,7 @@
|
|||
(pattern (#%plain-app (~and op (~literal conjugate)) c:unboxed-float-complex-opt-expr)
|
||||
#:when (subtypeof? this-syntax -FloatComplex)
|
||||
#:with real-binding #'c.real-binding
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed unary float complex"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -270,7 +270,7 @@
|
|||
#'0.0)))))))
|
||||
|
||||
(pattern (#%plain-app (~and op (~literal magnitude)) c:unboxed-float-complex-opt-expr)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding #'#f
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed unary float complex"
|
||||
|
|
@ -291,9 +291,9 @@
|
|||
(unsafe-fl* c.imag-binding c.imag-binding))]))))))
|
||||
|
||||
(pattern (#%plain-app (~and op (~literal exp)) c:unboxed-float-complex-opt-expr)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with scaling-factor (unboxed-gensym "unboxed-scaling-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with scaling-factor (generate-temporary "unboxed-scaling-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed unary float complex"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -335,7 +335,7 @@
|
|||
;; special handling of reals inside complex operations
|
||||
;; must be after any cases that we are supposed to handle
|
||||
(pattern e:float-arg-expr
|
||||
#:with real-binding (unboxed-gensym 'unboxed-float-)
|
||||
#:with real-binding (generate-temporary 'unboxed-float-)
|
||||
#:with imag-binding #'#f
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "float-arg-expr in complex ops"
|
||||
|
|
@ -348,8 +348,8 @@
|
|||
(pattern (#%plain-app (~and op (~or (~literal make-rectangular)
|
||||
(~literal unsafe-make-flrectangular)))
|
||||
real:float-arg-expr imag:float-arg-expr)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "make-rectangular elimination"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -359,10 +359,10 @@
|
|||
((imag-binding) imag.opt))))
|
||||
(pattern (#%plain-app (~and op (~literal make-polar))
|
||||
r:float-arg-expr theta:float-arg-expr)
|
||||
#:with magnitude (unboxed-gensym)
|
||||
#:with angle (unboxed-gensym)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with magnitude (generate-temporary)
|
||||
#:with angle (generate-temporary)
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "make-rectangular elimination"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -395,8 +395,8 @@
|
|||
#:when (let ((x (syntax->datum #'n)))
|
||||
(and (number? x)
|
||||
(not (eq? (imag-part x) 0))))
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed literal"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -410,7 +410,7 @@
|
|||
(exact->inexact (imag-part n))))))))
|
||||
(pattern (quote n)
|
||||
#:when (real? (syntax->datum #'n))
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding #'#f
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unboxed literal"
|
||||
|
|
@ -422,9 +422,9 @@
|
|||
|
||||
(pattern e:expr
|
||||
#:when (subtypeof? #'e -FloatComplex)
|
||||
#:with e* (unboxed-gensym)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with e* (generate-temporary)
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unbox float-complex"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -434,9 +434,9 @@
|
|||
((imag-binding) (unsafe-flimag-part e*)))))
|
||||
(pattern e:expr
|
||||
#:when (subtypeof? #'e -Number) ; complex, maybe exact, maybe not
|
||||
#:with e* (unboxed-gensym)
|
||||
#:with real-binding (unboxed-gensym "unboxed-real-")
|
||||
#:with imag-binding (unboxed-gensym "unboxed-imag-")
|
||||
#:with e* (generate-temporary)
|
||||
#:with real-binding (generate-temporary "unboxed-real-")
|
||||
#:with imag-binding (generate-temporary "unboxed-imag-")
|
||||
#:with (bindings ...)
|
||||
(begin (log-optimization "unbox complex"
|
||||
complex-unboxing-opt-msg
|
||||
|
|
@ -524,7 +524,6 @@
|
|||
complex-unboxing-opt-msg
|
||||
this-syntax)
|
||||
(add-disappeared-use #'op)
|
||||
(reset-unboxed-gensym)
|
||||
#`(let*-values (c*.bindings ...)
|
||||
#,(if (or (free-identifier=? #'op #'real-part)
|
||||
(free-identifier=? #'op #'flreal-part)
|
||||
|
|
@ -547,7 +546,6 @@
|
|||
complex-unboxing-opt-msg
|
||||
this-syntax)
|
||||
(add-disappeared-use #'op)
|
||||
(reset-unboxed-gensym)
|
||||
#`(let*-values (exp*.bindings ...)
|
||||
(unsafe-make-flrectangular #,(get-part-or-0.0 #'exp*.real-binding)
|
||||
#,(get-part-or-0.0 #'exp*.imag-binding)))))
|
||||
|
|
@ -577,8 +575,7 @@
|
|||
#:with imag-binding #'#f
|
||||
#:with (bindings ...) #'(exp*.bindings ...)
|
||||
#:with opt
|
||||
(begin (reset-unboxed-gensym)
|
||||
(add-disappeared-use #'op)
|
||||
(begin (add-disappeared-use #'op)
|
||||
#`(let*-values (exp*.bindings ...)
|
||||
#,(get-part-or-0.0 #'real-binding))))
|
||||
|
||||
|
|
@ -589,8 +586,7 @@
|
|||
#:with imag-binding #'exp*.imag-binding
|
||||
#:with (bindings ...) #'(exp*.bindings ...)
|
||||
#:with opt
|
||||
(begin (reset-unboxed-gensym)
|
||||
(add-disappeared-use #'op)
|
||||
(begin (add-disappeared-use #'op)
|
||||
#`(let*-values (exp*.bindings ...)
|
||||
(unsafe-make-flrectangular #,(get-part-or-0.0 #'exp*.real-binding)
|
||||
#,(get-part-or-0.0 #'exp*.imag-binding)))))
|
||||
|
|
@ -624,8 +620,7 @@
|
|||
#:with imag-binding #'exp*.imag-binding
|
||||
#:with (bindings ...) #'(exp*.bindings ...)
|
||||
#:with opt
|
||||
(begin (reset-unboxed-gensym)
|
||||
(add-disappeared-use #'op)
|
||||
(begin (add-disappeared-use #'op)
|
||||
#`(let*-values (exp*.bindings ...)
|
||||
(unsafe-make-flrectangular #,(get-part-or-0.0 #'exp*.real-binding)
|
||||
#,(get-part-or-0.0 #'exp*.imag-binding)))))
|
||||
|
|
@ -645,7 +640,6 @@
|
|||
;; same time
|
||||
(add-disappeared-use (syntax-local-introduce #'v))
|
||||
(add-disappeared-binding (syntax-local-introduce #'orig-binding))
|
||||
(reset-unboxed-gensym)
|
||||
#'(unsafe-make-flrectangular real-binding imag-binding))))
|
||||
|
||||
;; takes as argument a structure describing which arguments will be unboxed
|
||||
|
|
@ -668,7 +662,6 @@
|
|||
complex-unboxing-opt-msg
|
||||
this-syntax)
|
||||
(add-disappeared-use #'op)
|
||||
(reset-unboxed-gensym)
|
||||
#`(let*-values (e.bindings ... ...)
|
||||
(#%plain-app #,opt-operator
|
||||
#,@(stx-map get-part-or-0.0 #'(e.real-binding ...))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(require syntax/parse syntax/stx unstable/syntax unstable/sequence
|
||||
racket/list racket/dict racket/match
|
||||
racket/list racket/dict racket/match racket/syntax
|
||||
"../utils/utils.rkt"
|
||||
"../utils/tc-utils.rkt"
|
||||
(for-template racket/base)
|
||||
|
|
@ -301,9 +301,9 @@
|
|||
;; partition of the arguments
|
||||
#:with ((to-unbox ...) (boxed ...)) #'unboxed-info
|
||||
#:with (real-params ...)
|
||||
(stx-map (lambda (x) (unboxed-gensym "unboxed-real-")) #'(to-unbox ...))
|
||||
(stx-map (lambda (x) (generate-temporary "unboxed-real-")) #'(to-unbox ...))
|
||||
#:with (imag-params ...)
|
||||
(stx-map (lambda (x) (unboxed-gensym "unboxed-imag-")) #'(to-unbox ...))
|
||||
(stx-map (lambda (x) (generate-temporary "unboxed-imag-")) #'(to-unbox ...))
|
||||
#:with res
|
||||
(begin
|
||||
(log-optimization "fun -> unboxed fun" arity-raising-opt-msg #'v)
|
||||
|
|
|
|||
|
|
@ -11,7 +11,6 @@
|
|||
subtypeof? isoftype?
|
||||
mk-unsafe-tbl
|
||||
n-ary->binary n-ary-comp->binary
|
||||
unboxed-gensym reset-unboxed-gensym
|
||||
optimize
|
||||
syntax/loc/origin quasisyntax/loc/origin)
|
||||
|
||||
|
|
@ -49,7 +48,7 @@
|
|||
(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 (stx-map (lambda (x) (unboxed-gensym)) #`(#,arg2 #,@rest)))
|
||||
(define lifted (stx-map (lambda (x) (generate-temporary)) #`(#,arg2 #,@rest)))
|
||||
;; Second, build the list ((op arg1 tmp2) (op tmp2 tmp3) ...)
|
||||
(define tests
|
||||
(let loop ([res (list #`(#,op #,arg1 #,(car lifted)))]
|
||||
|
|
@ -65,15 +64,6 @@
|
|||
#`(#,lhs #,rhs))
|
||||
(and #,@tests)))
|
||||
|
||||
;; to generate temporary symbols in a predictable manner
|
||||
;; these identifiers are unique within a sequence of unboxed operations
|
||||
(define *unboxed-gensym-counter* 0)
|
||||
(define (unboxed-gensym [name 'unboxed-gensym-])
|
||||
(set! *unboxed-gensym-counter* (add1 *unboxed-gensym-counter*))
|
||||
(format-unique-id #'here "~a~a" name *unboxed-gensym-counter*))
|
||||
(define (reset-unboxed-gensym)
|
||||
(set! *unboxed-gensym-counter* 0))
|
||||
|
||||
;; to avoid mutually recursive syntax classes
|
||||
;; will be set to the actual optimization function at the entry point
|
||||
;; of the optimizer
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user