From 33581fd67e26e5cc21acac50b5380087e8e9c8b8 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 8 Dec 2010 14:29:19 -0500 Subject: [PATCH] map + syntax->list -> syntax-map --- collects/typed-scheme/optimizer/box.rkt | 4 +- .../typed-scheme/optimizer/float-complex.rkt | 41 +++++++++---------- collects/typed-scheme/optimizer/optimizer.rkt | 30 +++++++------- collects/typed-scheme/optimizer/pair.rkt | 4 +- collects/typed-scheme/optimizer/struct.rkt | 4 +- .../typed-scheme/optimizer/unboxed-let.rkt | 32 +++++++-------- collects/typed-scheme/optimizer/vector.rkt | 4 +- 7 files changed, 59 insertions(+), 60 deletions(-) diff --git a/collects/typed-scheme/optimizer/box.rkt b/collects/typed-scheme/optimizer/box.rkt index 8642c36863..66f3d09716 100644 --- a/collects/typed-scheme/optimizer/box.rkt +++ b/collects/typed-scheme/optimizer/box.rkt @@ -1,6 +1,6 @@ #lang scheme/base -(require syntax/parse +(require syntax/parse unstable/syntax racket/match "../utils/utils.rkt" (for-template scheme/base scheme/unsafe/ops) @@ -29,4 +29,4 @@ (pattern (#%plain-app op:box-op b:box-expr new:expr ...) #:with opt (begin (log-optimization "box" #'op) - #`(op.unsafe b.opt #,@(map (optimize) (syntax->list #'(new ...))))))) + #`(op.unsafe b.opt #,@(syntax-map (optimize) #'(new ...)))))) diff --git a/collects/typed-scheme/optimizer/float-complex.rkt b/collects/typed-scheme/optimizer/float-complex.rkt index 7c74f889b6..421cc50dcb 100644 --- a/collects/typed-scheme/optimizer/float-complex.rkt +++ b/collects/typed-scheme/optimizer/float-complex.rkt @@ -1,6 +1,6 @@ #lang scheme/base -(require syntax/parse syntax/id-table scheme/dict +(require syntax/parse syntax/id-table scheme/dict unstable/syntax "../utils/utils.rkt" racket/unsafe/ops (for-template scheme/base scheme/math racket/flonum scheme/unsafe/ops) (types abbrev) @@ -71,8 +71,7 @@ (let () ;; unlike addition, we simply can't skip real parts of imaginaries (define (skip-0s l) - (let* ((l1 (map (lambda (x) (if (syntax->datum x) x #'0.0)) - (syntax->list l))) + (let* ((l1 (syntax-map (lambda (x) (if (syntax->datum x) x #'0.0)) l)) ;; but we can skip all but the first 0 (l2 (filter (lambda (x) (not (equal? (syntax->datum x) 0.0))) (cdr l1)))) @@ -98,19 +97,19 @@ #`(c1.bindings ... c2.bindings ... cs.bindings ... ... ;; we want to bind the intermediate results to reuse them ;; the final results are bound to real-binding and imag-binding - #,@(let ((lr (map (lambda (x) (if (syntax->datum x) x #'0.0)) - (syntax->list #'(c1.real-binding c2.real-binding cs.real-binding ...)))) - (li (map (lambda (x) (if (syntax->datum x) x #'0.0)) - (syntax->list #'(c1.imag-binding c2.imag-binding cs.imag-binding ...))))) + #,@(let ((lr (syntax-map (lambda (x) (if (syntax->datum x) x #'0.0)) + #'(c1.real-binding c2.real-binding cs.real-binding ...))) + (li (syntax-map (lambda (x) (if (syntax->datum x) x #'0.0)) + #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))) (let loop ([o1 (car lr)] [o2 (car li)] [e1 (cdr lr)] [e2 (cdr li)] - [rs (append (map (lambda (x) (unboxed-gensym "unboxed-real-")) - (syntax->list #'(cs.real-binding ...))) + [rs (append (syntax-map (lambda (x) (unboxed-gensym "unboxed-real-")) + #'(cs.real-binding ...)) (list #'real-binding))] - [is (append (map (lambda (x) (unboxed-gensym "unboxed-imag-")) - (syntax->list #'(cs.imag-binding ...))) + [is (append (syntax-map (lambda (x) (unboxed-gensym "unboxed-imag-")) + #'(cs.imag-binding ...)) (list #'imag-binding))] [res '()]) (if (null? e1) @@ -142,10 +141,10 @@ #:when (or (isoftype? this-syntax -FloatComplex) (isoftype? this-syntax -Number)) #:with real-binding (unboxed-gensym "unboxed-real-") #:with imag-binding (unboxed-gensym "unboxed-imag-") - #:with reals (map (lambda (x) (if (syntax->datum x) x #'0.0)) - (syntax->list #'(c1.real-binding c2.real-binding cs.real-binding ...))) - #:with imags (map (lambda (x) (if (syntax->datum x) x #'0.0)) - (syntax->list #'(c1.imag-binding c2.imag-binding cs.imag-binding ...))) + #:with reals (syntax-map (lambda (x) (if (syntax->datum x) x #'0.0)) + #'(c1.real-binding c2.real-binding cs.real-binding ...)) + #:with imags (syntax-map (lambda (x) (if (syntax->datum x) x #'0.0)) + #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)) #:with (bindings ...) (begin (log-optimization "unboxed binary float complex" #'op) #`(c1.bindings ... c2.bindings ... cs.bindings ... ... @@ -155,14 +154,14 @@ [o2 (car (syntax->list #'imags))] [e1 (cdr (syntax->list #'reals))] [e2 (cdr (syntax->list #'imags))] - [rs (append (map (lambda (x) (unboxed-gensym "unboxed-real-")) - (syntax->list #'(cs.real-binding ...))) + [rs (append (syntax-map (lambda (x) (unboxed-gensym "unboxed-real-")) + #'(cs.real-binding ...)) (list #'real-binding))] - [is (append (map (lambda (x) (unboxed-gensym "unboxed-imag-")) - (syntax->list #'(cs.imag-binding ...))) + [is (append (syntax-map (lambda (x) (unboxed-gensym "unboxed-imag-")) + #'(cs.imag-binding ...)) (list #'imag-binding))] - [ds (map (lambda (x) (unboxed-gensym)) - (syntax->list #'(c2.real-binding cs.real-binding ...)))] + [ds (syntax-map (lambda (x) (unboxed-gensym)) + #'(c2.real-binding cs.real-binding ...))] [res '()]) (if (null? e1) (reverse res) diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt index 8de8b5b0c5..04bc1c790e 100644 --- a/collects/typed-scheme/optimizer/optimizer.rkt +++ b/collects/typed-scheme/optimizer/optimizer.rkt @@ -1,6 +1,6 @@ #lang scheme/base -(require syntax/parse +(require syntax/parse unstable/syntax racket/pretty (for-template scheme/base) "../utils/utils.rkt" @@ -37,41 +37,41 @@ ;; boring cases, just recur down (pattern ((~and op (~or (~literal #%plain-lambda) (~literal define-values))) formals e:expr ...) - #:with opt #`(op formals #,@(map (optimize) (syntax->list #'(e ...))))) + #:with opt #`(op formals #,@(syntax-map (optimize) #'(e ...)))) (pattern (case-lambda [formals e:expr ...] ...) ;; optimize all the bodies #:with (opt-parts ...) - (map (lambda (part) - (let ((l (syntax->list part))) - (cons (car l) - (map (optimize) (cdr l))))) - (syntax->list #'([formals e ...] ...))) + (syntax-map (lambda (part) + (let ((l (syntax->list part))) + (cons (car l) + (map (optimize) (cdr l))))) + #'([formals e ...] ...)) #:with opt #'(case-lambda opt-parts ...)) (pattern ((~and op (~or (~literal let-values) (~literal letrec-values))) ([ids e-rhs:expr] ...) e-body:expr ...) - #:with (opt-rhs ...) (map (optimize) (syntax->list #'(e-rhs ...))) + #:with (opt-rhs ...) (syntax-map (optimize) #'(e-rhs ...)) #:with opt #`(op ([ids opt-rhs] ...) - #,@(map (optimize) (syntax->list #'(e-body ...))))) + #,@(syntax-map (optimize) #'(e-body ...)))) (pattern (letrec-syntaxes+values stx-bindings ([(ids ...) e-rhs:expr] ...) e-body:expr ...) ;; optimize all the rhss #:with (opt-clauses ...) - (map (lambda (clause) - (let ((l (syntax->list clause))) - (list (car l) ((optimize) (cadr l))))) - (syntax->list #'([(ids ...) e-rhs] ...))) + (syntax-map (lambda (clause) + (let ((l (syntax->list clause))) + (list (car l) ((optimize) (cadr l))))) + #'([(ids ...) e-rhs] ...)) #:with opt #`(letrec-syntaxes+values stx-bindings (opt-clauses ...) - #,@(map (optimize) (syntax->list #'(e-body ...))))) + #,@(syntax-map (optimize) #'(e-body ...)))) (pattern (kw:identifier expr ...) #:when (for/or ([k (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression #'#%variable-reference #'with-continuation-mark)]) (free-identifier=? k #'kw)) ;; we don't want to optimize in the cases that don't match the #:when clause - #:with opt #`(kw #,@(map (optimize) (syntax->list #'(expr ...))))) + #:with opt #`(kw #,@(syntax-map (optimize) #'(expr ...)))) (pattern other:expr #:with opt #'other)) diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-scheme/optimizer/pair.rkt index 59ce9be2b9..fa90529ed9 100644 --- a/collects/typed-scheme/optimizer/pair.rkt +++ b/collects/typed-scheme/optimizer/pair.rkt @@ -1,6 +1,6 @@ #lang scheme/base -(require syntax/parse +(require syntax/parse unstable/syntax racket/match (for-template scheme/base scheme/unsafe/ops) "../utils/utils.rkt" @@ -52,7 +52,7 @@ (pattern (#%plain-app op:mpair-op p:mpair-expr e:expr ...) #:with opt (begin (log-optimization "mutable pair" #'op) - #`(op.unsafe p.opt #,@(map (optimize) (syntax->list #'(e ...))))))) + #`(op.unsafe p.opt #,@(syntax-map (optimize) #'(e ...)))))) ;; if the equivalent sequence of cars and cdrs is guaranteed not to fail, diff --git a/collects/typed-scheme/optimizer/struct.rkt b/collects/typed-scheme/optimizer/struct.rkt index fac20889e7..3271b18b1b 100644 --- a/collects/typed-scheme/optimizer/struct.rkt +++ b/collects/typed-scheme/optimizer/struct.rkt @@ -1,6 +1,6 @@ #lang scheme/base -(require syntax/parse +(require syntax/parse unstable/syntax (for-template scheme/base scheme/unsafe/ops) "../utils/utils.rkt" (types type-table) @@ -21,4 +21,4 @@ #`(unsafe-struct-ref #,((optimize) #'s) #,idx)) (begin (log-optimization "struct set" #'op) #`(unsafe-struct-set! #,((optimize) #'s) #,idx - #,@(map (optimize) (syntax->list #'(v ...))))))))) + #,@(syntax-map (optimize) #'(v ...)))))))) diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt index 7ef2dc0a9a..6d9c1f0d19 100644 --- a/collects/typed-scheme/optimizer/unboxed-let.rkt +++ b/collects/typed-scheme/optimizer/unboxed-let.rkt @@ -1,6 +1,6 @@ #lang scheme/base -(require syntax/parse +(require syntax/parse unstable/syntax scheme/list scheme/dict racket/match "../utils/utils.rkt" "../utils/tc-utils.rkt" @@ -62,7 +62,7 @@ (and (isoftype? (cadr p) -FloatComplex) (could-be-unboxed-in? (car (syntax-e (car p))) #'(begin body ...)))) - (map syntax->list (syntax->list #'(clause ...))))) + (syntax-map syntax->list #'(clause ...)))) ((function-candidates others) ;; extract function bindings that have float-complex arguments ;; we may be able to pass arguments unboxed @@ -142,7 +142,7 @@ (opt-candidates.bindings ... ... opt-functions.res ... opt-others.res ...) - #,@(map (optimize) (syntax->list #'(body ...))))))) + #,@(syntax-map (optimize) #'(body ...)))))) (define-splicing-syntax-class let-like-keyword #:commit @@ -185,13 +185,13 @@ ([ids e-rhs:expr] ...) e-body:expr ...) #:with rebindings (filter (lambda (x) x) - (map (syntax-parser - [((id) rhs) - #:when (and (identifier? #'rhs) - (free-identifier=? v #'rhs)) - #'id] - [_ #f]) - (syntax->list #'((ids e-rhs) ...)))) + (syntax-map (syntax-parser + [((id) rhs) + #:when (and (identifier? #'rhs) + (free-identifier=? v #'rhs)) + #'id] + [_ #f]) + #'((ids e-rhs) ...))) (or (look-at #'(e-rhs ... e-body ...)) (ormap (lambda (x) (could-be-unboxed-in? x exp)) (syntax->list #'rebindings)))] @@ -288,15 +288,15 @@ #:when (syntax->datum #'unboxed-info) ;; partition of the arguments #:with ((to-unbox ...) (boxed ...)) #'unboxed-info - #:with (real-params ...) (map (lambda (x) (unboxed-gensym "unboxed-real-")) - (syntax->list #'(to-unbox ...))) - #:with (imag-params ...) (map (lambda (x) (unboxed-gensym "unboxed-imag-")) - (syntax->list #'(to-unbox ...))) + #:with (real-params ...) (syntax-map (lambda (x) (unboxed-gensym "unboxed-real-")) + #'(to-unbox ...)) + #:with (imag-params ...) (syntax-map (lambda (x) (unboxed-gensym "unboxed-imag-")) + #'(to-unbox ...)) #:with res (begin (log-optimization "fun -> unboxed fun" #'v) ;; add unboxed parameters to the unboxed vars table - (let ((to-unbox (map syntax->datum (syntax->list #'(to-unbox ...))))) + (let ((to-unbox (syntax-map syntax->datum #'(to-unbox ...)))) (let loop ((params (syntax->list #'params)) (i 0) (real-parts (syntax->list #'(real-params ...))) @@ -308,7 +308,7 @@ ;; be inserted when optimizing the body #`((v) (#%plain-lambda (real-params ... imag-params ... #,@(reverse boxed)) - #,@(map (optimize) (syntax->list #'(body ...)))))] + #,@(syntax-map (optimize) #'(body ...))))] [(memq i to-unbox) ; we unbox the current param, add to the table (dict-set! unboxed-vars-table (car params) diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-scheme/optimizer/vector.rkt index 776a796f44..69c1841b9f 100644 --- a/collects/typed-scheme/optimizer/vector.rkt +++ b/collects/typed-scheme/optimizer/vector.rkt @@ -1,6 +1,6 @@ #lang scheme/base -(require syntax/parse +(require syntax/parse unstable/syntax racket/match (for-template scheme/base racket/flonum scheme/unsafe/ops) "../utils/utils.rkt" @@ -63,4 +63,4 @@ #:with opt (begin (log-optimization "vector" #'op) #`(op.unsafe v.opt #,((optimize) #'i) - #,@(map (optimize) (syntax->list #'(new ...))))))) + #,@(syntax-map (optimize) #'(new ...))))))