Use in-syntax instead of in-list/syntax->list.

(cherry picked from commit 83f38f4d3b)
This commit is contained in:
Eric Dobson 2013-05-24 22:31:50 -07:00 committed by Ryan Culpepper
parent 599f46ad32
commit c4c85ce9c8
18 changed files with 112 additions and 116 deletions

View File

@ -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)

View File

@ -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))]))

View File

@ -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)]

View File

@ -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]))))

View File

@ -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

View File

@ -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)))

View File

@ -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 ()
(for/list ((e (in-syntax #'(rest ...))))
(syntax-case e ()
[(#t) #t]
[_ #f]))
(syntax->list #'(rest ...))))
[_ #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,7 +278,7 @@
(~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 ...))])
(let ([doms (for/list ([d (in-syntax #'(dom ...))])
(parse-type d))])
(make-Function
(list (make-arr
@ -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

View File

@ -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]

View File

@ -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]

View File

@ -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)]

View File

@ -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)])))

View File

@ -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

View File

@ -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]

View File

@ -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))])))

View File

@ -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 ...)))])
(unless (for/and ([v (in-syntax #'(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))]
(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)))

View File

@ -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))))]))

View File

@ -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!

View File

@ -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,7 +42,7 @@ at least theoretically.
(syntax-parse stx
[(form id:identifier ...)
(with-syntax ([(id* ...)
(map (lambda (id)
(for/list ([id (in-syntax #'(id ...))])
(datum->syntax
id
`(lib
@ -54,8 +54,7 @@ at least theoretically.
(string-append (symbol->string (syntax-e id)) ".rkt"))
"/")
id id))
id id))
(syntax->list #'(id ...)))])
id id))])
(syntax-property (syntax/loc stx (combine-in id* ...))
'disappeared-use
#'form))]))
@ -63,7 +62,7 @@ at least theoretically.
(syntax-parse stx
[(_ id:identifier ...)
(with-syntax ([(id* ...)
(map (lambda (id)
(for/list ([id (in-syntax #'(id ...))])
(datum->syntax
id
`(lib
@ -74,8 +73,7 @@ at least theoretically.
(symbol->string (syntax-e #'nm))
(string-append (symbol->string (syntax-e id)) ".rkt"))
"/")
id id))))
(syntax->list #'(id ...)))])
id id))))])
(syntax/loc stx (combine-out (all-from-out id*) ...)))]))
(provide nm nm-out)))]))