Typos and type errors in new property stuff.

svn: r17700
This commit is contained in:
Carl Eastlund 2010-01-17 07:23:47 +00:00
parent 1f969b8831
commit bb7bd9de51
5 changed files with 29 additions and 24 deletions

View File

@ -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))))))

View File

@ -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 ...)

View File

@ -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"

View File

@ -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])])

View File

@ -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