additional fixes to the docs and racket/contract's exports to make them match up
This commit is contained in:
Robby Findler
parent
92fd8f2dd4
commit
ec50a8c5a2
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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?
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
}
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user