additional fixes to the docs and racket/contract's exports to make them match up

This commit is contained in:
Robby Findler 2011-04-14 18:41:26 -05:00
parent 92fd8f2dd4
commit ec50a8c5a2
7 changed files with 165 additions and 49 deletions

View File

@ -24,6 +24,11 @@
procedure-accepts-and-more?
check-procedure
check-procedure/more
make-contracted-function
contracted-function?
contracted-function-proc
contracted-function-ctc
make-contracted-function)
(all-from-out "private/arr-i.rkt")
(all-from-out "private/box.rkt")
@ -40,7 +45,15 @@
check-flat-named-contract)
(except-out (all-from-out "private/blame.rkt") make-blame)
(all-from-out "private/prop.rkt")
opt/c define-opt/c ;(all-from-out "private/opt.rkt")
)
(except-out (all-from-out "private/prop.rkt")
contract-struct-name
contract-struct-first-order
contract-struct-projection
contract-struct-stronger?
contract-struct?
chaperone-contract-struct?
flat-contract-struct?)
;; from private/opt.rkt:
opt/c define-opt/c)

View File

@ -39,7 +39,10 @@ v4 todo:
procedure-accepts-and-more?
check-procedure
check-procedure/more
(struct-out contracted-function))
contracted-function?
contracted-function-proc
contracted-function-ctc
make-contracted-function)
(define-syntax-parameter making-a-method #f)
(define-for-syntax (make-this-parameters id)

View File

@ -8,8 +8,7 @@
(require (for-syntax racket/base
"helpers.rkt"))
(provide
coerce-contract
(provide coerce-contract
coerce-contracts
coerce-flat-contract
coerce-flat-contracts
@ -23,7 +22,6 @@
flat-contract
flat-contract-predicate
flat-named-contract
build-flat-contract
build-compound-type-name
@ -182,9 +180,19 @@
(define-syntax (define/final-prop stx)
(syntax-case stx ()
[(_ header bodies ...)
(with-syntax ([ctc (if (identifier? #'header)
#'header
(car (syntax-e #'header)))])
(with-syntax ([ctc
(syntax-case #'header ()
[id
(identifier? #'id)
#'id]
[(id1 . rest)
(identifier? #'id1)
#'id1]
[_
(raise-syntax-error #f
"malformed header position"
stx
#'header)])])
(with-syntax ([ctc/proc (string->symbol (format "~a/proc" (syntax-e #'ctc)))])
#'(begin
(define ctc/proc
@ -501,6 +509,3 @@
(predicate-contract-pred that))))
#:name (λ (ctc) (predicate-contract-name ctc))
#:first-order (λ (ctc) (predicate-contract-pred ctc))))
(define (build-flat-contract name pred) (make-predicate-contract name pred))

View File

@ -477,7 +477,7 @@
(define/final-prop (not/c f)
(let* ([ctc (coerce-flat-contract 'not/c f)]
[pred (flat-contract-predicate ctc)])
(build-flat-contract
(flat-named-contract
(build-compound-type-name 'not/c ctc)
(λ (x) (not (pred x))))))
@ -636,7 +636,7 @@
(define/subexpression-pos-prop (syntax/c ctc-in)
(let ([ctc (coerce-contract 'syntax/c ctc-in)])
(build-flat-contract
(flat-named-contract
(build-compound-type-name 'syntax/c ctc)
(let ([pred (flat-contract-predicate ctc)])
(λ (val)

View File

@ -4,27 +4,29 @@
;; this code builds the list of predicates (in case it changes, this may need to be re-run)
#;
(define predicates
(define runtime-predicates
(let ([fn (build-path (collection-path "scheme")
"compiled"
"main_ss.zo")])
"main_rkt.zo")])
(let-values ([(vars stx)
(module-compiled-exports
(parameterize ([read-accept-compiled #t])
(call-with-input-file fn read)))])
(filter (λ (sym)
(let ([str (symbol->string sym)])
(and (not (equal? str ""))
(regexp-match #rx"[?]$" str)
(not (regexp-match #rx"[=<>][?]$" str)))))
(map car (cdr (assoc 0 vars)))))))
(sort
(filter (λ (sym)
(let ([str (symbol->string sym)])
(and (regexp-match #rx"[?]$" str)
(not (regexp-match #rx"[=<>][?]$" str)))))
(map car (cdr (assoc 0 vars))))
string<=?
#:key symbol->string))))
(define-for-syntax predicates
'(absolute-path?
arity-at-least?
bitwise-bit-set?
blame-original?
blame-swapped?
blame?
boolean?
box?
@ -35,6 +37,10 @@
bytes-converter?
bytes?
channel?
chaperone-contract-property?
chaperone-contract?
chaperone-of?
chaperone?
char-alphabetic?
char-blank?
char-graphic?
@ -59,21 +65,18 @@
continuation-prompt-tag?
continuation?
contract-first-order-passes?
contract-property?
contract-stronger?
contract?
contract-property?
contract-struct?
custodian-box?
custodian-memory-accounting-available?
custodian?
custom-print-quotable?
custom-write?
date-dst?
date?
dict-can-functional-set?
dict-can-remove-keys?
dict-mutable?
dict?
directory-exists?
double-flonum?
empty?
eof-object?
ephemeron?
@ -91,6 +94,7 @@
exn:fail:contract:blame?
exn:fail:contract:continuation?
exn:fail:contract:divide-by-zero?
exn:fail:contract:non-fixnum-result?
exn:fail:contract:variable?
exn:fail:contract?
exn:fail:filesystem:exists?
@ -113,12 +117,14 @@
file-exists?
file-stream-port?
fixnum?
flat-contract?
flat-contract-property?
flat-contract-struct?
flat-contract?
flonum?
generic?
handle-evt?
has-contract?
hash-eq?
hash-equal?
hash-eqv?
hash-has-key?
hash-placeholder?
@ -126,6 +132,10 @@
hash?
identifier?
immutable?
impersonator-of?
impersonator-property-accessor-procedure?
impersonator-property?
impersonator?
implementation?
inexact-real?
inexact?
@ -166,6 +176,7 @@
placeholder?
port-closed?
port-provides-progress-evts?
port-try-file-lock?
port-writes-atomic?
port-writes-special?
port?
@ -197,6 +208,7 @@
semaphore?
sequence?
set!-transformer?
single-flonum?
special-comment?
srcloc?
string?
@ -204,12 +216,14 @@
struct-constructor-procedure?
struct-mutator-procedure?
struct-predicate-procedure?
struct-type-property-accessor-procedure?
struct-type-property?
struct-type?
struct?
subclass?
subprocess?
symbol-interned?
symbol-unreadable?
symbol?
syntax-local-transforming-module-provides?
syntax-original?
@ -229,7 +243,7 @@
udp-connected?
udp?
unit?
; ??? unknown?
unsupplied-arg?
variable-reference?
vector?
void?

View File

@ -1436,6 +1436,12 @@ the other; both are provided for convenience and clarity.
}
@defproc[(blame-replace-negative [b blame?] [neg any/c]) blame?]{
Produces a @racket[blame?] object just like @racket[b] except
that it uses @racket[neg] instead of the negative
position @racket[b] has.
}
@defproc[(raise-blame-error [b blame?] [x any/c] [fmt string?] [v any/c] ...)
none/c]{
@ -1449,19 +1455,13 @@ specific to the precise violation.
}
@defproc[(exn:fail:contract:blame? [x any/c]) boolean?]{
This predicate recognizes exceptions raised by @racket[raise-blame-error].
}
@defproc[(exn:fail:contract:blame-object [e exn:fail:contract:blame?]) blame?]{
This accessor extracts the blame object associated with a contract violation.
@defstruct[(exn:fail:contract:blame exn:fail:contract) ([object blame?])]{
This exception is raised to signal a contract error. The @racket[blame]
field extracts the @racket[blame?] object associated with a contract violation.
}
@subsection{Contracts as structs}
@emph{@bold{Note:}
The interface in this section is unstable and subject to change.}
@para{
The property @racket[prop:contract] allows arbitrary structures to act as
contracts. The property @racket[prop:chaperone-contract] allows arbitrary
@ -1630,7 +1630,8 @@ where contracts appear in the source and where the positive and negative
positions of the contracts appear.
To make Check Syntax show obligation information for your new contract
combinators, use the following properties:
combinators, use the following properties (some helper macros and functions
are below):
@itemize[@item{@racketblock0['racket/contract:contract :
(vector/c symbol? (listof syntax?) (listof syntax?))]
@ -1692,6 +1693,28 @@ combinators, use the following properties:
}
]
@defform/subs[(define/final-prop header body ...)
([header main-id
(main-id id ...)
(main-id id ... . id)])]{
The same as @racket[(define header body ...)], except that uses of
@racket[main-id] in the header are annotated
with the @racket['racket/contract:contract] property
(as above).
}
@defform/subs[(define/subexpression-pos-prop header body ...)
([header main-id
(main-id id ...)
(main-id id ... . id)])]{
The same as @racket[(define header body ...)], except that uses of
@racket[main-id] in the header are annotated
with the @racket['racket/contract:contract] property
(as above) and arguments are annotated with the
@racket['racket/contract:positive-position] property.
}
@; ------------------------------------------------------------------------
@section{Contract Utilities}
@ -1871,3 +1894,63 @@ defines the @racket[bst/c] contract that checks the binary
search tree invariant. Removing the @racket[-opt/c] also
makes a binary search tree contract, but one that is
(approximately) 20 times slower.}
@section{Legacy Contracts}
@defproc[(make-proj-contract [name any/c]
[proj
(or/c (-> any/c
any/c
(list/c any/c any/c)
contact?
(-> any/c any/c))
(-> any/c
any/c
(list/c any/c any/c)
contact?
boolean?
(-> any/c any/c)))]
[first-order (-> any/c boolean?)])
contract?]{
Builds a contract using an old interface.
Modulo errors, it is equivalent to:
@racketblock[(make-contract
#:name name
#:first-order first-order
#:projection
(cond
[(procedure-arity-includes? proj 5)
(lambda (blame)
(proj (blame-positive blame)
(blame-negative blame)
(list (blame-source blame) (blame-value blame))
(blame-contract blame)
(not (blame-swapped? blame))))]
[(procedure-arity-includes? proj 4)
(lambda (blame)
(proj (blame-positive blame)
(blame-negative blame)
(list (blame-source blame) (blame-value blame))
(blame-contract blame)))]))]
}
@defproc[(raise-contract-error [val any/c] [src any/c] [pos any/c] [name any/c] [fmt string?] [arg any/c] ...)
any/c]{
Calls @racket[raise-blame-error] after building a @racket[blame] struct from
the @racket[val], @racket[src], @racket[pos], and @racket[name] arguments.
The @racket[fmt] string and following arguments are passed to
@racket[format] and used as the string in the error message.
}
@defproc[(contract-proc [c contract?])
(->* (symbol? symbol? (or/c syntax? (list/c any/c any/c)))
(boolean?)
(-> any/c any))]{
Constructs an old-style projection from a contract.
The resulting function accepts the information that is in a @racket[blame]
struct and returns a projection function that checks the contract.
}

View File

@ -1,8 +1,6 @@
#lang racket/base
(require racket/contract racket/dict racket/match)
(define (proj-get c) contract-proc)
(define path-element?
(or/c path-string? (symbols 'up 'same)))
;; Eli: We already have a notion of "path element" which is different
@ -174,7 +172,7 @@
values
(for/list ([elem (in-list elems)]
[elem/c (in-list elem/cs)])
((((proj-get elem/c) elem/c) pos neg src name blame) elem))))))
(((contract-proc elem/c) pos neg src name blame) elem))))))
(lambda (idx) idx)
#f
(lambda (idx) (more?))
@ -301,12 +299,12 @@
(define (project-in p x)
(match p
[(proj c o i s n b)
((((proj-get c) c) i o s n (not b)) x)]))
(((contract-proc c) i o s n (not b)) x)]))
(define (project-out p x)
(match p
[(proj c o i s n b)
((((proj-get c) c) o i s n b) x)]))
(((contract-proc c) o i s n b) x)]))
(define (dict->bindings dict)
(match dict