From c4c85ce9c84c50a8ff4c83136ab027fbff7fa7c0 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Fri, 24 May 2013 22:31:50 -0700 Subject: [PATCH] Use in-syntax instead of in-list/syntax->list. (cherry picked from commit 83f38f4d3bc7813ce2574a37b0831e0b9e4e0546) --- collects/typed-racket/base-env/colon.rkt | 5 +- collects/typed-racket/base-env/prims.rkt | 9 ++-- .../typed-racket/optimizer/float-complex.rkt | 6 +-- collects/typed-racket/optimizer/float.rkt | 13 +++-- .../typed-racket/optimizer/unboxed-let.rkt | 11 ++-- collects/typed-racket/optimizer/utils.rkt | 6 +-- collects/typed-racket/private/parse-type.rkt | 20 +++---- collects/typed-racket/private/with-types.rkt | 12 ++--- .../typecheck/provide-handling.rkt | 6 ++- .../typed-racket/typecheck/tc-app-helper.rkt | 2 +- .../typecheck/tc-app/tc-app-hetero.rkt | 17 +++--- .../typecheck/tc-app/tc-app-lambda.rkt | 10 ++-- .../typecheck/tc-app/tc-app-list.rkt | 6 +-- .../typecheck/tc-app/tc-app-values.rkt | 6 +-- .../typed-racket/typecheck/tc-toplevel.rkt | 30 +++++------ collects/typed-racket/types/subtype.rkt | 10 ++-- collects/typed-racket/utils/mutated-vars.rkt | 5 +- collects/typed-racket/utils/utils.rkt | 54 +++++++++---------- 18 files changed, 112 insertions(+), 116 deletions(-) diff --git a/collects/typed-racket/base-env/colon.rkt b/collects/typed-racket/base-env/colon.rkt index 6c8dc1ae9d..85ee88f55e 100644 --- a/collects/typed-racket/base-env/colon.rkt +++ b/collects/typed-racket/base-env/colon.rkt @@ -1,6 +1,7 @@ #lang racket/base -(require (for-syntax racket/base syntax/parse "internal.rkt" "../utils/disappeared-use.rkt") +(require (for-syntax racket/base syntax/parse unstable/sequence + "internal.rkt" "../utils/disappeared-use.rkt") "../typecheck/internal-forms.rkt" (prefix-in t: "base-types-extra.rkt")) @@ -13,7 +14,7 @@ ;; explicitly parenthesized (syntax-parse stx #:literals (: t:->) [(: id (~and kw :) x ...) - #:fail-unless (for/first ([i (in-list (syntax->list #'(x ...)))] + #:fail-unless (for/first ([i (in-syntax #'(x ...))] #:when (identifier? i) #:when (free-identifier=? i #'t:->)) i) diff --git a/collects/typed-racket/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt index 407a50c8dc..b97caeccf4 100644 --- a/collects/typed-racket/base-env/prims.rkt +++ b/collects/typed-racket/base-env/prims.rkt @@ -51,6 +51,7 @@ This file defines two sorts of primitives. All of them are provided into any mod racket/lazy-require syntax/parse racket/syntax + unstable/sequence racket/base racket/struct-info syntax/struct @@ -466,10 +467,12 @@ This file defines two sorts of primitives. All of them are provided into any mod (define-syntax (with-handlers: stx) (syntax-parse stx [(_ ([pred? action] ...) . body) - (with-syntax ([(pred?* ...) (map (lambda (s) (with-type-property #`(ann #,s : (Any -> Any)) #t)) - (syntax->list #'(pred? ...)))] + (with-syntax ([(pred?* ...) + (for/list ([s (in-syntax #'(pred? ...))]) + (with-type-property #`(ann #,s : (Any -> Any)) #t))] [(action* ...) - (map (lambda (s) (exn-handler-property s #t)) (syntax->list #'(action ...)))] + (for/list ([s (in-syntax #'(action ...))]) + (exn-handler-property s #t))] [body* (exn-body-property #'(let-values () . body) #t)]) (with-handlers-property #'(with-handlers ([pred?* action*] ...) body*) #t))])) diff --git a/collects/typed-racket/optimizer/float-complex.rkt b/collects/typed-racket/optimizer/float-complex.rkt index 3b7f1053bd..8b175e5880 100644 --- a/collects/typed-racket/optimizer/float-complex.rkt +++ b/collects/typed-racket/optimizer/float-complex.rkt @@ -1,7 +1,7 @@ #lang racket/base (require syntax/parse syntax/id-table racket/dict unstable/syntax racket/match - "../utils/utils.rkt" racket/unsafe/ops + "../utils/utils.rkt" racket/unsafe/ops unstable/sequence (for-template racket/base racket/math racket/flonum racket/unsafe/ops) (utils tc-utils) (types numeric-tower subtype type-table utils) @@ -495,7 +495,7 @@ ;; reasonable definition. (pattern e:arith-expr #:when (when (and (in-complex-layer? #'e) - (for/and ([subexpr (in-list (syntax->list #'(e.args ...)))]) + (for/and ([subexpr (in-syntax #'(e.args ...))]) (subtypeof? subexpr -Real))) (log-missed-optimization "unexpected complex type" @@ -601,7 +601,7 @@ (pattern (#%plain-app (~literal /) e:expr ...) #:when (subtypeof? this-syntax -FloatComplex) #:when (let ([irritants - (for/list ([c (syntax->list #'(e ...))] + (for/list ([c (in-syntax #'(e ...))] #:when (match (type-of c) [(tc-result1: t) (subtype -Zero t)] diff --git a/collects/typed-racket/optimizer/float.rkt b/collects/typed-racket/optimizer/float.rkt index 6e58ef217e..2914a3ef87 100644 --- a/collects/typed-racket/optimizer/float.rkt +++ b/collects/typed-racket/optimizer/float.rkt @@ -1,7 +1,6 @@ #lang racket/base -(require syntax/parse - racket/dict racket/flonum +(require syntax/parse unstable/sequence racket/dict racket/flonum (for-template racket/base racket/flonum racket/unsafe/ops racket/math) "../utils/utils.rkt" (utils tc-utils) @@ -124,12 +123,12 @@ ;; (Note: could allow for more args, if not next to each other, but ;; probably not worth the trouble (most ops have 2 args anyway)) (and (subtypeof? this-syntax -Flonum) - (for/and ([a (in-list (syntax->list #'(f1 f2 fs ...)))]) + (for/and ([a (in-syntax #'(f1 f2 fs ...))]) ;; flonum or provably non-zero (or (subtypeof? a -Flonum) (subtypeof? a (Un -PosReal -NegReal)))) (>= 1 - (for/sum ([a (in-list (syntax->list #'(f1 f2 fs ...)))] + (for/sum ([a (in-syntax #'(f1 f2 fs ...))] #:when (not (subtypeof? a -Flonum))) 1)))] ;; if we don't have a return type of float, or if the return type is @@ -143,7 +142,7 @@ (when missed-optimization? (log-float-real-missed-opt this-syntax - (for/list ([x (in-list (syntax->list #'(f1 f2 fs ...)))] + (for/list ([x (in-syntax #'(f1 f2 fs ...))] #:unless (subtypeof? x -Flonum)) x))) ;; If an optimization was expected (whether it was safe or not doesn't matter), @@ -158,7 +157,7 @@ (define extra-precision-subexprs (filter values - (for/list ([subexpr (in-list (syntax->list #'(f1 f2 fs ...)))] + (for/list ([subexpr (in-syntax #'(f1 f2 fs ...))] #:when (or (and (in-real-layer? subexpr) ;; exclude single-flonums (not (subtypeof? subexpr -InexactReal))) @@ -173,7 +172,7 @@ ;; if a subexpression has any float args, it will be reported as a ;; float-real mix missed opt, so this report would be redundant - #:when (for/and ([s (in-list (syntax->list #'(args ...)))]) + #:when (for/and ([s (in-syntax #'(args ...))]) (not (in-float-layer? s))) #'e] [_ #f])))) diff --git a/collects/typed-racket/optimizer/unboxed-let.rkt b/collects/typed-racket/optimizer/unboxed-let.rkt index 86d0e6574f..fc9a5de3da 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 +(require syntax/parse unstable/syntax unstable/sequence racket/list racket/dict racket/match "../utils/utils.rkt" "../utils/tc-utils.rkt" @@ -135,12 +135,9 @@ 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 ...)))) - (r (in-list (syntax->list - #'(opt-candidates.real-binding ...)))) - (i (in-list (syntax->list - #'(opt-candidates.imag-binding ...))))) + (for ((v (in-syntax #'(opt-candidates.id ...))) + (r (in-syntax #'(opt-candidates.real-binding ...))) + (i (in-syntax #'(opt-candidates.imag-binding ...)))) (dict-set! unboxed-vars-table v (list r i v))) ;; in the case where no bindings are unboxed, we create a let ;; that is equivalent to the original, but with all parts diff --git a/collects/typed-racket/optimizer/utils.rkt b/collects/typed-racket/optimizer/utils.rkt index 092aa381ea..21364041ea 100644 --- a/collects/typed-racket/optimizer/utils.rkt +++ b/collects/typed-racket/optimizer/utils.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require unstable/match racket/match +(require unstable/match racket/match unstable/sequence racket/dict syntax/id-table racket/syntax unstable/syntax "../utils/utils.rkt" (for-template racket/base) @@ -44,7 +44,7 @@ ;; this works on operations that are (A A -> A) (define (n-ary->binary op arg1 arg2 rest) (for/fold ([o arg1]) - ([e (in-list (syntax->list #`(#,arg2 #,@rest)))]) + ([e (in-syntax #`(#,arg2 #,@rest))]) #`(#,op #,o #,e))) ;; this works on operations that are (A A -> B) (define (n-ary-comp->binary op arg1 arg2 rest) @@ -63,7 +63,7 @@ (cdr l))]))) ;; Finally, build the whole thing. #`(let #,(for/list ([lhs (in-list lifted)] - [rhs (in-list (syntax->list #`(#,arg2 #,@rest)))]) + [rhs (in-syntax #`(#,arg2 #,@rest))]) #`(#,lhs #,rhs)) (and #,@tests))) diff --git a/collects/typed-racket/private/parse-type.rkt b/collects/typed-racket/private/parse-type.rkt index 4e4a14718c..18c6dbc336 100644 --- a/collects/typed-racket/private/parse-type.rkt +++ b/collects/typed-racket/private/parse-type.rkt @@ -8,7 +8,7 @@ [make-arr* make-arr]) (utils tc-utils stxclass-util) syntax/stx (prefix-in c: (contract-req)) - syntax/parse racket/dict + syntax/parse racket/dict unstable/sequence (env type-env-structs tvar-env type-name-env type-alias-env lexical-env index-env) racket/match @@ -47,7 +47,7 @@ (pattern (type)) (pattern (x ...) #:fail-unless (= 1 (length - (for/list ([i (in-list (syntax->list #'(x ...)))] + (for/list ([i (in-syntax #'(x ...))] #:when (and (identifier? i) (free-identifier=? i #'t:->))) i))) #f @@ -172,10 +172,10 @@ (map list (map syntax-e (syntax->list #'(fname ...))) (map parse-type (syntax->list #'(fty ...))) - (map (lambda (e) (syntax-case e () - [(#t) #t] - [_ #f])) - (syntax->list #'(rest ...)))) + (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 ...)))))] @@ -217,7 +217,7 @@ [((~and kw (~or case-lambda t:case->)) tys ...) (add-disappeared-use #'kw) (make-Function - (for/list ([ty (syntax->list #'(tys ...))]) + (for/list ([ty (in-syntax #'(tys ...))]) (let ([t (parse-type ty)]) (match t [(Function: (list arr)) arr] @@ -278,8 +278,8 @@ (~and kw t:->) (~and (~seq rest-dom ...) (~seq (~or _ (~between t:-> 1 +inf.0)) ...))) (add-disappeared-use #'kw) - (let ([doms (for/list ([d (syntax->list #'(dom ...))]) - (parse-type d))]) + (let ([doms (for/list ([d (in-syntax #'(dom ...))]) + (parse-type d))]) (make-Function (list (make-arr doms @@ -334,7 +334,7 @@ ;; use expr to rule out keywords [(dom:non-keyword-ty ... kws:keyword-tys ... (~and kw t:->) rng) (add-disappeared-use #'kw) - (let ([doms (for/list ([d (syntax->list #'(dom ...))]) + (let ([doms (for/list ([d (in-syntax #'(dom ...))]) (parse-type d))]) (make-Function (list (make-arr diff --git a/collects/typed-racket/private/with-types.rkt b/collects/typed-racket/private/with-types.rkt index 02c818b74b..0ad1f98128 100644 --- a/collects/typed-racket/private/with-types.rkt +++ b/collects/typed-racket/private/with-types.rkt @@ -32,15 +32,15 @@ (tc-error/stx stx "Type ~a could not be converted to a contract." t)) (set-box! typed-context? #t) (init) - (define fv-types (for/list ([t (in-list (syntax->list fvtys))]) + (define fv-types (for/list ([t (in-syntax fvtys)]) (parse-type t))) (define fv-cnts (for/list ([t (in-list fv-types)] - [stx (in-list (syntax->list fvtys))]) + [stx (in-syntax fvtys)]) (type->contract t #:typed-side #f (no-contract t)))) - (define ex-types (for/list ([t (in-list (syntax->list extys))]) + (define ex-types (for/list ([t (in-syntax extys)]) (parse-type t))) (define ex-cnts (for/list ([t (in-list ex-types)] - [stx (in-list (syntax->list extys))]) + [stx (in-syntax extys)]) (type->contract t #:typed-side #t (no-contract t)))) (define region-tc-result (and expr? (parse-tc-results resty))) @@ -55,7 +55,7 @@ t #:typed-side #t (no-contract t #'region-ty-stx)))]) null)) - (for ([i (in-list (syntax->list fvids))] + (for ([i (in-syntax fvids)] [ty (in-list fv-types)]) (register-type i ty)) (define expanded-body @@ -87,7 +87,7 @@ (report-all-errors) (set-box! typed-context? old-context) ;; then clear the new entries from the env ht - (for ([i (in-list (syntax->list fvids))]) + (for ([i (in-syntax fvids)]) (unregister-type i)) (with-syntax ([(fv.id ...) fvids] [(cnt ...) fv-cnts] diff --git a/collects/typed-racket/typecheck/provide-handling.rkt b/collects/typed-racket/typecheck/provide-handling.rkt index fa763728e0..9ca5b1d132 100644 --- a/collects/typed-racket/typecheck/provide-handling.rkt +++ b/collects/typed-racket/typecheck/provide-handling.rkt @@ -1,7 +1,7 @@ #lang racket/base (require "../utils/utils.rkt" - unstable/list syntax/id-table racket/dict racket/syntax + unstable/list unstable/sequence syntax/id-table racket/dict racket/syntax racket/struct-info racket/match syntax/parse syntax/location (only-in srfi/1/list s:member) (only-in (private type-contract) type->contract) @@ -21,7 +21,9 @@ [_ #f])) (define (remove-provides forms) - (filter (lambda (e) (not (provide? e))) (syntax->list forms))) + (for/list ([e (in-syntax forms)] + #:unless (provide? e)) + e)) (define (mem? i vd) (cond [(s:member i vd (lambda (i j) (free-identifier=? i (binding-name j)))) => car] diff --git a/collects/typed-racket/typecheck/tc-app-helper.rkt b/collects/typed-racket/typecheck/tc-app-helper.rkt index 8139071ec0..b13ffa385b 100644 --- a/collects/typed-racket/typecheck/tc-app-helper.rkt +++ b/collects/typed-racket/typecheck/tc-app-helper.rkt @@ -32,7 +32,7 @@ (tc-error/expr #:return error-ret "Wrong number of arguments, expected at least ~a and got ~a" (length dom) (length t-a))]) (for ([dom-t (if rest (in-sequence-forever dom rest) (in-list dom))] - [a (in-list (syntax->list args-stx))] + [a (in-syntax args-stx)] [arg-t (in-list t-a)]) (parameterize ([current-orig-stx a]) (check-below arg-t dom-t)))) (let* ([dom-count (length dom)] 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 97d87cab04..c320d156f5 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 + syntax/parse racket/match unstable/sequence syntax/parse/experimental/reflect "signatures.rkt" "utils.rkt" @@ -107,16 +107,16 @@ (pattern (~and form ((~or vector-immutable vector) args:expr ...)) (match expected [(tc-result1: (app resolve (Vector: t))) - (define es (syntax->list #'(args ...))) - (for ([e (in-list es)]) - (tc-expr/check e (ret t))) - (ret (make-HeterogeneousVector (map (λ (_) t) es)))] + (ret (make-HeterogeneousVector + (for/list ([e (in-syntax #'(args ...))]) + (tc-expr/check e (ret t)) + t)))] [(tc-result1: (app resolve (HeterogeneousVector: ts))) (unless (= (length ts) (length (syntax->list #'(args ...)))) (tc-error/expr "expected vector with ~a elements, but got ~a" (length ts) (make-HeterogeneousVector (map tc-expr/t (syntax->list #'(args ...)))))) - (for ([e (in-list (syntax->list #'(args ...)))] + (for ([e (in-syntax #'(args ...))] [t (in-list ts)]) (tc-expr/check e (ret t))) expected] @@ -133,6 +133,7 @@ [_ (continue)])] ;; since vectors are mutable, if there is no expected type, we want to generalize the element type [(or #f (tc-any-results:) (tc-result1: _)) - (ret (make-HeterogeneousVector (map (lambda (x) (generalize (tc-expr/t x))) - (syntax->list #'(args ...)))))] + (ret (make-HeterogeneousVector + (for/list ((e (in-syntax #'(args ...)))) + (generalize (tc-expr/t e)))))] [_ (int-err "bad expected: ~a" expected)]))) diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt index 7f993f88f9..7b1a0111dd 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt +++ b/collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt @@ -69,7 +69,7 @@ (generalize (tc-expr/t ac)))))] [ts (cons ts1 ann-ts)]) ;; check that the actual arguments are ok here - (for/list ([a (in-list (syntax->list #'(actuals ...)))] + (for/list ([a (in-syntax #'(actuals ...))] [t (in-list ann-ts)]) (tc-expr/check a (ret t))) ;; then check that the function typechecks with the inferred types @@ -80,8 +80,8 @@ ((~and inner-body (if e1 e2 e3:id))) (null actuals ...)) #:when (free-identifier=? #'val #'e3) - (let ([ts (for/list ([ac (in-list (syntax->list #'(actuals ...)))] - [f (in-list (syntax->list #'(acc ...)))]) + (let ([ts (for/list ([ac (in-syntax #'(actuals ...))] + [f (in-syntax #'(acc ...))]) (let ([type (type-annotation f #:infer #t)]) (if type (tc-expr/check/t ac (ret type)) @@ -96,8 +96,8 @@ expected)] ;; special case when argument needs inference [(_ body* _) - (let ([ts (for/list ([ac (in-list (syntax->list actuals))] - [f (in-list (syntax->list args))]) + (let ([ts (for/list ([ac (in-syntax actuals)] + [f (in-syntax args)]) (let* ([infer-t (or (type-annotation f #:infer #t) (find-annotation #'(begin . body*) f))]) (if infer-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 f3c78a0d1a..c9b2824bf7 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 + syntax/parse racket/match unstable/sequence syntax/parse/experimental/reflect (only-in '#%kernel [reverse k:reverse]) (typecheck signatures tc-funapp) @@ -81,13 +81,13 @@ (pattern (list . args) (match expected [(tc-result1: (Listof: elem-ty)) - (for ([i (in-list (syntax->list #'args))]) + (for ([i (in-syntax #'args)]) (tc-expr/check i (ret elem-ty))) expected] [(tc-result1: (List: (? (lambda (ts) (= (length (syntax->list #'args)) (length ts))) ts))) - (for ([ac (in-list (syntax->list #'args))] + (for ([ac (in-syntax #'args)] [exp (in-list ts)]) (tc-expr/check ac (ret exp))) expected] diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-values.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-values.rkt index 0ef1e23c03..a041cbbe38 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-values.rkt +++ b/collects/typed-racket/typecheck/tc-app/tc-app-values.rkt @@ -3,7 +3,7 @@ (require "../../utils/utils.rkt" "signatures.rkt" "utils.rkt" - syntax/parse racket/match + syntax/parse racket/match unstable/sequence syntax/parse/experimental/reflect (typecheck signatures tc-funapp) (types abbrev utils) @@ -45,7 +45,7 @@ (match expected [(tc-results: ets efs eos) (match-let ([(list (tc-result1: ts fs os) ...) - (for/list ([arg (in-list (syntax->list #'args))] + (for/list ([arg (in-syntax #'args)] [et (in-list ets)] [ef (in-list efs)] [eo (in-list eos)]) @@ -55,6 +55,6 @@ (tc-error/expr #:return expected "wrong number of values: expected ~a but got ~a" (length ets) (length (syntax->list #'args)))))] [_ (match-let ([(list (tc-result1: ts fs os) ...) - (for/list ([arg (in-list (syntax->list #'args))]) + (for/list ([arg (in-syntax #'args)]) (single-value arg))]) (ret ts fs os))]))) diff --git a/collects/typed-racket/typecheck/tc-toplevel.rkt b/collects/typed-racket/typecheck/tc-toplevel.rkt index 6563961cfc..fea45b5abd 100644 --- a/collects/typed-racket/typecheck/tc-toplevel.rkt +++ b/collects/typed-racket/typecheck/tc-toplevel.rkt @@ -1,8 +1,8 @@ #lang racket/base (require (rename-in "../utils/utils.rkt" [infer r:infer]) - syntax/kerncase racket/syntax syntax/parse syntax/id-table - racket/list unstable/list racket/dict racket/match + syntax/kerncase racket/syntax syntax/parse syntax/stx syntax/id-table + racket/list unstable/list racket/dict racket/match unstable/sequence (prefix-in c: (contract-req)) (rep type-rep free-variance) (types utils abbrev type-table) @@ -233,23 +233,19 @@ ;; definitions just need to typecheck their bodies [(define-values (var ...) expr) - (let* ([vars (syntax->list #'(var ...))] - [ts (map lookup-type vars)]) - (unless (for/and ([v (in-list (syntax->list #'(var ...)))]) - (free-id-table-ref unann-defs v (lambda _ #f))) - (when (= 1 (length vars)) - (add-scoped-tvars #'expr (lookup-scoped-tvars (first vars)))) - (tc-expr/check #'expr (ret ts))) - (void))] + (unless (for/and ([v (in-syntax #'(var ...))]) + (free-id-table-ref unann-defs v (lambda _ #f))) + (let ([ts (map lookup-type (syntax->list #'(var ...)))]) + (when (= 1 (length ts)) + (add-scoped-tvars #'expr (lookup-scoped-tvars (stx-car #'(var ...))))) + (tc-expr/check #'expr (ret ts)))) + (void)] ;; to handle the top-level, we have to recur into begins [(begin) (void)] [(begin . rest) - (let loop ([l (syntax->list #'rest)]) - (if (null? (cdr l)) - (tc-toplevel/pass2 (car l)) - (begin (tc-toplevel/pass2 (car l)) - (loop (cdr l)))))] + (for/last ([form (in-syntax #'rest)]) + (tc-toplevel/pass2 form))] ;; otherwise, the form was just an expression [_ (tc-expr/check form tc-any-results)]))) @@ -354,7 +350,7 @@ (~datum expand))))) (syntax-parse p #:literals (#%provide) [(#%provide form ...) - (for/fold ([h h]) ([f (in-list (syntax->list #'(form ...)))]) + (for/fold ([h h]) ([f (in-syntax #'(form ...))]) (parameterize ([current-orig-stx f]) (syntax-parse f [i:id @@ -418,7 +414,7 @@ ;; Don't open up `begin`s that are supposed to be ignored #:when (not (or (ignore-property form) (ignore-some-property form))) (define result - (for/last ([form (in-list (syntax->list #'(e ...)))]) + (for/last ([form (in-syntax #'(e ...))]) (define-values (_ result) (tc-toplevel-form form)) result)) (begin0 (values #f (or result (void))) diff --git a/collects/typed-racket/types/subtype.rkt b/collects/typed-racket/types/subtype.rkt index 534aa96362..60aadd88cc 100644 --- a/collects/typed-racket/types/subtype.rkt +++ b/collects/typed-racket/types/subtype.rkt @@ -6,7 +6,7 @@ (utils tc-utils) (types utils resolve base-abbrev match-expanders numeric-tower substitute current-seen) - (for-syntax racket/base syntax/parse)) + (for-syntax racket/base syntax/parse unstable/sequence)) (lazy-require ("union.rkt" (Un)) @@ -66,10 +66,10 @@ [(_ init (s:sub* . args) ...+) (with-syntax ([(A* ... A-last) (generate-temporaries #'(s ...))]) (with-syntax ([(clauses ...) - (for/list ([s (in-list (syntax->list #'(s ...)))] - [args (in-list (syntax->list #'(args ...)))] - [A (in-list (syntax->list #'(init A* ...)))] - [A-next (in-list (syntax->list #'(A* ... A-last)))]) + (for/list ([s (in-syntax #'(s ...))] + [args (in-syntax #'(args ...))] + [A (in-syntax #'(init A* ...))] + [A-next (in-syntax #'(A* ... A-last))]) #`[#,A-next (#,s #,A . #,args)])]) (syntax/loc stx (let*/and (clauses ...) A-last))))])) diff --git a/collects/typed-racket/utils/mutated-vars.rkt b/collects/typed-racket/utils/mutated-vars.rkt index 3b3162bfd2..a8e53f032e 100644 --- a/collects/typed-racket/utils/mutated-vars.rkt +++ b/collects/typed-racket/utils/mutated-vars.rkt @@ -1,7 +1,7 @@ #lang racket/base (require (for-template racket/base) racket/dict - syntax/id-table syntax/kerncase) + syntax/id-table syntax/kerncase unstable/sequence) ;; find and add to mapping all the set!'ed variables in form ;; if the supplied mapping is mutable, mutates it @@ -14,8 +14,7 @@ (let loop ([stx form] [tbl tbl]) ;; syntax-list -> table (define (fmv/list lstx) - (for/fold ([tbl tbl]) - ([stx (in-list (syntax->list lstx))]) + (for/fold ([tbl tbl]) ([stx (in-syntax lstx)]) (loop stx tbl))) (kernel-syntax-case* stx #f (#%top-interaction) ;; what we care about: set! diff --git a/collects/typed-racket/utils/utils.rkt b/collects/typed-racket/utils/utils.rkt index 10fc2ec5cf..19f1463ee5 100644 --- a/collects/typed-racket/utils/utils.rkt +++ b/collects/typed-racket/utils/utils.rkt @@ -5,7 +5,7 @@ This file is for utilities that are of general interest, at least theoretically. |# -(require (for-syntax racket/base syntax/parse racket/string) +(require (for-syntax racket/base syntax/parse racket/string unstable/sequence) racket/require-syntax racket/provide-syntax racket/struct-info "timing.rkt") @@ -42,20 +42,19 @@ at least theoretically. (syntax-parse stx [(form id:identifier ...) (with-syntax ([(id* ...) - (map (lambda (id) - (datum->syntax - id - `(lib - ,(datum->syntax - #f - (string-join - (list "typed-racket" - (symbol->string (syntax-e #'nm)) - (string-append (symbol->string (syntax-e id)) ".rkt")) - "/") - id id)) - id id)) - (syntax->list #'(id ...)))]) + (for/list ([id (in-syntax #'(id ...))]) + (datum->syntax + id + `(lib + ,(datum->syntax + #f + (string-join + (list "typed-racket" + (symbol->string (syntax-e #'nm)) + (string-append (symbol->string (syntax-e id)) ".rkt")) + "/") + id id)) + id id))]) (syntax-property (syntax/loc stx (combine-in id* ...)) 'disappeared-use #'form))])) @@ -63,19 +62,18 @@ at least theoretically. (syntax-parse stx [(_ id:identifier ...) (with-syntax ([(id* ...) - (map (lambda (id) - (datum->syntax - id - `(lib - ,(datum->syntax - #f - (string-join - (list "typed-racket" - (symbol->string (syntax-e #'nm)) - (string-append (symbol->string (syntax-e id)) ".rkt")) - "/") - id id)))) - (syntax->list #'(id ...)))]) + (for/list ([id (in-syntax #'(id ...))]) + (datum->syntax + id + `(lib + ,(datum->syntax + #f + (string-join + (list "typed-racket" + (symbol->string (syntax-e #'nm)) + (string-append (symbol->string (syntax-e id)) ".rkt")) + "/") + id id))))]) (syntax/loc stx (combine-out (all-from-out id*) ...)))])) (provide nm nm-out)))]))