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 2f788300..4cd53296 100644 --- a/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/parse-type-tests.rkt @@ -3,7 +3,7 @@ (utils tc-utils) (env type-alias-env type-env-structs tvar-env type-name-env init-envs) (rep type-rep) - (rename-in (types comparison subtype union utils convenience) + (rename-in (types subtype union utils convenience) [Un t:Un] [-> t:->] [->* t:->*]) (base-env base-types base-types-extra colon) (for-template (base-env base-types base-types-extra base-env colon)) diff --git a/collects/tests/typed-racket/unit-tests/type-equal-tests.rkt b/collects/tests/typed-racket/unit-tests/type-equal-tests.rkt index 969e3983..2436dc08 100644 --- a/collects/tests/typed-racket/unit-tests/type-equal-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/type-equal-tests.rkt @@ -2,7 +2,7 @@ (require "test-utils.rkt" (for-syntax scheme/base) (rep type-rep) - (types comparison abbrev numeric-tower union) + (types abbrev numeric-tower union) rackunit) (provide type-equal-tests) diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index e77d18ce..e021602e 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -1,5 +1,8 @@ #lang racket/base +(require (for-syntax typed-racket/env/global-env) typed-racket/env/global-env + (for-template typed-racket/env/global-env) + (for-meta 2 typed-racket/env/global-env)) (require "test-utils.rkt" (for-syntax racket/base) (for-template racket/base)) @@ -27,6 +30,8 @@ (env global-env) (base-env base-env-indexing)) racket/file racket/port racket/flonum + (env global-env) + (for-meta 2 (env global-env)) (for-template racket/file racket/port (base-env base-types base-types-extra base-env-indexing)) diff --git a/collects/typed-racket/base-env/base-types.rkt b/collects/typed-racket/base-env/base-types.rkt index 312e401b..876f1e84 100644 --- a/collects/typed-racket/base-env/base-types.rkt +++ b/collects/typed-racket/base-env/base-types.rkt @@ -1,5 +1,12 @@ #lang s-exp "type-env-lang.rkt" +;; This require is necessary, otherwise a somewhat random +;; selection of unit tests fail. +;; +;; I don't understand this at all. :( +;; -- STH, 6/26/12 +(require (for-syntax "../env/global-env.rkt")) + [Complex -Number] [Number -Number] [Inexact-Complex -InexactComplex] diff --git a/collects/typed-racket/base-env/prims.rkt b/collects/typed-racket/base-env/prims.rkt index 1a2312ca..306c0e1a 100644 --- a/collects/typed-racket/base-env/prims.rkt +++ b/collects/typed-racket/base-env/prims.rkt @@ -52,7 +52,6 @@ This file defines two sorts of primitives. All of them are provided into any mod "annotate-classes.rkt" "internal.rkt" "../utils/tc-utils.rkt" - "../env/type-name-env.rkt" "for-clauses.rkt") "../types/numeric-predicates.rkt") (provide index?) ; useful for assert, and racket doesn't have it @@ -207,7 +206,8 @@ This file defines two sorts of primitives. All of them are provided into any mod (pattern #:name-exists)) (syntax-parse stx [(_ ty:id pred:id lib (~optional ne:name-exists-kw) ...) - (register-type-name #'ty (make-Opaque #'pred (syntax-local-certifier))) + ((dynamic-require 'typed-racket/env/type-name-env 'register-type-name) + #'ty (make-Opaque #'pred (syntax-local-certifier))) (with-syntax ([hidden (generate-temporary #'pred)]) (quasisyntax/loc stx (begin diff --git a/collects/typed-racket/base-env/type-env-lang.rkt b/collects/typed-racket/base-env/type-env-lang.rkt index 6458823b..77ce95f7 100644 --- a/collects/typed-racket/base-env/type-env-lang.rkt +++ b/collects/typed-racket/base-env/type-env-lang.rkt @@ -1,8 +1,7 @@ #lang racket/base (require "../utils/utils.rkt" - (for-syntax "../env/global-env.rkt" - racket/base syntax/parse + (for-syntax racket/base syntax/parse (except-in (rep filter-rep type-rep) make-arr) (rename-in (types numeric-tower abbrev convenience)))) @@ -23,7 +22,7 @@ (list (list #'nm ty) ...)))))])) (provide #%module-begin - require + require provide (all-from-out racket/base) (for-syntax (rep-out type-rep) diff --git a/collects/typed-racket/env/global-env.rkt b/collects/typed-racket/env/global-env.rkt index 47b851e0..5f50ff1d 100644 --- a/collects/typed-racket/env/global-env.rkt +++ b/collects/typed-racket/env/global-env.rkt @@ -4,11 +4,10 @@ ;; maps identifiers to their types, updated by mutation (require "../utils/utils.rkt" + "../types/tc-error.rkt" syntax/id-table (rep type-rep) - (utils tc-utils) - (types utils comparison)) - + (utils tc-utils)) (provide register-type register-type-if-undefined finish-register-type maybe-finish-register-type diff --git a/collects/typed-racket/private/type-annotation.rkt b/collects/typed-racket/private/type-annotation.rkt index f28c91e9..338990cd 100644 --- a/collects/typed-racket/private/type-annotation.rkt +++ b/collects/typed-racket/private/type-annotation.rkt @@ -4,7 +4,7 @@ (rep type-rep) (utils tc-utils) (env global-env) - (except-in (types subtype union convenience resolve utils generalize comparison) -> ->* one-of/c) + (except-in (types subtype union convenience resolve utils generalize) -> ->* one-of/c) (private parse-type) (contract-req) racket/match) diff --git a/collects/typed-racket/rep/rep-utils.rkt b/collects/typed-racket/rep/rep-utils.rkt index 267a1873..ebe2982e 100644 --- a/collects/typed-racket/rep/rep-utils.rkt +++ b/collects/typed-racket/rep/rep-utils.rkt @@ -3,8 +3,7 @@ racket/match (contract-req) "free-variance.rkt" - "interning.rkt" - unstable/match unstable/struct + "interning.rkt" unstable/struct racket/stxparam (for-syntax racket/match diff --git a/collects/typed-racket/typecheck/tc-app-helper.rkt b/collects/typed-racket/typecheck/tc-app-helper.rkt index 2f6e613c..e7045f5a 100644 --- a/collects/typed-racket/typecheck/tc-app-helper.rkt +++ b/collects/typed-racket/typecheck/tc-app-helper.rkt @@ -336,3 +336,4 @@ (if (not (for/and ([t (apply append (map fv/list msg-doms))]) (memq t msg-vars))) (string-append "Type Variables: " (stringify msg-vars) "\n") ""))))))])) + diff --git a/collects/typed-racket/typecheck/tc-if.rkt b/collects/typed-racket/typecheck/tc-if.rkt index 1e67c97f..f70a1b89 100644 --- a/collects/typed-racket/typecheck/tc-if.rkt +++ b/collects/typed-racket/typecheck/tc-if.rkt @@ -2,7 +2,7 @@ (require (rename-in "../utils/utils.rkt" [infer r:infer]) "signatures.rkt" "check-below.rkt" (rep type-rep filter-rep object-rep) - (rename-in (types convenience subtype union utils comparison remove-intersect abbrev filter-ops) + (rename-in (types convenience subtype union utils remove-intersect abbrev filter-ops) [remove *remove]) (env lexical-env type-env-structs) (r:infer infer) diff --git a/collects/typed-racket/types/abbrev.rkt b/collects/typed-racket/types/abbrev.rkt index 6bf7f764..0cb6268e 100644 --- a/collects/typed-racket/types/abbrev.rkt +++ b/collects/typed-racket/types/abbrev.rkt @@ -3,7 +3,6 @@ (require "../utils/utils.rkt") (require (rename-in (rep type-rep object-rep filter-rep rep-utils) [make-Base make-Base*]) - "resolve.rkt" (utils tc-utils) racket/list racket/match @@ -13,6 +12,7 @@ '#%place unstable/function racket/udp + unstable/lazy-require (except-in racket/contract/base ->* ->) (prefix-in c: racket/contract/base) (for-syntax racket/base syntax/parse racket/list) @@ -21,6 +21,8 @@ ;; for base type predicates racket/promise racket/tcp racket/flonum) +(lazy-require ["resolve.rkt" (resolve)]) + (provide (except-out (all-defined-out) Promise make-Base) (rename-out [make-Listof -lst] [make-MListof -mlst])) @@ -74,7 +76,6 @@ (foldr -pair b l)) (define (untuple t) - ;; FIXME - do we really need resolution here? (match (resolve t) [(Value: '()) null] [(Pair: a b) (cond [(untuple b) => (lambda (l) (cons a l))] diff --git a/collects/typed-racket/types/filter-ops.rkt b/collects/typed-racket/types/filter-ops.rkt index e24e336b..0c11b2a4 100644 --- a/collects/typed-racket/types/filter-ops.rkt +++ b/collects/typed-racket/types/filter-ops.rkt @@ -4,7 +4,7 @@ (rep type-rep filter-rep object-rep rep-utils) (utils tc-utils) (only-in (infer infer) restrict) "abbrev.rkt" (only-in racket/contract current-blame-format [-> -->] listof) - (types comparison printer union subtype utils remove-intersect) + (types printer union subtype utils remove-intersect) racket/list racket/match (for-syntax syntax/parse racket/base) syntax/id-table racket/dict diff --git a/collects/typed-racket/types/subtype.rkt b/collects/typed-racket/types/subtype.rkt index becf609c..915d465e 100644 --- a/collects/typed-racket/types/subtype.rkt +++ b/collects/typed-racket/types/subtype.rkt @@ -2,7 +2,7 @@ (require "../utils/utils.rkt" (rep type-rep filter-rep object-rep rep-utils) (utils tc-utils) - (types utils comparison resolve abbrev numeric-tower substitute) + (types utils resolve abbrev numeric-tower substitute) (env type-name-env) (only-in (infer infer-dummy) unify) racket/match unstable/match diff --git a/collects/typed-racket/types/tc-error.rkt b/collects/typed-racket/types/tc-error.rkt new file mode 100644 index 00000000..4b6db709 --- /dev/null +++ b/collects/typed-racket/types/tc-error.rkt @@ -0,0 +1,31 @@ +#lang racket/base + +(require "../utils/utils.rkt" + (rep type-rep filter-rep object-rep rep-utils) + (utils tc-utils) + racket/match) + +(provide tc-error/expr lookup-type-fail lookup-fail) + +(define (tc-error/expr msg + #:return [return (make-Union null)] + #:stx [stx (current-orig-stx)] + . rest) + (apply tc-error/delayed #:stx stx msg rest) + return) + +;; error for unbound variables +(define (lookup-fail e) + (match (identifier-binding e) + ['lexical (tc-error/expr "untyped identifier ~a" (syntax-e e))] + [#f (tc-error/expr "untyped top-level identifier ~a" (syntax-e e))] + [(list _ _ nominal-source-mod nominal-source-id _ _ _) + (let-values ([(x y) (module-path-index-split nominal-source-mod)]) + (cond [(and (not x) (not y)) + (tc-error/expr "untyped identifier ~a" (syntax-e e))] + [else + (tc-error/expr "untyped identifier ~a imported from module <~a>" + (syntax-e e) x)]))])) + +(define (lookup-type-fail i) + (tc-error/expr "~a is not bound as a type" (syntax-e i))) diff --git a/collects/typed-racket/types/union.rkt b/collects/typed-racket/types/union.rkt index 1a19bc46..5035161d 100644 --- a/collects/typed-racket/types/union.rkt +++ b/collects/typed-racket/types/union.rkt @@ -4,7 +4,7 @@ (rep type-rep rep-utils) (utils tc-utils) (prefix-in c: (contract-req)) - (types utils subtype abbrev comparison) + (types utils subtype abbrev) racket/match) diff --git a/collects/typed-racket/types/utils.rkt b/collects/typed-racket/types/utils.rkt index 3edd8fcc..082a2630 100644 --- a/collects/typed-racket/types/utils.rkt +++ b/collects/typed-racket/types/utils.rkt @@ -8,10 +8,11 @@ (env index-env tvar-env) racket/match racket/list - racket/contract) + (contract-req) + "tc-error.rkt") -(provide (all-from-out "tc-result.rkt")) +(provide (all-from-out "tc-result.rkt" "tc-error.rkt")) ;; unfold : Type -> Type @@ -62,29 +63,6 @@ (define (fv/list ts) (hash-map (combine-frees (map free-vars* ts)) (lambda (k v) k))) -(define (tc-error/expr msg - #:return [return (make-Union null)] - #:stx [stx (current-orig-stx)] - . rest) - (apply tc-error/delayed #:stx stx msg rest) - return) - -;; error for unbound variables -(define (lookup-fail e) - (match (identifier-binding e) - ['lexical (tc-error/expr "untyped identifier ~a" (syntax-e e))] - [#f (tc-error/expr "untyped top-level identifier ~a" (syntax-e e))] - [(list _ _ nominal-source-mod nominal-source-id _ _ _) - (let-values ([(x y) (module-path-index-split nominal-source-mod)]) - (cond [(and (not x) (not y)) - (tc-error/expr "untyped identifier ~a" (syntax-e e))] - [else - (tc-error/expr "untyped identifier ~a imported from module <~a>" - (syntax-e e) x)]))])) - -(define (lookup-type-fail i) - (tc-error/expr "~a is not bound as a type" (syntax-e i))) - ;; a parameter for the current polymorphic structure being defined ;; to allow us to prevent non-regular datatypes (define-struct poly (name vars) #:prefab)