diff --git a/typed-racket-lib/typed-racket/typecheck/tc-literal.rkt b/typed-racket-lib/typed-racket/typecheck/tc-literal.rkt index cfabe4c6..153d7895 100644 --- a/typed-racket-lib/typed-racket/typecheck/tc-literal.rkt +++ b/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)) diff --git a/typed-racket-lib/typed-racket/types/generalize.rkt b/typed-racket-lib/typed-racket/types/generalize.rkt index cab68b18..46cf0f26 100644 --- a/typed-racket-lib/typed-racket/types/generalize.rkt +++ b/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*] diff --git a/typed-racket-lib/typed-racket/utils/stxclass-util.rkt b/typed-racket-lib/typed-racket/utils/stxclass-util.rkt index 62dfbba8..d70dedf2 100644 --- a/typed-racket-lib/typed-racket/utils/stxclass-util.rkt +++ b/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 diff --git a/typed-racket-test/succeed/literal-char-gh-issue-434.rkt b/typed-racket-test/succeed/literal-char-gh-issue-434.rkt index a302c4ae..0f242d29 100644 --- a/typed-racket-test/succeed/literal-char-gh-issue-434.rkt +++ b/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 \ No newline at end of file +;; (set-box! c #\a) ouch, it would be nice if this worked +(set-box! c (ann #\a #\a)) \ No newline at end of file diff --git a/typed-racket-test/succeed/literal-regexp-gh-issue-539.rkt b/typed-racket-test/succeed/literal-regexp-gh-issue-539.rkt new file mode 100644 index 00000000..a5517bc2 --- /dev/null +++ b/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") \ No newline at end of file diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt index 55a7e47f..7db30b30 100644 --- a/typed-racket-test/unit-tests/typecheck-tests.rkt +++ b/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