singleton char types if expected type (#527)

typed-racket-lib/typed-racket/typecheck/tc-literal.rkt

@@ -28,7 +28,7 @@
 ;; tc-literal: racket-value-syntax [type] -> type
 (define (tc-literal v-stx [expected #f])
   (define-syntax-class exp
-    (pattern (~and i (~or :number :str :bytes))
+    (pattern (~and i (~or :number :str :bytes :char))
              #:fail-unless expected #f
              #:fail-unless (let ([n (syntax-e #'i)])
                              (subtype (-val n) expected #:obj (if (exact-integer? n) (-lexp n) -empty-obj))) #f))

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

@@ -28,6 +28,7 @@
         [(? (lambda (t) (subtype t -FloatComplex))) -FloatComplex]
         [(? (lambda (t) (subtype t -SingleFlonumComplex))) -SingleFlonumComplex]
         [(? (lambda (t) (subtype t -Number))) -Number]
+        [(? (lambda (t) (subtype t -Char))) -Char]
         [(? (lambda (t) (subtype t -ExtFlonum))) -ExtFlonum]
         [(Listof: _) t*]
         [(Pair: t1 (== -Null)) (-lst t1)]

typed-racket-test/succeed/literal-char-gh-issue-434.rkt

@@ -0,0 +1,28 @@
+#lang typed/racket
+
+;; The precise type for chars should be the char itself:
+(ann #\nul #\nul)
+;; Up-casting as Char should still work:
+(ann #\nul Char)
+(ann (ann #\b '#\b) Char)
+
+;; Check that the inferred type is still implicitly widened to Char by default,
+;; for backwards compatibility (previously, all chars had the type Char):
+;; * Check that when passed as a #:∀ type, the inferred type is Char
+(ann (let #:∀ (C) ([c : C #\a])
+         (λ ([x : C]) x))
+       (→ Char Char))
+;; * Check that loops which rely on the first iteration having the wider Char
+;;   type still work:
+(let loop : Void ([c #\a])
+    (if (equal? c #\a)
+        (loop #\b)
+        (void)))
+
+(define v (vector #\a #\b #\c))
+(define b (box #\a))
+(define c (ann (box (ann #\a '#\a)) (Boxof '#\a)))
+
+(vector-set! v 0 #\d)
+(set-box! b #\z)
+;; (set-box! c #\a) ouch, it would be nice if this worked

typed-racket-test/unit-tests/typecheck-tests.rkt

@@ -3928,6 +3928,17 @@
              (-refine/fresh x -Fixnum (-eq (-lexp x) (-lexp 123456)))]
        [tc-e (ann 123456 (Refine [x : Integer] (= x 123456)))
              (-refine/fresh x -Int (-eq (-lexp x) (-lexp 123456)))]
+
+       ;; chars can be typechecked at their precise, singleton type
+       ;; when it is the expected type
+       [tc-e (ann #\nul #\nul) (-val #\nul)]
+       [tc-e (ann #\a #\a) (-val #\a)]
+       [tc-e (ann #\b '#\b) (-val '#\b)]
+       ;; Check that the inferred type is still implicitly widened to Char by default,
+       ;; for backwards compatibility (previously, all chars had the type Char):
+       ;; * Check that when passed as a #:∀ type, the inferred type is Char
+       [tc-e #\b -Char]
+       [tc-e (ann #\b Char) -Char]
        )
 
   (test-suite