scribble HTML output: add page-specific table-of-contents; also add call-with-values and values to reference
svn: r7025
This commit is contained in:
Matthew Flatt
parent
972429ddf7
commit
36c962cae1
|
|
@ -273,24 +273,32 @@
|
|||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define/public (table-of-contents part ht)
|
||||
(define/private (do-table-of-contents part ht delta quiet)
|
||||
(make-table #f (render-toc part
|
||||
(sub1 (length (collected-info-number
|
||||
(part-collected-info part))))
|
||||
#t)))
|
||||
(+ delta
|
||||
(length (collected-info-number
|
||||
(part-collected-info part))))
|
||||
#t
|
||||
quiet)))
|
||||
|
||||
(define/public (table-of-contents part ht)
|
||||
(do-table-of-contents part ht -1 not))
|
||||
|
||||
(define/public (local-table-of-contents part ht)
|
||||
(table-of-contents part ht))
|
||||
|
||||
(define/private (render-toc part base-len skip?)
|
||||
(define/public (quiet-table-of-contents part ht)
|
||||
(do-table-of-contents part ht 1 (lambda (x) #t)))
|
||||
|
||||
(define/private (render-toc part base-len skip? quiet)
|
||||
(let ([number (collected-info-number (part-collected-info part))])
|
||||
(let ([subs
|
||||
(if (not (and (styled-part? part)
|
||||
(eq? 'quiet (styled-part-style part))
|
||||
(not (= base-len (sub1 (length number))))))
|
||||
(if (quiet (and (styled-part? part)
|
||||
(eq? 'quiet (styled-part-style part))
|
||||
(not (= base-len (sub1 (length number))))))
|
||||
(apply
|
||||
append
|
||||
(map (lambda (p) (render-toc p base-len #f)) (part-parts part)))
|
||||
(map (lambda (p) (render-toc p base-len #f quiet)) (part-parts part)))
|
||||
null)])
|
||||
(if skip?
|
||||
subs
|
||||
|
|
|
|||
|
|
@ -32,7 +32,8 @@
|
|||
get-dest-directory
|
||||
format-number
|
||||
strip-aux
|
||||
lookup)
|
||||
lookup
|
||||
quiet-table-of-contents)
|
||||
|
||||
(define/override (get-suffix) #".html")
|
||||
|
||||
|
|
@ -47,7 +48,11 @@
|
|||
fns)
|
||||
ht))
|
||||
|
||||
(define/public (part-whole-page? d)
|
||||
(define/public (part-whole-page? p ht)
|
||||
(let ([dest (lookup p ht `(part ,(part-tag p)))])
|
||||
(caddr dest)))
|
||||
|
||||
(define/public (current-part-whole-page?)
|
||||
#f)
|
||||
|
||||
(define/override (collect-part-tag d ht number)
|
||||
|
|
@ -55,7 +60,7 @@
|
|||
`(part ,(part-tag d))
|
||||
(list (current-output-file)
|
||||
(part-title-content d)
|
||||
(part-whole-page? d))))
|
||||
(current-part-whole-page?))))
|
||||
|
||||
(define/override (collect-target-element i ht)
|
||||
(hash-table-put! ht
|
||||
|
|
@ -71,37 +76,117 @@
|
|||
(if p
|
||||
(loop p d)
|
||||
(values d mine))))])
|
||||
`((div ((class "tocview"))
|
||||
(div ((class "tocviewtitle"))
|
||||
(a ((href "index.html")
|
||||
(class "tocviewlink"))
|
||||
,@(render-content (part-title-content top) d ht)))
|
||||
(div nbsp)
|
||||
(table
|
||||
((class "tocviewlist")
|
||||
(cellspacing "0"))
|
||||
,@(map (lambda (p)
|
||||
`(tr
|
||||
(td
|
||||
((align "right"))
|
||||
,@(format-number (collected-info-number (part-collected-info p))
|
||||
'((tt nbsp))))
|
||||
(td
|
||||
(a ((href ,(let ([dest (lookup p ht `(part ,(part-tag p)))])
|
||||
(format "~a~a~a"
|
||||
(from-root (car dest)
|
||||
(get-dest-directory))
|
||||
(if (caddr dest)
|
||||
""
|
||||
"#")
|
||||
(if (caddr dest)
|
||||
""
|
||||
`(part ,(part-tag p))))))
|
||||
(class ,(if (eq? p mine)
|
||||
"tocviewselflink"
|
||||
"tocviewlink")))
|
||||
,@(render-content (part-title-content p) d ht)))))
|
||||
(part-parts top)))))))
|
||||
`((div ((class "tocset"))
|
||||
(div ((class "tocview"))
|
||||
(div ((class "tocviewtitle"))
|
||||
(a ((href "index.html")
|
||||
(class "tocviewlink"))
|
||||
,@(render-content (part-title-content top) d ht)))
|
||||
(div nbsp)
|
||||
(table
|
||||
((class "tocviewlist")
|
||||
(cellspacing "0"))
|
||||
,@(map (lambda (p)
|
||||
`(tr
|
||||
(td
|
||||
((align "right"))
|
||||
,@(format-number (collected-info-number (part-collected-info p))
|
||||
'((tt nbsp))))
|
||||
(td
|
||||
(a ((href ,(let ([dest (lookup p ht `(part ,(part-tag p)))])
|
||||
(format "~a~a~a"
|
||||
(from-root (car dest)
|
||||
(get-dest-directory))
|
||||
(if (caddr dest)
|
||||
""
|
||||
"#")
|
||||
(if (caddr dest)
|
||||
""
|
||||
`(part ,(part-tag p))))))
|
||||
(class ,(if (eq? p mine)
|
||||
"tocviewselflink"
|
||||
"tocviewlink")))
|
||||
,@(render-content (part-title-content p) d ht)))))
|
||||
(part-parts top))))
|
||||
,@(if (ormap (lambda (p) (part-whole-page? p ht)) (part-parts d))
|
||||
null
|
||||
(let ([ps (cdr
|
||||
(let flatten ([d d])
|
||||
(cons d
|
||||
(apply
|
||||
append
|
||||
(letrec ([flow-targets
|
||||
(lambda (flow)
|
||||
(apply append (map flow-element-targets (flow-paragraphs flow))))]
|
||||
[flow-element-targets
|
||||
(lambda (e)
|
||||
(cond
|
||||
[(table? e) (table-targets e)]
|
||||
[(paragraph? e) (para-targets e)]
|
||||
[(itemization? e)
|
||||
(apply append (map flow-targets (itemization-flows e)))]
|
||||
[(blockquote? e)
|
||||
(apply append (map flow-element-targets (blockquote-paragraphs e)))]
|
||||
[(delayed-flow-element? e)
|
||||
null]))]
|
||||
[para-targets
|
||||
(lambda (para)
|
||||
(let loop ([c (paragraph-content para)])
|
||||
(cond
|
||||
[(empty? c) null]
|
||||
[else (let ([a (car c)])
|
||||
(cond
|
||||
[(toc-target-element? a)
|
||||
(cons a (loop (cdr c)))]
|
||||
[(element? a)
|
||||
(append (loop (element-content a))
|
||||
(loop (cdr c)))]
|
||||
[(delayed-element? a)
|
||||
(loop (cons (force-delayed-element a this d ht)
|
||||
(cdr c)))]
|
||||
[else
|
||||
(loop (cdr c))]))])))]
|
||||
[table-targets
|
||||
(lambda (table)
|
||||
(apply append
|
||||
(map (lambda (flows)
|
||||
(apply append (map (lambda (f)
|
||||
(if (eq? f 'cont)
|
||||
null
|
||||
(flow-targets f)))
|
||||
flows)))
|
||||
(table-flowss table))))])
|
||||
(apply append (map flow-element-targets (flow-paragraphs (part-flow d)))))
|
||||
(map flatten (part-parts d))))))])
|
||||
(if (null? ps)
|
||||
null
|
||||
`((div ((class "tocsub"))
|
||||
(div ((class "tocsubtitle"))
|
||||
"On this page:")
|
||||
(table
|
||||
((class "tocsublist")
|
||||
(cellspacing "0"))
|
||||
,@(map (lambda (p)
|
||||
(parameterize ([current-no-links #t])
|
||||
`(tr
|
||||
(td
|
||||
,@(if (part? p)
|
||||
`((span ((class "tocsublinknumber"))
|
||||
,@(format-number (collected-info-number (part-collected-info p))
|
||||
'((tt nbsp)))))
|
||||
'(""))
|
||||
(a ((href ,(if (part? p)
|
||||
(let ([dest (lookup p ht `(part ,(part-tag p)))])
|
||||
(format "#~a"
|
||||
`(part ,(part-tag p))))
|
||||
(format "#~a" (target-element-tag p))))
|
||||
(class ,(if (part? p)
|
||||
"tocsubseclink"
|
||||
"tocsublink")))
|
||||
,@(if (part? p)
|
||||
(render-content (part-title-content p) d ht)
|
||||
(render-content (element-content p) d ht)))))))
|
||||
ps)))))))))))
|
||||
|
||||
(define/public (render-one-part d ht fn number)
|
||||
(parameterize ([current-output-file fn])
|
||||
|
|
@ -356,7 +441,7 @@
|
|||
(build-path fn "index.html"))
|
||||
fns)))
|
||||
|
||||
(define/override (part-whole-page? d)
|
||||
(define/override (current-part-whole-page?)
|
||||
((collecting-sub) . <= . 2))
|
||||
|
||||
(define/private (toc-part? d)
|
||||
|
|
|
|||
|
|
@ -487,7 +487,7 @@
|
|||
(loop (cdr a) (cons (car a) o-accum)))))
|
||||
(loop (cdr a) (cons (car a) r-accum))))]
|
||||
[(tagged) (if first?
|
||||
(make-target-element
|
||||
(make-toc-target-element
|
||||
#f
|
||||
(list (to-element (make-just-context (car prototype)
|
||||
stx-id)))
|
||||
|
|
@ -661,12 +661,13 @@
|
|||
(cons #t (map (lambda (x) #f) (cdr prototypes))))))
|
||||
(content-thunk))))))
|
||||
|
||||
(define (make-target-element* stx-id content wrappers)
|
||||
(define (make-target-element* inner-make-target-element stx-id content wrappers)
|
||||
(if (null? wrappers)
|
||||
content
|
||||
(make-target-element*
|
||||
make-target-element
|
||||
stx-id
|
||||
(make-target-element
|
||||
(inner-make-target-element
|
||||
#f
|
||||
(list content)
|
||||
(register-scheme-definition
|
||||
|
|
@ -686,38 +687,42 @@
|
|||
(cons
|
||||
(list (make-flow
|
||||
(list
|
||||
(let* ([the-name
|
||||
(make-target-element*
|
||||
stx-id
|
||||
(to-element (if (pair? name)
|
||||
(map (lambda (x)
|
||||
(make-just-context x stx-id))
|
||||
name)
|
||||
stx-id))
|
||||
(let ([name (if (pair? name)
|
||||
(car name)
|
||||
name)])
|
||||
(list* (list name)
|
||||
(list name '?)
|
||||
(list 'make- name)
|
||||
(append
|
||||
(map (lambda (f)
|
||||
(list name '- (car f)))
|
||||
fields)
|
||||
(if immutable?
|
||||
null
|
||||
(map (lambda (f)
|
||||
(list 'set- name '- (car f) '!))
|
||||
fields))))))]
|
||||
[short-width (apply +
|
||||
(length fields)
|
||||
8
|
||||
(map (lambda (s)
|
||||
(string-length (symbol->string s)))
|
||||
(append (if (pair? name)
|
||||
name
|
||||
(list name))
|
||||
(map car fields))))])
|
||||
(let* ([the-name
|
||||
(let ([just-name
|
||||
(make-target-element*
|
||||
make-toc-target-element
|
||||
stx-id
|
||||
(to-element (if (pair? name)
|
||||
(make-just-context (car name) stx-id)
|
||||
stx-id))
|
||||
(let ([name (if (pair? name)
|
||||
(car name)
|
||||
name)])
|
||||
(list* (list name)
|
||||
(list name '?)
|
||||
(list 'make- name)
|
||||
(append
|
||||
(map (lambda (f)
|
||||
(list name '- (car f)))
|
||||
fields)
|
||||
(if immutable?
|
||||
null
|
||||
(map (lambda (f)
|
||||
(list 'set- name '- (car f) '!))
|
||||
fields))))))])
|
||||
(if (pair? name)
|
||||
(to-element (list just-name
|
||||
(make-just-context (cadr name) stx-id)))
|
||||
just-name))]
|
||||
[short-width (apply +
|
||||
(length fields)
|
||||
8
|
||||
(map (lambda (s)
|
||||
(string-length (symbol->string s)))
|
||||
(append (if (pair? name)
|
||||
name
|
||||
(list name))
|
||||
(map car fields))))])
|
||||
(if (and (short-width . < . max-proto-width)
|
||||
(not immutable?)
|
||||
(not transparent?))
|
||||
|
|
@ -836,7 +841,7 @@
|
|||
(list (make-flow
|
||||
(list
|
||||
(make-paragraph
|
||||
(list (make-target-element
|
||||
(list (make-toc-target-element
|
||||
#f
|
||||
(list (to-element (make-just-context name stx-id)))
|
||||
(register-scheme-definition stx-id))
|
||||
|
|
@ -885,7 +890,7 @@
|
|||
. ,(cdr form)))))))
|
||||
(and kw-id
|
||||
(eq? form (car forms))
|
||||
(make-target-element
|
||||
(make-toc-target-element
|
||||
#f
|
||||
(list (to-element (make-just-context (if (pair? form)
|
||||
(car form)
|
||||
|
|
|
|||
|
|
@ -35,15 +35,24 @@
|
|||
border: 0.5em solid #F5F5DC;
|
||||
}
|
||||
|
||||
.tocview {
|
||||
.tocset {
|
||||
position: relative;
|
||||
float: left;
|
||||
width: 10em;
|
||||
margin-right: 2em;
|
||||
}
|
||||
|
||||
.tocview {
|
||||
text-align: left;
|
||||
background-color: #F5F5DC;
|
||||
}
|
||||
|
||||
.tocsub {
|
||||
margin-top: 1em;
|
||||
text-align: left;
|
||||
background-color: #DCF5F5;
|
||||
}
|
||||
|
||||
.tocviewtitle {
|
||||
font-size: 80%;
|
||||
font-weight: bold;
|
||||
|
|
@ -63,6 +72,35 @@
|
|||
text-decoration: none;
|
||||
}
|
||||
|
||||
.tocsublist {
|
||||
margin: 0.2em 0.2em 0.2em 0.2em;
|
||||
}
|
||||
|
||||
.tocsublist td {
|
||||
vertical-align: top;
|
||||
padding-left: 1em;
|
||||
text-indent: -1em;
|
||||
}
|
||||
|
||||
.tocsublinknumber {
|
||||
font-size: 80%;
|
||||
}
|
||||
|
||||
.tocsublink {
|
||||
text-decoration: none;
|
||||
}
|
||||
|
||||
.tocsubseclink {
|
||||
font-size: 80%;
|
||||
text-decoration: none;
|
||||
}
|
||||
|
||||
.tocsubtitle {
|
||||
font-size: 80%;
|
||||
font-style: italic;
|
||||
margin: 0.2em 0.2em 0.2em 0.2em;
|
||||
}
|
||||
|
||||
.leftindent {
|
||||
margin-left: 1em;
|
||||
margin-right: 0em;
|
||||
|
|
|
|||
|
|
@ -72,6 +72,7 @@
|
|||
[element ([style any/c]
|
||||
[content list?])]
|
||||
[(target-element element) ([tag tag?])]
|
||||
[(toc-target-element target-element) ()]
|
||||
[(link-element element) ([tag tag?])]
|
||||
[(index-element element) ([tag tag?]
|
||||
[plain-seq (listof string?)]
|
||||
|
|
|
|||
|
|
@ -802,3 +802,344 @@ source location of the location where the contract was assumed. If the
|
|||
syntax object wraps a symbol, the symbol is used as the name of the
|
||||
primitive whose contract was assumed. If absent, it defaults to the
|
||||
source location of the @scheme[contract] expression.}
|
||||
|
||||
@; ------------------------------------------------------------------------
|
||||
|
||||
@section{Building New Contract Combinators}
|
||||
|
||||
Contracts are represented internally as functions that
|
||||
accept information about the contract (who is to blame,
|
||||
source locations, etc) and produce projections (in the
|
||||
spirit of Dana Scott) that enforce the contract. A
|
||||
projection is a function that accepts an arbitrary value,
|
||||
and returns a value that satisfies the corresponding
|
||||
contract. For example, a projection that accepts only
|
||||
integers corresponds to the contract @scheme[(flat-contract
|
||||
integer?)], and can be written like this:
|
||||
|
||||
@schemeblock[
|
||||
(define int-proj
|
||||
(lambda (x)
|
||||
(if (integer? x)
|
||||
x
|
||||
(signal-contract-violation))))
|
||||
]
|
||||
|
||||
As a second example, a projection that accepts unary functions
|
||||
on integers looks like this:
|
||||
|
||||
@schemeblock[
|
||||
(define int->int-proj
|
||||
(lambda (f)
|
||||
(if (and (procedure? f)
|
||||
(procedure-arity-includes? f 1))
|
||||
(lambda (x)
|
||||
(int-proj (f (int-proj x))))
|
||||
(signal-contract-violation))))
|
||||
]
|
||||
|
||||
Although these projections have the right error behavior,
|
||||
they are not quite ready for use as contracts, because they
|
||||
do not accomodate blame, and do not provide good error
|
||||
messages. In order to accomodate these, contracts do not
|
||||
just use simple projections, but use functions that accept
|
||||
the names of two parties that are the candidates for blame,
|
||||
as well as a record of the source location where the
|
||||
contract was established and the name of the contract. They
|
||||
can then, in turn, pass that information
|
||||
to @scheme[raise-contract-error] to signal a good error
|
||||
message (see below for details on its behavior).
|
||||
|
||||
Here is the first of those two projections, rewritten for
|
||||
use in the contract system:
|
||||
|
||||
@schemeblock[
|
||||
(define (int-proj pos neg src-info contract-name)
|
||||
(lambda (x)
|
||||
(if (integer? x)
|
||||
x
|
||||
(raise-contract-error
|
||||
val
|
||||
src-info
|
||||
pos
|
||||
contract-name
|
||||
"expected <integer>, given: ~e"
|
||||
val))))
|
||||
]
|
||||
|
||||
The first two new arguments specify who is to be blamed for
|
||||
positive and negative contract violations,
|
||||
respectively. Contracts, in this system, are always
|
||||
established between two parties. One party provides some
|
||||
value according to the contract, and the other consumes the
|
||||
value, also according to the contract. The first is called
|
||||
the ``positive'' person and the second the ``negative''. So,
|
||||
in the case of just the integer contract, the only thing
|
||||
that can go wrong is that the value provided is not an
|
||||
integer. Thus, only the positive argument can ever accrue
|
||||
blame (and thus only @scheme[pos] is passed
|
||||
to @scheme[raise-contract-error]).
|
||||
|
||||
Compare that to the projection for our function contract:
|
||||
|
||||
@schemeblock[
|
||||
(define (int->int-proj pos neg src-info contract-name)
|
||||
(let ([dom (int-proj neg pos src-info contract-name)]
|
||||
[rng (int-proj pos neg src-info contract-name)])
|
||||
(lambda (f)
|
||||
(if (and (procedure? f)
|
||||
(procedure-arity-includes? f 1))
|
||||
(lambda (x)
|
||||
(rng (f (dom x))))
|
||||
(raise-contract-error
|
||||
val
|
||||
src-info
|
||||
pos
|
||||
contract-name
|
||||
"expected a procedure of one argument, given: ~e"
|
||||
val)))))
|
||||
]
|
||||
|
||||
In this case, the only explicit blame covers the situation
|
||||
where either a non-procedure is supplied to the contract, or
|
||||
where the procedure does not accept one argument. As with
|
||||
the integer projection, the blame here also lies with the
|
||||
producer of the value, which is
|
||||
why @scheme[raise-contract-error] gets @scheme[pos] and
|
||||
not @scheme[neg] as its argument.
|
||||
|
||||
The checking for the domain and range are delegated to
|
||||
the @scheme[int-proj] function, which is supplied its
|
||||
arguments in the first two line of
|
||||
the @scheme[int->int-proj] function. The trick here is that,
|
||||
even though the @scheme[int->int-proj] function always
|
||||
blames what it sees as positive we can reverse the order of
|
||||
the @scheme[pos] and @scheme[neg] arguments so that the
|
||||
positive becomes the negative.
|
||||
|
||||
This is not just a cheap trick to get this example to work,
|
||||
however. The reversal of the positive and the negative is a
|
||||
natural consequence of the way functions behave. That is,
|
||||
imagine the flow of values in a program between two
|
||||
modules. First, one module defines a function, and then that
|
||||
module is required by another. So, far the function itself
|
||||
has to go from the original, providing module to the
|
||||
requiring module. Now, imagine that the providing module
|
||||
invokes the function, suppying it an argument. At this
|
||||
point, the flow of values reverses. The argument is
|
||||
travelling back from the requiring module to the providing
|
||||
module! And finally, when the function produces a result,
|
||||
that result flows back in the original
|
||||
direction. Accordingly, the contract on the domain reverses
|
||||
the positive and the negative, just like the flow of values
|
||||
reverses.
|
||||
|
||||
We can use this insight to generalize the function contracts
|
||||
and build a function that accepts any two contracts and
|
||||
returns a contract for functions between them.
|
||||
|
||||
@schemeblock[
|
||||
(define (make-simple-function-contract dom-proj range-proj)
|
||||
(lambda (pos neg src-info contract-name)
|
||||
(let ([dom (dom-proj neg pos src-info contract-name)]
|
||||
[rng (range-proj pos neg src-info contract-name)])
|
||||
(lambda (f)
|
||||
(if (and (procedure? f)
|
||||
(procedure-arity-includes? f 1))
|
||||
(lambda (x)
|
||||
(rng (f (dom x))))
|
||||
(raise-contract-error
|
||||
val
|
||||
src-info
|
||||
pos
|
||||
contract-name
|
||||
"expected a procedure of one argument, given: ~e"
|
||||
val))))))
|
||||
]
|
||||
|
||||
Projections like the ones described above, but suited to
|
||||
other, new kinds of value you might make, can be used with
|
||||
the contract library primitives below.
|
||||
|
||||
@defproc[(make-proj-contract [name any/c]
|
||||
[proj (symbol? symbol? any/c any/c . -> . any/c)]
|
||||
[first-order-test (any/c . -> . any/c)])
|
||||
contract?]{
|
||||
|
||||
The simplest way to build a contract. It can be less
|
||||
efficient than using other contract constructors described
|
||||
below, but it is the right choice for new contract
|
||||
constructors or first-time contract builders.
|
||||
|
||||
The first argument is the name of the contract. It can be an
|
||||
arbitrary s-expression. The second is a projection (see
|
||||
above).
|
||||
|
||||
The final argument is a predicate that is a
|
||||
conservative, first-order test of a value. It should be a
|
||||
function that accepts one argument and returns a boolean. If
|
||||
it returns @scheme[#f], its argument must be guaranteed to
|
||||
fail the contract, and the contract should detect this right
|
||||
when the projection is invoked. If it returns true,
|
||||
the value may or may not violate the contract, but any
|
||||
violations must not be signaled immediately.
|
||||
|
||||
From the example above, the predicate should accept unary
|
||||
functions, but reject all other values.}
|
||||
|
||||
@defproc[(build-compound-type-name [c/s any/c] ...) any]{
|
||||
|
||||
Produces an s-expression to be used as a name
|
||||
for a contract. The arguments should be either contracts or
|
||||
symbols. It wraps parenthesis around its arguments and
|
||||
extracts the names from any contracts it is supplied with.}
|
||||
|
||||
@defform[(coerce-contract id expr)]{
|
||||
|
||||
Evaluates @scheme[expr] and, if the result is a
|
||||
contract, just returns it. If the result is a procedure of arity
|
||||
one, it converts that into a contract. If the result is neither, it
|
||||
signals an error, using the first argument in the error
|
||||
message. The message says that a contract or a procedure of
|
||||
arity one was expected.}
|
||||
|
||||
@defproc[(flat-contract/predicate? [val any/c]) boolean?]{
|
||||
|
||||
A predicate that indicates when @scheme[coerce-contract] will fail.}
|
||||
|
||||
@defproc[(raise-contract-error [val any/c]
|
||||
[src-info any/c]
|
||||
[to-blame symbol?]
|
||||
[contract-name any/c]
|
||||
[fmt string?]
|
||||
[arg any/c] ...)
|
||||
any]{
|
||||
|
||||
Signals a contract violation. The first argument is the value that
|
||||
failed to satisfy the contract. The second argument is is the
|
||||
@scheme[src-info] passed to the projection and the third should be
|
||||
either @scheme[pos] or @scheme[neg] (typically @scheme[pos], see the
|
||||
beginning of this section) that was passed to the projection. The
|
||||
fourth argument is the @scheme[contract-name] that was passed to the
|
||||
projection and the remaining arguments are used with @scheme[format]
|
||||
to build an actual error message.}
|
||||
|
||||
@;{
|
||||
% to document:
|
||||
% proj-prop proj-pred? proj-get
|
||||
% name-prop name-pred? name-get
|
||||
% stronger-prop stronger-pred? stronger-get
|
||||
% flat-prop flat-pred? flat-get
|
||||
% first-order-prop first-order-get
|
||||
% contract-stronger?
|
||||
}
|
||||
|
||||
@; ------------------------------------------------------------------------
|
||||
|
||||
@section{Contract Utilities}
|
||||
|
||||
@defproc[(guilty-party [exn exn?]) any]{
|
||||
|
||||
Extracts the name of the guilty party from an exception
|
||||
raised by the contract system.}
|
||||
|
||||
@defproc[(contract? [v any/c]) boolean?]{
|
||||
|
||||
Returns @scheme[#t] if its argument is a contract (ie, constructed
|
||||
with one of the combinators described in this section), @scheme[#f]
|
||||
otherwise.}
|
||||
|
||||
@defproc[(flat-contract? [v any/c]) boolean?]{
|
||||
|
||||
Returns @scheme[#t] when its argument is a contract that has been
|
||||
constructed with @scheme[flat-contract] (and thus is essentially just
|
||||
a predicate), @scheme[#f] otherwise.}
|
||||
|
||||
@defproc[(flat-contract-predicate [v flat-contract?])
|
||||
(any/c . -> . any/c)]{
|
||||
|
||||
Extracts the predicate from a flat contract.}
|
||||
|
||||
|
||||
@defproc[(contract-first-order-passes? [contract contract?]
|
||||
[v any/c])
|
||||
boolean?]{
|
||||
|
||||
Returns a boolean indicating if the first-order tests
|
||||
of @scheme[contract] pass for @scheme[v].
|
||||
|
||||
If it returns @scheme[#f], the contract is guaranteed not to
|
||||
hold for that value; if it returns @scheme[#t], the contract
|
||||
may or may not hold. If the contract is a first-order
|
||||
contract, a result of @scheme[#t] guarantees that the
|
||||
contract holds.}
|
||||
|
||||
|
||||
@defproc[(make-none/c [sexp-name any/c]) contract?]{
|
||||
|
||||
Makes a contract that accepts no values, and reports the
|
||||
name @scheme[sexp-name] when signaling a contract violation.}
|
||||
|
||||
|
||||
@defparam[contract-violation->string
|
||||
proc
|
||||
(any/c any/c symbol? symbol? any/c string? . -> . string?)]{
|
||||
|
||||
|
||||
This is a parameter that is used when constructing a
|
||||
contract violation error. Its value is procedure that
|
||||
accepts six arguments: the value that the contract applies
|
||||
to, a syntax object representing the source location where
|
||||
the contract was established, the names of the two parties
|
||||
to the contract (as symbols) where the first one is the
|
||||
guilty one, an sexpression representing the contract, and a
|
||||
message indicating the kind of violation. The procedure then
|
||||
returns a string that is put into the contract error
|
||||
message. Note that the value is often already included in
|
||||
the message that indicates the violation.}
|
||||
|
||||
|
||||
@defform[(recursive-contract contract-expr)]{
|
||||
|
||||
Delays the evaluation of its argument until the contract is checked,
|
||||
making recursive contracts possible.}
|
||||
|
||||
|
||||
@defform[(opt/c contract-expr)]{
|
||||
|
||||
This optimizes its argument contract expression by
|
||||
traversing its syntax and, for known contract combinators,
|
||||
fuses them into a single contract combinator that avoids as
|
||||
much allocation overhad as possible. The result is a
|
||||
contract that should behave identically to its argument,
|
||||
except faster (due to the less allocation).}
|
||||
|
||||
|
||||
@defform[(define-opt/c (id id ...) expr)]{
|
||||
|
||||
This defines a recursive contract and simultaneously
|
||||
optimizes it. Semantically, it behaves just as if
|
||||
the @scheme[-opt/c] were not present, defining a function on
|
||||
contracts (except that the body expression must return a
|
||||
contract). But, it also optimizes that contract definition,
|
||||
avoiding extra allocation, much like @scheme[opt/c] does.
|
||||
|
||||
For example,
|
||||
|
||||
@schemeblock[
|
||||
(define-contract-struct bt (val left right))
|
||||
|
||||
(define-opt/c (bst-between/c lo hi)
|
||||
(or/c null?
|
||||
(bt/c [val (between/c lo hi)]
|
||||
[left (val) (bst-between/c lo val)]
|
||||
[right (val) (bst-between/c val hi)])))
|
||||
|
||||
(define bst/c (bst-between/c -inf.0 +inf.0))
|
||||
]
|
||||
|
||||
defines the @scheme[bst/c] contract that checks the binary
|
||||
search tree invariant. Removing the @scheme[-opt/c] also
|
||||
makes a binary search tree contract, but one that is
|
||||
(approximately) 20 times slower.}
|
||||
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@
|
|||
|
||||
@local-table-of-contents[]
|
||||
|
||||
@include-section["values.scrbl"]
|
||||
@include-section["exns.scrbl"]
|
||||
@include-section["cont.scrbl"]
|
||||
@include-section["cont-marks.scrbl"]
|
||||
|
|
|
|||
|
|
@ -119,7 +119,7 @@ specification of @tech{tail positions} goes with each syntactic form,
|
|||
like @scheme[if].
|
||||
|
||||
@;------------------------------------------------------------------------
|
||||
@section{Multiple Return Values}
|
||||
@section[#:tag "mz:values-model"]{Multiple Return Values}
|
||||
|
||||
A Scheme expression can evaluate to @deftech{multiple values}, in the
|
||||
same way that a procedure can accept multiple arguments.
|
||||
|
|
|
|||
35
collects/scribblings/reference/values.scrbl
Normal file
35
collects/scribblings/reference/values.scrbl
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
#reader(lib "docreader.ss" "scribble")
|
||||
@require["mz.ss"]
|
||||
|
||||
@title[#:tag "mz:values"]{Multiple Values}
|
||||
|
||||
See @secref["mz:values-model"] for general information about multiple
|
||||
result values. In addition to @scheme[call-with-values] (described in
|
||||
this section), the @scheme[let-values], @scheme[let*-values],
|
||||
@scheme[letrec-values], and @scheme[define-values] forms (among
|
||||
others) create continuations that receive multiple values.
|
||||
|
||||
@defproc[(values [v any/c] ...) any]{
|
||||
|
||||
Returns the given @scheme[v]s. That is, @scheme[values] returns as
|
||||
provided arguments.
|
||||
|
||||
@examples[
|
||||
(values 1)
|
||||
(values 1 2 3)
|
||||
(values)
|
||||
]}
|
||||
|
||||
@defproc[(call-with-values [generator (-> any)] [receiver procedure?]) any]{
|
||||
|
||||
Calls @scheme[generator], and passes the values that
|
||||
@scheme[generator] produces as arguments to @scheme[receiver]. Thus,
|
||||
@scheme[call-with-values] creates a continuation that accepts any
|
||||
number of values that @scheme[receiver] can accept. The
|
||||
@scheme[receiver] procedure is called in tail position with respect to
|
||||
the @scheme[call-with-values] call.
|
||||
|
||||
@examples[
|
||||
(call-with-values (lambda () (values 1 2)) +)
|
||||
(call-with-values (lambda () 1) (lambda (x y) (+ x y)))
|
||||
]}
|
||||
Loading…
Reference in New Issue
Block a user