compiles again

svn: r14625

collects/typed-scheme/env/type-environments.ss

@@ -19,9 +19,6 @@
          env-keys+vals
          with-dotted-env/extend)
 
-(provide/contract [make-empty-env ((-> any/c any/c any/c) . -> . env?)]
-                  [])
-
 ;; eq? has the type of equal?, and l is an alist (with conses!)
 (define-struct env (eq? l))
 
@@ -87,3 +84,5 @@
 (define-syntax with-dotted-env/extend
   (syntax-rules ()
     [(_ i t v . b) (parameterize ([dotted-env (extend/values (list i) (list (cons t v)) (dotted-env))]) . b)]))
+
+(provide/contract [make-empty-env ((-> any/c any/c any/c) . -> . env?)])

collects/typed-scheme/private/parse-type.ss

@@ -300,7 +300,7 @@
        (and (eq? (syntax-e #'Refinement) 'Refinement)
             (identifier? #'p?))
        (match (lookup-type/lexical #'p?)
-              [(and t (Function: (list (arr: (list dom) rng #f #f '() _ _))))
+              [(and t (Function: (list (arr: (list dom) _ #f #f '()))))
                (make-Refinement dom #'p? (syntax-local-certifier))]
               [t (tc-error "cannot declare refinement for non-predicate ~a" t)])]
       [(Instance t)

collects/typed-scheme/typecheck/tc-toplevel.ss

@@ -41,9 +41,10 @@
        (list)]
 
       ;; declare-refinement
+      ;; FIXME - this sucks and should die
       [(define-values () (begin (quote-syntax (declare-refinement-internal pred)) (#%plain-app values)))
        (match (lookup-type/lexical #'pred)
-              [(and t (Function: (list (arr: (list dom) rng #f #f '() _ _))))
+              [(and t (Function: (list (arr: (list dom) rng #f #f '()))))
                (register-type #'pred 
                               (make-pred-ty (list dom)
                                             rng

collects/typed-scheme/typecheck/typechecker.ss

@@ -13,5 +13,5 @@
 
 (provide-signature-elements typechecker^ tc-expr^)
 
-(define-values/link-units/infer
-  tc-toplevel@ tc-new-if@ tc-lambda@ tc-dots@ tc-new-app@ tc-let@ tc-expr@ check-subforms@)
+(define-values/invoke-unit/infer
+  (link tc-toplevel@ tc-new-if@ tc-lambda@ tc-dots@ tc-new-app@ tc-let@ tc-expr@ check-subforms@))

collects/typed-scheme/types/utils.ss

@@ -29,7 +29,8 @@
          (struct-out DottedBoth)
          just-Dotted?
          tc-error/expr
-         lookup-fail)
+         lookup-fail
+         lookup-type-fail)
 
 
 ;; substitute : Type Name Type -> Type
@@ -254,4 +255,16 @@
   return)
 
 ;; error for unbound variables
-(define (lookup-fail e) (tc-error/expr "unbound identifier ~a" e))
+(define (lookup-fail e) 
+  (match (identifier-binding e)
+    ['lexical (int-err "untyped lexical variable ~a" (syntax-e e))]
+    [#f (int-err "untyped top-level variable ~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)))