Fixes 539: Type of literal regexp is not the literal regexp itself

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

@@ -27,8 +27,10 @@
 ;; return the type of a literal value
 ;; tc-literal: racket-value-syntax [type] -> type
 (define (tc-literal v-stx [expected #f])
+  (define-syntax-class regexp-cls #:attributes () (pattern x #:when (regexp? (syntax-e #'x))))
+  (define-syntax-class byte-regexp-cls #:attributes () (pattern x #:when (byte-regexp? (syntax-e #'x))))
   (define-syntax-class exp
-    (pattern (~and i (~or :number :str :bytes :char))
+    (pattern (~and i (~or :number :str :bytes :char :regexp-cls :byte-regexp-cls))
              #:fail-unless expected #f
              #:fail-unless (let ([n (syntax-e #'i)])
                              (subtype (-val n) expected (if (exact-integer? n) (-lexp n) -empty-obj))) #f))

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

@@ -28,6 +28,10 @@
         [(? (lambda (t) (subtype t -FloatComplex))) -FloatComplex]
         [(? (lambda (t) (subtype t -SingleFlonumComplex))) -SingleFlonumComplex]
         [(? (lambda (t) (subtype t -Number))) -Number]
+        [(? (lambda (t) (subtype t -Base-Regexp))) -Regexp]
+        [(? (lambda (t) (subtype t -PRegexp))) -PRegexp]
+        [(? (lambda (t) (subtype t -Byte-Base-Regexp))) -Byte-Regexp]
+        [(? (lambda (t) (subtype t -Byte-PRegexp))) -Byte-PRegexp]
         [(? (lambda (t) (subtype t -Char))) -Char]
         [(? (lambda (t) (subtype t -ExtFlonum))) -ExtFlonum]
         [(Listof: _) t*]

typed-racket-lib/typed-racket/utils/stxclass-util.rkt

@@ -23,7 +23,7 @@
            [#,i #:declare #,i pat #'#,get-i])))]))
 
 (define (atom? v)
-  (or (number? v) (string? v) (boolean? v) (symbol? v) (char? v) (bytes? v) (regexp? v)))
+  (or (number? v) (string? v) (boolean? v) (symbol? v) (char? v) (bytes? v) (regexp? v) (byte-regexp? v)))
 
 (define-syntax-class (3d pred)
   (pattern s

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

@@ -25,4 +25,5 @@
 
 (vector-set! v 0 #\d)
 (set-box! b #\z)
-;; (set-box! c #\a) ouch, it would be nice if this worked
+;; (set-box! c #\a) ouch, it would be nice if this worked
+(set-box! c (ann #\a #\a))

typed-racket-test/succeed/literal-regexp-gh-issue-539.rkt

@@ -0,0 +1,128 @@
+#lang typed/racket
+
+;; The precise type for a regexp should be the regexp itself:
+(ann #rx"abc" #rx"abc")
+(ann #px"abc" #px"abc")
+(ann #rx"abc" '#rx"abc")
+(ann #px"abc" '#px"abc")
+;; The precise type for a byte-regexp should be the regexp itself:
+(ann #rx#"abc" #rx#"abc")
+(ann #px#"abc" #px#"abc")
+(ann #rx#"abc" '#rx#"abc")
+(ann #px#"abc" '#px#"abc")
+;; Up-casting as Regexp should still work:
+(ann #rx"abc" Regexp)
+(ann (ann #rx"abc" #rx"abc") Regexp)
+(ann (ann #rx"abc" '#rx"abc") Regexp)
+(ann #px"abc" Regexp)
+(ann (ann #px"abc" #px"abc") Regexp)
+(ann (ann #px"abc" '#px"abc") Regexp)
+(ann #px"abc" PRegexp)
+(ann (ann #px"abc" #px"abc") PRegexp)
+(ann (ann #px"abc" '#px"abc") PRegexp)
+;; Up-casting as Byte-Regexp should still work:
+(ann #rx#"abc" Byte-Regexp)
+(ann (ann #rx#"abc" #rx#"abc") Byte-Regexp)
+(ann (ann #rx#"abc" '#rx#"abc") Byte-Regexp)
+(ann #px#"abc" Byte-Regexp)
+(ann (ann #px#"abc" #px#"abc") Byte-Regexp)
+(ann (ann #px#"abc" '#px#"abc") Byte-Regexp)
+(ann #px#"abc" Byte-PRegexp)
+(ann (ann #px#"abc" #px#"abc") Byte-PRegexp)
+(ann (ann #px#"abc" '#px#"abc") Byte-PRegexp)
+
+;; Check that the inferred type is still implicitly widened to (P)Regexp by
+;; default, for backwards compatibility (previously, all regexps had the type
+;; Regexp):
+;; * Check that when passed as a #:∀ type, the inferred type is Regexp
+(ann (let #:∀ (R) ([r : R #rx"abc"])
+       (λ ([x : R]) r))
+     (→ Regexp Regexp))
+(ann (let #:∀ (R) ([r : R #px"abc"])
+       (λ ([x : R]) r))
+     (→ PRegexp PRegexp))
+;; * Check that loops which rely on the first iteration having the wider
+;;   (P)Regexp type still work:
+(let loop : Void ([r #rx"abc"])
+  (if (equal? r #rx"abc")
+      (loop #rx"xyz")
+      (void)))
+(let loop : Void ([r #px"abc"])
+  (if (equal? r #px"abc")
+      (loop #px"xyz")
+      (void)))
+
+;; Check that the inferred type is still implicitly widened to Byte-(P)Regexp by
+;; default, for backwards compatibility (previously, all regexps had the type
+;; Regexp):
+;; * Check that when passed as a #:∀ type, the inferred type is Byte-Regexp
+(ann (let #:∀ (R) ([r : R #rx#"abc"])
+       (λ ([x : R]) r))
+     (→ Byte-Regexp Byte-Regexp))
+(ann (let #:∀ (R) ([r : R #px#"abc"])
+       (λ ([x : R]) r))
+     (→ Byte-Regexp Byte-Regexp))
+;; * Check that loops which rely on the first iteration having the wider
+;;   Byte-(P)Regexp type still work:
+(let loop : Void ([r #rx#"abc"])
+  (if (equal? r #rx#"abc")
+      (loop #rx#"xyz")
+      (void)))
+(let loop : Void ([r #px#"abc"])
+  (if (equal? r #px#"abc")
+      (loop #px#"xyz")
+      (void)))
+
+(define v (vector #rx"abc" #px"abc" #rx#"abc" #px#"abc"))
+(define b1 (box #rx".*"))
+(define b2 (box #px".*"))
+(define b3 (box #rx#".*"))
+(define b4 (box #px#".*"))
+(define c1 (ann (box (ann #rx"abc" #rx"abc")) (Boxof #rx"abc")))
+(define c2 (ann (box (ann #px"abc" #px"abc")) (Boxof #px"abc")))
+(define c3 (ann (box (ann #rx#"abc" #rx#"abc")) (Boxof #rx#"abc")))
+(define c4 (ann (box (ann #px#"abc" #px#"abc")) (Boxof #px#"abc")))
+
+(vector-set! v 0 #rx".*")
+(vector-set! v 1 #px".*")
+(vector-set! v 2 #rx#".*")
+(vector-set! v 3 #px#".*")
+(set-box! b1 #rx"abc")
+(set-box! b1 #px"abc") ;; Upcast #px to Regexp: b1 is a (Boxof Regexp)
+(set-box! b2 #px"abc")
+(set-box! b3 #rx#"abc")
+(set-box! b3 #px#"abc") ;; Upcast #px# to Byte-Regexp: b3 is a (Boxof Regexp)
+(set-box! b4 #px#"abc")
+;; (set-box! c1 #rx".*") ouch, it would be nice if this worked
+;; (set-box! c2 #px".*") ouch, it would be nice if this worked
+;; (set-box! c3 #rx#".*") ouch, it would be nice if this worked
+;; (set-box! c4 #px#".*") ouch, it would be nice if this worked
+(set-box! c1 (ann #rx"abc" #rx"abc"))
+(set-box! c2 (ann #px"abc" #px"abc"))
+(set-box! c3 (ann #rx#"abc" #rx#"abc"))
+(set-box! c4 (ann #px#"abc" #px#"abc"))
+
+
+(ann (let ([x : #rx"abc" #rx"abc"])
+       (if ((make-predicate #rx"abc") x)
+           x
+           0))
+     #rx"abc")
+
+(ann (let ([x : #px"abc" #px"abc"])
+       (if ((make-predicate #px"abc") x)
+           x
+           0))
+     #px"abc")
+
+(ann (let ([x : #rx#"abc" #rx#"abc"])
+       (if ((make-predicate #rx#"abc") x)
+           x
+           0))
+     #rx#"abc")
+
+(ann (let ([x : #px#"abc" #px#"abc"])
+       (if ((make-predicate #px#"abc") x)
+           x
+           0))
+     #px#"abc")

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

@@ -4466,6 +4466,45 @@
         [tc-e/t (let: ([x : (Un Flonum Natural) 0.0])
                   (if (not (natural? x)) x 1.0))
                -Flonum]
+
+       ;; regexps can be typechecked at their precise, singleton type
+       ;; when it is the expected type
+       [tc-e (ann #rx"abc" #rx"abc") (-val #rx"abc")]
+       [tc-e (ann #px"abc" #px"abc") (-val #px"abc")]
+       [tc-e (ann #rx#"abc" #rx#"abc") (-val #rx#"abc")]
+       [tc-e (ann #px#"abc" #px#"abc") (-val #px#"abc")]
+       ;; Check that the inferred type is still implicitly widened to Regexp,
+       ;; Pregexp, Byte-Regexp or Byte-PRegexp by default, for backwards
+       ;; compatibility (previously, all regexps had the type Regexp, Pregexp,
+       ;; Byte-Regexp or Byte-PRegexp):
+       [tc-e #rx"abc" -Regexp]
+       [tc-e #px"abc" -PRegexp]
+       [tc-e #rx#"abc" -Byte-Regexp]
+       [tc-e #px#"abc" -Byte-PRegexp]
+       [tc-e (ann #rx"abc" Regexp) -Regexp]
+       [tc-e (ann #px"abc" PRegexp) -PRegexp]
+       [tc-e (ann #px"abc" Regexp) -Regexp] ;; PRegexp is a subtype of Regexp
+       [tc-e (ann #rx#"abc" Byte-Regexp) -Byte-Regexp]
+       [tc-e (ann #px#"abc" Byte-PRegexp) -Byte-PRegexp]
+       [tc-e (ann #px#"abc" Byte-Regexp) -Byte-Regexp]  ;; Byte-PRegexp is a subtype of Byte-Regexp
+
+       [tc-err (ann (ann #rx"abc" Regexp) PRegexp) #:ret (tc-ret -PRegexp)] ;; Regexp not a subtype of PRegexp
+       [tc-err (ann (ann #rx#"abc" Byte-Regexp) Byte-PRegexp) #:ret (tc-ret -Byte-PRegexp)] ;; Byte-Regexp not a subtype of Byte-PRegexp
+
+       [tc-err (ann (ann #rx"abc" Regexp) Byte-Regexp) #:ret (tc-ret -Byte-Regexp)] ;; Regexp not a subtype of Byte-Regexp
+       [tc-err (ann (ann #rx"abc" Regexp) Byte-PRegexp) #:ret (tc-ret -Byte-PRegexp)] ;; Regexp not a subtype of Byte-PRegexp
+       [tc-err (ann (ann #rx#"abc" Byte-Regexp) Regexp) #:ret (tc-ret -Regexp)] ;; Byte-Regexp not a subtype of Regexp
+       [tc-err (ann (ann #px#"abc" Byte-PRegexp) Regexp) #:ret (tc-ret -Regexp)] ;; Byte-PRegexp not a subtype of Regexp
+
+       [tc-err (ann (ann #px"abc" PRegexp) Byte-Regexp) #:ret (tc-ret -Byte-Regexp)] ;; PRegexp not a subtype of Byte-Regexp
+       [tc-err (ann (ann #px"abc" PRegexp) Byte-PRegexp) #:ret (tc-ret -Byte-PRegexp)] ;; PRegexp not a subtype of Byte-PRegexp
+       [tc-err (ann (ann #rx#"abc" Byte-Regexp) PRegexp) #:ret (tc-ret -PRegexp)] ;; Byte-Regexp not a subtype of PRegexp
+       [tc-err (ann (ann #px#"abc" Byte-PRegexp) PRegexp) #:ret (tc-ret -PRegexp)] ;; Byte-PRegexp not a subtype of PRegexp
+
+       ;; Inferred type should be PRegexp, so we should not be able to set a Regexp:
+       [tc-err (let () (define b2 (box #px".*")) (set-box! b2 #rx".*"))]
+       ;; Inferred type should be Byte-PRegexp, so we should not be able to set a Byte-Regexp:
+       [tc-err (let () (define b2 (box #px#".*")) (set-box! b2 #rx#".*"))]
        )
 
   (test-suite