185 lines
No EOL
168 KiB
HTML
185 lines
No EOL
168 KiB
HTML
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
|
|
<html><head><meta http-equiv="content-type" content="text/html; charset=utf-8"/><meta name="viewport" content="width=device-width, initial-scale=0.8"/><title>7.8 Building New Contracts</title><link rel="stylesheet" type="text/css" href="../scribble.css" title="default"/><link rel="stylesheet" type="text/css" href="../racket.css" title="default"/><link rel="stylesheet" type="text/css" href="../manual-style.css" title="default"/><link rel="stylesheet" type="text/css" href="../manual-racket.css" title="default"/><link rel="stylesheet" type="text/css" href="../manual-racket.css" title="default"/><link rel="stylesheet" type="text/css" href="../doc-site.css" title="default"/><script type="text/javascript" src="../scribble-common.js"></script><script type="text/javascript" src="../manual-racket.js"></script><script type="text/javascript" src="../manual-racket.js"></script><script type="text/javascript" src="../doc-site.js"></script><script type="text/javascript" src="../local-redirect/local-redirect.js"></script><script type="text/javascript" src="../local-redirect/local-user-redirect.js"></script><!--[if IE 6]><style type="text/css">.SIEHidden { overflow: hidden; }</style><![endif]--></head><body id="doc-racket-lang-org"><div class="tocset"><div class="tocview"><div class="tocviewlist tocviewlisttopspace"><div class="tocviewtitle"><table cellspacing="0" cellpadding="0"><tr><td style="width: 1em;"><a href="javascript:void(0);" title="Expand/Collapse" class="tocviewtoggle" onclick="TocviewToggle(this,"tocview_0");">►</a></td><td></td><td><a href="index.html" class="tocviewlink" data-pltdoc="x">The Racket Guide</a></td></tr></table></div><div class="tocviewsublisttop" style="display: none;" id="tocview_0"><table cellspacing="0" cellpadding="0"><tr><td align="right">1 </td><td><a href="intro.html" class="tocviewlink" data-pltdoc="x">Welcome to Racket</a></td></tr><tr><td align="right">2 </td><td><a href="to-scheme.html" class="tocviewlink" data-pltdoc="x">Racket Essentials</a></td></tr><tr><td align="right">3 </td><td><a href="datatypes.html" class="tocviewlink" data-pltdoc="x">Built-<wbr></wbr>In Datatypes</a></td></tr><tr><td align="right">4 </td><td><a href="scheme-forms.html" class="tocviewlink" data-pltdoc="x">Expressions and Definitions</a></td></tr><tr><td align="right">5 </td><td><a href="define-struct.html" class="tocviewlink" data-pltdoc="x">Programmer-<wbr></wbr>Defined Datatypes</a></td></tr><tr><td align="right">6 </td><td><a href="modules.html" class="tocviewlink" data-pltdoc="x">Modules</a></td></tr><tr><td align="right">7 </td><td><a href="contracts.html" class="tocviewselflink" data-pltdoc="x">Contracts</a></td></tr><tr><td align="right">8 </td><td><a href="i_o.html" class="tocviewlink" data-pltdoc="x">Input and Output</a></td></tr><tr><td align="right">9 </td><td><a href="regexp.html" class="tocviewlink" data-pltdoc="x">Regular Expressions</a></td></tr><tr><td align="right">10 </td><td><a href="control.html" class="tocviewlink" data-pltdoc="x">Exceptions and Control</a></td></tr><tr><td align="right">11 </td><td><a href="for.html" class="tocviewlink" data-pltdoc="x">Iterations and Comprehensions</a></td></tr><tr><td align="right">12 </td><td><a href="match.html" class="tocviewlink" data-pltdoc="x">Pattern Matching</a></td></tr><tr><td align="right">13 </td><td><a href="classes.html" class="tocviewlink" data-pltdoc="x">Classes and Objects</a></td></tr><tr><td align="right">14 </td><td><a href="units.html" class="tocviewlink" data-pltdoc="x">Units</a></td></tr><tr><td align="right">15 </td><td><a href="reflection.html" class="tocviewlink" data-pltdoc="x">Reflection and Dynamic Evaluation</a></td></tr><tr><td align="right">16 </td><td><a href="macros.html" class="tocviewlink" data-pltdoc="x">Macros</a></td></tr><tr><td align="right">17 </td><td><a href="languages.html" class="tocviewlink" data-pltdoc="x">Creating Languages</a></td></tr><tr><td align="right">18 </td><td><a href="concurrency.html" class="tocviewlink" data-pltdoc="x">Concurrency and Synchronization</a></td></tr><tr><td align="right">19 </td><td><a href="performance.html" class="tocviewlink" data-pltdoc="x">Performance</a></td></tr><tr><td align="right">20 </td><td><a href="parallelism.html" class="tocviewlink" data-pltdoc="x">Parallelism</a></td></tr><tr><td align="right">21 </td><td><a href="running.html" class="tocviewlink" data-pltdoc="x">Running and Creating Executables</a></td></tr><tr><td align="right">22 </td><td><a href="More_Libraries.html" class="tocviewlink" data-pltdoc="x">More Libraries</a></td></tr><tr><td align="right">23 </td><td><a href="dialects.html" class="tocviewlink" data-pltdoc="x">Dialects of Racket and Scheme</a></td></tr><tr><td align="right">24 </td><td><a href="other-editors.html" class="tocviewlink" data-pltdoc="x">Command-<wbr></wbr>Line Tools and Your Editor of Choice</a></td></tr><tr><td align="right"></td><td><a href="doc-bibliography.html" class="tocviewlink" data-pltdoc="x">Bibliography</a></td></tr><tr><td align="right"></td><td><a href="doc-index.html" class="tocviewlink" data-pltdoc="x">Index</a></td></tr></table></div></div><div class="tocviewlist"><table cellspacing="0" cellpadding="0"><tr><td style="width: 1em;"><a href="javascript:void(0);" title="Expand/Collapse" class="tocviewtoggle" onclick="TocviewToggle(this,"tocview_1");">▼</a></td><td>7 </td><td><a href="contracts.html" class="tocviewlink" data-pltdoc="x">Contracts</a></td></tr></table><div class="tocviewsublist" style="display: block;" id="tocview_1"><table cellspacing="0" cellpadding="0"><tr><td align="right">7.1 </td><td><a href="contract-boundaries.html" class="tocviewlink" data-pltdoc="x">Contracts and Boundaries</a></td></tr><tr><td align="right">7.2 </td><td><a href="contract-func.html" class="tocviewlink" data-pltdoc="x">Simple Contracts on Functions</a></td></tr><tr><td align="right">7.3 </td><td><a href="contracts-general-functions.html" class="tocviewlink" data-pltdoc="x">Contracts on Functions in General</a></td></tr><tr><td align="right">7.4 </td><td><a href="contracts-first.html" class="tocviewlink" data-pltdoc="x">Contracts:<span class="mywbr"> </span> A Thorough Example</a></td></tr><tr><td align="right">7.5 </td><td><a href="contracts-struct.html" class="tocviewlink" data-pltdoc="x">Contracts on Structures</a></td></tr><tr><td align="right">7.6 </td><td><a href="contracts-exists.html" class="tocviewlink" data-pltdoc="x">Abstract Contracts using <span class="RktPn">#:<span class="mywbr"> </span>exists</span> and <span class="RktPn">#:<span class="mywbr"> </span>∃</span></a></td></tr><tr><td align="right">7.7 </td><td><a href="contracts-examples.html" class="tocviewlink" data-pltdoc="x">Additional Examples</a></td></tr><tr><td align="right">7.8 </td><td><a href="Building_New_Contracts.html" class="tocviewselflink" data-pltdoc="x">Building New Contracts</a></td></tr><tr><td align="right">7.9 </td><td><a href="contracts-gotchas.html" class="tocviewlink" data-pltdoc="x">Gotchas</a></td></tr></table></div></div><div class="tocviewlist"><table cellspacing="0" cellpadding="0"><tr><td style="width: 1em;"><a href="javascript:void(0);" title="Expand/Collapse" class="tocviewtoggle" onclick="TocviewToggle(this,"tocview_2");">►</a></td><td>7.8 </td><td><a href="Building_New_Contracts.html" class="tocviewselflink" data-pltdoc="x">Building New Contracts</a></td></tr></table><div class="tocviewsublistbottom" style="display: none;" id="tocview_2"><table cellspacing="0" cellpadding="0"><tr><td align="right">7.8.1 </td><td><a href="Building_New_Contracts.html#%28part._.Contract_.Struct_.Properties%29" class="tocviewlink" data-pltdoc="x">Contract Struct Properties</a></td></tr><tr><td align="right">7.8.2 </td><td><a href="Building_New_Contracts.html#%28part._.With_all_the_.Bells_and_.Whistles%29" class="tocviewlink" data-pltdoc="x">With all the Bells and Whistles</a></td></tr></table></div></div></div><div class="tocsub"><div class="tocsubtitle">On this page:</div><table class="tocsublist" cellspacing="0"><tr><td><span class="tocsublinknumber">7.8.1<tt> </tt></span><a href="Building_New_Contracts.html#%28part._.Contract_.Struct_.Properties%29" class="tocsubseclink" data-pltdoc="x">Contract Struct Properties</a></td></tr><tr><td><span class="tocsublinknumber">7.8.2<tt> </tt></span><a href="Building_New_Contracts.html#%28part._.With_all_the_.Bells_and_.Whistles%29" class="tocsubseclink" data-pltdoc="x">With all the Bells and Whistles</a></td></tr></table></div></div><div class="maincolumn"><div class="main"><div class="navsettop"><span class="navleft"><form class="searchform"><input class="searchbox" id="searchbox" type="text" tabindex="1" placeholder="...search manuals..." title="Enter a search string to search the manuals" onkeypress="return DoSearchKey(event, this, "8.6", "../");"/></form> <a href="https://docs.racket-lang.org/index.html" title="up to the documentation top" data-pltdoc="x" onclick="return GotoPLTRoot("8.6");">top</a><span class="tocsettoggle"> <a href="javascript:void(0);" title="show/hide table of contents" onclick="TocsetToggle();">contents</a></span></span><span class="navright"> <a href="contracts-examples.html" title="backward to "7.7 Additional Examples"" data-pltdoc="x">← prev</a> <a href="contracts.html" title="up to "7 Contracts"" data-pltdoc="x">up</a> <a href="contracts-gotchas.html" title="forward to "7.9 Gotchas"" data-pltdoc="x">next →</a></span> </div><h4 x-source-module="(lib "scribblings/guide/guide.scrbl")" x-source-pkg="racket-doc" x-part-tag=""Building_New_Contracts"">7.8<tt> </tt><a name="(part._.Building_.New_.Contracts)"></a>Building New Contracts</h4><p>Contracts are represented internally as functions that
|
|
accept information about the contract (who is to blame,
|
|
source locations, etc<span class="Sendabbrev">.</span>) and produce projections (in the
|
|
spirit of Dana Scott) that enforce the contract.</p><p>In a general sense, 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 <span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=data-structure-contracts.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fmisc..rkt%2529._flat-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">flat-contract</a></span><span class="stt"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="RktPn">)</span>, and can be written like this:</p><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">int-proj</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">x</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">x</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">signal-contract-violation</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></blockquote><p>As a second example, a projection that accepts unary functions
|
|
on integers looks like this:</p><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">int->int-proj</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._and%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">and</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure-arity-includes%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure-arity-includes?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">x</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">int-proj</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">int-proj</span><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">signal-contract-violation</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></blockquote><p>Although these projections have the right error behavior,
|
|
they are not quite ready for use as contracts, because they
|
|
do not accommodate blame and do not provide good error
|
|
messages. In order to accommodate these, contracts do not
|
|
just use simple projections, but use functions that accept a
|
|
<a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528tech._blame._object%2529&version=8.6" class="techoutside Sq" data-pltdoc="x"><span class="techinside">blame object</span></a> encapsulating
|
|
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 <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span> to signal a good error
|
|
message.</p><p><div class="SIntrapara">Here is the first of those two projections, rewritten for
|
|
use in the contract system:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">int-proj</span><span class="hspace"> </span><span class="RktSym">blame</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">x</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">x</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">blame</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">x</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">(</span><span class="RktVal">expected:</span><span class="hspace"> </span><span class="RktVal">"<integer>"</span><span class="hspace"> </span><span class="RktVal">given:</span><span class="hspace"> </span><span class="RktVal">"~e"</span><span class="RktVal">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></blockquote></div><div class="SIntrapara">The new argument specifies who is to be blamed for
|
|
positive and negative contract violations.</div></p><p>Contracts, in this system, are always
|
|
established between two parties. One party, called the server, provides some
|
|
value according to the contract, and the other, the client, consumes the
|
|
value, also according to the contract. The server is called
|
|
the positive position and the client the negative position. 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 party (the server) can ever accrue
|
|
blame. The <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span> function always blames
|
|
the positive party.</p><p>Compare that to the projection for our function contract:</p><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">int->int-proj</span><span class="hspace"> </span><span class="RktSym">blame</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">dom</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">int-proj</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-swap%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-swap</a></span><span class="hspace"> </span><span class="RktSym">blame</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">rng</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">int-proj</span><span class="hspace"> </span><span class="RktSym">blame</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._and%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">and</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure-arity-includes%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure-arity-includes?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">x</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">rng</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">dom</span><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">blame</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">(</span><span class="RktVal">expected</span><span class="hspace"> </span><span class="RktVal">"a procedure of one argument"</span><span class="hspace"> </span><span class="RktVal">given:</span><span class="hspace"> </span><span class="RktVal">"~e"</span><span class="RktVal">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></blockquote><p>In this case, the only explicit blame covers the situation
|
|
where either a non-procedure is supplied to the contract or
|
|
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 <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span> is passed <span class="RktSym">blame</span> unchanged.</p><p>The checking for the domain and range are delegated to
|
|
the <span class="RktSym">int-proj</span> function, which is supplied its
|
|
arguments in the first two lines of
|
|
the <span class="RktSym">int->int-proj</span> function. The trick here is that,
|
|
even though the <span class="RktSym">int->int-proj</span> function always
|
|
blames what it sees as positive, we can swap the blame parties by
|
|
calling <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-swap%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-swap</a></span> on the given
|
|
<a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528tech._blame._object%2529&version=8.6" class="techoutside Sq" data-pltdoc="x"><span class="techinside">blame object</span></a>, replacing
|
|
the positive party with the negative party and vice versa.</p><p>This technique is not merely a cheap trick to get the 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 (the server) defines a function, and then that
|
|
module is required by another (the client). So far, the function itself
|
|
has to go from the original, providing module to the
|
|
requiring module. Now, imagine that the requiring module
|
|
invokes the function, supplying it an argument. At this
|
|
point, the flow of values reverses. The argument is
|
|
traveling back from the requiring module to the providing
|
|
module! The client is “serving” the argument to the server,
|
|
and the server is receiving that value as a client.
|
|
And finally, when the function produces a result,
|
|
that result flows back in the original
|
|
direction from server to client.
|
|
Accordingly, the contract on the domain reverses
|
|
the positive and the negative blame parties, just like the flow
|
|
of values reverses.</p><p>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.</p><p>This projection also goes further and uses
|
|
<span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-add-context%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-add-context</a></span> to improve the error messages
|
|
when a contract violation is detected.</p><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">make-simple-function-contract</span><span class="hspace"> </span><span class="RktSym">dom-proj</span><span class="hspace"> </span><span class="RktSym">range-proj</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">blame</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">dom</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">dom-proj</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-add-context%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-add-context</a></span><span class="hspace"> </span><span class="RktSym">blame</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">"the argument of"</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:swap?</span><span class="hspace"> </span><span class="RktVal">#t</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">rng</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">range-proj</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-add-context%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-add-context</a></span><span class="hspace"> </span><span class="RktSym">blame</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">"the range of"</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._and%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">and</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure-arity-includes%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure-arity-includes?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">x</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">rng</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">dom</span><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">blame</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">(</span><span class="RktVal">expected</span><span class="hspace"> </span><span class="RktVal">"a procedure of one argument"</span><span class="hspace"> </span><span class="RktVal">given:</span><span class="hspace"> </span><span class="RktVal">"~e"</span><span class="RktVal">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></blockquote><p><div class="SIntrapara">While these projections are supported by the contract library
|
|
and can be used to build new contracts, the contract library
|
|
also supports a different API for projections that can be more
|
|
efficient. Specifically, a
|
|
<a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528tech._late._neg._projection%2529&version=8.6" class="techoutside Sq" data-pltdoc="x"><span class="techinside">late neg projection</span></a> accepts
|
|
a blame object without the negative blame information and then
|
|
returns a function that accepts both the value to be contracted and
|
|
the name of the negative party, in that order.
|
|
The returned function then in turn
|
|
returns the value with the contract. Rewriting <span class="RktSym">int->int-proj</span>
|
|
to use this API looks like this:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">int->int-proj</span><span class="hspace"> </span><span class="RktSym">blame</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">dom-blame</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-add-context%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-add-context</a></span><span class="hspace"> </span><span class="RktSym">blame</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">"the argument of"</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:swap?</span><span class="hspace"> </span><span class="RktVal">#t</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">rng-blame</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-add-context%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-add-context</a></span><span class="hspace"> </span><span class="RktSym">blame</span><span class="hspace"> </span><span class="RktVal">"the range of"</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">check-int</span><span class="hspace"> </span><span class="RktSym">v</span><span class="hspace"> </span><span class="RktSym">to-blame</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=when_unless.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._unless%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">unless</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="hspace"> </span><span class="RktSym">v</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">to-blame</span><span class="hspace"> </span><span class="RktPn">#:missing-party</span><span class="hspace"> </span><span class="RktSym">neg-party</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">v</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">(</span><span class="RktVal">expected</span><span class="hspace"> </span><span class="RktVal">"an integer"</span><span class="hspace"> </span><span class="RktVal">given:</span><span class="hspace"> </span><span class="RktVal">"~e"</span><span class="RktVal">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">v</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._and%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">and</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure-arity-includes%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure-arity-includes?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">x</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">check-int</span><span class="hspace"> </span><span class="RktSym">x</span><span class="hspace"> </span><span class="RktSym">dom-blame</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">ans</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">check-int</span><span class="hspace"> </span><span class="RktSym">ans</span><span class="hspace"> </span><span class="RktSym">rng-blame</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">ans</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">blame</span><span class="hspace"> </span><span class="RktPn">#:missing-party</span><span class="hspace"> </span><span class="RktSym">neg-party</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">(</span><span class="RktVal">expected</span><span class="hspace"> </span><span class="RktVal">"a procedure of one argument"</span><span class="hspace"> </span><span class="RktVal">given:</span><span class="hspace"> </span><span class="RktVal">"~e"</span><span class="RktVal">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div><div class="SIntrapara">The advantage of this style of contract is that the <span class="RktVar">blame</span>
|
|
argument can be supplied on the server side of the
|
|
contract boundary and the result can be used for each different
|
|
client. With the simpler situation, a new blame object has to be
|
|
created for each client.</div></p><p>One final problem remains before this contract can be used with the
|
|
rest of the contract system. In the function above,
|
|
the contract is implemented by creating a wrapper function for
|
|
<span class="RktSym">f</span>, but this wrapper function does not cooperate with
|
|
<span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Equality.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._equal%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">equal?</a></span>, nor does it let the runtime system know that there
|
|
is a relationship between the result function and <span class="RktSym">f</span>, the input
|
|
function.</p><p>To remedy these two problems, we should use
|
|
<a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=chaperones.html%23%2528tech._chaperone%2529&version=8.6" class="techoutside Sq" data-pltdoc="x"><span class="techinside">chaperones</span></a> instead
|
|
of just using <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span> to create the wrapper function. Here is the
|
|
<span class="RktSym">int->int-proj</span> function rewritten to use a
|
|
<a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=chaperones.html%23%2528tech._chaperone%2529&version=8.6" class="techoutside Sq" data-pltdoc="x"><span class="techinside">chaperone</span></a>:</p><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">int->int-proj</span><span class="hspace"> </span><span class="RktSym">blame</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">dom-blame</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-add-context%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-add-context</a></span><span class="hspace"> </span><span class="RktSym">blame</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">"the argument of"</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:swap?</span><span class="hspace"> </span><span class="RktVal">#t</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">rng-blame</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-add-context%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-add-context</a></span><span class="hspace"> </span><span class="RktSym">blame</span><span class="hspace"> </span><span class="RktVal">"the range of"</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">check-int</span><span class="hspace"> </span><span class="RktSym">v</span><span class="hspace"> </span><span class="RktSym">to-blame</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=when_unless.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._unless%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">unless</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="hspace"> </span><span class="RktSym">v</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">to-blame</span><span class="hspace"> </span><span class="RktPn">#:missing-party</span><span class="hspace"> </span><span class="RktSym">neg-party</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">v</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">(</span><span class="RktVal">expected</span><span class="hspace"> </span><span class="RktVal">"an integer"</span><span class="hspace"> </span><span class="RktVal">given:</span><span class="hspace"> </span><span class="RktVal">"~e"</span><span class="RktVal">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">v</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._and%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">and</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure-arity-includes%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure-arity-includes?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=chaperones.html%23%2528def._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._chaperone-procedure%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">chaperone-procedure</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">x</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">check-int</span><span class="hspace"> </span><span class="RktSym">x</span><span class="hspace"> </span><span class="RktSym">dom-blame</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=values.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._values%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">values</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">ans</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">check-int</span><span class="hspace"> </span><span class="RktSym">ans</span><span class="hspace"> </span><span class="RktSym">rng-blame</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">ans</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">blame</span><span class="hspace"> </span><span class="RktPn">#:missing-party</span><span class="hspace"> </span><span class="RktSym">neg-party</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">(</span><span class="RktVal">expected</span><span class="hspace"> </span><span class="RktVal">"a procedure of one argument"</span><span class="hspace"> </span><span class="RktVal">given:</span><span class="hspace"> </span><span class="RktVal">"~e"</span><span class="RktVal">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote><p><div class="SIntrapara">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. Specifically, we can use
|
|
<span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fcombinator..rkt%2529._make-chaperone-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">make-chaperone-contract</a></span> to build it:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">int->int-contract</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fprop..rkt%2529._make-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">make-contract</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:name</span><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">int->int</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:late-neg-projection</span><span class="hspace"> </span><span class="RktSym">int->int-proj</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div><div class="SIntrapara">and then combine it with a value and get some contract
|
|
checking.
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=attaching-contracts-to-values.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fregion..rkt%2529._define%252Fcontract%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define/contract</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">int->int-contract</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">"not an int"</span><span class="RktPn">)</span></td></tr></table></td></tr><tr><td><p> </p></td></tr><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">#f</span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktErr">f: contract violation;</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">expected an integer</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">given: #f</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">in: the argument of</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">int->int</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">contract from: (function f)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">blaming: top-level</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(assuming the contract is correct)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">at: eval:5:0</span></p></td></tr><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktErr">f: broke its own contract;</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">promised an integer</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">produced: "not an int"</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">in: the range of</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">int->int</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">contract from: (function f)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">blaming: (function f)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(assuming the contract is correct)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">at: eval:5:0</span></p></td></tr></table></td></tr></table></blockquote></div></p><h5 x-source-module="(lib "scribblings/guide/guide.scrbl")" x-source-pkg="racket-doc" x-part-tag=""Contract_Struct_Properties"">7.8.1<tt> </tt><a name="(part._.Contract_.Struct_.Properties)"></a>Contract Struct Properties</h5><p>The <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fcombinator..rkt%2529._make-chaperone-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">make-chaperone-contract</a></span> function is okay for one-off contracts,
|
|
but often you want to make many different contracts that differ only
|
|
in some pieces. The best way to do that is to use a <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define-struct.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._struct%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">struct</a></span>
|
|
with either <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fprop..rkt%2529._prop%7E3acontract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">prop:contract</a></span>, <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fprop..rkt%2529._prop%7E3achaperone-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">prop:chaperone-contract</a></span>, or
|
|
<span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fprop..rkt%2529._prop%7E3aflat-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">prop:flat-contract</a></span>.</p><p><div class="SIntrapara">For example, lets say we wanted to make a simple form of the <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=function-contracts.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fbase..rkt%2529._-%7E3e%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x"><span class="nobreak">-></span></a></span>
|
|
contract that accepts one contract for the range and one for the domain.
|
|
We should define a struct with two fields and use
|
|
<span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fcombinator..rkt%2529._build-chaperone-contract-property%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">build-chaperone-contract-property</a></span> to construct the chaperone contract
|
|
property we need.
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define-struct.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._struct%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">struct</a></span><span class="hspace"> </span><span class="RktSym">simple-arrow</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">dom</span><span class="hspace"> </span><span class="RktSym">rng</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:property</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fprop..rkt%2529._prop%7E3achaperone-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">prop:chaperone-contract</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fcombinator..rkt%2529._build-chaperone-contract-property%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">build-chaperone-contract-property</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:name</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-name</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:late-neg-projection</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-late-neg-proj</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div></p><p><div class="SIntrapara">To do the automatic coercion of values like <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span> and <span class="RktVal">#f</span>
|
|
into contracts, we need to call <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._coerce-chaperone-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">coerce-chaperone-contract</a></span>
|
|
(note that this rejects impersonator contracts and does not insist
|
|
on flat contracts; to do either of those things, call <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._coerce-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">coerce-contract</a></span>
|
|
or <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._coerce-flat-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">coerce-flat-contract</a></span> instead).
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym">dom</span><span class="hspace"> </span><span class="RktSym">rng</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._coerce-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">coerce-contract</a></span><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym">dom</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._coerce-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">coerce-contract</a></span><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym">rng</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div></p><p><div class="SIntrapara">To define <span class="RktVar">simple-arrow-name</span> is straight-forward; it needs to return
|
|
an s-expression representing the contract:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-name</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">`</span><span class="RktVal">(</span><span class="RktVal"><span class="nobreak">-></span></span><span class="hspace"> </span><span class="RktRdr">,</span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=contract-utilities.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._contract-name%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-name</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-dom</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktRdr">,</span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=contract-utilities.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._contract-name%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-name</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-rng</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktVal">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div><div class="SIntrapara">And we can define the projection using a generalization of the
|
|
projection we defined earlier, this time using
|
|
<a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=chaperones.html%23%2528tech._chaperone%2529&version=8.6" class="techoutside Sq" data-pltdoc="x"><span class="techinside">chaperones</span></a>:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-late-neg-proj</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">dom-ctc</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=contract-utilities.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._get%252Fbuild-late-neg-projection%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">get/build-late-neg-projection</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-dom</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">rng-ctc</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=contract-utilities.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._get%252Fbuild-late-neg-projection%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">get/build-late-neg-projection</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-rng</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">blame</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">dom+blame</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">dom-ctc</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-add-context%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-add-context</a></span><span class="hspace"> </span><span class="RktSym">blame</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">"the argument of"</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:swap?</span><span class="hspace"> </span><span class="RktVal">#t</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">rng+blame</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">rng-ctc</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._blame-add-context%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">blame-add-context</a></span><span class="hspace"> </span><span class="RktSym">blame</span><span class="hspace"> </span><span class="RktVal">"the range of"</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._and%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">and</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure-arity-includes%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure-arity-includes?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=chaperones.html%23%2528def._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._chaperone-procedure%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">chaperone-procedure</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">arg</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=values.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._values%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">values</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">result</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">rng+blame</span><span class="hspace"> </span><span class="RktSym">result</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">dom+blame</span><span class="hspace"> </span><span class="RktSym">arg</span><span class="hspace"> </span><span class="RktSym">neg-party</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fblame..rkt%2529._raise-blame-error%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">raise-blame-error</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">blame</span><span class="hspace"> </span><span class="RktPn">#:missing-party</span><span class="hspace"> </span><span class="RktSym">neg-party</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">(</span><span class="RktVal">expected</span><span class="hspace"> </span><span class="RktVal">"a procedure of one argument"</span><span class="hspace"> </span><span class="RktVal">given:</span><span class="hspace"> </span><span class="RktVal">"~e"</span><span class="RktVal">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div></p><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=attaching-contracts-to-values.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fregion..rkt%2529._define%252Fcontract%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define/contract</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktSym">x</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=booleans.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._boolean%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">boolean?</a></span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">"not a boolean"</span><span class="RktPn">)</span></td></tr></table></td></tr><tr><td><p> </p></td></tr><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">#f</span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktErr">f: contract violation</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">expected: integer?</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">given: #f</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">in: the argument of</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(-> integer? boolean?)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">contract from: (function f)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">blaming: top-level</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(assuming the contract is correct)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">at: eval:12:0</span></p></td></tr><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktErr">f: broke its own contract</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">promised: boolean?</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">produced: "not a boolean"</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">in: the range of</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(-> integer? boolean?)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">contract from: (function f)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">blaming: (function f)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(assuming the contract is correct)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">at: eval:12:0</span></p></td></tr></table></td></tr></table></blockquote><h5 x-source-module="(lib "scribblings/guide/guide.scrbl")" x-source-pkg="racket-doc" x-part-tag=""With_all_the_Bells_and_Whistles"">7.8.2<tt> </tt><a name="(part._.With_all_the_.Bells_and_.Whistles)"></a>With all the Bells and Whistles</h5><p>There are a number of optional pieces to a contract that
|
|
<span class="RktSym">simple-arrow-contract</span> did not add. In this section,
|
|
we walk through all of them to show examples of how they can
|
|
be implemented.</p><p><div class="SIntrapara">The first is a first-order check. This is used by <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=data-structure-contracts.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fbase..rkt%2529._or%252Fc%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">or/c</a></span>
|
|
in order to determine which of the higher-order argument contracts
|
|
to use when it sees a value. Here’s the function for
|
|
our simple arrow contract.
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-first-order</span><span class="hspace"> </span><span class="RktSym">ctc</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">v</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._and%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">and</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure?</a></span><span class="hspace"> </span><span class="RktSym">v</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure-arity-includes%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure-arity-includes?</a></span><span class="hspace"> </span><span class="RktSym">v</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div><div class="SIntrapara">It accepts a value and returns <span class="RktVal">#f</span> if the value is guaranteed not
|
|
to satisfy the contract, and <span class="RktVal">#t</span> if, as far as we can tell,
|
|
the value satisfies the contract, just be inspecting first-order
|
|
properties of the value.</div></p><p>The next is random generation. Random generation in the contract
|
|
library consists of two pieces: the ability to randomly generate
|
|
values satisfying the contract and the ability to exercise values
|
|
that match the contract that are given, in the hopes of finding bugs
|
|
in them (and also to try to get them to produce interesting values to
|
|
be used elsewhere during generation).</p><p><div class="SIntrapara">To exercise contracts, we need to implement a function that
|
|
is given a <span class="RktSym">arrow-contract</span> struct and some fuel. It should return
|
|
two values: a function that accepts values of the contract
|
|
and exercises them, plus a list of values that the exercising
|
|
process will always produce. In the case of our simple
|
|
contract, we know that we can always produce values of the range,
|
|
as long as we can generate values of the domain (since we can just
|
|
call the function). So, here’s a function that matches the
|
|
<span class="RktVar">exercise</span> argument of <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fcombinator..rkt%2529._build-chaperone-contract-property%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">build-chaperone-contract-property</a></span>’s
|
|
contract:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-contract-exercise</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">env</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-random-generate-get-current-environment%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-random-generate-get-current-environment</a></span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">fuel</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">dom-generate</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-random-generate%252Fchoose%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-random-generate/choose</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-dom</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktSym">fuel</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._cond%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">cond</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">[</span><span class="RktSym">dom-generate</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=values.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._values%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">values</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-random-generate-stash%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-random-generate-stash</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">env</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-rng</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">dom-generate</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=pairs.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._list%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">list</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-rng</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">]</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">[</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._else%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">else</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=values.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._values%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">values</a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=void.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._void%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">void</a></span><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">(</span><span class="RktVal">)</span><span class="RktPn">)</span><span class="RktPn">]</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div><div class="SIntrapara">If the domain contract can be generated, then we know we can do some good via exercising.
|
|
In that case, we return a procedure that calls <span class="RktVar">f</span> (the function matching
|
|
the contract) with something that we generated from the domain, and we stash the result
|
|
value in the environment too. We also return <span class="RktPn">(</span><span class="RktSym">simple-arrow-rng</span><span class="stt"> </span><span class="RktSym">arr</span><span class="RktPn">)</span>
|
|
to indicate that exercising will always produce something of that contract.</div></p><p>If we cannot, then we simply return a function that
|
|
does no exercising (<span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=void.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._void%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">void</a></span>) and the empty list (indicating that we won’t generate
|
|
any values).</p><p><div class="SIntrapara">Then, to generate values matching the contract, we define a function
|
|
that when given the contract and some fuel, makes up a random function.
|
|
To help make it a more effective testing function, we can exercise
|
|
any arguments it receives, and also stash them into the generation
|
|
environment, but only if we can generate values of the range contract.
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-contract-generate</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">fuel</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">env</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-random-generate-get-current-environment%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-random-generate-get-current-environment</a></span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">rng-generate</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-random-generate%252Fchoose%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-random-generate/choose</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-rng</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktSym">fuel</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._cond%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">cond</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">[</span><span class="RktSym">rng-generate</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">arg</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-random-generate-stash%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-random-generate-stash</a></span><span class="hspace"> </span><span class="RktSym">env</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-dom</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktSym">arg</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">rng-generate</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">]</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">[</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._else%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">else</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktVal">#f</span><span class="RktPn">]</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div></p><p>When the random generation pulls something out of the environment,
|
|
it needs to be able to tell if a value that has been passed to
|
|
<span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-random-generate-stash%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-random-generate-stash</a></span> is a candidate for
|
|
the contract it is trying to generate. Of course, it the contract
|
|
passed to <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-random-generate-stash%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-random-generate-stash</a></span> is an exact
|
|
match, then it can use it. But it can also use the value if the
|
|
contract is stronger (in the sense that it accepts fewer values).</p><p><div class="SIntrapara">To provide that functionality, we implement this function:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-first-stronger?</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=createclass.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fclass-internal..rkt%2529._this%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">this</a></span><span class="hspace"> </span><span class="RktSym">that</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fletstx-scheme..rkt%2529._and%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">and</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow?</span><span class="hspace"> </span><span class="RktSym">that</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._contract-stronger%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-stronger?</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-dom</span><span class="hspace"> </span><span class="RktSym">that</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-dom</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=createclass.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fclass-internal..rkt%2529._this%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">this</a></span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._contract-stronger%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-stronger?</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-rng</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=createclass.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fclass-internal..rkt%2529._this%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">this</a></span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-rng</span><span class="hspace"> </span><span class="RktSym">that</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div><div class="SIntrapara">This function accepts <span class="RktVar">this</span> and <span class="RktVar">that</span>, two contracts. It is
|
|
guaranteed that <span class="RktVar">this</span> will be one of our simple arrow contracts,
|
|
since we’re supplying this function together with the simple arrow implementation.
|
|
But the <span class="RktVar">that</span> argument might be any contract. This function
|
|
checks to see if <span class="RktVar">that</span> is also a simple arrow contract and, if so
|
|
compares the domain and range. Of course, there are other contracts that we
|
|
could also check for (e.g., contracts built using <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=function-contracts.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fbase..rkt%2529._-%7E3e%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x"><span class="nobreak">-></span></a></span> or <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=function-contracts.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fbase..rkt%2529._-%7E3e%252A%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x"><span class="nobreak">-></span>*</a></span>),
|
|
but we do not need to. The stronger function is allowed to return <span class="RktVal">#f</span>
|
|
if it doesn’t know the answer but if it returns <span class="RktVal">#t</span>, then the contract
|
|
really must be stronger.</div></p><p><div class="SIntrapara">Now that we have all of the pieces implemented, we need to pass them
|
|
to <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fcombinator..rkt%2529._build-chaperone-contract-property%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">build-chaperone-contract-property</a></span> so the contract system
|
|
starts using them:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define-struct.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._struct%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">struct</a></span><span class="hspace"> </span><span class="RktSym">simple-arrow</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">dom</span><span class="hspace"> </span><span class="RktSym">rng</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:property</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Printer_Extension.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._prop%7E3acustom-write%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">prop:custom-write</a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=contract-utilities.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._contract-custom-write-property-proc%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-custom-write-property-proc</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:property</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fprop..rkt%2529._prop%7E3achaperone-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">prop:chaperone-contract</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fcombinator..rkt%2529._build-chaperone-contract-property%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">build-chaperone-contract-property</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:name</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-name</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:late-neg-projection</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=lambda.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._%7Ece%7Ebb%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">λ</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-late-neg-proj</span><span class="hspace"> </span><span class="RktSym">arr</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:first-order</span><span class="hspace"> </span><span class="RktSym">simple-arrow-first-order</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:stronger</span><span class="hspace"> </span><span class="RktSym">simple-arrow-first-stronger?</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:generate</span><span class="hspace"> </span><span class="RktSym">simple-arrow-contract-generate</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">#:exercise</span><span class="hspace"> </span><span class="RktSym">simple-arrow-contract-exercise</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym">dom</span><span class="hspace"> </span><span class="RktSym">rng</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow</span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._coerce-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">coerce-contract</a></span><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym">dom</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Building_New_Contract_Combinators.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fguts..rkt%2529._coerce-contract%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">coerce-contract</a></span><span class="hspace"> </span><span class="RktVal">'</span><span class="RktVal">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym">rng</span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr></table></blockquote></div><div class="SIntrapara">We also add a <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Printer_Extension.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._prop%7E3acustom-write%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">prop:custom-write</a></span> property so
|
|
that the contracts print properly, e.g.:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktRes">(-> integer? integer?)</span></p></td></tr></table></blockquote></div><div class="SIntrapara">(We use <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Printer_Extension.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._prop%7E3acustom-write%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">prop:custom-write</a></span> because the contract library
|
|
can not depend on </div><div class="SIntrapara"><blockquote class="SCodeFlow"><p><a href="Module_Syntax.html#%28part._hash-lang%29" class="RktModLink" data-pltdoc="x"><span class="RktMod">#lang</span></a><span class="hspace"> </span><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=struct-generics.html&version=8.6" class="RktModLink Sq" data-pltdoc="x"><span class="RktSym">racket/generic</span></a></p></blockquote></div><div class="SIntrapara"> but yet still wants
|
|
to provide some help to make it easy to use the right printer.)</div></p><p><div class="SIntrapara">Now that that’s done, we can use the new functionality. Here’s a random function,
|
|
generated by the contract library, using our <span class="RktSym">simple-arrow-contract-generate</span>
|
|
function:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=define.html%23%2528form._%2528%2528lib._racket%252Fprivate%252Fbase..rkt%2529._define%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define</a></span><span class="hspace"> </span><span class="RktSym">a-random-function</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-random-generate%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-random-generate</a></span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="RktPn">)</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr><tr><td><p> </p></td></tr><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym">a-random-function</span><span class="hspace"> </span><span class="RktVal">0</span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktRes">0</span></p></td></tr><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym">a-random-function</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktRes">1</span></p></td></tr></table></td></tr></table></blockquote></div></p><p><div class="SIntrapara">Here’s how the contract system can now automatically find bugs in functions
|
|
that consume simple arrow contracts:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=attaching-contracts-to-values.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fregion..rkt%2529._define%252Fcontract%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define/contract</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">misbehaved-f</span><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=function-contracts.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fbase..rkt%2529._-%7E3e%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x"><span class="nobreak">-></span></a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._integer%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">integer?</a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=booleans.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._boolean%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">boolean?</a></span><span class="RktPn">)</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=data-structure-contracts.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fprivate%252Fmisc..rkt%2529._any%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">any</a></span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">"not an integer"</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr><tr><td><p> </p></td></tr><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=Random_generation.html%23%2528def._%2528%2528lib._racket%252Fcontract..rkt%2529._contract-exercise%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">contract-exercise</a></span><span class="hspace"> </span><span class="RktSym">misbehaved-f</span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktErr">misbehaved-f: broke its own contract</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">promised: integer?</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">produced: "not an integer"</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">in: the argument of</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">the 1st argument of</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(-> (-> integer? boolean?) any)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">contract from: (function misbehaved-f)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">blaming: (function misbehaved-f)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(assuming the contract is correct)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">at: eval:25:0</span></p></td></tr></table></td></tr></table></blockquote></div></p><p><div class="SIntrapara">And if we hadn’t implemented <span class="RktSym">simple-arrow-first-order</span>, then
|
|
<span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=data-structure-contracts.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fbase..rkt%2529._or%252Fc%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">or/c</a></span> would not be able to tell which branch of the <span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=data-structure-contracts.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fbase..rkt%2529._or%252Fc%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">or/c</a></span>
|
|
to use in this program:
|
|
</div><div class="SIntrapara"><blockquote class="SCodeFlow"><table cellspacing="0" cellpadding="0"><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=attaching-contracts-to-values.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fregion..rkt%2529._define%252Fcontract%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">define/contract</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">maybe-accepts-a-function</span><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=data-structure-contracts.html%23%2528def._%2528%2528lib._racket%252Fcontract%252Fbase..rkt%2529._or%252Fc%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">or/c</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">simple-arrow-contract</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._real%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">real?</a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._real%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">real?</a></span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=function-contracts.html%23%2528form._%2528%2528lib._racket%252Fcontract%252Fbase..rkt%2529._-%7E3e%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x"><span class="nobreak">-></span></a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._real%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">real?</a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._real%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">real?</a></span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._real%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">real?</a></span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=number-types.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._real%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">real?</a></span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=procedures.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._procedure%7E3f%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">procedure?</a></span><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=if.html%23%2528form._%2528%2528quote._%7E23%7E25kernel%2529._if%2529%2529&version=8.6" class="RktStxLink Sq" data-pltdoc="x">if</a></span><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">procedure-arity-includes</span><span class="hspace"> </span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">1132</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktPn">(</span><span class="RktSym">f</span><span class="hspace"> </span><span class="RktVal">11</span><span class="hspace"> </span><span class="RktVal">2</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr><tr><td><span class="hspace"> </span><span class="RktSym">f</span><span class="RktPn">)</span><span class="RktPn">)</span></td></tr></table></td></tr><tr><td><p> </p></td></tr><tr><td><table cellspacing="0" cellpadding="0" class="RktBlk"><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym">maybe-accepts-a-function</span><span class="hspace"> </span><span class="RktSym"><a href="https://download.racket-lang.org/releases/8.6/doc/local-redirect/index.html?doc=reference&rel=generic-numbers.html%23%2528def._%2528%2528quote._%7E23%7E25kernel%2529._sqrt%2529%2529&version=8.6" class="RktValLink Sq" data-pltdoc="x">sqrt</a></span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktErr">maybe-accepts-a-function: contract violation</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">expected: real?</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">given: #<procedure:sqrt></span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">in: the argument of</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">a part of the or/c of</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(or/c</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(-> real? real?)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(-> real? real? real?)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">real?)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">contract from: </span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(function maybe-accepts-a-function)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">blaming: top-level</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">(assuming the contract is correct)</span></p></td></tr><tr><td><p><span class="RktErr"></span><span class="hspace"> </span><span class="RktErr">at: eval:27:0</span></p></td></tr><tr><td><span class="stt">> </span><span class="RktPn">(</span><span class="RktSym">maybe-accepts-a-function</span><span class="hspace"> </span><span class="RktVal">123</span><span class="RktPn">)</span></td></tr><tr><td><p><span class="RktRes">123</span></p></td></tr></table></td></tr></table></blockquote></div></p><div class="navsetbottom"><span class="navleft"><form class="searchform"><input class="searchbox" id="searchbox" type="text" tabindex="1" placeholder="...search manuals..." title="Enter a search string to search the manuals" onkeypress="return DoSearchKey(event, this, "8.6", "../");"/></form> <a href="https://docs.racket-lang.org/index.html" title="up to the documentation top" data-pltdoc="x" onclick="return GotoPLTRoot("8.6");">top</a><span class="tocsettoggle"> <a href="javascript:void(0);" title="show/hide table of contents" onclick="TocsetToggle();">contents</a></span></span><span class="navright"> <a href="contracts-examples.html" title="backward to "7.7 Additional Examples"" data-pltdoc="x">← prev</a> <a href="contracts.html" title="up to "7 Contracts"" data-pltdoc="x">up</a> <a href="contracts-gotchas.html" title="forward to "7.9 Gotchas"" data-pltdoc="x">next →</a></span> </div></div></div><div id="contextindicator"> </div></body></html> |