diff --git a/collects/tests/typed-racket/fail/exn-any.rkt b/collects/tests/typed-racket/fail/exn-any.rkt new file mode 100644 index 00000000..48b4dab9 --- /dev/null +++ b/collects/tests/typed-racket/fail/exn-any.rkt @@ -0,0 +1,17 @@ +#; +(exn-pred "Any") +#lang racket/load + +(module m typed/racket + (struct: s ()) + + (struct: s2 s ()) + (define: v : Any (s2)) + (provide v)) + +(module n racket + (require 'm) + v) + +(require 'n) + diff --git a/collects/tests/typed-racket/succeed/custodian.rkt b/collects/tests/typed-racket/succeed/custodian.rkt new file mode 100644 index 00000000..8cf5031f --- /dev/null +++ b/collects/tests/typed-racket/succeed/custodian.rkt @@ -0,0 +1,6 @@ +#lang typed/racket + +;; Make sure the Custodian type is bound + +(: cust Custodian) +(define cust (current-custodian)) \ No newline at end of file diff --git a/collects/tests/typed-racket/succeed/parameter-c.rkt b/collects/tests/typed-racket/succeed/parameter-c.rkt new file mode 100644 index 00000000..95743ae0 --- /dev/null +++ b/collects/tests/typed-racket/succeed/parameter-c.rkt @@ -0,0 +1,7 @@ +#lang typed/racket/base + +(require/typed + rackunit + [current-check-around (Parameter Any)]) + + diff --git a/collects/tests/typed-racket/succeed/variance-test.rkt b/collects/tests/typed-racket/succeed/variance-test.rkt new file mode 100644 index 00000000..63ac07cc --- /dev/null +++ b/collects/tests/typed-racket/succeed/variance-test.rkt @@ -0,0 +1,16 @@ +#lang typed/racket + +;; Test a variance regression + +(struct: (A) Foo ([elems : (Vectorof A)])) + +(: make-foo (All (A) (A -> (Foo A)))) +(define (make-foo x) (Foo (vector x))) + +;; Need a module+ here because this test failed +;; originally when variance information wasn't preserved +;; across modules. +(module+ test + ;; should type check, but won't if the element has + ;; the Any type incorrectly + (+ 1 (vector-ref (Foo-elems (make-foo 1)) 0))) diff --git a/collects/tests/typed-racket/succeed/vector-chap.rkt b/collects/tests/typed-racket/succeed/vector-chap.rkt new file mode 100644 index 00000000..7ca8aa75 --- /dev/null +++ b/collects/tests/typed-racket/succeed/vector-chap.rkt @@ -0,0 +1,11 @@ +#lang racket/load + +(module m1 racket + (define (f x y) (equal? x y)) + (provide f)) + +(module m2 typed/racket + (require/typed 'm1 [f (Any Any -> Boolean)]) + (f (vector 1 2) (vector 1 2))) + +(require 'm2) diff --git a/collects/typed-racket/base-env/base-env.rkt b/collects/typed-racket/base-env/base-env.rkt index 6f9b4754..fcb090e3 100644 --- a/collects/typed-racket/base-env/base-env.rkt +++ b/collects/typed-racket/base-env/base-env.rkt @@ -1484,8 +1484,8 @@ ;;racket/udp [udp-open-socket (->opt [(-opt -String) (-opt -String)] -UDP-Socket)] -[udp-bind! (-> -UDP-Socket (-opt -String) -PosInt)] -[udp-connect! (-> -UDP-Socket (-opt -String) -PosInt)] +[udp-bind! (-> -UDP-Socket (-opt -String) -Nat -Void)] +[udp-connect! (-> -UDP-Socket (-opt -String) (-opt -Nat) -Void)] [udp-send-to (->opt -UDP-Socket -String -Nat -Bytes [-Nat -Nat] -Void)] [udp-send (->opt -UDP-Socket -Bytes [-Nat -Nat] -Void)] diff --git a/collects/typed-racket/private/type-contract.rkt b/collects/typed-racket/private/type-contract.rkt index 8b85b94c..e537217a 100644 --- a/collects/typed-racket/private/type-contract.rkt +++ b/collects/typed-racket/private/type-contract.rkt @@ -54,14 +54,24 @@ (let ([typ (if maker? ((map fld-t (Struct-flds (lookup-type-name (Name-id typ)))) #f . t:->* . typ) typ)]) - (with-syntax ([cnt (type->contract - typ - ;; this is for a `require/typed', so the value is not from the typed side - #:typed-side #f - #:kind kind - (lambda () (tc-error/stx prop "Type ~a could not be converted to a contract." typ)))]) - (quasisyntax/loc stx (define-values (n) (recursive-contract cnt #,(contract-kind->keyword kind))))))] - [_ (int-err "should never happen - not a define-values: ~a" (syntax->datum stx))])) + (with-syntax ([cnt (type->contract + typ + ;; this is for a `require/typed', so the value is not from the typed side + #:typed-side #f + #:kind kind + (λ () + (tc-error/stx + prop + "Type ~a could not be converted to a contract." + typ)))]) + (quasisyntax/loc + stx + (define-values (n) + (recursive-contract + cnt + #,(contract-kind->keyword kind))))))] + [_ (int-err "should never happen - not a define-values: ~a" + (syntax->datum stx))])) (define (change-contract-fixups forms) (map (lambda (e) @@ -89,7 +99,6 @@ (for/fold ((acc i)) ((v args)) (contract-kind-max2 v acc))) - (define (contract-kind-min i . args) (define (contract-kind-min2 x y) (cond @@ -106,7 +115,7 @@ (string->keyword (symbol->string sym))) (define (type->contract ty fail #:out [out? #f] #:typed-side [from-typed? #t] #:kind [kind 'impersonator]) - (define vars (make-parameter '())) + (define vars (make-parameter '())) (define current-contract-kind (make-parameter flat-sym)) (define (increase-current-contract-kind! kind) (current-contract-kind (contract-kind-max (current-contract-kind) kind))) @@ -138,7 +147,9 @@ [(and (> (length arrs) 1) ;; Keyword args, range and rest specs all the same. - (let ([xs (map (match-lambda [(arr: _ rng rest-spec _ kws) (list rng rest-spec kws)]) arrs)]) + (let ([xs (map (match-lambda [(arr: _ rng rest-spec _ kws) + (list rng rest-spec kws)]) + arrs)]) (foldl equal? (first xs) (rest xs))) ;; Positionals are monotonically increasing. (let-values ([(_ ok?) @@ -338,11 +349,13 @@ (match-let ([(Mu-name: n-nm _) ty]) (with-syntax ([(n*) (generate-temporaries (list n-nm))]) (parameterize ([vars (cons (list n #'n*) (vars))] - [current-contract-kind (contract-kind-min kind chaperone-sym)]) + [current-contract-kind + (contract-kind-min kind chaperone-sym)]) (define ctc (t->c b)) #`(letrec ([n* (recursive-contract #,ctc - #,(contract-kind->keyword (current-contract-kind)))]) + #,(contract-kind->keyword + (current-contract-kind)))]) n*))))] [(Value: #f) #'false/c] [(Instance: (? Mu? t)) @@ -389,7 +402,9 @@ #`(syntax/c #,(t->c t #:kind flat-sym))] [(Value: v) #`(flat-named-contract #,(format "~a" v) (lambda (x) (equal? x '#,v)))] ;; TODO Is this sound? - [(Param: in out) #`(parameter/c #,(t->c out))] + [(Param: in out) + (set-impersonator!) + #`(parameter/c #,(t->c out))] [(Hashtable: k v) (when (equal? kind flat-sym) (exit (fail))) #`(hash/c #,(t->c k #:kind chaperone-sym) #,(t->c v) #:immutable 'dont-care)] diff --git a/collects/typed-racket/rep/free-variance.rkt b/collects/typed-racket/rep/free-variance.rkt index 8ded52ed..77e5e793 100644 --- a/collects/typed-racket/rep/free-variance.rkt +++ b/collects/typed-racket/rep/free-variance.rkt @@ -46,7 +46,7 @@ (match var ((== Covariant) #'Covariant) ((== Contravariant) #'Contravariant) - ((== Invariant) #'Contravariant) + ((== Invariant) #'Invariant) ((== Constant) #'Constant) ((== Dotted) #'Dotted))) diff --git a/collects/typed-racket/scribblings/guide/begin.scrbl b/collects/typed-racket/scribblings/guide/begin.scrbl index be91b94a..24c45c7b 100644 --- a/collects/typed-racket/scribblings/guide/begin.scrbl +++ b/collects/typed-racket/scribblings/guide/begin.scrbl @@ -1,7 +1,7 @@ #lang scribble/manual @begin[(require (for-label (only-meta-in 0 typed/racket)) scribble/eval - "../utils.rkt" (only-in "quick.scrbl" typed-mod))] + "../utils.rkt" (only-in "quick.scrbl" typed-mod))] @(define the-eval (make-base-eval)) @(the-eval '(require typed/racket)) @@ -131,3 +131,6 @@ Typed Racket also attempts to detect more than one error in the module. (string-append "a string" (add1 "not a number")) ] } + + +@close-eval[the-eval] diff --git a/collects/typed-racket/typecheck/tc-app/tc-app-eq.rkt b/collects/typed-racket/typecheck/tc-app/tc-app-eq.rkt index 1a817035..97302903 100644 --- a/collects/typed-racket/typecheck/tc-app/tc-app-eq.rkt +++ b/collects/typed-racket/typecheck/tc-app/tc-app-eq.rkt @@ -40,7 +40,7 @@ ;; identifier expr expr -> tc-results (define (tc/eq comparator v1 v2) (define (eq?-able e) (or (boolean? e) (keyword? e) (symbol? e) (eof-object? e))) - (define (eqv?-able e) (or (eq?-able e) (number? e))) + (define (eqv?-able e) (or (eq?-able e) (number? e) (char? e))) (define (equal?-able e) #t) (define (ok? val) (define-syntax-rule (alt nm pred ...) diff --git a/collects/typed-racket/types/abbrev.rkt b/collects/typed-racket/types/abbrev.rkt index cadae87b..30e8258a 100644 --- a/collects/typed-racket/types/abbrev.rkt +++ b/collects/typed-racket/types/abbrev.rkt @@ -14,12 +14,11 @@ ;; avoid the other dependencies of `racket/place` '#%place unstable/function - racket/udp unstable/lazy-require (except-in racket/contract/base ->* -> one-of/c) (prefix-in c: racket/contract/base) (for-syntax racket/base syntax/parse racket/list) - (for-template racket/base racket/contract/base racket/promise racket/tcp racket/flonum) + (for-template racket/base racket/contract/base racket/promise racket/tcp racket/flonum racket/udp '#%place) racket/pretty racket/udp ;; for base type predicates racket/promise racket/tcp racket/flonum) @@ -215,7 +214,7 @@ (define -Special-Comment (make-Base 'Special-Comment #'special-comment? special-comment? #'-Special-Comment)) -(define -Custodian (make-Base 'Custodian #'custodian? custodian? #'Custodian)) +(define -Custodian (make-Base 'Custodian #'custodian? custodian? #'-Custodian)) (define -Parameterization (make-Base 'Parameterization #'parameterization? parameterization? #'-Parameterization)) diff --git a/collects/typed-racket/types/printer.rkt b/collects/typed-racket/types/printer.rkt index 20df7bda..41eaaf40 100644 --- a/collects/typed-racket/types/printer.rkt +++ b/collects/typed-racket/types/printer.rkt @@ -36,10 +36,16 @@ ;; does t have a type name associated with it currently? ;; has-name : Type -> Maybe[Symbol] (define (has-name? t) - (and print-aliases - (for/first ([(n t*) (in-pairs (in-list (force (current-type-names))))] - #:when (and (Type? t*) (type-equal? t t*))) - n))) + (cond + [print-aliases + (define candidates + (for/list ([(n t*) (in-pairs (in-list (force (current-type-names))))] + #:when (and (Type? t*) (type-equal? t t*))) + n)) + (if (null? candidates) + #f + (car (sort candidates string>? #:key symbol->string)))] + [else #f])) (define (print-filter c port write?) (define (fp . args) (apply fprintf port args)) diff --git a/collects/typed-racket/utils/any-wrap.rkt b/collects/typed-racket/utils/any-wrap.rkt index da3f65d9..3ebcd0be 100644 --- a/collects/typed-racket/utils/any-wrap.rkt +++ b/collects/typed-racket/utils/any-wrap.rkt @@ -6,13 +6,15 @@ (define (traverse b) (define (fail v) - (raise-blame-error (blame-swap b) v "Attempted to use a higher-order value passed as `Any`")) + (raise-blame-error + (blame-swap b) v + "Attempted to use a higher-order value passed as `Any` in untyped code")) (define (t v) (define (wrap-struct s) (define (extract-functions struct-type) (define-values (sym init auto ref set! imms par skip?) - (struct-type-info type)) + (struct-type-info struct-type)) (when skip? (fail s)) ;; "Opaque struct type!") (define-values (fun/chap-list _) (for/fold ([res null] @@ -34,7 +36,7 @@ res) imms)))) (cond - [par (cons fun/chap-list (extract-functions par))] + [par (append fun/chap-list (extract-functions par))] [else fun/chap-list])) (define-values (type skipped?) (struct-info s)) (when skipped? (fail s)); "Opaque struct type!" @@ -43,10 +45,24 @@ (match v [(? (lambda (e) (or (number? e) (string? e) (char? e) (symbol? e) - (null? e) (regexp? e) (eq? undef e) - (keyword? e) (bytes? e) (boolean? e) (void? e)))) + (null? e) (regexp? e) (eq? undef e) (path? e) + (regexp? e) (keyword? e) (bytes? e) (boolean? e) (void? e)))) v] [(cons x y) (cons (t x) (t y))] + [(? vector? (? immutable?)) + ;; fixme -- should have an immutable for/vector + (vector->immutable-vector + (for/vector #:length (vector-length v) + ([i (in-vector v)]) (t i)))] + [(? box? (? immutable?)) (box-immutable (t (unbox v)))] + ;; fixme -- handling keys + ;; [(? hasheq? (? immutable?)) + ;; (for/hasheq ([(k v) (in-hash v)]) (values k v))] + ;; [(? hasheqv? (? immutable?)) + ;; (for/hasheqv ([(k v) (in-hash v)]) (values k v))] + + [(? hash? (? immutable?)) + (for/hash ([(k v) (in-hash v)]) (values (t k) (t v)))] [(? vector?) (chaperone-vector v (lambda (v i e) (t e)) (lambda (v i e) (fail v)))] diff --git a/collects/typed/framework/framework.rkt b/collects/typed/framework/framework.rkt index d03ebffe..8501d9b0 100644 --- a/collects/typed/framework/framework.rkt +++ b/collects/typed/framework/framework.rkt @@ -9,28 +9,13 @@ () ([get-font (-> (Instance Font%))]))))]))) -(dt Racket:Text% (Class () - () - ([begin-edit-sequence (-> Void)] - [end-edit-sequence (-> Void)] - [lock (Boolean -> Void)] - [last-position (-> Number)] - [last-paragraph (-> Exact-Nonnegative-Integer)] - [delete (Number Number -> Void)] - [auto-wrap (Any -> Void)] - [paragraph-end-position (Number -> Natural)] - [paragraph-start-position (Number -> Natural)] - [get-start-position (-> Number)] - [get-end-position (-> Number)] - [insert (String Number Number -> Void)]))) - (require/typed/provide framework/framework [preferences:set-default (Symbol Sexp (Any -> Boolean) -> Void)] [preferences:set (Symbol Sexp -> Void)] [editor:get-standard-style-list (-> (Instance Style-List%))] - [racket:text% Racket:Text%] + [racket:text% Text:Basic%] [gui-utils:ok/cancel-buttons ((Instance Horizontal-Panel%) ((Instance Button%) (Instance Event%) -> Void) diff --git a/collects/typed/mred/mred.rkt b/collects/typed/mred/mred.rkt index 9b1ca81a..2fa0519e 100644 --- a/collects/typed/mred/mred.rkt +++ b/collects/typed/mred/mred.rkt @@ -20,28 +20,30 @@ ([parent Any] [width Integer] [label String]) ([show (Any -> Void)]))) (dt Text-Field% (Class () - ([parent Any] [callback Any] [label String]) - ([get-value (-> String)] - [focus (-> Void)]))) + ([parent (Instance Dialog%)] + [callback (Any Any -> Any)] + [label String]) + ([get-value (-> String)] + [focus (-> Void)]))) (dt Horizontal-Panel% (Class () - ([parent Any] + ([parent (Instance Dialog%)] [stretchable-height Any #t] [alignment (List Symbol Symbol) #t]) ())) (dt Choice% (Class () - ([parent Any] [label String] [choices (Listof Any)] [callback Any]) + ([parent (Instance Horizontal-Panel%)] [label String] [choices (Listof Any)] [callback (Any Any -> Any)]) ([get-selection (-> (Option Natural))] [set-selection (Integer -> Any)] [get-string-selection (-> (Option String))] [set-string-selection (String -> Void)]))) (dt Message% (Class () - ([parent Any] [label String]) + ([parent (Instance Horizontal-Panel%)] [label String]) ([set-label ((U String (Instance Bitmap%)) -> Void)]))) (dt Horizontal-Pane% (Class () - ([parent Any]) + ([parent (Instance Horizontal-Panel%)]) ())) (dt Editor-Canvas% (Class () - ([parent Any] [editor Any]) + ([parent (Instance Dialog%)] [editor (Instance Text:Basic%)]) ([set-line-count ((U #f Integer) -> Void)]))) (dt Bitmap-DC% (Class ((Instance Bitmap%)) () @@ -55,6 +57,22 @@ (dt Snip% (Class () () ([get-count (-> Integer)]))) +(dt Text:Basic% (Class () + () + ([begin-edit-sequence (-> Void)] + [end-edit-sequence (-> Void)] + [lock (Boolean -> Void)] + [last-position (-> Number)] + [last-paragraph (-> Exact-Nonnegative-Integer)] + [delete (Number Number -> Void)] + [auto-wrap (Any -> Void)] + [paragraph-end-position (Number -> Integer)] + [paragraph-start-position (Number -> Integer)] + [get-start-position (-> Integer)] + [get-end-position (-> Integer)] + [get-text (Integer (U Integer 'eof) -> String)] + [insert (String Number Number -> Void)]))) + (dt Text% (Class () () ([begin-edit-sequence (-> Void)] diff --git a/collects/typed/rackunit.rkt b/collects/typed/rackunit.rkt index 54e18f1f..6b9d16d1 100644 --- a/collects/typed/rackunit.rkt +++ b/collects/typed/rackunit.rkt @@ -1,3 +1,3 @@ -#lang racket +#lang racket/base (require typed/rackunit/main) (provide (all-from-out typed/rackunit/main)) diff --git a/doc/release-notes/typed-racket/HISTORY.txt b/doc/release-notes/typed-racket/HISTORY.txt index 42577848..67868c22 100644 --- a/doc/release-notes/typed-racket/HISTORY.txt +++ b/doc/release-notes/typed-racket/HISTORY.txt @@ -1,3 +1,7 @@ +5.3.1 +- Revised handling of `Any` exported to untyped code +- Added `cast` +- Correctly compute variance of polymorphic type application 5.3 - Keyword and optional arguments - Faster startup