Typos and type errors in new property stuff.
svn: r17700
This commit is contained in:
parent
1f969b8831
commit
bb7bd9de51
|
@ -365,7 +365,7 @@
|
|||
[(val blame name-id) outer-args])
|
||||
(syntax
|
||||
(let ([dom-contract-x (coerce-contract '-> dom)] ...)
|
||||
(let ([dom-x (contract-proc dom-contract-x)] ...)
|
||||
(let ([dom-x (contract-projection dom-contract-x)] ...)
|
||||
(let ([name-id (build-compound-type-name '-> name-dom-contract-x ... 'any)])
|
||||
body))))))
|
||||
|
||||
|
|
|
@ -331,9 +331,9 @@
|
|||
...
|
||||
[field-ctc-var (coerce-contract 'object-contract field-ctc-stx)]
|
||||
...)
|
||||
(let ([method-var (contract-proc method-ctc-var)]
|
||||
(let ([method-var (contract-projection method-ctc-var)]
|
||||
...
|
||||
[field-var (contract-proc field-ctc-var)]
|
||||
[field-var (contract-projection field-ctc-var)]
|
||||
...)
|
||||
(let ([cls (make-wrapper-class 'wrapper-class
|
||||
'(method-name ...)
|
||||
|
|
|
@ -57,13 +57,15 @@ improve method arity mismatch contract violation error messages?
|
|||
[(syntax? info) (build-source-location info)]
|
||||
[(list? info)
|
||||
(let ([loc (list-ref info 0)])
|
||||
(struct-copy
|
||||
srcloc loc
|
||||
[source
|
||||
(resolved-module-path-name
|
||||
(module-path-index-resolve
|
||||
(syntax-source-module
|
||||
(srcloc-source loc))))]))]
|
||||
(if (syntax? (srcloc-source loc))
|
||||
(struct-copy
|
||||
srcloc loc
|
||||
[source
|
||||
(resolved-module-path-name
|
||||
(module-path-index-resolve
|
||||
(syntax-source-module
|
||||
(srcloc-source loc))))])
|
||||
loc))]
|
||||
[else
|
||||
(error 'contract
|
||||
"expected a syntax object or list of two elements, got: ~e"
|
||||
|
|
|
@ -109,14 +109,18 @@
|
|||
(syntax-line stx)
|
||||
(syntax-column stx)
|
||||
(syntax-position stx))
|
||||
(values (source->name
|
||||
(resolved-module-path-name
|
||||
(module-path-index-resolve
|
||||
(syntax-source-module
|
||||
(srcloc-source stx)))))
|
||||
(srcloc-line stx)
|
||||
(srcloc-column stx)
|
||||
(srcloc-position stx)))])
|
||||
(if (syntax? (srcloc-source stx))
|
||||
(values (source->name
|
||||
(resolved-module-path-name
|
||||
(module-path-index-resolve
|
||||
(syntax-source-module
|
||||
(srcloc-source stx)))))
|
||||
(srcloc-line stx)
|
||||
(srcloc-column stx)
|
||||
(srcloc-position stx))
|
||||
(error 'contract
|
||||
"malformed srcloc has non-syntax source: ~e"
|
||||
stx)))])
|
||||
(let ([location (cond [(and line col) (format "~a:~a" line col)]
|
||||
[pos (format "~a" pos)]
|
||||
[else #f])])
|
||||
|
|
|
@ -740,7 +740,7 @@
|
|||
'type-name
|
||||
val))
|
||||
(fill-name p-app val))))
|
||||
predicate?)))))))]))
|
||||
#:first-order predicate?)))))))]))
|
||||
|
||||
(define listof
|
||||
(*-immutableof list? map andmap list listof))
|
||||
|
@ -902,8 +902,7 @@
|
|||
"expected immutable <~a>, given: ~e"
|
||||
"expected <~a>, given: ~e")
|
||||
'type-name
|
||||
v)))))
|
||||
#f))))))))]
|
||||
v)))))))))))))]
|
||||
[(_ predicate? constructor (arb? selector) correct-size type-name name)
|
||||
(eq? #t (syntax->datum (syntax arb?)))
|
||||
(syntax
|
||||
|
@ -936,8 +935,7 @@
|
|||
v
|
||||
"expected <~a>, given: ~e"
|
||||
'type-name
|
||||
v)))))
|
||||
#f))))))]))
|
||||
v)))))))))))]))
|
||||
|
||||
(define cons/c (*-immutable/c pair? cons (#f car cdr) cons cons/c #f))
|
||||
(define box-immutable/c (*-immutable/c box? box-immutable (#f unbox) immutable-box box-immutable/c))
|
||||
|
@ -1012,6 +1010,7 @@
|
|||
[ctc-proc (contract-projection ctc)])
|
||||
(simple-contract
|
||||
#:name (build-compound-type-name 'promise/c ctc)
|
||||
#:projection
|
||||
(λ (blame)
|
||||
(let ([p-app (ctc-proc blame)])
|
||||
(λ (val)
|
||||
|
@ -1022,7 +1021,7 @@
|
|||
"expected <promise>, given: ~e"
|
||||
val))
|
||||
(delay (p-app (force val))))))
|
||||
promise?))))
|
||||
#:first-order promise?))))
|
||||
|
||||
#|
|
||||
as with copy-struct in struct.ss, this first begin0
|
||||
|
|
Loading…
Reference in New Issue
Block a user