From 5ead0f43e28ecab8fc504d0db8b9ed7e66718219 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 27 Aug 2010 13:48:25 -0400 Subject: [PATCH] Cleanup of syntax-parse patterns. original commit: 988466369739ac5682205e49185c3956e07f3f0d --- collects/typed-scheme/optimizer/float.rkt | 14 +++++----- .../optimizer/inexact-complex.rkt | 26 +++++++++---------- .../typed-scheme/optimizer/unboxed-let.rkt | 20 +++++++------- 3 files changed, 29 insertions(+), 31 deletions(-) diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt index 334b3600..236c0be3 100644 --- a/collects/typed-scheme/optimizer/float.rkt +++ b/collects/typed-scheme/optimizer/float.rkt @@ -72,17 +72,17 @@ #:with opt #'e.opt)) (define-syntax-class float-opt-expr - (pattern (~and res (#%plain-app (~var op (float-op unary-float-ops)) f:float-expr)) - #:when (subtypeof? #'res -Flonum) + (pattern (#%plain-app (~var op (float-op unary-float-ops)) f:float-expr) + #:when (subtypeof? this-syntax -Flonum) #:with opt (begin (log-optimization "unary float" #'op) #'(op.unsafe f.opt))) - (pattern (~and res (#%plain-app (~var op (float-op binary-float-ops)) - f1:float-arg-expr - f2:float-arg-expr - fs:float-arg-expr ...)) + (pattern (#%plain-app (~var op (float-op binary-float-ops)) + f1:float-arg-expr + f2:float-arg-expr + fs:float-arg-expr ...) ;; if the result is a float, we can coerce integers to floats and optimize - #:when (subtypeof? #'res -Flonum) + #:when (subtypeof? this-syntax -Flonum) #:with opt (begin (log-optimization "binary float" #'op) (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...)))) diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt index a733651c..27443c5a 100644 --- a/collects/typed-scheme/optimizer/inexact-complex.rkt +++ b/collects/typed-scheme/optimizer/inexact-complex.rkt @@ -376,9 +376,9 @@ (begin (log-optimization "unary inexact complex" #'op) #'(op.unsafe n.opt))) - (pattern (~and exp (#%plain-app (~and op (~literal make-polar)) r theta)) - #:when (isoftype? #'exp -InexactComplex) - #:with exp*:unboxed-inexact-complex-opt-expr #'exp + (pattern (#%plain-app (~and op (~literal make-polar)) r theta) + #:when (isoftype? this-syntax -InexactComplex) + #:with exp*:unboxed-inexact-complex-opt-expr this-syntax #:with opt (begin (log-optimization "make-polar" #'op) (reset-unboxed-gensym) @@ -386,12 +386,12 @@ (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding)))) - (pattern (~and e (#%plain-app op:id args:expr ...)) + (pattern (#%plain-app op:id args:expr ...) #:with unboxed-info (dict-ref unboxed-funs-table #'op #f) #:when (syntax->datum #'unboxed-info) #:with (~var e* (inexact-complex-call-site-opt-expr #'unboxed-info #'op)) ; no need to optimize op - #'e + this-syntax #:with opt (begin (log-optimization "call to fun with unboxed args" #'op) #'e*.opt)) @@ -401,26 +401,26 @@ (define-syntax-class inexact-complex-arith-opt-expr - (pattern (~and exp (#%plain-app op:inexact-complex->float-op e:expr ...)) - #:when (subtypeof? #'exp -Flonum) - #:with exp*:unboxed-inexact-complex-opt-expr #'exp + (pattern (#%plain-app op:inexact-complex->float-op e:expr ...) + #:when (subtypeof? this-syntax -Flonum) + #:with exp*:unboxed-inexact-complex-opt-expr this-syntax #:with real-binding #'exp*.real-binding #:with imag-binding #f #:with (bindings ...) #'(exp*.bindings ...) #:with opt - (begin (log-optimization "unboxed inexact complex->float" #'exp) + (begin (log-optimization "unboxed inexact complex->float" this-syntax) (reset-unboxed-gensym) #'(let*-values (exp*.bindings ...) real-binding))) - (pattern (~and exp (#%plain-app op:inexact-complex-op e:expr ...)) - #:when (isoftype? #'exp -InexactComplex) - #:with exp*:unboxed-inexact-complex-opt-expr #'exp + (pattern (#%plain-app op:inexact-complex-op e:expr ...) + #:when (isoftype? this-syntax -InexactComplex) + #:with exp*:unboxed-inexact-complex-opt-expr this-syntax #:with real-binding #'exp*.real-binding #:with imag-binding #'exp*.imag-binding #:with (bindings ...) #'(exp*.bindings ...) #:with opt - (begin (log-optimization "unboxed inexact complex" #'exp) + (begin (log-optimization "unboxed inexact complex" this-syntax) (reset-unboxed-gensym) #'(let*-values (exp*.bindings ...) (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding)))) diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt index 73047acd..a50225c4 100644 --- a/collects/typed-scheme/optimizer/unboxed-let.rkt +++ b/collects/typed-scheme/optimizer/unboxed-let.rkt @@ -25,18 +25,17 @@ ;; we can extend unboxing (define-syntax-class app-of-unboxed-let-opt-expr #:literal-sets (kernel-literals) - (pattern (~and e ((~literal #%plain-app) - (~and let-e - ((~literal letrec-values) - bindings - loop-fun:id)) ; sole element of the body - args:expr ...)) + (pattern (#%plain-app + (~and let-e ((~literal letrec-values) + bindings + loop-fun:id)) ; sole element of the body + args:expr ...) #:with (~var operator (unboxed-let-opt-expr-internal #t)) #'let-e #:with unboxed-info (dict-ref unboxed-funs-table #'loop-fun #f) #:when (syntax->datum #'unboxed-info) #:with (~var e* (inexact-complex-call-site-opt-expr #'unboxed-info #'operator.opt)) - #'e + this-syntax #:with opt (begin (log-optimization "unboxed let loop" #'loop-fun) #'e*.opt))) @@ -46,9 +45,8 @@ ;; functions (define-syntax-class (unboxed-let-opt-expr-internal let-loop?) #:literal-sets (kernel-literals) - (pattern (~and exp (letk:let-like-keyword - ((~and clause (lhs rhs ...)) ...) - body:expr ...)) + (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 ;; these are candidates for unboxing @@ -125,7 +123,7 @@ #:with (opt-functions:unboxed-fun-clause ...) #'(function-candidates ...) #:with (opt-others:opt-let-clause ...) #'(others ...) #:with opt - (begin (log-optimization "unboxed let bindings" #'exp) + (begin (log-optimization "unboxed let bindings" 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 ...))))