diff --git a/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt b/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt index 7c345193..2f788300 100644 --- a/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt @@ -1,6 +1,5 @@ #lang scheme/base (require "test-utils.rkt" (for-syntax scheme/base) - racket/set (utils tc-utils) (env type-alias-env type-env-structs tvar-env type-name-env init-envs) (rep type-rep) @@ -108,7 +107,7 @@ [(Listof Number) (make-Listof N)] - [a (-v a) (set-add initial-tvar-env 'a)] + [a (-v a) (cons 'a initial-tvar-env)] [(All (a ...) (a ... -> Number)) (-polydots (a) ((list) [a a] . ->... . N))] diff --git a/collects/typed-racket/base-env/type-env-lang.rkt b/collects/typed-racket/base-env/type-env-lang.rkt index 45273846..618e0ae3 100644 --- a/collects/typed-racket/base-env/type-env-lang.rkt +++ b/collects/typed-racket/base-env/type-env-lang.rkt @@ -8,14 +8,14 @@ (define-syntax (#%module-begin stx) (syntax-parse stx #:literals (require provide) - [(mb (require . args) ... (provide . args2) ... [nm ty] ...) - (unless (andmap identifier? (syntax->list #'(nm ...))) - (raise-syntax-error #f "not all ids")) + [(mb (require . args) ... (provide . args2) ... [nm:id ty] ...) #'(#%plain-module-begin (begin (require . args) ... (provide . args2) ... - (define-syntax nm (lambda (stx) (raise-syntax-error 'type-check "type name used out of context" stx))) ... + (define-syntax (nm stx) + (raise-syntax-error 'type-check "type name used out of context" stx)) + ... (provide nm) ... (begin-for-syntax (initialize-type-name-env diff --git a/collects/typed-racket/env/index-env.rkt b/collects/typed-racket/env/index-env.rkt index 7e98e713..d50dbd2a 100644 --- a/collects/typed-racket/env/index-env.rkt +++ b/collects/typed-racket/env/index-env.rkt @@ -6,24 +6,24 @@ ;; to types representing the type variable ;; technically, the mapped-to type is unnecessary, but it's convenient to have it around? maybe? -(require racket/require racket/set (path-up "utils/tc-utils.rkt")) +(require "../utils/tc-utils.rkt") (provide (all-defined-out)) ;; the initial type variable environment - empty ;; this is used in the parsing of types -(define initial-index-env (seteq)) +(define initial-index-env (list)) ;; a parameter for the current type variables (define current-indexes (make-parameter initial-index-env)) ;; takes a single index (define-syntax-rule (extend-indexes index . body) - (parameterize ([current-indexes (set-add (current-indexes) index)]) . body)) + (parameterize ([current-indexes (cons index (current-indexes))]) . body)) -(define (bound-index? v) (set-member? (current-indexes) v)) +(define (bound-index? v) (memq v (current-indexes))) (define (infer-index stx) - (define bounds (set-map (current-indexes) values)) + (define bounds (current-indexes)) (when (null? bounds) (tc-error/stx stx "No type variable bound with ... in scope for ... type")) (unless (null? (cdr bounds)) diff --git a/collects/typed-racket/env/init-envs.rkt b/collects/typed-racket/env/init-envs.rkt index 30e5406a..f87da204 100644 --- a/collects/typed-racket/env/init-envs.rkt +++ b/collects/typed-racket/env/init-envs.rkt @@ -9,6 +9,7 @@ (types union) racket/shared racket/base) (types union convenience) + racket/syntax mzlib/pconvert racket/match) (define (initialize-type-name-env initial-type-names) diff --git a/collects/typed-racket/env/tvar-env.rkt b/collects/typed-racket/env/tvar-env.rkt index 6516e2a9..c8dd82d7 100644 --- a/collects/typed-racket/env/tvar-env.rkt +++ b/collects/typed-racket/env/tvar-env.rkt @@ -7,18 +7,17 @@ ;; to types representing the type variable ;; technically, the mapped-to type is unnecessary, but it's convenient to have it around? maybe? -(require racket/set) (provide (all-defined-out)) ;; the initial type variable environment - empty ;; this is used in the parsing of types -(define initial-tvar-env (seteq)) +(define initial-tvar-env (list)) ;; a parameter for the current type variables (define current-tvars (make-parameter initial-tvar-env)) ;; takes a list of vars (define-syntax-rule (extend-tvars vars . body) - (parameterize ([current-tvars (foldr (λ (v s) (set-add s v)) (current-tvars) vars)]) . body)) + (parameterize ([current-tvars (append vars (current-tvars))]) . body)) -(define (bound-tvar? v) (set-member? (current-tvars) v)) +(define (bound-tvar? v) (memq v (current-tvars))) diff --git a/collects/typed-racket/env/type-alias-env.rkt b/collects/typed-racket/env/type-alias-env.rkt index 5d40bfb0..62fcb9cb 100644 --- a/collects/typed-racket/env/type-alias-env.rkt +++ b/collects/typed-racket/env/type-alias-env.rkt @@ -2,8 +2,7 @@ (require "../utils/utils.rkt" syntax/boundmap - (utils tc-utils) - mzlib/trace + (utils tc-utils) racket/match) (provide register-type-alias diff --git a/collects/typed-racket/env/type-name-env.rkt b/collects/typed-racket/env/type-name-env.rkt index a1811661..10038224 100644 --- a/collects/typed-racket/env/type-name-env.rkt +++ b/collects/typed-racket/env/type-name-env.rkt @@ -1,8 +1,7 @@ #lang racket/base (require "../utils/utils.rkt") -(require syntax/boundmap - mzlib/trace +(require syntax/boundmap (env type-alias-env) (utils tc-utils) (rep type-rep) diff --git a/collects/typed-racket/infer/infer-unit.rkt b/collects/typed-racket/infer/infer-unit.rkt index e9bc2f24..69fc411f 100644 --- a/collects/typed-racket/infer/infer-unit.rkt +++ b/collects/typed-racket/infer/infer-unit.rkt @@ -13,7 +13,7 @@ "signatures.rkt" racket/match mzlib/etc - racket/trace racket/contract + racket/contract unstable/sequence unstable/list unstable/hash racket/list) diff --git a/collects/typed-racket/infer/infer.rkt b/collects/typed-racket/infer/infer.rkt index ccf9f1ad..d760db89 100644 --- a/collects/typed-racket/infer/infer.rkt +++ b/collects/typed-racket/infer/infer.rkt @@ -3,7 +3,6 @@ (require (except-in "../utils/utils.rkt" infer)) (require "infer-unit.rkt" "constraints.rkt" "dmap.rkt" "signatures.rkt" "restrict.rkt" "promote-demote.rkt" - racket/trace (only-in racket/unit provide-signature-elements define-values/invoke-unit/infer link)) diff --git a/collects/typed-racket/infer/restrict.rkt b/collects/typed-racket/infer/restrict.rkt index 0800ca5c..27ec40ea 100644 --- a/collects/typed-racket/infer/restrict.rkt +++ b/collects/typed-racket/infer/restrict.rkt @@ -4,7 +4,7 @@ (require (rep type-rep) (types utils union subtype remove-intersect resolve substitute abbrev) "signatures.rkt" - racket/match mzlib/trace) + racket/match) (import infer^) (export restrict^) diff --git a/collects/typed-racket/minimal.rkt b/collects/typed-racket/minimal.rkt index e5de9664..45599a0b 100644 --- a/collects/typed-racket/minimal.rkt +++ b/collects/typed-racket/minimal.rkt @@ -1,9 +1,9 @@ #lang racket/base (provide #%module-begin provide require rename-in rename-out prefix-in only-in all-from-out except-out except-in - providing begin subtract-in) + providing begin) -(require (for-syntax racket/base) racket/require) +(require (for-syntax racket/base)) (define-for-syntax ts-mod 'typed-racket/typed-racket) diff --git a/collects/typed-racket/private/type-annotation.rkt b/collects/typed-racket/private/type-annotation.rkt index ba37dee8..e6ac2e56 100644 --- a/collects/typed-racket/private/type-annotation.rkt +++ b/collects/typed-racket/private/type-annotation.rkt @@ -7,7 +7,7 @@ (except-in (types subtype union convenience resolve utils comparison) -> ->* one-of/c) (private parse-type) (contract-req) - racket/match mzlib/trace) + racket/match) (provide type-annotation get-type diff --git a/collects/typed-racket/private/type-contract.rkt b/collects/typed-racket/private/type-contract.rkt index 928ff129..a6b82e9a 100644 --- a/collects/typed-racket/private/type-contract.rkt +++ b/collects/typed-racket/private/type-contract.rkt @@ -12,7 +12,7 @@ (types resolve utils) (prefix-in t: (types convenience abbrev)) (private parse-type) - racket/match unstable/match syntax/struct syntax/stx mzlib/trace racket/syntax racket/list + racket/match unstable/match syntax/struct syntax/stx racket/syntax racket/list (only-in racket/contract -> ->* case-> cons/c flat-rec-contract provide/contract any/c) (for-template racket/base racket/contract racket/set (utils any-wrap) (prefix-in t: (types numeric-predicates)) diff --git a/collects/typed-racket/rep/type-rep.rkt b/collects/typed-racket/rep/type-rep.rkt index eb637381..8a866462 100644 --- a/collects/typed-racket/rep/type-rep.rkt +++ b/collects/typed-racket/rep/type-rep.rkt @@ -3,7 +3,7 @@ (require (utils tc-utils) "rep-utils.rkt" "object-rep.rkt" "filter-rep.rkt" "free-variance.rkt" - mzlib/trace racket/match mzlib/etc + racket/match mzlib/etc racket/contract (for-syntax racket/base syntax/parse)) diff --git a/collects/typed-racket/typecheck/def-export.rkt b/collects/typed-racket/typecheck/def-export.rkt index 57d092e0..f354db5d 100644 --- a/collects/typed-racket/typecheck/def-export.rkt +++ b/collects/typed-racket/typecheck/def-export.rkt @@ -10,12 +10,12 @@ [(def-export export-id:identifier id:identifier cnt-id:identifier) #'(define-syntax export-id (if (unbox typed-context?) - (renamer #'id #:alt #'cnt-id) + (renamer #'id #'cnt-id) (renamer #'cnt-id)))] [(def-export export-id:identifier id:identifier cnt-id:identifier #:alias) #'(define-syntax export-id (if (unbox typed-context?) (begin (add-alias #'export-id #'id) - (renamer #'id #:alt #'cnt-id)) + (renamer #'id #'cnt-id)) (renamer #'cnt-id)))])) diff --git a/collects/typed-racket/typecheck/find-annotation.rkt b/collects/typed-racket/typecheck/find-annotation.rkt index 36f14836..c5aa37f1 100644 --- a/collects/typed-racket/typecheck/find-annotation.rkt +++ b/collects/typed-racket/typecheck/find-annotation.rkt @@ -71,6 +71,3 @@ (find #'body))] [e:core-expr (ormap find (syntax->list #'(e.expr ...)))])) - -; (require racket/trace) -; (trace find-annotation) diff --git a/collects/typed-racket/typecheck/provide-handling.rkt b/collects/typed-racket/typecheck/provide-handling.rkt index 27c47ede..f105c569 100644 --- a/collects/typed-racket/typecheck/provide-handling.rkt +++ b/collects/typed-racket/typecheck/provide-handling.rkt @@ -3,10 +3,9 @@ (require "../utils/utils.rkt" (only-in srfi/1/list s:member) syntax/kerncase syntax/boundmap - (env type-name-env type-alias-env) - mzlib/trace + (env type-name-env type-alias-env) (only-in (private type-contract) type->contract) - (private typed-renaming) + "renamer.rkt" (rep type-rep) (utils tc-utils) (for-syntax syntax/parse racket/base) diff --git a/collects/typed-racket/typecheck/renamer.rkt b/collects/typed-racket/typecheck/renamer.rkt index 577e6616..58c6863b 100644 --- a/collects/typed-racket/typecheck/renamer.rkt +++ b/collects/typed-racket/typecheck/renamer.rkt @@ -1,9 +1,23 @@ #lang racket/base -(require "../private/typed-renaming.rkt") -(provide renamer) +(provide renamer get-alternate) -(define (renamer id #:alt [alt #f]) +;; target : identifier +;; alternate : identifier +(define-struct typed-renaming (target alternate) + #:property prop:rename-transformer 0) + +;; identifier -> identifier +;; get the alternate field of the renaming, if it exists +(define (get-alternate id) + (define-values (v new-id) (syntax-local-value/immediate id (λ _ (values #f #f)))) + (cond [(typed-renaming? v) + (typed-renaming-alternate v)] + [(rename-transformer? v) + (get-alternate (rename-transformer-target v))] + [else id])) + +(define (renamer id [alt #f]) (if alt (make-typed-renaming (syntax-property id 'not-free-identifier=? #t) alt) (make-rename-transformer (syntax-property id 'not-free-identifier=? #t)))) diff --git a/collects/typed-racket/typecheck/tc-app.rkt b/collects/typed-racket/typecheck/tc-app.rkt index 0a304d69..13c872eb 100644 --- a/collects/typed-racket/typecheck/tc-app.rkt +++ b/collects/typed-racket/typecheck/tc-app.rkt @@ -4,7 +4,7 @@ "signatures.rkt" "tc-metafunctions.rkt" "check-below.rkt" "tc-app-helper.rkt" "find-annotation.rkt" "tc-funapp.rkt" "tc-subst.rkt" (prefix-in c: racket/contract) - syntax/parse racket/match racket/trace racket/list + syntax/parse racket/match racket/list unstable/sequence unstable/list ;; fixme - don't need to be bound in this phase - only to make tests work racket/bool diff --git a/collects/typed-racket/typecheck/tc-envops.rkt b/collects/typed-racket/typecheck/tc-envops.rkt index 88a19af8..fe64ee0a 100644 --- a/collects/typed-racket/typecheck/tc-envops.rkt +++ b/collects/typed-racket/typecheck/tc-envops.rkt @@ -12,7 +12,7 @@ (only-in (env type-env-structs lexical-env) env? update-type/lexical env-map env-props replace-props) racket/contract racket/match - mzlib/trace unstable/struct + unstable/struct "tc-metafunctions.rkt" (for-syntax racket/base)) diff --git a/collects/typed-racket/typecheck/tc-if.rkt b/collects/typed-racket/typecheck/tc-if.rkt index 0f0eda88..1e67c97f 100644 --- a/collects/typed-racket/typecheck/tc-if.rkt +++ b/collects/typed-racket/typecheck/tc-if.rkt @@ -10,7 +10,6 @@ "tc-envops.rkt" "tc-metafunctions.rkt" (types type-table) syntax/kerncase - racket/trace racket/match) ;; if typechecking diff --git a/collects/typed-racket/typecheck/tc-lambda-unit.rkt b/collects/typed-racket/typecheck/tc-lambda-unit.rkt index 35b40f29..d2ca1f83 100644 --- a/collects/typed-racket/typecheck/tc-lambda-unit.rkt +++ b/collects/typed-racket/typecheck/tc-lambda-unit.rkt @@ -4,7 +4,7 @@ "signatures.rkt" "tc-metafunctions.rkt" "tc-subst.rkt" "check-below.rkt" - mzlib/trace racket/dict + racket/dict racket/list syntax/parse "parse-cl.rkt" racket/syntax unstable/struct syntax/stx (rename-in racket/contract [-> -->] [->* -->*] [one-of/c -one-of/c]) diff --git a/collects/typed-racket/typecheck/tc-let-unit.rkt b/collects/typed-racket/typecheck/tc-let-unit.rkt index 85807d7f..5d218045 100644 --- a/collects/typed-racket/typecheck/tc-let-unit.rkt +++ b/collects/typed-racket/typecheck/tc-let-unit.rkt @@ -8,7 +8,6 @@ (env lexical-env type-alias-env global-env type-env-structs) (rep type-rep) syntax/free-vars - ;racket/trace racket/match (prefix-in c: racket/contract) (except-in racket/contract -> ->* one-of/c) syntax/kerncase syntax/parse unstable/syntax diff --git a/collects/typed-racket/typecheck/tc-structs.rkt b/collects/typed-racket/typecheck/tc-structs.rkt index 5158a88c..be1ac69a 100644 --- a/collects/typed-racket/typecheck/tc-structs.rkt +++ b/collects/typed-racket/typecheck/tc-structs.rkt @@ -8,9 +8,7 @@ (utils tc-utils) "def-binding.rkt" syntax/kerncase - syntax/struct - mzlib/trace - + syntax/struct racket/function racket/match (only-in racket/contract diff --git a/collects/typed-racket/types/filter-ops.rkt b/collects/typed-racket/types/filter-ops.rkt index 61b46e38..e24e336b 100644 --- a/collects/typed-racket/types/filter-ops.rkt +++ b/collects/typed-racket/types/filter-ops.rkt @@ -8,7 +8,6 @@ racket/list racket/match (for-syntax syntax/parse racket/base) syntax/id-table racket/dict - racket/trace (for-template racket/base)) (provide (all-defined-out)) diff --git a/collects/typed-racket/types/remove-intersect.rkt b/collects/typed-racket/types/remove-intersect.rkt index ea5e93f1..0cd68b85 100644 --- a/collects/typed-racket/types/remove-intersect.rkt +++ b/collects/typed-racket/types/remove-intersect.rkt @@ -3,7 +3,7 @@ (require "../utils/utils.rkt" (rep type-rep rep-utils) (types union subtype resolve convenience utils) - racket/match mzlib/trace) + racket/match) (provide (rename-out [*remove remove]) overlap) diff --git a/collects/typed-racket/types/type-table.rkt b/collects/typed-racket/types/type-table.rkt index acbab238..6df1d2a6 100644 --- a/collects/typed-racket/types/type-table.rkt +++ b/collects/typed-racket/types/type-table.rkt @@ -2,6 +2,7 @@ (require syntax/id-table racket/dict racket/match mzlib/pconvert "../utils/utils.rkt" + "../utils/tc-utils.rkt" (contract-req) (rep type-rep object-rep) (types utils union) diff --git a/collects/typed-racket/utils/require-contract.rkt b/collects/typed-racket/utils/require-contract.rkt index d3baf9b0..411cef5b 100644 --- a/collects/typed-racket/utils/require-contract.rkt +++ b/collects/typed-racket/utils/require-contract.rkt @@ -4,7 +4,7 @@ syntax/location (for-syntax racket/base syntax/parse - (prefix-in tr: "../private/typed-renaming.rkt"))) + (prefix-in tr: "../typecheck/renamer.rkt"))) (provide require/contract define-ignored) diff --git a/collects/typed-racket/utils/tc-utils.rkt b/collects/typed-racket/utils/tc-utils.rkt index 36820309..cef97c84 100644 --- a/collects/typed-racket/utils/tc-utils.rkt +++ b/collects/typed-racket/utils/tc-utils.rkt @@ -180,6 +180,7 @@ don't depend on any other portion of the system ;; are we currently expanding in a typed module (or top-level form)? (define typed-context? (box #f)) + ;; list of syntax objects that should count as disappeared uses (define disappeared-use-todo (make-parameter '())) (define (add-disappeared-use t)