Make case-> reduce to -> when it can.

original commit: f2431bd819b4458cd6b39e3258478f4907d5bf5b

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/case-lambda.rkt

@@ -62,7 +62,7 @@
 (define-match-expander case->/sc:
   (syntax-parser
     [(_ args ...)
-     #'(case->/combinator (list args ...))]))
+     #'(case-combinator (list args ...))]))
 
 (define-match-expander arr/sc:
   (syntax-parser

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/optimize.rkt

@@ -71,6 +71,37 @@
       [else sc])]
 
 
+    ;; case->/sc cases
+    [(case->/sc: arrs ...)
+     (match arrs
+       ;; We can turn case->/sc contracts int ->* contracts in some cases.
+       [(list (arr/sc: args #f ranges) ...) (=> fail)
+        ;; All results must have the same range
+        (unless (equal? (set-count (apply set ranges)) 1)
+          (fail))
+        (define sorted-args (sort args (λ (l1 l2) (< (length l1) (length l2)))))
+        (define shortest-args (first sorted-args))
+        (define longest-args (last sorted-args))
+        ;; The number of arguments must increase by 1 with no gaps
+        (unless (equal? (map length sorted-args)
+                        (range (length shortest-args)
+                               (add1 (length longest-args))))
+          (fail))
+        ;; All arities must be prefixes of the longest arity
+        (unless (for/and ([args (in-list sorted-args)])
+                  (equal? args (take longest-args (length args))))
+          (fail))
+        ;; All the checks passed
+        (function/sc
+          (take longest-args (length shortest-args))
+          (drop longest-args (length shortest-args))
+          empty
+          empty
+          #f
+          (first ranges))]
+       [else sc])]
+
+
 
     [else sc]))
 

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/static-contract-optimizer-tests.rkt

@@ -275,4 +275,20 @@
       #:pos any/sc
       #:neg (cons/sc any/sc list?/sc))
 
+    (check-optimize
+      (case->/sc
+        (list
+          (arr/sc empty #f (list set?/sc))
+          (arr/sc (list identifier?/sc) #f (list (listof/sc set?/sc)))))
+      #:pos  (function/sc (list)
+                          (list identifier?/sc)
+                          (list)
+                          (list)
+                          #f
+                          #f)
+      #:neg (case->/sc
+              (list
+                (arr/sc empty #f (list set?/sc))
+                (arr/sc (list any/sc) #f (list (listof/sc set?/sc))))))
+
     ))