diff --git a/collects/typed-racket/optimizer/box.rkt b/collects/typed-racket/optimizer/box.rkt index 2aa95aa7..e531f438 100644 --- a/collects/typed-racket/optimizer/box.rkt +++ b/collects/typed-racket/optimizer/box.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require syntax/parse unstable/syntax +(require syntax/parse syntax/stx racket/match "../utils/utils.rkt" (for-template racket/base racket/unsafe/ops) @@ -31,4 +31,4 @@ #:with opt (begin (log-optimization "box" "Box check elimination." this-syntax) (add-disappeared-use #'op) - #`(op.unsafe b.opt #,@(syntax-map (optimize) #'(new ...)))))) + #`(op.unsafe b.opt #,@(stx-map (optimize) #'(new ...)))))) diff --git a/collects/typed-racket/optimizer/float-complex.rkt b/collects/typed-racket/optimizer/float-complex.rkt index 8b175e58..a4c56a0d 100644 --- a/collects/typed-racket/optimizer/float-complex.rkt +++ b/collects/typed-racket/optimizer/float-complex.rkt @@ -1,6 +1,7 @@ #lang racket/base -(require syntax/parse syntax/id-table racket/dict unstable/syntax racket/match +(require syntax/parse syntax/stx syntax/id-table racket/dict + unstable/syntax racket/match "../utils/utils.rkt" racket/unsafe/ops unstable/sequence (for-template racket/base racket/math racket/flonum racket/unsafe/ops) (utils tc-utils) @@ -127,7 +128,7 @@ (let () ;; unlike addition, we simply can't skip real parts of imaginaries (define (skip-0s l) - (let* ((l1 (syntax-map get-part-or-0.0 l)) + (let* ((l1 (stx-map get-part-or-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)))) @@ -168,19 +169,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 (syntax-map get-part-or-0.0 - #'(c1.real-binding c2.real-binding cs.real-binding ...))) - (li (syntax-map get-part-or-0.0 - #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))) + #,@(let ((lr (stx-map get-part-or-0.0 + #'(c1.real-binding c2.real-binding cs.real-binding ...))) + (li (stx-map get-part-or-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 (syntax-map (lambda (x) (unboxed-gensym "unboxed-real-")) - #'(cs.real-binding ...)) + [rs (append (stx-map (lambda (x) (unboxed-gensym "unboxed-real-")) + #'(cs.real-binding ...)) (list #'real-binding))] - [is (append (syntax-map (lambda (x) (unboxed-gensym "unboxed-imag-")) - #'(cs.imag-binding ...)) + [is (append (stx-map (lambda (x) (unboxed-gensym "unboxed-imag-")) + #'(cs.imag-binding ...)) (list #'imag-binding))] [res '()]) (if (null? e1) @@ -212,10 +213,10 @@ #:when (subtypeof? this-syntax -FloatComplex) #:with real-binding (unboxed-gensym "unboxed-real-") #:with imag-binding (unboxed-gensym "unboxed-imag-") - #:with reals (syntax-map get-part-or-0.0 - #'(c1.real-binding c2.real-binding cs.real-binding ...)) - #:with imags (syntax-map get-part-or-0.0 - #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)) + #: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 + #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)) #:with (bindings ...) (begin (log-optimization "unboxed binary float complex" complex-unboxing-opt-msg @@ -228,11 +229,11 @@ [b (car (syntax->list #'imags))] [e1 (cdr (syntax->list #'reals))] [e2 (cdr (syntax->list #'imags))] - [rs (append (syntax-map (lambda (x) (unboxed-gensym "unboxed-real-")) - #'(cs.real-binding ...)) + [rs (append (stx-map (lambda (x) (unboxed-gensym "unboxed-real-")) + #'(cs.real-binding ...)) (list #'real-binding))] - [is (append (syntax-map (lambda (x) (unboxed-gensym "unboxed-imag-")) - #'(cs.imag-binding ...)) + [is (append (stx-map (lambda (x) (unboxed-gensym "unboxed-imag-")) + #'(cs.imag-binding ...)) (list #'imag-binding))] [res '()]) (if (null? e1) @@ -674,7 +675,7 @@ (reset-unboxed-gensym) #`(let*-values (e.bindings ... ...) (#%plain-app #,opt-operator - #,@(syntax-map get-part-or-0.0 #'(e.real-binding ...)) - #,@(syntax-map get-part-or-0.0 #'(e.imag-binding ...)) + #,@(stx-map get-part-or-0.0 #'(e.real-binding ...)) + #,@(stx-map get-part-or-0.0 #'(e.imag-binding ...)) #,@(map (lambda (i) ((optimize) (get-arg i))) boxed)))])))) ; boxed params diff --git a/collects/typed-racket/optimizer/hidden-costs.rkt b/collects/typed-racket/optimizer/hidden-costs.rkt index 9f2e6d47..93c6cbc8 100644 --- a/collects/typed-racket/optimizer/hidden-costs.rkt +++ b/collects/typed-racket/optimizer/hidden-costs.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require syntax/parse unstable/syntax +(require syntax/parse syntax/stx (for-template racket/base) "../utils/utils.rkt" (optimizer utils logging) @@ -31,11 +31,11 @@ (syntax->list #'(args ...))) #:with opt (begin (log-optimization-info "hidden parameter" #'op) - #`(op #,@(syntax-map (optimize) #'(args ...))))) + #`(op #,@(stx-map (optimize) #'(args ...))))) ;; Log calls to struct constructors, so that OC can report those used in ;; hot loops. (pattern (#%plain-app op:id args ...) #:when (struct-constructor? #'op) #:with opt (begin (log-optimization-info "struct constructor" #'op) - #`(op #,@(syntax-map (optimize) #'(args ...)))))) + #`(op #,@(stx-map (optimize) #'(args ...)))))) diff --git a/collects/typed-racket/optimizer/optimizer.rkt b/collects/typed-racket/optimizer/optimizer.rkt index d05fe695..ecc27308 100644 --- a/collects/typed-racket/optimizer/optimizer.rkt +++ b/collects/typed-racket/optimizer/optimizer.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require syntax/parse unstable/syntax +(require syntax/parse syntax/stx unstable/sequence racket/pretty (for-template racket/base) "../utils/utils.rkt" @@ -51,36 +51,34 @@ ;; boring cases, just recur down (pattern ((~and op (~or (~literal #%plain-lambda) (~literal define-values))) formals e:expr ...) - #:with opt (quasisyntax/loc/origin this-syntax #'op (op formals #,@(syntax-map (optimize) #'(e ...))))) + #:with opt (quasisyntax/loc/origin this-syntax #'op (op formals #,@(stx-map (optimize) #'(e ...))))) (pattern ((~and op case-lambda) [formals e:expr ...] ...) ;; optimize all the bodies #:with (opt-parts ...) - (syntax-map (lambda (part) - (let ((l (syntax->list part))) - (cons (car l) - (map (optimize) (cdr l))))) - #'([formals e ...] ...)) + (for/list ([part (in-syntax #'([formals e ...] ...))]) + (let ((l (syntax->list part))) + (cons (car l) + (map (optimize) (cdr l))))) #:with opt (syntax/loc/origin this-syntax #'op (op opt-parts ...))) (pattern ((~and op (~or (~literal let-values) (~literal letrec-values))) ([ids e-rhs:expr] ...) e-body:expr ...) - #:with (opt-rhs ...) (syntax-map (optimize) #'(e-rhs ...)) + #:with (opt-rhs ...) (stx-map (optimize) #'(e-rhs ...)) #:with opt (quasisyntax/loc/origin this-syntax #'op (op ([ids opt-rhs] ...) - #,@(syntax-map (optimize) #'(e-body ...))))) + #,@(stx-map (optimize) #'(e-body ...))))) (pattern ((~and op letrec-syntaxes+values) stx-bindings ([(ids ...) e-rhs:expr] ...) e-body:expr ...) ;; optimize all the rhss #:with (opt-clauses ...) - (syntax-map (lambda (clause) - (let ((l (syntax->list clause))) - (list (car l) ((optimize) (cadr l))))) - #'([(ids ...) e-rhs] ...)) + (for/list ([clause (in-syntax #'([(ids ...) e-rhs] ...))]) + (let ((l (syntax->list clause))) + (list (car l) ((optimize) (cadr l))))) #:with opt (quasisyntax/loc/origin this-syntax #'op (letrec-syntaxes+values stx-bindings (opt-clauses ...) - #,@(syntax-map (optimize) #'(e-body ...))))) + #,@(stx-map (optimize) #'(e-body ...))))) (pattern (kw:identifier expr ...) #:when (for/or ([k (in-list (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression @@ -88,7 +86,7 @@ (free-identifier=? k #'kw)) ;; we don't want to optimize in the cases that don't match the #:when clause #:with opt (quasisyntax/loc/origin this-syntax #'kw - (kw #,@(syntax-map (optimize) #'(expr ...))))) + (kw #,@(stx-map (optimize) #'(expr ...))))) (pattern other:expr #:with opt #'other)) diff --git a/collects/typed-racket/optimizer/pair.rkt b/collects/typed-racket/optimizer/pair.rkt index b500cb84..8e082379 100644 --- a/collects/typed-racket/optimizer/pair.rkt +++ b/collects/typed-racket/optimizer/pair.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require syntax/parse unstable/syntax +(require syntax/parse syntax/stx racket/match (for-template racket/base racket/unsafe/ops racket/list) "../utils/utils.rkt" @@ -66,7 +66,7 @@ #:with opt (begin (log-pair-opt this-syntax) (add-disappeared-use #'op) - #`(op.unsafe #,@(syntax-map (optimize) #'(p e ...)))))) + #`(op.unsafe #,@(stx-map (optimize) #'(p e ...)))))) ;; change the source location of a given syntax object diff --git a/collects/typed-racket/optimizer/struct.rkt b/collects/typed-racket/optimizer/struct.rkt index c0f9a031..838ac745 100644 --- a/collects/typed-racket/optimizer/struct.rkt +++ b/collects/typed-racket/optimizer/struct.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require syntax/parse unstable/syntax +(require syntax/parse syntax/stx unstable/syntax (for-template racket/base racket/unsafe/ops) "../utils/utils.rkt" (utils tc-utils) @@ -25,4 +25,4 @@ #`(unsafe-struct-ref #,((optimize) #'s) #,idx)) (begin (log-optimization "struct set" struct-opt-msg this-syntax) #`(unsafe-struct-set! #,((optimize) #'s) #,idx - #,@(syntax-map (optimize) #'(v ...)))))))) + #,@(stx-map (optimize) #'(v ...)))))))) diff --git a/collects/typed-racket/optimizer/unboxed-let.rkt b/collects/typed-racket/optimizer/unboxed-let.rkt index 9bc90ea8..e9cf6664 100644 --- a/collects/typed-racket/optimizer/unboxed-let.rkt +++ b/collects/typed-racket/optimizer/unboxed-let.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require syntax/parse unstable/syntax unstable/sequence +(require syntax/parse syntax/stx unstable/syntax unstable/sequence racket/list racket/dict racket/match "../utils/utils.rkt" "../utils/tc-utils.rkt" @@ -66,7 +66,7 @@ (and (subtypeof? (cadr p) -FloatComplex) (could-be-unboxed-in? (car (syntax-e (car p))) #'(begin body ...)))) - (syntax-map syntax->list #'(clause ...)))) + (stx-map syntax->list #'(clause ...)))) ((function-candidates others) ;; extract function bindings that have float-complex arguments ;; we may be able to pass arguments unboxed @@ -148,7 +148,7 @@ (opt-functions.res ... opt-others.res ... opt-candidates.bindings ... ...) - #,@(syntax-map (optimize) #'(body ...))))))) + #,@(stx-map (optimize) #'(body ...))))))) (define-splicing-syntax-class let-like-keyword #:commit @@ -194,13 +194,13 @@ ([ids e-rhs:expr] ...) e-body:expr ...) #:with rebindings (filter (lambda (x) x) - (syntax-map (syntax-parser - [((id) rhs) - #:when (and (identifier? #'rhs) - (free-identifier=? v #'rhs)) - #'id] - [_ #f]) - #'((ids e-rhs) ...))) + (stx-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)))] @@ -301,16 +301,14 @@ ;; partition of the arguments #:with ((to-unbox ...) (boxed ...)) #'unboxed-info #:with (real-params ...) - (syntax-map (lambda (x) (unboxed-gensym "unboxed-real-")) - #'(to-unbox ...)) + (stx-map (lambda (x) (unboxed-gensym "unboxed-real-")) #'(to-unbox ...)) #:with (imag-params ...) - (syntax-map (lambda (x) (unboxed-gensym "unboxed-imag-")) - #'(to-unbox ...)) + (stx-map (lambda (x) (unboxed-gensym "unboxed-imag-")) #'(to-unbox ...)) #:with res (begin (log-optimization "fun -> unboxed fun" arity-raising-opt-msg #'v) ;; add unboxed parameters to the unboxed vars table - (let ((to-unbox (syntax-map syntax->datum #'(to-unbox ...)))) + (let ((to-unbox (syntax->datum #'(to-unbox ...)))) (let loop ((params (syntax->list #'params)) (i 0) (real-parts (syntax->list #'(real-params ...))) @@ -323,7 +321,7 @@ #`((v) (#%plain-lambda (real-params ... imag-params ... #,@(reverse boxed)) - #,@(syntax-map (optimize) #'(body ...))))] + #,@(stx-map (optimize) #'(body ...))))] [(memq i to-unbox) ;; we unbox the current param, add to the table diff --git a/collects/typed-racket/optimizer/vector.rkt b/collects/typed-racket/optimizer/vector.rkt index b83e3229..c1a6ef48 100644 --- a/collects/typed-racket/optimizer/vector.rkt +++ b/collects/typed-racket/optimizer/vector.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require syntax/parse unstable/syntax +(require syntax/parse syntax/stx racket/match racket/flonum (for-template racket/base racket/flonum racket/unsafe/ops) "../utils/utils.rkt" @@ -74,7 +74,7 @@ (begin (log-optimization "vector" "Vector bounds checking elimination." this-syntax) (add-disappeared-use #'op) #`(op.unsafe v.opt #,((optimize) #'i) - #,@(syntax-map (optimize) #'(new ...))))) + #,@(stx-map (optimize) #'(new ...))))) ;; we can do the bounds checking separately, to eliminate some of the checks (pattern (#%plain-app op:vector-op v:expr i:fixnum-expr new:expr ...) @@ -83,7 +83,7 @@ "Partial bounds checking elimination." this-syntax) (add-disappeared-use #'op) - (let ([safe-fallback #`(op new-v new-i #,@(syntax-map (optimize) #'(new ...)))] + (let ([safe-fallback #`(op new-v new-i #,@(stx-map (optimize) #'(new ...)))] [i-known-nonneg? (subtypeof? #'i -NonNegFixnum)]) #`(let ([new-i #,((optimize) #'i)] [new-v #,((optimize) #'v)]) @@ -95,7 +95,7 @@ one-sided #`(and (unsafe-fx>= new-i 0) #,one-sided))) - (op.unsafe new-v new-i #,@(syntax-map (optimize) #'(new ...))) + (op.unsafe new-v new-i #,@(stx-map (optimize) #'(new ...))) #,safe-fallback) ; will error. to give the right error message ;; not an impersonator, can use unsafe-vector* ops (if #,(let ([one-sided #'(unsafe-fx< new-i (unsafe-vector-length new-v))]) @@ -103,7 +103,7 @@ one-sided #`(and (unsafe-fx>= new-i 0) #,one-sided))) - (op.unsafe-no-impersonator new-v new-i #,@(syntax-map (optimize) #'(new ...))) + (op.unsafe-no-impersonator new-v new-i #,@(stx-map (optimize) #'(new ...))) #,safe-fallback)))))) ;; similarly for flvectors (pattern (#%plain-app op:flvector-op v:expr i:fixnum-expr new:expr ...) @@ -112,7 +112,7 @@ "Partial bounds checking elimination." this-syntax) (add-disappeared-use #'op) - (let ([safe-fallback #`(op new-v new-i #,@(syntax-map (optimize) #'(new ...)))] + (let ([safe-fallback #`(op new-v new-i #,@(stx-map (optimize) #'(new ...)))] [i-known-nonneg? (subtypeof? #'i -NonNegFixnum)]) #`(let ([new-i #,((optimize) #'i)] [new-v #,((optimize) #'v)]) @@ -121,5 +121,5 @@ one-sided #`(and (unsafe-fx>= new-i 0) #,one-sided))) - (op.unsafe new-v new-i #,@(syntax-map (optimize) #'(new ...))) + (op.unsafe new-v new-i #,@(stx-map (optimize) #'(new ...))) #,safe-fallback)))))) diff --git a/collects/typed-racket/typecheck/tc-let-unit.rkt b/collects/typed-racket/typecheck/tc-let-unit.rkt index 9fa7146b..f2cfe1d5 100644 --- a/collects/typed-racket/typecheck/tc-let-unit.rkt +++ b/collects/typed-racket/typecheck/tc-let-unit.rkt @@ -10,7 +10,7 @@ syntax/free-vars (typecheck signatures tc-metafunctions tc-subst check-below) racket/match (contract-req) - syntax/kerncase syntax/parse unstable/syntax + syntax/kerncase syntax/parse syntax/stx (for-template racket/base (typecheck internal-forms))) @@ -202,9 +202,7 @@ (cond [(andmap (lambda (fv) (or (not (s:member fv letrec-bound-ids bound-identifier=?)) ; from outside (s:member fv transitively-safe-bindings bound-identifier=?))) - (apply append - (syntax-map (lambda (x) (free-vars x)) - clause-rhs))) + (apply append (stx-map free-vars clause-rhs))) 'transitively-safe] [else (syntax-parse clause-rhs #:literal-sets (kernel-literals) diff --git a/collects/typed/untyped-utils.rkt b/collects/typed/untyped-utils.rkt index df98ad1f..7de48175 100644 --- a/collects/typed/untyped-utils.rkt +++ b/collects/typed/untyped-utils.rkt @@ -2,8 +2,8 @@ (require (for-syntax racket/base syntax/parse + syntax/stx racket/syntax - unstable/syntax typed-racket/utils/tc-utils) typed-racket/utils/tc-utils) @@ -32,7 +32,7 @@ (typed/untyped-renamer #'typed-name #'untyped-name)))])) (define-for-syntax (freshen ids) - (syntax-map (lambda (id) ((make-syntax-introducer) id)) ids)) + (stx-map (lambda (id) ((make-syntax-introducer) id)) ids)) (define-syntax (require/untyped-contract stx) (syntax-parse stx #:literals (begin)