Move from syntax->list and map to stx-map.

original commit: 9af426b99f165a64e4baa1451832b8e996bd9517

collects/typed-racket/base-env/prims.rkt

@@ -50,6 +50,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
          (for-syntax
           racket/lazy-require
           syntax/parse
+          syntax/stx
           racket/syntax
           unstable/sequence
           unstable/syntax
@@ -643,7 +644,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
                       [spec (if (syntax-e #'name.parent) #'(nm parent) #'nm)]
                       [num-fields (syntax-length #'(fld ...))]
                       [(type-des _ pred sel ...) (build-struct-names #'nm (syntax->list #'(fld ...)) #f #t)]
-                      [(mut ...) (map (lambda _ #'#f) (syntax->list #'(sel ...)))]
+                      [(mut ...) (stx-map (lambda _ #'#f) #'(sel ...))]
                       [maker-name #'input-maker.name]
                       ;maker-name's symbolic form is used in the require form
                       [id-is-ctor? (or (attribute input-maker.extra) (bound-identifier=? #'maker-name #'nm))]

collects/typed-racket/optimizer/utils.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
-(require unstable/match racket/match unstable/sequence
-         racket/dict syntax/id-table racket/syntax unstable/syntax
+(require unstable/match racket/match unstable/sequence unstable/syntax
+         racket/dict syntax/id-table racket/syntax syntax/stx
          "../utils/utils.rkt"
          (for-template racket/base)
          (types type-table utils subtype)
@@ -50,8 +50,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 (map (lambda (x) (unboxed-gensym))
-                      (syntax->list #`(#,arg2 #,@rest))))
+  (define lifted (stx-map (lambda (x) (unboxed-gensym)) #`(#,arg2 #,@rest)))
   ;; Second, build the list ((op arg1 tmp2) (op tmp2 tmp3) ...)
   (define tests
     (let loop ([res  (list #`(#,op #,arg1 #,(car lifted)))]

collects/typed-racket/private/parse-type.rkt

@@ -70,7 +70,7 @@
     [((~and kw t:All) (vars:id ... v:id dd:ddd) . t:all-body)
      (when (check-duplicate-identifier (syntax->list #'(vars ... v)))
        (tc-error "All: duplicate type variable or index"))
-     (let* ([vars (map syntax-e (syntax->list #'(vars ...)))]
+     (let* ([vars (stx-map syntax-e #'(vars ...))]
             [v (syntax-e #'v)])
        (add-disappeared-use #'kw)
        (extend-indexes v
@@ -79,7 +79,7 @@
     [((~and kw t:All) (vars:id ...) . t:all-body)
      (when (check-duplicate-identifier (syntax->list #'(vars ...)))
        (tc-error "All: duplicate type variable"))
-     (let* ([vars (map syntax-e (syntax->list #'(vars ...)))])
+     (let* ([vars (stx-map syntax-e #'(vars ...))])
        (add-disappeared-use #'kw)
        (extend-tvars vars
          (make-Poly vars (parse-type #'t.type))))]
@@ -151,6 +151,9 @@
                              (attribute o.object)
                              -no-obj)))
 
+(define (parse-types stx-list)
+  (stx-map parse-type stx-list))
+
 (define (parse-type stx)
   (parameterize ([current-orig-stx stx])
     (syntax-parse
@@ -166,17 +169,17 @@
       [((~and kw t:Class) (pos-args ...) ([fname fty . rest] ...) ([mname mty] ...))
        (add-disappeared-use #'kw)
        (make-Class
-        (map parse-type (syntax->list #'(pos-args ...)))
+        (parse-types #'(pos-args ...))
         (map list
-             (map syntax-e (syntax->list #'(fname ...)))
-             (map parse-type (syntax->list #'(fty ...)))
+             (stx-map syntax-e #'(fname ...))
+             (parse-types #'(fty ...))
              (for/list ((e (in-syntax #'(rest ...))))
                (syntax-case e ()
                  [(#t) #t]
                  [_ #f])))
         (map list
-             (map syntax-e (syntax->list #'(mname ...)))
-             (map parse-type (syntax->list #'(mty ...)))))]
+             (stx-map syntax-e #'(mname ...))
+             (parse-types #'(mty ...))))]
       [((~and kw t:Refinement) p?:id)
        (add-disappeared-use #'kw)
        (match (lookup-type/lexical #'p?)
@@ -202,10 +205,10 @@
        (parse-list-type stx)]
       [((~and kw t:List*) ts ... t)
        (add-disappeared-use #'kw)
-       (-Tuple* (map parse-type (syntax->list #'(ts ...))) (parse-type #'t))]
+       (-Tuple* (parse-types #'(ts ...)) (parse-type #'t))]
       [((~and kw t:Vector) ts ...)
        (add-disappeared-use #'kw)
-       (make-HeterogeneousVector (map parse-type (syntax->list #'(ts ...))))]
+       (make-HeterogeneousVector (parse-types #'(ts ...)))]
       [((~and kw cons) fst rst)
        (add-disappeared-use #'kw)
        (-pair (parse-type #'fst) (parse-type #'rst))]
@@ -252,7 +255,7 @@
                  t*))))]
       [((~and kw t:U) ts ...)
        (add-disappeared-use #'kw)
-       (apply Un (map parse-type (syntax->list #'(ts ...))))]
+       (apply Un (parse-types #'(ts ...)))]
       [((~and kw quote) (t1 . t2))
        (add-disappeared-use #'kw)
        (-pair (parse-type #'(quote t1)) (parse-type #'(quote t2)))]
@@ -285,7 +288,7 @@
       [(dom ... (~and kw t:->) rng : latent:full-latent)
        (add-disappeared-use #'kw)
        ;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
-       (->* (map parse-type (syntax->list #'(dom ...)))
+       (->* (parse-types #'(dom ...))
             (parse-type #'rng)
             : (-FS (attribute latent.positive) (attribute latent.negative))
             : (attribute latent.object))]
@@ -297,7 +300,7 @@
        (add-disappeared-use #'kw)
        (make-Function
         (list (make-arr
-               (map parse-type (syntax->list #'(dom ...)))
+               (parse-types #'(dom ...))
                (parse-values-type #'rng)
                #:rest (parse-type #'rest)
                #:kws (attribute kws.Keyword))))]
@@ -310,7 +313,7 @@
                          bnd))
          (make-Function
           (list
-           (make-arr-dots (map parse-type (syntax->list #'(dom ...)))
+           (make-arr-dots (parse-types #'(dom ...))
                           (parse-values-type #'rng)
                           (extend-tvars (list bnd)
                             (parse-type #'rest))
@@ -320,14 +323,14 @@
        (let ([var (infer-index stx)])
          (make-Function
           (list
-           (make-arr-dots (map parse-type (syntax->list #'(dom ...)))
+           (make-arr-dots (parse-types #'(dom ...))
                           (parse-values-type #'rng)
                           (extend-tvars (list var) (parse-type #'rest))
                           var))))]
       #| ;; has to be below the previous one
      [(dom:expr ... (~and kw t:->) rng)
       (add-disappeared-use #'kw)
-      (->* (map parse-type (syntax->list #'(dom ...)))
+      (->* (parse-types #'(dom ...))
            (parse-values-type #'rng))]     |#
       ;; use expr to rule out keywords
       [(dom:non-keyword-ty ... kws:keyword-tys ... (~and kw t:->) rng)
@@ -385,7 +388,7 @@
       [(id arg args ...)
        (let loop
          ([rator (parse-type #'id)]
-          [args (map parse-type (syntax->list #'(arg args ...)))])
+          [args (parse-types #'(arg args ...))])
          (resolve-app-check-error rator args stx)
          (match rator
            [(Name: _) (make-App rator args stx)]
@@ -425,7 +428,7 @@
            (if (bound-tvar? var)
                (tc-error/stx #'bound "Used a type variable (~a) not bound with ... as a bound on a ..." var)
                (tc-error/stx #'bound "Type variable ~a is unbound" var)))
-         (-Tuple* (map parse-type (syntax->list #'(tys ...)))
+         (-Tuple* (parse-types #'(tys ...))
                   (make-ListDots
                    (extend-tvars (list var)
                      (parse-type #'dty))
@@ -433,14 +436,14 @@
       [((~and kw t:List) tys ... dty _:ddd)
        (add-disappeared-use #'kw)
        (let ([var (infer-index stx)])
-         (-Tuple* (map parse-type (syntax->list #'(tys ...)))
-                    (make-ListDots
-                     (extend-tvars (list var)
-                       (parse-type #'dty))
-                     var)))]
+         (-Tuple* (parse-types #'(tys ...))
+                  (make-ListDots
+                    (extend-tvars (list var)
+                      (parse-type #'dty))
+                    var)))]
       [((~and kw t:List) tys ...)
        (add-disappeared-use #'kw)
-       (-Tuple (map parse-type (syntax->list #'(tys ...))))])))
+       (-Tuple (parse-types #'(tys ...)))])))
 
 ;; Syntax -> Type
 ;; Parse a (Values ...) type
@@ -454,20 +457,20 @@
            (if (bound-tvar? var)
                (tc-error/stx #'bound "Used a type variable (~a) not bound with ... as a bound on a ..." var)
                (tc-error/stx #'bound "Type variable ~a is unbound" var)))
-         (-values-dots (map parse-type (syntax->list #'(tys ...)))
+         (-values-dots (parse-types #'(tys ...))
                        (extend-tvars (list var)
                          (parse-type #'dty))
                        var))]
       [((~and kw (~or t:Values values)) tys ... dty _:ddd)
        (add-disappeared-use #'kw)
        (let ([var (infer-index stx)])
-         (-values-dots (map parse-type (syntax->list #'(tys ...)))
+         (-values-dots (parse-types #'(tys ...))
                        (extend-tvars (list var)
                          (parse-type #'dty))
                        var))]
       [((~and kw (~or t:Values values)) tys ...)
        (add-disappeared-use #'kw)
-       (-values (map parse-type (syntax->list #'(tys ...))))]
+       (-values (parse-types #'(tys ...)))]
       [t
        (-values (list (parse-type #'t)))])))
 
@@ -475,9 +478,9 @@
   (syntax-parse stx #:literals (values)
     [((~and kw values) t ...)
      (add-disappeared-use #'kw)
-     (ret (map parse-type (syntax->list #'(t ...)))
-          (map (lambda (x) (make-NoFilter)) (syntax->list #'(t ...)))
-          (map (lambda (x) (make-NoObject)) (syntax->list #'(t ...))))]
+     (ret (parse-types #'(t ...))
+          (stx-map (lambda (x) (make-NoFilter)) #'(t ...))
+          (stx-map (lambda (x) (make-NoObject)) #'(t ...)))]
     [t (ret (parse-type #'t) (make-NoFilter) (make-NoObject))]))
 
 (define parse-tc-results/id (parse/id parse-tc-results))

collects/typed-racket/private/type-contract.rkt

@@ -383,7 +383,7 @@
              (match-let ([(Poly-names: vs-nm _) ty])
                (with-syntax ([(v ...) (generate-temporaries vs-nm)])
                  (set-impersonator!)
-                 (parameterize ([vars (append (map list vs (syntax->list #'(v ...)))
+                 (parameterize ([vars (append (stx-map list vs #'(v ...))
                                               (vars))])
                    #`(parametric->/c (v ...) #,(t->c b))))))]
         [(Mu: n b)

collects/typed-racket/tc-setup.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
 (require "utils/utils.rkt"
-         (except-in syntax/parse id)
+         (except-in syntax/parse id) syntax/stx
          racket/pretty racket/promise racket/lazy-require
          (private type-contract)
          (types utils)
@@ -24,7 +24,7 @@
   (if (optimize?)
       (begin
         (do-time "Starting optimizer")
-        (begin0 (map optimize-top (syntax->list body))
+        (begin0 (stx-map optimize-top body)
           (do-time "Optimized")))
       body))
 

collects/typed-racket/typecheck/tc-app/tc-app-eq.rkt

@@ -3,7 +3,7 @@
 (require "../../utils/utils.rkt"
          "signatures.rkt"
          "utils.rkt"
-         syntax/parse racket/match
+         syntax/parse syntax/stx racket/match
          syntax/parse/experimental/reflect
          (typecheck signatures tc-funapp)
          (types abbrev union utils)
@@ -30,7 +30,7 @@
   (pattern (eq?:comparator v1 v2)
     ;; make sure the whole expression is type correct
     (match* ((tc/funapp #'eq? #'(v1 v2) (single-value #'eq?)
-                        (map single-value (syntax->list #'(v1 v2))) expected)
+                        (stx-map single-value #'(v1 v2)) expected)
              ;; check thn and els with the eq? info
              (tc/eq #'eq? #'v1 #'v2))
       [((tc-result1: t) (tc-result1: t* f o))

collects/typed-racket/typecheck/tc-app/tc-app-hetero.rkt

@@ -2,7 +2,7 @@
 
 (require "../../utils/utils.rkt"
          (prefix-in c: (contract-req))
-         syntax/parse racket/match unstable/sequence unstable/syntax
+         syntax/parse syntax/stx racket/match unstable/sequence unstable/syntax
          syntax/parse/experimental/reflect
          "signatures.rkt"
          "utils.rkt"
@@ -115,7 +115,7 @@
        (unless (= (length ts) (syntax-length #'(args ...)))
          (tc-error/expr "expected vector with ~a elements, but got ~a"
                         (length ts)
-                        (make-HeterogeneousVector (map tc-expr/t (syntax->list #'(args ...))))))
+                        (make-HeterogeneousVector (stx-map tc-expr/t #'(args ...)))))
        (for ([e (in-syntax #'(args ...))]
              [t (in-list ts)])
          (tc-expr/check e (ret t)))

collects/typed-racket/typecheck/tc-app/tc-app-keywords.rkt

@@ -4,8 +4,7 @@
 (require (rename-in "../../utils/utils.rkt" [infer r:infer])
          "signatures.rkt"
          "utils.rkt"
-         syntax/parse racket/match
-         racket/set
+         syntax/parse syntax/stx racket/match racket/set
          syntax/parse/experimental/reflect
          (typecheck signatures tc-app-helper tc-funapp tc-metafunctions)
          (types abbrev utils union substitute subtype)
@@ -36,7 +35,7 @@
        (=> fail)
        (unless (set-empty? (fv/list kw-formals))
          (fail))
-       (match (map single-value (syntax->list #'pos-args))
+       (match (stx-map single-value #'pos-args)
          [(list (tc-result1: argtys-t) ...)
           (let* ([subst (infer vars null argtys-t dom rng
                                (and expected (tc-results->values expected)))])
@@ -58,7 +57,7 @@
     [(arr: dom rng rest #f ktys)
      ;; assumes that everything is in sorted order
      (let loop ([actual-kws kws]
-                [actuals (map tc-expr/t (syntax->list kw-args))]
+                [actuals (stx-map tc-expr/t kw-args)]
                 [formals ktys])
        (match* (actual-kws formals)
          [('() '())
@@ -101,7 +100,7 @@
      (tc-keywords/internal a kws kw-args #t)
      (tc/funapp (car (syntax-e form)) kw-args
                 (ret (make-Function (list (make-arr* dom rng #:rest rest))))
-                (map tc-expr (syntax->list pos-args)) expected)]
+                (stx-map tc-expr pos-args) expected)]
     [(list (and a (arr: doms rngs rests (and drests #f) ktyss)) ...)
      (let ([new-arities
             (for/list ([a (in-list arities)]
@@ -113,7 +112,7 @@
            (domain-mismatches
             (car (syntax-e form)) (cdr (syntax-e form))
             arities doms rests drests rngs
-            (map tc-expr (syntax->list pos-args))
+            (stx-map tc-expr pos-args)
             #f #f #:expected expected
             #:return (or expected (ret (Un)))
             #:msg-thunk
@@ -122,7 +121,7 @@
                              dom)))
            (tc/funapp (car (syntax-e form)) kw-args
                       (ret (make-Function new-arities))
-                      (map tc-expr (syntax->list pos-args)) expected)))]))
+                      (stx-map tc-expr pos-args) expected)))]))
 
 (define (type->list t)
   (match t

collects/typed-racket/typecheck/tc-app/tc-app-list.rkt

@@ -4,7 +4,7 @@
 (require "../../utils/utils.rkt"
          "signatures.rkt"
          "utils.rkt"
-         syntax/parse racket/match unstable/sequence unstable/syntax
+         syntax/parse syntax/stx racket/match unstable/sequence unstable/syntax
          syntax/parse/experimental/reflect
          (only-in '#%kernel [reverse k:reverse])
          (typecheck signatures tc-funapp)
@@ -29,7 +29,7 @@
   #:literals (reverse k:reverse list list*
               cons map andmap ormap)
   (pattern (~and form (map f arg0 arg ...))
-    (match* ((single-value #'arg0) (map single-value (syntax->list #'(arg ...))))
+    (match* ((single-value #'arg0) (stx-map single-value #'(arg ...)))
       ;; if the argument is a ListDots
       [((tc-result1: (ListDots: t0 bound0))
         (list (tc-result1: (or (and (ListDots: t bound) (app (λ _ #f) var))
@@ -92,11 +92,11 @@
          (tc-expr/check ac (ret exp)))
        expected]
       [_
-       (let ([tys (map tc-expr/t (syntax->list #'args))])
+       (let ([tys (stx-map tc-expr/t #'args)])
          (ret (apply -lst* tys)))]))
   ;; special case for `list*'
   (pattern (list* . args)
-    (match-let* ([(list tys ... last) (map tc-expr/t (syntax->list #'args))])
+    (match-let* ([(list tys ... last) (stx-map tc-expr/t #'args)])
       (ret (foldr -pair last tys))))
   ;; special case for `reverse' to propagate expected type info
   (pattern ((~or reverse k:reverse) arg)

collects/typed-racket/typecheck/tc-app/tc-app-objects.rkt

@@ -3,7 +3,7 @@
 (require "../../utils/utils.rkt"
          "signatures.rkt"
          "utils.rkt"
-         syntax/parse racket/match unstable/sequence unstable/syntax
+         syntax/parse syntax/stx racket/match unstable/sequence unstable/syntax
          syntax/parse/experimental/reflect
          (typecheck signatures tc-funapp)
          (types abbrev union utils)
@@ -31,8 +31,8 @@
 ;; do-make-object now takes blame as its first argument, which isn't checked
 ;; (it's just an s-expression)
 (define (check-do-make-object b cl pos-args names named-args)
-  (let* ([names (map syntax-e (syntax->list names))]
-         [name-assoc (map list names (syntax->list named-args))])
+  (let* ([names (stx-map syntax-e names)]
+         [name-assoc (stx-map list names named-args)])
     (let loop ([t (tc-expr cl)])
       (match t
         [(tc-result1: (? Mu? t*)) (loop (ret (unfold t*)))]

collects/typed-racket/typecheck/tc-app/tc-app-special.rkt

@@ -5,7 +5,7 @@
          "utils.rkt"
          syntax/parse racket/match
          syntax/parse/experimental/reflect
-         unstable/list
+         unstable/list syntax/stx
          (typecheck signatures tc-funapp)
          (types abbrev utils)
          (private type-annotation)
@@ -51,7 +51,7 @@
          (tc-expr/check #'quo (ret Univ))
          (tc/funapp #'op #'(quo arg)
                     (ret (instantiate-poly t (extend (list Univ Univ)
-                                                     (map type-annotation (syntax->list #'(i ...)))
+                                                     (stx-map type-annotation #'(i ...))
                                                      Univ)))
                     (list (ret Univ) (single-value #'arg))
                     expected)]))

collects/typed-racket/typecheck/tc-expr-unit.rkt

@@ -13,7 +13,7 @@
          (utils tc-utils stxclass-util)
          (env lexical-env type-env-structs tvar-env index-env)
          racket/private/class-internal
-         syntax/parse 
+         syntax/parse syntax/stx
          unstable/function unstable/syntax #;unstable/debug         
          (only-in srfi/1 split-at)
          (for-template "internal-forms.rkt" (only-in '#%paramz [parameterization-key pz:pk])))
@@ -75,7 +75,7 @@
                          [_
                           (instantiate-poly ty (map parse-type stx-list))]))))]
               [else
-               (instantiate-poly ty (map parse-type (syntax->list inst)))])))]
+               (instantiate-poly ty (stx-map parse-type inst))])))]
     [_ (if inst
            (tc-error/expr #:return (Un)
                           "Cannot instantiate expression that produces ~a values"

collects/typed-racket/typecheck/tc-lambda-unit.rkt

@@ -320,7 +320,7 @@
 (define (tc/mono-lambda/type formals bodies expected)
   (make-Function (map lam-result->type
                       (tc/mono-lambda
-                        (map make-formals (syntax->list formals))
+                        (stx-map make-formals formals)
                         (syntax->list bodies)
                         expected))))
 

collects/typed-racket/typecheck/tc-let-unit.rkt

@@ -107,7 +107,7 @@
   tcr)
 
 (define (tc/letrec-values namess exprs body form [expected #f])
-  (let* ([names (map syntax->list (syntax->list namess))]
+  (let* ([names (stx-map syntax->list namess)]
          [orig-flat-names (apply append names)]
          [exprs (syntax->list exprs)]
          ;; the clauses for error reporting
@@ -223,7 +223,7 @@
 
 (define (tc/let-values namess exprs body form [expected #f])
   (let* (;; a list of each name clause
-         [names (map syntax->list (syntax->list namess))]
+         [names (stx-map syntax->list namess)]
          ;; all the trailing expressions - the ones actually bound to the names
          [exprs (syntax->list exprs)]
          ;; the types of the exprs

collects/typed-racket/typecheck/tc-send.rkt

@@ -2,7 +2,7 @@
 
 
 (require "../utils/utils.rkt"
-         racket/match 
+         racket/match syntax/stx
          (typecheck signatures tc-funapp)
          (types base-abbrev utils type-table)
          (rep type-rep) 
@@ -18,7 +18,7 @@
        [(tc-result1: (Value: (? symbol? s)))
         (let* ([ftype (cond [(assq s methods) => cadr]
                             [else (tc-error/expr "send: method ~a not understood by class ~a" s c)])]
-               [retval (tc/funapp rcvr args (ret ftype) (map tc-expr (syntax->list args)) expected)])
+               [retval (tc/funapp rcvr args (ret ftype) (stx-map tc-expr args) expected)])
           (add-typeof-expr form retval)
           retval)]
        [(tc-result1: t) (int-err "non-symbol methods not supported by Typed Racket: ~a" t)])]

collects/typed-racket/typecheck/tc-toplevel.rkt

@@ -178,11 +178,11 @@
 
       ;; to handle the top-level, we have to recur into begins
       [(begin . rest)
-       (apply append (filter list? (map tc-toplevel/pass1 (syntax->list #'rest))))]
+       (apply append (filter list? (stx-map tc-toplevel/pass1 #'rest)))]
 
       ;; define-syntaxes just get noted
       [(define-syntaxes (var:id ...) . rest)
-       (map make-def-stx-binding (syntax->list #'(var ...)))]
+       (stx-map make-def-stx-binding #'(var ...))]
 
       ;; otherwise, do nothing in this pass
       ;; handles expressions, provides, requires, etc and whatnot
@@ -235,7 +235,7 @@
       [(define-values (var ...) expr)
        (unless (for/and ([v (in-syntax #'(var ...))])
                  (free-id-table-ref unann-defs v (lambda _ #f)))
-         (let ([ts (map lookup-type (syntax->list #'(var ...)))])
+         (let ([ts (stx-map lookup-type #'(var ...))])
            (when (= 1 (length ts))
              (add-scoped-tvars #'expr (lookup-scoped-tvars (stx-car #'(var ...)))))
            (tc-expr/check #'expr (ret ts))))

collects/typed-racket/utils/arm.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require (for-template racket/base))
+(require (for-template racket/base) syntax/stx)
 
 (provide arm)
 
@@ -15,7 +15,7 @@
     [(#%require . _) stx]
     [(#%provide . _) stx]
     [(begin form ...)
-     (quasisyntax/loc stx (begin #,@(map arm (syntax->list #'(form ...)))))]
+     (quasisyntax/loc stx (begin #,@(stx-map arm #'(form ...))))]
     [(define-values ids expr)
      (quasisyntax/loc stx (define-values ids #,(arm #'expr)))]
     [(define-syntaxes ids expr)