From 88ff5fee69ecf58527bb76923f4d4fd91aaa1967 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 25 Jun 2012 14:51:54 -0400 Subject: [PATCH] Minor refactorings. - Remove tracing requires. - Use lists instead of sets in a few environments. - Small cleanups. --- .../unit-tests/parse-type-tests.rkt | 3 +-- .../typed-racket/base-env/type-env-lang.rkt | 8 ++++---- collects/typed-racket/env/index-env.rkt | 10 +++++----- collects/typed-racket/env/init-envs.rkt | 1 + collects/typed-racket/env/tvar-env.rkt | 7 +++---- collects/typed-racket/env/type-alias-env.rkt | 3 +-- collects/typed-racket/env/type-name-env.rkt | 3 +-- collects/typed-racket/infer/infer-dummy.rkt | 2 +- collects/typed-racket/infer/infer-unit.rkt | 2 +- collects/typed-racket/infer/infer.rkt | 1 - collects/typed-racket/infer/restrict.rkt | 2 +- collects/typed-racket/minimal.rkt | 4 ++-- .../typed-racket/private/type-annotation.rkt | 2 +- .../typed-racket/private/type-contract.rkt | 2 +- .../typed-racket/private/typed-renaming.rkt | 20 ------------------- collects/typed-racket/rep/type-rep.rkt | 2 +- .../typed-racket/typecheck/def-export.rkt | 4 ++-- .../typecheck/find-annotation.rkt | 3 --- .../typecheck/provide-handling.rkt | 5 ++--- collects/typed-racket/typecheck/renamer.rkt | 20 ++++++++++++++++--- collects/typed-racket/typecheck/tc-app.rkt | 2 +- collects/typed-racket/typecheck/tc-envops.rkt | 2 +- collects/typed-racket/typecheck/tc-if.rkt | 1 - .../typed-racket/typecheck/tc-lambda-unit.rkt | 2 +- .../typed-racket/typecheck/tc-let-unit.rkt | 1 - .../typed-racket/typecheck/tc-structs.rkt | 4 +--- collects/typed-racket/types/convenience.rkt | 1 - collects/typed-racket/types/filter-ops.rkt | 1 - .../typed-racket/types/remove-intersect.rkt | 2 +- collects/typed-racket/types/type-table.rkt | 1 + .../typed-racket/utils/require-contract.rkt | 2 +- collects/typed-racket/utils/tc-utils.rkt | 1 + 32 files changed, 53 insertions(+), 71 deletions(-) delete mode 100644 collects/typed-racket/private/typed-renaming.rkt 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 7c345193bb..2f7883006b 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 452738467e..618e0ae33f 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 7e98e713b6..d50dbd2a9c 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 30e5406a06..f87da20417 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 6516e2a9f5..c8dd82d7f5 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 5d40bfb013..62fcb9cbc9 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 a1811661a0..1003822417 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-dummy.rkt b/collects/typed-racket/infer/infer-dummy.rkt index 9d412aed87..3fc72dbf7a 100644 --- a/collects/typed-racket/infer/infer-dummy.rkt +++ b/collects/typed-racket/infer/infer-dummy.rkt @@ -1,7 +1,7 @@ #lang racket/base (require "../utils/utils.rkt") -(require (rep type-rep) (utils tc-utils) mzlib/trace) +(require (rep type-rep) (utils tc-utils)) (define infer-param (make-parameter (lambda e (int-err "infer not initialized")))) (define (unify X S T) ((infer-param) X null S T (make-Univ))) diff --git a/collects/typed-racket/infer/infer-unit.rkt b/collects/typed-racket/infer/infer-unit.rkt index e9bc2f2495..69fc411f26 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 ccf9f1ad58..d760db89ca 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 0800ca5c7a..27ec40ea66 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 e5de966449..45599a0b1f 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 ba37dee8b2..e6ac2e5685 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 928ff129f9..a6b82e9a13 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/private/typed-renaming.rkt b/collects/typed-racket/private/typed-renaming.rkt deleted file mode 100644 index 9310827fd7..0000000000 --- a/collects/typed-racket/private/typed-renaming.rkt +++ /dev/null @@ -1,20 +0,0 @@ -#lang racket/base - -(require (for-syntax racket/base)) - -(provide make-typed-renaming get-alternate) - -;; 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 (lambda _ (values #f #f)))) - (cond [(typed-renaming? v) - (typed-renaming-alternate v)] - [(rename-transformer? v) - (get-alternate (rename-transformer-target v))] - [else id])) diff --git a/collects/typed-racket/rep/type-rep.rkt b/collects/typed-racket/rep/type-rep.rkt index eb637381d4..8a8664625c 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 57d092e062..f354db5d3b 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 36f148362b..c5aa37f101 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 27c47ede3c..f105c56903 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 577e661610..58c6863baf 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 0a304d695e..13c872eb8b 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 88a19af86c..fe64ee0a4a 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 0f0eda8817..1e67c97f3b 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 35b40f29ff..d2ca1f83e8 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 85807d7f25..5d21804511 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 5158a88cd5..be1ac69a8a 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/convenience.rkt b/collects/typed-racket/types/convenience.rkt index 4645f59a87..4a0a9198e4 100644 --- a/collects/typed-racket/types/convenience.rkt +++ b/collects/typed-racket/types/convenience.rkt @@ -7,7 +7,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/filter-ops.rkt b/collects/typed-racket/types/filter-ops.rkt index 61b46e3882..e24e336b66 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 ea5e93f1b8..0cd68b852e 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 acbab23847..6df1d2a6f2 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 d3baf9b08b..411cef5b22 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 36820309e0..cef97c8401 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)