diff --git a/collects/typed-racket/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt index 6d5f6f22..57d41a41 100644 --- a/collects/typed-racket/base-env/prims.rkt +++ b/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))] diff --git a/collects/typed-racket/optimizer/utils.rkt b/collects/typed-racket/optimizer/utils.rkt index 21364041..b8767f32 100644 --- a/collects/typed-racket/optimizer/utils.rkt +++ b/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)))] diff --git a/collects/typed-racket/private/parse-type.rkt b/collects/typed-racket/private/parse-type.rkt index 54c18513..550fa443 100644 --- a/collects/typed-racket/private/parse-type.rkt +++ b/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)) diff --git a/collects/typed-racket/private/type-contract.rkt b/collects/typed-racket/private/type-contract.rkt index 9b7eb21d..af9732d9 100644 --- a/collects/typed-racket/private/type-contract.rkt +++ b/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) diff --git a/collects/typed-racket/tc-setup.rkt b/collects/typed-racket/tc-setup.rkt index 90b00d98..16854995 100644 --- a/collects/typed-racket/tc-setup.rkt +++ 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)) diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-eq.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-eq.rkt index 55cdc85f..578f9879 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-eq.rkt +++ b/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)) diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-hetero.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-hetero.rkt index 118b3ef2..c99484f8 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-hetero.rkt +++ b/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))) diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-keywords.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-keywords.rkt index ef35e321..0899ce04 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-keywords.rkt +++ b/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 diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-list.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-list.rkt index 218266cd..74f83e4b 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-list.rkt +++ b/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) diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-objects.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-objects.rkt index 769ab4aa..b0b1a072 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-objects.rkt +++ b/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*)))] diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-special.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-special.rkt index 35c8e314..31afeaf2 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-special.rkt +++ b/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)])) diff --git a/collects/typed-racket/typecheck/tc-expr-unit.rkt b/collects/typed-racket/typecheck/tc-expr-unit.rkt index e27d1103..3839df41 100644 --- a/collects/typed-racket/typecheck/tc-expr-unit.rkt +++ b/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" diff --git a/collects/typed-racket/typecheck/tc-lambda-unit.rkt b/collects/typed-racket/typecheck/tc-lambda-unit.rkt index 8cb61644..0823672f 100644 --- a/collects/typed-racket/typecheck/tc-lambda-unit.rkt +++ b/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)))) diff --git a/collects/typed-racket/typecheck/tc-let-unit.rkt b/collects/typed-racket/typecheck/tc-let-unit.rkt index f2cfe1d5..6ee275b6 100644 --- a/collects/typed-racket/typecheck/tc-let-unit.rkt +++ b/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 diff --git a/collects/typed-racket/typecheck/tc-send.rkt b/collects/typed-racket/typecheck/tc-send.rkt index 7949f801..2c467188 100644 --- a/collects/typed-racket/typecheck/tc-send.rkt +++ b/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)])] diff --git a/collects/typed-racket/typecheck/tc-toplevel.rkt b/collects/typed-racket/typecheck/tc-toplevel.rkt index fea45b5a..d44f138a 100644 --- a/collects/typed-racket/typecheck/tc-toplevel.rkt +++ b/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)))) diff --git a/collects/typed-racket/utils/arm.rkt b/collects/typed-racket/utils/arm.rkt index fc4b5a19..116ccb57 100644 --- a/collects/typed-racket/utils/arm.rkt +++ b/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)