Formatting.
This commit is contained in:
parent
becaac8c18
commit
63b5747018
|
@ -11,8 +11,9 @@
|
|||
|
||||
(provide unboxed-let-opt-expr)
|
||||
|
||||
;; possibly replace bindings of complex numbers by bindings of their 2 components
|
||||
;; useful for intermediate results used more than once and for loop variables
|
||||
;; possibly replace bindings of complex numbers by bindings of their 2
|
||||
;; components useful for intermediate results used more than once and for
|
||||
;; loop variables
|
||||
(define-syntax-class unboxed-let-opt-expr
|
||||
#:commit
|
||||
(pattern e:app-of-unboxed-let-opt-expr
|
||||
|
@ -50,7 +51,8 @@
|
|||
(define-syntax-class (unboxed-let-opt-expr-internal let-loop?)
|
||||
#:commit
|
||||
#:literal-sets (kernel-literals)
|
||||
(pattern (letk:let-like-keyword ((~and clause (lhs rhs ...)) ...)
|
||||
(pattern
|
||||
(letk:let-like-keyword ((~and clause (lhs rhs ...)) ...)
|
||||
body:expr ...)
|
||||
;; we look for bindings of complexes that are not mutated and only
|
||||
;; used in positions where we would unbox them
|
||||
|
@ -90,7 +92,8 @@
|
|||
;; and can be unboxed
|
||||
(syntax-parse (cadr p)
|
||||
[((~literal #%plain-lambda) params body ...)
|
||||
;; keep track of the param # of each param that can be unboxed
|
||||
;; keep track of the param # of each param that can be
|
||||
;; unboxed
|
||||
(let loop ((unboxed '())
|
||||
(boxed '())
|
||||
(i 0)
|
||||
|
@ -136,14 +139,18 @@
|
|||
this-syntax))
|
||||
;; add the unboxed bindings to the table, for them to be used by
|
||||
;; further optimizations
|
||||
(for ((v (in-list (syntax->list #'(opt-candidates.id ...))))
|
||||
(r (in-list (syntax->list #'(opt-candidates.real-binding ...))))
|
||||
(i (in-list (syntax->list #'(opt-candidates.imag-binding ...)))))
|
||||
(for ((v (in-list (syntax->list
|
||||
#'(opt-candidates.id ...))))
|
||||
(r (in-list (syntax->list
|
||||
#'(opt-candidates.real-binding ...))))
|
||||
(i (in-list (syntax->list
|
||||
#'(opt-candidates.imag-binding ...)))))
|
||||
(dict-set! unboxed-vars-table v (list r i v)))
|
||||
;; in the case where no bindings are unboxed, we create a let
|
||||
;; that is equivalent to the original, but with all parts
|
||||
;; optimized
|
||||
(quasisyntax/loc/origin this-syntax #'letk.kw
|
||||
(quasisyntax/loc/origin
|
||||
this-syntax #'letk.kw
|
||||
(letk.key ...
|
||||
(opt-candidates.bindings ... ...
|
||||
opt-functions.res ...
|
||||
|
@ -213,8 +220,9 @@
|
|||
(look-at #'(e ... ...))]
|
||||
[(kw:identifier expr ...)
|
||||
#:when (ormap (lambda (k) (free-identifier=? k #'kw))
|
||||
(list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
|
||||
#'#%variable-reference #'with-continuation-mark))
|
||||
(list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app
|
||||
#'#%expression #'#%variable-reference
|
||||
#'with-continuation-mark))
|
||||
(look-at #'(expr ...))]
|
||||
|
||||
;; not used, not worth unboxing
|
||||
|
@ -224,12 +232,12 @@
|
|||
(and (not (is-var-mutated? v))
|
||||
(rec exp)))
|
||||
|
||||
;; very simple escape analysis for functions
|
||||
;; if a function is ever used in a non-operator position, we consider it escapes
|
||||
;; if it doesn't escape, we may be able to pass its float complex args unboxed
|
||||
;; if we are in a let loop, don't consider functions that escape by being the
|
||||
;; Very simple escape analysis for functions.
|
||||
;; If a function is used in a non-operator position, we consider it escapes.
|
||||
;; If it doesn't escape, we may be able to pass its float complex args unboxed.
|
||||
;; If we are in a let loop, don't consider functions that escape by being the
|
||||
;; sole thing in the let's body as escaping, since they would only escape to
|
||||
;; a call site that we control, which is fine
|
||||
;; a call site that we control, which is fine.
|
||||
(define (escapes? v exp let-loop?)
|
||||
|
||||
(define (look-at exp)
|
||||
|
@ -259,8 +267,9 @@
|
|||
(look-at #'(e-rhs ... e-body ...))]
|
||||
[(kw:identifier expr ...)
|
||||
#:when (ormap (lambda (k) (free-identifier=? k #'kw))
|
||||
(list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
|
||||
#'#%variable-reference #'with-continuation-mark))
|
||||
(list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app
|
||||
#'#%expression #'#%variable-reference
|
||||
#'with-continuation-mark))
|
||||
(look-at #'(expr ...))]
|
||||
|
||||
;; does not escape
|
||||
|
@ -288,7 +297,8 @@
|
|||
|
||||
;; let clause whose rhs is a function with some float complex arguments
|
||||
;; these arguments may be unboxed
|
||||
;; the new function will have all the unboxed arguments first, then all the boxed
|
||||
;; the new function will have all the unboxed arguments first, then all the
|
||||
;; boxed
|
||||
(define-syntax-class unboxed-fun-clause
|
||||
#:commit
|
||||
(pattern ((v:id) (#%plain-lambda params body:expr ...))
|
||||
|
@ -297,9 +307,11 @@
|
|||
#:when (syntax->datum #'unboxed-info)
|
||||
;; partition of the arguments
|
||||
#:with ((to-unbox ...) (boxed ...)) #'unboxed-info
|
||||
#:with (real-params ...) (syntax-map (lambda (x) (unboxed-gensym "unboxed-real-"))
|
||||
#:with (real-params ...)
|
||||
(syntax-map (lambda (x) (unboxed-gensym "unboxed-real-"))
|
||||
#'(to-unbox ...))
|
||||
#:with (imag-params ...) (syntax-map (lambda (x) (unboxed-gensym "unboxed-imag-"))
|
||||
#:with (imag-params ...)
|
||||
(syntax-map (lambda (x) (unboxed-gensym "unboxed-imag-"))
|
||||
#'(to-unbox ...))
|
||||
#:with res
|
||||
(begin
|
||||
|
@ -312,16 +324,20 @@
|
|||
(imag-parts (syntax->list #'(imag-params ...)))
|
||||
(boxed '()))
|
||||
(cond [(null? params) ; done, create the new clause
|
||||
;; real parts of unboxed parameters go first, then all imag
|
||||
;; parts, then boxed occurrences of unboxed parameters will
|
||||
;; be inserted when optimizing the body
|
||||
;; real parts of unboxed parameters go first, then all
|
||||
;; imag parts, then boxed occurrences of unboxed
|
||||
;; parameters will be inserted when optimizing the body
|
||||
#`((v) (#%plain-lambda
|
||||
(real-params ... imag-params ... #,@(reverse boxed))
|
||||
(real-params ... imag-params ...
|
||||
#,@(reverse boxed))
|
||||
#,@(syntax-map (optimize) #'(body ...))))]
|
||||
|
||||
[(memq i to-unbox) ; we unbox the current param, add to the table
|
||||
[(memq i to-unbox)
|
||||
;; we unbox the current param, add to the table
|
||||
(dict-set! unboxed-vars-table (car params)
|
||||
(list (car real-parts) (car imag-parts) (car params)))
|
||||
(list (car real-parts)
|
||||
(car imag-parts)
|
||||
(car params)))
|
||||
(loop (cdr params) (add1 i)
|
||||
(cdr real-parts) (cdr imag-parts)
|
||||
boxed)]
|
||||
|
|
Loading…
Reference in New Issue
Block a user