Add bottom as a special case in multiple value context.

original commit: 11e19caa026d2edae8ed0640b426c516eec8a943

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

@@ -405,9 +405,22 @@
                         (cgen/filter-set V X Y f-s f-t)
                         (cgen/object V X Y o-s o-t))]
 
-          ;; Values just delegate to cgen/seq
+          ;; Values just delegate to cgen/seq, except special handling for -Bottom.
+          ;; A single -Bottom in a Values means that there is no value returned and so any other
+          ;; Values or ValuesDots should be above it.
           [((ValuesSeq: s-seq) (ValuesSeq: t-seq))
-           (cgen/seq V X Y s-seq t-seq)]
+           ;; Check for a substition that S is below (ret -Bottom).
+           (define bottom-case
+             (match S
+               [(Values: (list (Result: s f-s o-s)))
+                (cgen V X Y s -Bottom)]
+               [else #f]))
+           (define regular-case
+             (cgen/seq V X Y s-seq t-seq))
+           ;; If we want the OR of the csets that the two cases return.
+           (cset-join
+             (filter values
+               (list bottom-case regular-case)))]
 
           ;; they're subtypes. easy.
           [(a b) 

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

@@ -549,7 +549,9 @@
          ;; subtyping on structs follows the declared hierarchy
          [((Struct: nm (? Type/c? parent) _ _ _ _) other)
           (subtype* A0 parent other)]
-         ;; subtyping on values is pointwise
+         ;; subtyping on values is pointwise, except special case for Bottom
+         [((Values: (list (Result: (== -Bottom) _ _))) _)
+          A0]
          [((Values: vals1) (Values: vals2)) (subtypes* A0 vals1 vals2)]
          [((ValuesDots: s-rs s-dty dbound) (ValuesDots: t-rs t-dty dbound))
           (subtype-seq A0

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/infer-tests.rkt

@@ -225,6 +225,9 @@
     [infer-t (-lst* -String) (make-ListDots -Symbol 'b) #:indices '(b) #:fail]
     [infer-t (->* (list -Symbol) -Symbol -Void) (->* (list) (-v a) -Void) #:vars '(a) #:fail]
 
+    [infer-t (-> (-values (list -Bottom))) (-> (-values (list (-v b) (-v b)))) #:vars '(a)]
+    [infer-t (-> (-values (list (-v a)))) (-> (-values (list (-v b) (-v b)))) #:vars '(a)]
+
     ;; Currently Broken
     ;(infer-t (make-ListDots -Symbol 'b) (-pair -Symbol (-lst -Symbol)) #:indices '(b))
     [i2-t (-v a) N ('a N)]

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subtype-tests.rkt

@@ -262,6 +262,7 @@
    [(make-ListDots (-> -Symbol (make-F 'a)) 'a) (-lst (-> -Symbol Univ))]
 
    [FAIL (make-ValuesDots (list) -Symbol 'a) (make-ValuesDots (list (-result -String)) -String 'a)]
+   [(-values (list -Bottom)) (-values (list -String -Symbol))]
 
    ;; keyword function types
    [(->key #:x -Symbol #f Univ) (->key Univ)]