Fix TR contracts.
This commit is contained in:
parent
088006413f
commit
034aacafab
|
@ -27,12 +27,16 @@
|
|||
(define (seen-before s t)
|
||||
(cons (Type-seq s) (Type-seq t)))
|
||||
(define/cond-contract (remember s t A)
|
||||
((or/c AnyValues? Values/c) (or/c AnyValues? Values/c)
|
||||
(listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?)) . -> .
|
||||
(listof (cons/c exact-nonnegative-integer? exact-nonnegative-integer?)))
|
||||
((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?
|
||||
exact-nonnegative-integer?)))
|
||||
(cons (seen-before s t) A))
|
||||
(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)))
|
||||
|
||||
|
||||
|
|
|
@ -3,9 +3,9 @@
|
|||
|
||||
(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)
|
||||
racket/match racket/list
|
||||
racket/match racket/list (prefix-in c: racket/contract/base)
|
||||
(for-syntax racket/base syntax/parse racket/list)
|
||||
(for-template racket/base))
|
||||
|
||||
|
@ -93,13 +93,13 @@
|
|||
[(+ -) (make-FilterSet + -)]))
|
||||
|
||||
(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)))
|
||||
-top
|
||||
(make-TypeFilter t p i)))
|
||||
|
||||
(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)))
|
||||
-top
|
||||
(make-NotTypeFilter t p i)))
|
||||
|
@ -118,10 +118,10 @@
|
|||
(define/cond-contract (make-arr* dom rng
|
||||
#:rest [rest #f] #:drest [drest #f] #:kws [kws null]
|
||||
#:filters [filters -no-filter] #:object [obj -no-obj])
|
||||
(c:->* ((listof Type/c) (or/c SomeValues/c Type/c))
|
||||
(#:rest (or/c #f Type/c)
|
||||
#:drest (or/c #f (cons/c Type/c symbol?))
|
||||
#:kws (listof Keyword?)
|
||||
(c:->* ((c:listof Type/c) (c:or/c SomeValues/c Type/c))
|
||||
(#:rest (c:or/c #f Type/c)
|
||||
#:drest (c:or/c #f (c:cons/c Type/c symbol?))
|
||||
#:kws (c:listof Keyword?)
|
||||
#:filters FilterSet?
|
||||
#:object Object?)
|
||||
arr?)
|
||||
|
|
|
@ -11,7 +11,7 @@
|
|||
|
||||
(provide Listof: List: MListof:)
|
||||
(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:
|
||||
|
|
|
@ -4,15 +4,15 @@
|
|||
(rep type-rep filter-rep object-rep rep-utils)
|
||||
(utils tc-utils)
|
||||
"base-abbrev.rkt"
|
||||
(contract-req)
|
||||
(rename-in (contract-req) [-> c:->] [->* c:->*])
|
||||
racket/match)
|
||||
|
||||
(provide/cond-contract
|
||||
[tc-error/expr ((string?) (#:return any/c #:stx syntax?) #:rest (listof any/c)
|
||||
. ->* . any/c)]
|
||||
. c:->* . any/c)]
|
||||
|
||||
[lookup-fail (identifier? . -> . Type/c)]
|
||||
[lookup-type-fail (identifier? . -> . Type/c)])
|
||||
[lookup-fail (identifier? . c:-> . Type/c)]
|
||||
[lookup-type-fail (identifier? . c:-> . Type/c)])
|
||||
|
||||
(define (tc-error/expr msg
|
||||
#:return [return -Bottom]
|
||||
|
|
Loading…
Reference in New Issue
Block a user