Improve triggering for generalizing lists.

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

@@ -29,19 +29,20 @@
         [(? (lambda (t) (subtype t -SingleFlonumComplex))) -SingleFlonumComplex]
         [(? (lambda (t) (subtype t -Number))) -Number]
         [(? (lambda (t) (subtype t -ExtFlonum))) -ExtFlonum]
-        [(Mu: var (Union: (list (Value: '()) (Pair: _ (F: var))))) t*]
+        [(Listof: _) t*]
         [(Pair: t1 (Value: '())) (-lst t1)]
         [(MPair: t1 (Value: '())) (-mlst t1)]
         [(or (Pair: t1 t2) (MPair: t1 t2))
          (let ([t-new (loop t2)])
-           (if (type-equal? ((match t*
+           (define -lst-type
-                               [(Pair: _ _) -lst]
+             ((match t*
-                               [(MPair: _ _) -mlst])
+                [(Pair: _ _) -lst]
-                             t1)
+                [(MPair: _ _) -mlst])
-                            t-new)
+              t1))
-               t-new
+           (if (type-compare? -lst-type t-new)
+               -lst-type
                (exit t)))]
         [(ListDots: t bound) (-lst (substitute Univ bound t))]
         [(? (lambda (t) (subtype t -Symbol))) -Symbol]
         [(Value: #t) -Boolean]
-        [_ (exit t)]))))
+        [_ t*]))))

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

@@ -40,4 +40,5 @@
   "init-env-tests.rkt"
   "filter-tests.rkt"
   "metafunction-tests.rkt"
+  "generalize-tests.rkt"
   "rep-tests.rkt")

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

@@ -0,0 +1,34 @@
+#lang racket/base
+
+(require "test-utils.rkt"
+         racket/format
+         rackunit
+         (rep rep-utils)
+         (types generalize abbrev union)
+         (for-syntax racket/base syntax/parse))
+
+(provide tests)
+(gen-test-main)
+
+(define-syntax check-generalize
+  (syntax-parser
+    [(_ t*:expr exp*:expr)
+     #'(test-case (~a `(t* => exp*))
+         (define actual (generalize t*))
+         (define expected exp*)
+         (with-check-info (['actual actual]
+                           ['expected expected])
+           (unless (type-equal? actual expected)
+             (fail-check "Didn't generalize to expected type."))))]))
+
+
+(define tests
+  (test-suite "Generalize Tests"
+    (check-generalize -Null (-lst Univ))
+    (check-generalize
+      (-pair -Symbol (-lst -Symbol))
+      (-lst -Symbol))
+    (check-generalize
+      (-pair -Symbol (Un -Null (-pair -Symbol (-lst -Symbol))))
+      (-lst -Symbol))
+    ))