From bde8ebbef08bc12b82b75410e0ac3ed588588259 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 25 Oct 2012 00:18:50 -0700 Subject: [PATCH 01/16] Improve contract generation in Typed Racket. This fixes several issues: - `Parameter` generates impersonator contracts correctly - `Any` handling now copies immutable data when possible - `Any` now recognizes more atomic base types Merge to 5.3.1. original commit: c6dc1e6ece441a7d56c2f2229dc9c0e144f8ff6f --- .../typed-racket/succeed/parameter-c.rkt | 7 +++ .../typed-racket/succeed/vector-chap.rkt | 11 +++++ .../typed-racket/private/type-contract.rkt | 43 +++++++++++++------ collects/typed-racket/utils/any-wrap.rkt | 21 +++++++-- 4 files changed, 65 insertions(+), 17 deletions(-) create mode 100644 collects/tests/typed-racket/succeed/parameter-c.rkt create mode 100644 collects/tests/typed-racket/succeed/vector-chap.rkt 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/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/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/utils/any-wrap.rkt b/collects/typed-racket/utils/any-wrap.rkt index da3f65d9..4699ad75 100644 --- a/collects/typed-racket/utils/any-wrap.rkt +++ b/collects/typed-racket/utils/any-wrap.rkt @@ -1,12 +1,12 @@ #lang racket/base -(require racket/match racket/contract/base racket/contract/combinator) +(require racket/match racket/contract/base racket/contract/combinator racket/flonum racket/fixnum) (define undef (letrec ([x x]) x)) (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) @@ -43,10 +43,25 @@ (match v [(? (lambda (e) (or (number? e) (string? e) (char? e) (symbol? e) - (null? e) (regexp? e) (eq? undef e) + (null? e) (regexp? e) (eq? undef e) (path? e) + (flvector? e) (flvector? 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)))] From 45bc44e686694ca7e2ddc3a6826aeabe639b5c5b Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 26 Oct 2012 11:05:53 -0700 Subject: [PATCH 02/16] Flvectors and Fxvectors are higher-order if we give them restricted float types. original commit: fa5846cb0c32b11e15cbfb0ca6e1fa2aadbd876e --- collects/typed-racket/utils/any-wrap.rkt | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/collects/typed-racket/utils/any-wrap.rkt b/collects/typed-racket/utils/any-wrap.rkt index 4699ad75..fcac9b53 100644 --- a/collects/typed-racket/utils/any-wrap.rkt +++ b/collects/typed-racket/utils/any-wrap.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require racket/match racket/contract/base racket/contract/combinator racket/flonum racket/fixnum) +(require racket/match racket/contract/base racket/contract/combinator) (define undef (letrec ([x x]) x)) @@ -44,8 +44,7 @@ [(? (lambda (e) (or (number? e) (string? e) (char? e) (symbol? e) (null? e) (regexp? e) (eq? undef e) (path? e) - (flvector? e) (flvector? e) (regexp? e) - (keyword? e) (bytes? e) (boolean? e) (void? e)))) + (regexp? e) (keyword? e) (bytes? e) (boolean? e) (void? e)))) v] [(cons x y) (cons (t x) (t y))] [(? vector? (? immutable?)) From b299fdb71c964fd69d578dd2560315510c576eff Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sat, 27 Oct 2012 17:28:56 -0700 Subject: [PATCH 03/16] Formatting. original commit: 7573fd7ee0f61b45dcff96d85e0cc6aab1982e6f --- collects/typed-racket/utils/any-wrap.rkt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/collects/typed-racket/utils/any-wrap.rkt b/collects/typed-racket/utils/any-wrap.rkt index fcac9b53..4cecd411 100644 --- a/collects/typed-racket/utils/any-wrap.rkt +++ b/collects/typed-racket/utils/any-wrap.rkt @@ -6,7 +6,9 @@ (define (traverse b) (define (fail v) - (raise-blame-error (blame-swap b) v "Attempted to use a higher-order value passed as `Any` in untyped code")) + (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) From 4d00c000727becd21e0c1fccc9db80f660b324fd Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sat, 27 Oct 2012 17:44:12 -0700 Subject: [PATCH 04/16] Add more specific class types instead of `Any`. Fixes Insert Large Letters dialog. Merge to 5.3.1. original commit: 4124c9a41b26092aa0dd7a33916fd8e080aa626f --- collects/typed/framework/framework.rkt | 17 +------------ collects/typed/mred/mred.rkt | 34 ++++++++++++++++++++------ 2 files changed, 27 insertions(+), 24 deletions(-) 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)] From fa259393da45d7761f2e4fc908cc7a0d837f2641 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sun, 28 Oct 2012 13:55:02 -0400 Subject: [PATCH 05/16] Make Typed Racket name printing more deterministic. original commit: 5861bf0b9fc5ff3b237619d02dc6d5eb4a55837e --- collects/typed-racket/types/printer.rkt | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) 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)) From ab1005ae6f79d372e9238489f2d3ae60d37a82c5 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 31 Oct 2012 21:13:01 -0400 Subject: [PATCH 06/16] Fix accidental use of the wrong letrec-bound variable. original commit: 0e71f2d5dc58bd497a686f23c0ed0781590a3dc6 --- collects/tests/typed-racket/succeed/exn-any.rkt | 15 +++++++++++++++ collects/typed-racket/utils/any-wrap.rkt | 4 ++-- 2 files changed, 17 insertions(+), 2 deletions(-) create mode 100644 collects/tests/typed-racket/succeed/exn-any.rkt diff --git a/collects/tests/typed-racket/succeed/exn-any.rkt b/collects/tests/typed-racket/succeed/exn-any.rkt new file mode 100644 index 00000000..131aec6e --- /dev/null +++ b/collects/tests/typed-racket/succeed/exn-any.rkt @@ -0,0 +1,15 @@ +#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/typed-racket/utils/any-wrap.rkt b/collects/typed-racket/utils/any-wrap.rkt index 4cecd411..3ebcd0be 100644 --- a/collects/typed-racket/utils/any-wrap.rkt +++ b/collects/typed-racket/utils/any-wrap.rkt @@ -14,7 +14,7 @@ (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] @@ -36,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!" From 1240dcfc3ece4bdf2e267edb46c540e0761557ad Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 31 Oct 2012 21:39:16 -0400 Subject: [PATCH 07/16] Fix binding of `udp?`. original commit: f2fd47905f4fe981dea4bda03fd08bd930dc63a1 --- collects/typed-racket/types/abbrev.rkt | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/collects/typed-racket/types/abbrev.rkt b/collects/typed-racket/types/abbrev.rkt index cadae87b..517b6451 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) racket/pretty racket/udp ;; for base type predicates racket/promise racket/tcp racket/flonum) From 4229c80060a4bad497c563421b7d4494ddc8cc17 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 30 Oct 2012 13:42:20 -0400 Subject: [PATCH 08/16] Correct TR types for udp-bind! and udp-connect!. original commit: a57e158c43b25fac9803cb1af399e53b97144df0 --- collects/typed-racket/base-env/base-env.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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)] From dd38ff4d8c47b4647c216e24bc76cd99ab60b78b Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Thu, 1 Nov 2012 15:14:23 -0600 Subject: [PATCH 09/16] adding close-eval at the end of scribble files that have a toplevel evaluator original commit: dcf4d8b040f1acdc535d1542e0d7b1bb1112d987 --- collects/typed-racket/scribblings/guide/begin.scrbl | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/collects/typed-racket/scribblings/guide/begin.scrbl b/collects/typed-racket/scribblings/guide/begin.scrbl index be91b94a..3cfd2ebe 100644 --- a/collects/typed-racket/scribblings/guide/begin.scrbl +++ b/collects/typed-racket/scribblings/guide/begin.scrbl @@ -131,3 +131,7 @@ 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] \ No newline at end of file From 2dfa34a01cf012f837cbf5e5c744d983024ad862 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 1 Nov 2012 14:06:03 -0400 Subject: [PATCH 10/16] This test always errors -- belongs in fail. original commit: c1cace28ec8072e77d70ccc40c27011c5f788295 --- collects/tests/typed-racket/{succeed => fail}/exn-any.rkt | 2 ++ 1 file changed, 2 insertions(+) rename collects/tests/typed-racket/{succeed => fail}/exn-any.rkt (89%) diff --git a/collects/tests/typed-racket/succeed/exn-any.rkt b/collects/tests/typed-racket/fail/exn-any.rkt similarity index 89% rename from collects/tests/typed-racket/succeed/exn-any.rkt rename to collects/tests/typed-racket/fail/exn-any.rkt index 131aec6e..48b4dab9 100644 --- a/collects/tests/typed-racket/succeed/exn-any.rkt +++ b/collects/tests/typed-racket/fail/exn-any.rkt @@ -1,3 +1,5 @@ +#; +(exn-pred "Any") #lang racket/load (module m typed/racket From 27093f11370cef244f3261da76260a42446a2bf6 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 2 Nov 2012 15:35:05 -0400 Subject: [PATCH 11/16] Typed Racket HISTORY. original commit: 6f1f04f99c919bc7e877214f8bb98b5159a38e27 --- doc/release-notes/typed-racket/HISTORY.txt | 4 ++++ 1 file changed, 4 insertions(+) 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 From 3fdc7889cbd4fcaf0af56d72b1c819a150ce5843 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 6 Nov 2012 12:39:56 -0500 Subject: [PATCH 12/16] Some "obvious" switching from `racket' to `racket/base'. original commit: 1c8001d174db69c57bfb0ee42e0ce75c2371e72e --- collects/typed/rackunit.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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)) From 3e4bbc8394bbfc391edc134a245d8a52084eb3f2 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 6 Nov 2012 14:07:15 -0500 Subject: [PATCH 13/16] Newlines at EOFs. original commit: 14d8c8b5a5b665d03c14748e5416ec2f1753d4fb --- collects/typed-racket/scribblings/guide/begin.scrbl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/collects/typed-racket/scribblings/guide/begin.scrbl b/collects/typed-racket/scribblings/guide/begin.scrbl index 3cfd2ebe..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)) @@ -133,5 +133,4 @@ Typed Racket also attempts to detect more than one error in the module. } - -@close-eval[the-eval] \ No newline at end of file +@close-eval[the-eval] From dcb7dbac6d800f6ecffe5e9c9f7e0e69bfa81854 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 7 Nov 2012 09:34:57 -0500 Subject: [PATCH 14/16] Chars are compared with `eqv?`. original commit: 056c1aaff44918a4e2439aa84c6b931e1afd4473 --- collects/typed-racket/typecheck/tc-app/tc-app-eq.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 ...) From 3892d0101e61f7de6c3127809d035bf1d744d808 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 7 Nov 2012 12:20:29 -0500 Subject: [PATCH 15/16] Correctly bind `place?` for contract generation. original commit: 0a0ac35ee6a427d3ca8341eb04a844a4ae7b8514 --- collects/typed-racket/types/abbrev.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/typed-racket/types/abbrev.rkt b/collects/typed-racket/types/abbrev.rkt index 517b6451..df0a3a2b 100644 --- a/collects/typed-racket/types/abbrev.rkt +++ b/collects/typed-racket/types/abbrev.rkt @@ -18,7 +18,7 @@ (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 racket/udp) + (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) From cf1a2c71d056ff6247e46daf1bfa955a3d7d530f Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Thu, 8 Nov 2012 23:02:37 -0500 Subject: [PATCH 16/16] Fix a free variance bug Commit ffe45ecce had introduced a regression with some polymorphic functions imported between typed modules due to miscommunicated variance information. original commit: daca1c0d5b6040978b1c75d4cc822c0a3a819181 --- .../tests/typed-racket/succeed/variance-test.rkt | 16 ++++++++++++++++ collects/typed-racket/rep/free-variance.rkt | 2 +- 2 files changed, 17 insertions(+), 1 deletion(-) create mode 100644 collects/tests/typed-racket/succeed/variance-test.rkt 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/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)))