suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix TR contracts.

Browse Source
This commit is contained in:
Vincent St-Amour 2013-02-25 19:25:39 -05:00
parent 088006413f
commit 034aacafab
4 changed files with 21 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/typed-racket/infer/infer-unit.rkt
View File

@ -27,12 +27,16 @@
(define (seen-before s t) (define (seen-before s t)
(cons (Type-seq s) (Type-seq t))) (cons (Type-seq s) (Type-seq t)))
(define/cond-contract (remember s t A) (define/cond-contract (remember s t A)
((or/c AnyValues? Values/c) (or/c AnyValues? Values/c) ((or/c AnyValues? Values/c ValuesDots?) (or/c AnyValues? Values/c ValuesDots?)
(listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?)) . -> . (listof (cons/c exact-nonnegative-integer?
(listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?))) exact-nonnegative-integer?))
. -> .
(listof (cons/c exact-nonnegative-integer?
exact-nonnegative-integer?)))
(cons (seen-before s t) A)) (cons (seen-before s t) A))
(define/cond-contract (seen? s t) (define/cond-contract (seen? s t)
((or/c AnyValues? Values/c) (or/c AnyValues? Values/c) . -> . any/c) ((or/c AnyValues? Values/c ValuesDots?) (or/c AnyValues? Values/c ValuesDots?)
. -> . any/c)
(member (seen-before s t) (current-seen))) (member (seen-before s t) (current-seen)))

16
collects/typed-racket/types/base-abbrev.rkt
View File

@ -3,9 +3,9 @@
(require "../utils/utils.rkt") (require "../utils/utils.rkt")
(require (rep type-rep filter-rep object-rep) (require (rep type-rep filter-rep object-rep rep-utils)
(env mvar-env) (env mvar-env)
racket/match racket/list racket/match racket/list (prefix-in c: racket/contract/base)
(for-syntax racket/base syntax/parse racket/list) (for-syntax racket/base syntax/parse racket/list)
(for-template racket/base)) (for-template racket/base))
@ -93,13 +93,13 @@
[(+ -) (make-FilterSet + -)])) [(+ -) (make-FilterSet + -)]))
(define/cond-contract (-filter t i [p null]) (define/cond-contract (-filter t i [p null])
(c:->* (Type/c name-ref/c) ((listof PathElem?)) Filter/c) (c:->* (Type/c name-ref/c) ((c:listof PathElem?)) Filter/c)
(if (or (type-equal? Univ t) (and (identifier? i) (is-var-mutated? i))) (if (or (type-equal? Univ t) (and (identifier? i) (is-var-mutated? i)))
-top -top
(make-TypeFilter t p i))) (make-TypeFilter t p i)))
(define/cond-contract (-not-filter t i [p null]) (define/cond-contract (-not-filter t i [p null])
(c:->* (Type/c name-ref/c) ((listof PathElem?)) Filter/c) (c:->* (Type/c name-ref/c) ((c:listof PathElem?)) Filter/c)
(if (or (type-equal? -Bottom t) (and (identifier? i) (is-var-mutated? i))) (if (or (type-equal? -Bottom t) (and (identifier? i) (is-var-mutated? i)))
-top -top
(make-NotTypeFilter t p i))) (make-NotTypeFilter t p i)))
@ -118,10 +118,10 @@
(define/cond-contract (make-arr* dom rng (define/cond-contract (make-arr* dom rng
#:rest [rest #f] #:drest [drest #f] #:kws [kws null] #:rest [rest #f] #:drest [drest #f] #:kws [kws null]
#:filters [filters -no-filter] #:object [obj -no-obj]) #:filters [filters -no-filter] #:object [obj -no-obj])
(c:->* ((listof Type/c) (or/c SomeValues/c Type/c)) (c:->* ((c:listof Type/c) (c:or/c SomeValues/c Type/c))
(#:rest (or/c #f Type/c) (#:rest (c:or/c #f Type/c)
#:drest (or/c #f (cons/c Type/c symbol?)) #:drest (c:or/c #f (c:cons/c Type/c symbol?))
#:kws (listof Keyword?) #:kws (c:listof Keyword?)
#:filters FilterSet? #:filters FilterSet?
#:object Object?) #:object Object?)
arr?) arr?)

2
collects/typed-racket/types/match-expanders.rkt
View File

@ -11,7 +11,7 @@
(provide Listof: List: MListof:) (provide Listof: List: MListof:)
(provide/cond-contract (provide/cond-contract
[untuple (Type/c -> (or/c #f (listof Type/c)))]) [untuple (Type/c . -> . (or/c #f (listof Type/c)))])
(define-match-expander Listof: (define-match-expander Listof:

8
collects/typed-racket/types/tc-error.rkt
View File

@ -4,15 +4,15 @@
(rep type-rep filter-rep object-rep rep-utils) (rep type-rep filter-rep object-rep rep-utils)
(utils tc-utils) (utils tc-utils)
"base-abbrev.rkt" "base-abbrev.rkt"
(contract-req) (rename-in (contract-req) [-> c:->] [->* c:->*])
racket/match) racket/match)
(provide/cond-contract (provide/cond-contract
[tc-error/expr ((string?) (#:return any/c #:stx syntax?) #:rest (listof any/c) [tc-error/expr ((string?) (#:return any/c #:stx syntax?) #:rest (listof any/c)
. ->* . any/c)] . c:->* . any/c)]
[lookup-fail (identifier? . -> . Type/c)] [lookup-fail (identifier? . c:-> . Type/c)]
[lookup-type-fail (identifier? . -> . Type/c)]) [lookup-type-fail (identifier? . c:-> . Type/c)])
(define (tc-error/expr msg (define (tc-error/expr msg
#:return [return -Bottom] #:return [return -Bottom]