More refactoring and reduction of runtime dependencies.

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

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)

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

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]

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

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"
+         (for-syntax racket/base syntax/parse
-                     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)

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)
+         (utils tc-utils)) 
-         (types utils comparison))
-
 (provide register-type register-type-if-undefined
          finish-register-type
          maybe-finish-register-type

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)

collects/typed-racket/rep/rep-utils.rkt

@@ -3,8 +3,7 @@
          racket/match
          (contract-req)
          "free-variance.rkt"
-         "interning.rkt"
+         "interning.rkt" unstable/struct
-         unstable/match unstable/struct
          racket/stxparam
          (for-syntax
           racket/match

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")
                                                  ""))))))]))
+

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)

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

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

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

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

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)
 
 

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)