bug fix

Author: capfredf

typed-racket-lib/typed-racket/infer/infer-unit.rkt

@@ -578,9 +578,15 @@
          #f
          ;; constrain v to be below T (but don't mention bounds)
          (define maybe-type-bound (hash-ref (context-type-bounds context) v #f))
-         (if (and maybe-type-bound (subtype maybe-type-bound T obj))
-             (singleton maybe-type-bound v (var-demote T (context-bounds context)))
-             #f)]
+         (if maybe-type-bound
+             (if (subtype maybe-type-bound T obj)
+                 (singleton maybe-type-bound
+                            v
+                            (var-demote T (context-bounds context)))
+                 #f)
+             (singleton -Bottom
+                        v
+                        (var-demote T (context-bounds context))))]
 
         [(S (F: (? (inferable-var? context) v)))
          #:return-when
@@ -590,9 +596,15 @@
          #f
          (define maybe-type-bound (hash-ref (context-type-bounds context) v #f))
          ;; constrain v to be above S (but don't mention bounds)
-         (if (and maybe-type-bound (subtype S maybe-type-bound obj))
-             (singleton (var-promote S (context-bounds context)) v maybe-type-bound)
-             #f)]
+         (if maybe-type-bound
+             (if (subtype S maybe-type-bound obj)
+                 (singleton (var-demote S (context-bounds context))
+                            v
+                            maybe-type-bound)
+                 #f)
+             (singleton (var-demote S (context-bounds context))
+                        v
+                        Univ))]
 
         ;; recursive names should get resolved as they're seen
         [(s (? Name? t))
@@ -1010,7 +1022,7 @@
  (let ()
    (define/cond-contract (infer X Y S T R [expected #f]
                                 #:multiple? [multiple-substitutions? #f]
-                                #:bounds [bounds '#()]
+                                #:bounds [bounds '#hash()]
                                 #:objs [objs '()])
      (((listof symbol?) (listof symbol?) (listof Type?) (listof Type?)
        (or/c #f Values/c AnyValues? ValuesDots?))

typed-racket-lib/typed-racket/rep/type-rep.rkt

@@ -1499,8 +1499,8 @@
        (make-PolyRow constraints (rec/lvl body (add1 lvl)))]
       [(PolyDots: n body)
        (make-PolyDots n (rec/lvl body (+ n lvl)))]
-      [(Poly: n bound body)
-       (make-Poly n (rec/lvl body (+ n lvl)))]
+      [(Poly: n bounds body)
+       (make-Poly n bounds (rec/lvl body (+ n lvl)))]
       [_ (Rep-fmap cur rec)])))
 
 
@@ -1678,13 +1678,10 @@
                           (values (list-ref names idx) v)))
      (unless (= (length names) n)
        (int-err "Wrong number of names: expected ~a got ~a" n (length names)))
-     (eprintf "new bounds is ~a ~n" new-bounds)
      (instantiate-type body
                        (map (lambda (n)
                               (make-F n (hash-ref new-bounds n #f)))
-                            names)
-                       #;
-                       (map F* names))]))
+                            names))]))
 
 ;; PolyDots 'smart' constructor
 (define (PolyDots* names body)
@@ -1717,7 +1714,7 @@
 (define (PolyRow-body* names t)
   (match t
     [(PolyRow: constraints body)
-     (instantiate-type body (map  names))]))
+     (instantiate-type body (map F* names))]))
 
 
 ;;***************************************************************
@@ -1982,7 +1979,7 @@
     [(Some: n body)
      (unless (= (length names) n)
        (int-err "Wrong number of names: expected ~a got ~a" n (length names)))
-     (instantiate-type body (map  names))]))
+     (instantiate-type body (map F* names))]))
 
 
 (define-match-expander Some-names: