fix bugs revealed by conditional contracts

Author: capfredf

typed-racket-lib/typed-racket/env/lexical-env.rkt

@@ -33,7 +33,7 @@
  [lookup-obj-type/lexical ((Object?) (env? #:fail (or/c #f Type? (-> any/c (or/c Type? #f))))
                                      . ->* .
                                      (or/c Type? #f))]
- [lookup-alias/lexical ((identifier?) (env?) . ->* . (or/c Path? Empty?))])
+ [lookup-alias/lexical ((identifier?) (env?) . ->* . (or/c OptObject? #f))])
 
 ;; used at the top level
 (define (add-props-to-current-lexical! ps)

typed-racket-lib/typed-racket/static-contracts/combinators/dep-function.rkt

@@ -88,10 +88,10 @@
 
 (provide/cond-contract
  [struct ->i/sc ([typed-side? boolean?]
-                          [ids (listof identifier?)]
-                          [dom (listof static-contract?)]
-                          [dom-deps (listof (listof identifier?))]
-                          [pre (or/c #f proposition-contract?)]
-                          [pre-deps (listof (listof identifier?))]
-                          [rng (listof static-contract?)]
-                          [rng-deps (listof identifier?)])])
+                 [ids (listof identifier?)]
+                 [dom (listof static-contract?)]
+                 [dom-deps (listof (listof identifier?))]
+                 [pre (or/c #f proposition-contract?)]
+                 [pre-deps (listof identifier?)]
+                 [rng (listof static-contract?)]
+                 [rng-deps (listof identifier?)])])

typed-racket-lib/typed-racket/static-contracts/combinators/exist.rkt

@@ -12,7 +12,7 @@
 (provide exist/sc:)
 
 (provide/cond-contract
- [exist/sc ((listof identifier?) (listof static-contract?) (listof static-contract?) . -> . static-contract?)])
+ [exist/sc ((listof identifier?) static-contract? static-contract? . -> . static-contract?)])
 
 
 (struct exist-combinator combinator ()

typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt

@@ -181,7 +181,8 @@
        (cond
          [(tc-expr/check? #'t.body expected)
           (tc-error/expr #:stx #'t.body (format "Expected a type check error!"))]
-         [else expected])]
+         [else
+          (fix-results expected)])]
       ;; data
       [(quote #f) (ret (-val #f) -false-propset)]
       [(quote #t) (ret (-val #t) -true-propset)]
@@ -294,34 +295,34 @@
          [_ (tc-expr/check form #f)])]
       ;; opt function def
       [(~and (let-values ([(f) fun]) . body) opt:opt-lambda^)
-       #:when expected
-       (define conv-type
-         (match expected
-           [(tc-result1: fun-type)
-            (match-define (list required-pos optional-pos optional-supplied?)
-                          (attribute opt.value))
-            (opt-convert fun-type required-pos optional-pos optional-supplied?)]
-           [_ #f]))
-       (if conv-type
-           (begin (tc-expr/check/type #'fun conv-type) expected)
-           (tc-expr/check form #f))]
+	   #:when expected
+	   (define conv-type
+		 (match expected
+		   [(tc-result1: fun-type)
+			(match-define (list required-pos optional-pos optional-supplied?)
+			  (attribute opt.value))
+			(opt-convert fun-type required-pos optional-pos optional-supplied?)]
+		   [_ #f]))
+	   (if conv-type
+		   (begin (tc-expr/check/type #'fun conv-type) (fix-results expected))
+		   (tc-expr/check form #f))]
       [(~and _:kw-lambda^
-         (let-values ([(f) fun])
-           (let-values _
-             (#%plain-app
-              maker
-              lambda-for-kws
-              (case-lambda ; wrapper function
-                (formals . cl-body) ...)
-              (~or (quote (mand-kw:keyword ...))
-                   (~and _ (~bind [(mand-kw 1) '()])))
-              (quote (all-kw:keyword ...))
-              . rst))))
-       (define p (plambda-property form))
-       (ret (kw-unconvert (tc-expr/t (plambda-property #'fun p))
-                          (syntax->list #'(formals ...))
-                          (syntax->datum #'(mand-kw ...))
-                          (syntax->datum #'(all-kw ...))))]
+			 (let-values ([(f) fun])
+			   (let-values _
+				 (#%plain-app
+				  maker
+				  lambda-for-kws
+				  (case-lambda ; wrapper function
+					(formals . cl-body) ...)
+				  (~or (quote (mand-kw:keyword ...))
+					   (~and _ (~bind [(mand-kw 1) '()])))
+				  (quote (all-kw:keyword ...))
+				  . rst))))
+	   (define p (plambda-property form))
+	   (ret (kw-unconvert (tc-expr/t (plambda-property #'fun p))
+						  (syntax->list #'(formals ...))
+						  (syntax->datum #'(mand-kw ...))
+						  (syntax->datum #'(all-kw ...))))]
       [(~and opt:opt-lambda^
              (let-values ([(f) fun])
                (case-lambda (formals . cl-body) ...)))

typed-racket-lib/typed-racket/types/subtype.rkt

@@ -805,7 +805,7 @@
   [(case: F (F: var1))
    (match t2
      ;; tvars are equal if they are the same variable
-     [(F: var2) (eq? var1 var2)]
+     [(F: var2) (and (eq? var1 var2) A)]
      [_ (continue<: A t1 t2 obj)])]
   [(case: Fun (Fun: arrows1))
    (match* (t2 arrows1)