Author: yamakenz Date: Sun Jul 22 14:55:12 2007 New Revision: 4781 Added: vendor/misc/srfi-69.html vendor/misc/srfi-9.html Modified: vendor/misc/README
Log: * vendor/misc/srfi-9.html - New file imported from http://srfi.schemers.org/srfi-9/srfi-9.html * vendor/misc/srfi-69.html - New file imported from http://srfi.schemers.org/srfi-69/srfi-69.html * vendor/misc/README - Add entry for srfi-9.html and srfi-69.html Modified: vendor/misc/README ============================================================================== --- vendor/misc/README (original) +++ vendor/misc/README Sun Jul 22 14:55:12 2007 @@ -86,3 +86,53 @@ Boston, MA 02111-1307, USA; or view http://swiss.csail.mit.edu/~jaffer/GPL.html ------------------------------------------------------------------------------ +File: srfi-9.html +URL: http://srfi.schemers.org/srfi-9/srfi-9.html +License type: MIT +License terms: + Copyright (C) Richard Kelsey (1999). All Rights Reserved. + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + "Software"), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be + included in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE + LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION + OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION + WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +------------------------------------------------------------------------------ +File: srfi-69.html +URL: http://srfi.schemers.org/srfi-69/srfi-69.html +License type: MIT +License terms: + Copyright (C) Panu Kalliokoski (2005). All Rights Reserved. + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the + "Software"), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY + CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, + TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE + SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +------------------------------------------------------------------------------ Added: vendor/misc/srfi-69.html ============================================================================== --- (empty file) +++ vendor/misc/srfi-69.html Sun Jul 22 14:55:12 2007 @@ -0,0 +1,687 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> +<html> +<head> + <title>SRFI 69: Basic hash tables</title> + <meta name="author" content="Panu Kalliokoski"> + <meta name="generator" content="stx2any"> + <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"> + <meta name="date" content="2005-02-24"> +</head> +<body> + +<a name="Ttl"><H1>Title</H1></a> + +Basic hash tables + +<a name="thr"><H1>Author</H1></a> + +Panu Kalliokoski + +<H1>Status</H1> + +This SRFI is currently in ``final'' status. To see an explanation of each +status that a SRFI can hold, see +<a HREF="http://srfi.schemers.org/srfi-process.html";>here</a>. +It will remain in draft status until 2005/09/09, or as amended. To +provide input on this SRFI, please <code> +<a HREF="mailto:srfi minus 69 at srfi dot schemers dot org">mailto:srfi minus 69 at srfi dot schemers dot org</a></code>. +See <a HREF="http://srfi.schemers.org/srfi-list-subscribe.html";>instructions +here</a> to subscribe to the list. You can access previous messages via +<a HREF="http://srfi.schemers.org/srfi-69/mail-archive/maillist.html";>the +archive of the mailing list</a>. +<p> +<ul> + <li>Received: 2005/04/25</li> + <li>Revised: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-69/srfi-69.html?rev=1.1";>2005/05/09</a></li> + <li>Revised: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-69/srfi-69.html?rev=1.2";>2005/08/03</a></li> + <li>Revised: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-69/srfi-69.html?rev=1.3";>2005/08/10</a></li> + <li>Draft extended: 2005/08/10 - 2005/09/09</li> + <li>Revised: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-69/srfi-69.html?rev=1.4";>2005/08/30</a></li> + <li>Final: <a href="http://srfi.schemers.org/cgi-bin/viewcvs.cgi/*checkout*/srfi/srfi-69/srfi-69.html?rev=1.5";>2005/09/14</a></li> +</ul> + +<h1><a name="bstr">Abstract</a></h1> + +<p>This SRFI defines basic hash tables. Hash tables are widely recognised +as a fundamental data structure for a wide variety of applications. A +hash table is a data structure that: + +<ol><li>provides a mapping from some set of keys to some set of values +associated to those keys +<li>has no intrinsic order for the (key, value) associations it contains +<li>supports in-place modification as the primary means of setting the +contents of a hash table +<li>provides key lookup and destructive update in amortised constant +time, provided that a good hash function is used. + +</ol><p>This SRFI aims to accomplish these goals: + +<ol><li>to provide a consistent, generic and widely applicable API for hash +tables +<li>to improve code portability by providing a standard hash table +facility with guaranteed behaviour +<li>to help the programmer by defining utility routines that account for +the most common situations of using hash tables. + +</ol><h1><a name="sss">Issues</a></h1> + +<p>There is no single best way to make hash tables. The tables presented +in this SRFI aim at being both conceptually simple and usable for a wide +variety of applications. Even though a portable implementation is +provided, Scheme implementations can speed things up considerably by +e.g. providing an internal hash function for symbols. Moreover, almost +every Scheme implementation already has some kind of low-level hash +table functionality, because that's the natural way to implement +the global environment, and specifically, to provide support for +<tt>string->symbol</tt>. There might be some benefit in integration +between implementation-specific environment data types and the hash +table API presented here; however, these issues are left open. + +<p>This SRFI does not conform to the interface of maps presented in SRFI +44. Following SRFI 44 would seriously cripple the interface of hash +tables. The naming of the operations for maps in SRFI 44 goes against +common use and is unnatural. However, this SRFI has been written so +that it does not <em>prevent</em> a SRFI-44 API to hash tables. An +implementation supporting both SRFI 44 and this SRFI is encouraged to +provide a SRFI 44 interface to hash tables in addition to the one +presented here. + +<h1><a name="Rtn">Rationale</a></h1> + +<p>Hash tables are widely recognised as a fundamental data structure for +many kinds of computational tasks. Thus far, there is no existing +standard for Scheme hash tables; however, almost every non-minimal +Scheme implementation provides some kind of hash table functionality. + +<p>Alas, although somewhat similar, these hash table APIs have many +differences: some trivial, like the naming of certain functions; some +complex, like revealing different aspects of the internal implementation +to the user; some coarse, like requiring keys to be of some specific +type(s); some subtle, like requiring the user to guess the size of the +hash table in advance to get optimal performance. As a result, the +existing hash table facilities cannot be used to write portable +programs. + +<p>The primary aim of this SRFI is to establish a standard API for hash +tables so that portable programs can be written that make efficient use +of common hash table functionality. The SRFI resolves discrepancies +that exist between the various hash table API's with respect to naming +and semantics of hash table operations. A lot of effort has been put +into making the the API consistent, simple and generic. The SRFI also +defines some of the most common utility routines that would otherwise +need to be written and rewritten for various applications. + +<p>Incorporating this SRFI as a standard feature in Scheme implementations +makes it possible to write efficient and portable programs that use hash +tables. + +<h1><a name="Spcf">Specification</a></h1> + +<p>Names defined in this SRFI: + +<dl><dt>Type constructors and predicate</dt> +<dd><a href="srfi-69.html#mkh">make-hash-table</a>, <a href="srfi-69.html#hsht">hash-table?</a>, <a href="srfi-69.html#lst">alist->hash-table</a> + +</dd><dt>Reflective queries</dt> +<dd><a href="srfi-69.html#hsht1">hash-table-equivalence-function</a>, <a href="srfi-69.html#hsht2">hash-table-hash-function</a> + +</dd><dt>Dealing with single elements</dt> +<dd><a href="srfi-69.html#hsht3">hash-table-ref</a>, <a href="srfi-69.html#hsht4">hash-table-ref/default</a>, <a href="srfi-69.html#hsht5">hash-table-set!</a>, +<a href="srfi-69.html#hsht6">hash-table-delete!</a>, <a href="srfi-69.html#hsht7">hash-table-exists?</a>, +<a href="srfi-69.html#hsht8">hash-table-update!</a>, <a href="srfi-69.html#hsht9">hash-table-update!/default</a> + +</dd><dt>Dealing with the whole contents</dt> +<dd><a href="srfi-69.html#hsht11">hash-table-size</a>, <a href="srfi-69.html#hsht12">hash-table-keys</a>, <a href="srfi-69.html#hsht13">hash-table-values</a>, +<a href="srfi-69.html#hsht14">hash-table-walk</a>, <a href="srfi-69.html#hsht15">hash-table-fold</a>, <a href="srfi-69.html#hsht16">hash-table->alist</a>, +<a href="srfi-69.html#hsht17">hash-table-copy</a>, <a href="srfi-69.html#hsht18">hash-table-merge!</a> + +</dd><dt>Hashing</dt> +<dd><a href="srfi-69.html#hsh">hash</a>, <a href="srfi-69.html#strng">string-hash</a>, <a href="srfi-69.html#strng19">string-ci-hash</a>, <a href="srfi-69.html#hshb">hash-by-identity</a> + +</dd></dl><p>An implementation that does not provide <tt>hash-table-ref</tt>, +<tt>hash-table-set!</tt>, <tt>hash-table-delete!</tt>, <tt>hash-table-update!</tt>, +<tt>hash-table-exists?</tt>, and <tt>hash-table-size</tt> in amortised constant +time (when a good hash function is used), or fails to provide good hash +function definitions for <tt>hash</tt>, <tt>string-hash</tt>, <tt>string-ci-hash</tt>, +and <tt>hash-by-identity</tt>, does not conform to this SRFI. + +<p>Hash table implementations are allowed to rely on the fact that the hash +value of a key in hash table does not change. In most cases, modifying +a key in-place after it has been inserted into the hash table will +violate this constraint and thus leads to unspecified behaviour. + +<h2><a name="Tpc">Type constructors and predicate</a></h2> + +<p>Procedure: <a name="mkh">make-hash-table</a> [ <var>equal?</var> [ <var>hash</var> [ <var>args</var> … ]]] +→ <var>hash-table</var> + +<p>Create a new hash table with no associations. <var>equal?</var> is a +predicate that should accept two keys and return a boolean telling +whether they denote the same key value; it defaults to <tt>equal?</tt>. + +<p><var>hash</var> is a hash function, and defaults to an appropriate hash function +for the given <var>equal?</var> predicate (see section <a href="srfi-69.html#Hshn">Hashing</a>). However, +an acceptable default is not guaranteed to be given for any equivalence +predicate coarser than <tt>equal?</tt>, except for <tt>string-ci=?</tt>.<small>[1]</small> The function <var>hash</var> must be acceptable for <var>equal?</var>, so if +you use coarser equivalence than <tt>equal?</tt> other than <tt>string-ci=?</tt>, +you must always provide the function <var>hash</var> yourself. +<br><small>[1]</small> An +equivalence predicate <var>c1</var> is coarser than a equivalence predicate <var>c2</var> +iff there exist values <var>x</var> and <var>y</var> such that <tt>(and (c1 x y) (not (c2 x +y)))</tt>.<br> + +<p>Implementations are allowed to use the rest <var>args</var> for +implementation-specific extensions. Be warned, though, that using these +extensions will make your program less portable. + +<p>Procedure: <a name="hsht">hash-table?</a> <var>obj</var> → <var>boolean</var> + +<p>A predicate to test whether a given object <var>obj</var> is a hash table. The +hash table type should be disjoint from all other types, if possible. + +<p>Procedure: <a name="lst">alist->hash-table</a> <var>alist</var> [ <var>equal?</var> [ <var>hash</var> +[ <var>args</var> … ]]] → <var>hash-table</var> + +<p>Takes an <q>association list</q> <var>alist</var> and creates a hash table +<var>hash-table</var> which maps the <tt>car</tt> of every element in <var>alist</var> to the +<tt>cdr</tt> of corresponding elements in <var>alist</var>. <var>equal?</var>, <var>hash</var>, and +<var>args</var> are interpreted as in <tt>make-hash-table</tt>. If some key occurs +multiple times in <var>alist</var>, the value in the first association will take +precedence over later ones. (Note: the choice of using <tt>cdr</tt> (instead +of <tt>cadr</tt>) for values tries to strike balance between the two +approaches: using <tt>cadr</tt> would render this procedure unusable for +<tt>cdr</tt> alists, but not vice versa.) + +<p>The rest <var>args</var> are passed to <a href="srfi-69.html#mkh">make-hash-table</a> and can thus be used for +implementation-specific extensions. + +<h2><a name="Rflc">Reflective queries</a></h2> + +<p>Procedure: <a name="hsht1">hash-table-equivalence-function</a> <var>hash-table</var> + +<p>Returns the equivalence predicate used for keys of <var>hash-table</var>. + +<p>Procedure: <a name="hsht2">hash-table-hash-function</a> <var>hash-table</var> + +<p>Returns the hash function used for keys of <var>hash-table</var>. + +<h2><a name="Dln">Dealing with single elements</a></h2> + +<p>Procedure: <a name="hsht3">hash-table-ref</a> <var>hash-table</var> <var>key</var> [ <var>thunk</var> ] → <var>value</var> + +<p>This procedure returns the <var>value</var> associated to <var>key</var> in <var>hash-table</var>. +If no <var>value</var> is associated to <var>key</var> and <var>thunk</var> is given, it is called +with no arguments and its value is returned; if <var>thunk</var> is not given, an +error is signalled. +Given a good hash function, this operation should have an (amortised) +complexity of O(1) with respect to the number of associations in +<var>hash-table</var>. (Note: this rules out implementation by association lists +or fixed-length hash tables.) + +<p>Procedure: <a name="hsht4">hash-table-ref/default</a> <var>hash-table</var> <var>key</var> <var>default</var> → +<var>value</var> + +<p>Evaluates to the same value as <tt>(hash-table-ref hash-table key (lambda +() default))</tt>. +Given a good hash function, this operation should have an (amortised) +complexity of O(1) with respect to the number of associations in +<var>hash-table</var>. (Note: this rules out implementation by association lists +or fixed-length hash tables.) + +<p>Procedure: <a name="hsht5">hash-table-set!</a> <var>hash-table</var> <var>key</var> <var>value</var> → undefined + +<p>This procedure sets the <var>value</var> associated to <var>key</var> in <var>hash-table</var>. +The previous association (if any) is removed. +Given a good hash function, this operation should have an (amortised) +complexity of O(1) with respect to the number of associations in +<var>hash-table</var>. (Note: this rules out implementation by association lists +or fixed-length hash tables.) + +<p>Procedure: <a name="hsht6">hash-table-delete!</a> <var>hash-table</var> <var>key</var> → undefined + +<p>This procedure removes any association to <var>key</var> in <var>hash-table</var>. It is +not an error if no association for that key exists; in this case, +nothing is done. +Given a good hash function, this operation should have an (amortised) +complexity of O(1) with respect to the number of associations in +<var>hash-table</var>. (Note: this rules out implementation by association lists +or fixed-length hash tables.) + +<p>Procedure: <a name="hsht7">hash-table-exists?</a> <var>hash-table</var> <var>key</var> → <var>boolean</var> + +<p>This predicate tells whether there is any association to <var>key</var> in +<var>hash-table</var>. +Given a good hash function, this operation should have an (amortised) +complexity of O(1) with respect to the number of associations in +<var>hash-table</var>. (Note: this rules out implementation by association lists +or fixed-length hash tables.) + +<p>Procedure: <a name="hsht8">hash-table-update!</a> <var>hash-table</var> <var>key</var> <var>function</var> +[ <var>thunk</var> ] → undefined + +<p>Semantically equivalent to, but may be implemented more efficiently +than, the following code: +<pre> +(hash-table-set! hash-table key + (function (hash-table-ref hash-table key thunk))) +</pre> + +<p>Procedure: <a name="hsht9">hash-table-update!/default</a> +<var>hash-table</var> <var>key</var> <var>function</var> <var>default</var> → undefined + +<p>Behaves as if it evaluates to <tt>(hash-table-update! hash-table key +function (lambda () default))</tt>. + +<h2><a name="Dln10">Dealing with the whole contents</a></h2> + +<p>Procedure: <a name="hsht11">hash-table-size</a> <var>hash-table</var> → <var>integer</var> + +<p>Returns the number of associations in <var>hash-table</var>. This operation +must have a complexity of O(1) with respect to the number of +associations in <var>hash-table</var>. + +<p>Procedure: <a name="hsht12">hash-table-keys</a> <var>hash-table</var> → <var>list</var> + +<p>Returns a list of keys in <var>hash-table</var>. The order of the keys is +unspecified. + +<p>Procedure: <a name="hsht13">hash-table-values</a> <var>hash-table</var> → <var>list</var> + +<p>Returns a list of values in <var>hash-table</var>. The order of the values is +unspecified, and is not guaranteed to match the order of keys in the +result of <a href="srfi-69.html#hsht12">hash-table-keys</a>. + +<p>Procedure: <a name="hsht14">hash-table-walk</a> <var>hash-table</var> <var>proc</var> → unspecified + +<p><var>proc</var> should be a function taking two arguments, a <var>key</var> and a <var>value</var>. +This procedure calls <var>proc</var> for each association in <var>hash-table</var>, giving +the key of the association as <var>key</var> and the value of the association as +<var>value</var>. The results of <var>proc</var> are discarded. The order in which +<var>proc</var> is called for the different associations is unspecified. + +<p>(Note: in some implementations, there is a procedure called +<tt>hash-table-map</tt> which does the same as this procedure. However, in +other implementations, <tt>hash-table-map</tt> does something else. In no +implementation that I know of, <tt>hash-table-map</tt> does a real functorial +map that lifts an ordinary function to the domain of hash tables. +Because of these reasons, <tt>hash-table-map</tt> is left outside this SRFI.) + +<p>Procedure: <a name="hsht15">hash-table-fold</a> <var>hash-table</var> <var>f</var> <var>init-value</var> +→ <var>final-value</var> + +<p>This procedure calls <var>f</var> for every association in <var>hash-table</var> with +three arguments: the key of the association <var>key</var>, the value of the +association <var>value</var>, and an <q>accumulated value</q>, <var>val</var>. <var>val</var> is +<var>init-value</var> for the first invocation of <var>f</var>, and for subsequent +invocations of <var>f</var>, the return value of the previous invocation of <var>f</var>. +The value <var>final-value</var> returned by <tt>hash-table-fold</tt> is the return +value of the last invocation of <var>f</var>. The order in which <var>f</var> is called +for different associations is unspecified. + +<p>Procedure: <a name="hsht16">hash-table->alist</a> <var>hash-table</var> → <var>alist</var> + +<p>Returns an association list such that the <tt>car</tt> of each element in +<var>alist</var> is a key in <var>hash-table</var> and the corresponding <tt>cdr</tt> of each +element in <var>alist</var> is the value associated to the key in <var>hash-table</var>. +The order of the elements is unspecified. + +<p>The following should always produce a hash table with the same mappings +as a hash table <tt>h</tt>: +<pre> +(alist->hash-table (hash-table->alist h) + (hash-table-equivalence-function h) + (hash-table-hash-function h)) +</pre> + +<p>Procedure: <a name="hsht17">hash-table-copy</a> <var>hash-table</var> → <var>hash-table</var> + +<p>Returns a new hash table with the same equivalence predicate, hash +function and mappings as in <var>hash-table</var>. + +<p>Procedure: <a name="hsht18">hash-table-merge!</a> <var>hash-table1</var> <var>hash-table2</var> → +<var>hash-table</var> + +<p>Adds all mappings in <var>hash-table2</var> into <var>hash-table1</var> and returns the +resulting hash table. This function may modify <var>hash-table1</var> +destructively. + +<h2><a name="Hshn">Hashing</a></h2> + +<p>Hashing means the act of taking some value and producing a number from +the value. A hash function is a function that does this. Every +equivalence predicate <var>e</var> has a set of <var>acceptable</var> hash functions for +that predicate; a hash funtion <var>hash</var> is acceptable iff <tt>(e obj1 +obj2)</tt> → <tt>(= (hash obj1) (hash obj2))</tt>. + +<p>A hash function <var>h</var> is <var>good</var> for a equivalence predicate <var>e</var> if it +distributes the result numbers (<var>hash values</var>) for non-equal objects (by +<var>e</var>) as uniformly as possible over the numeric range of hash values, +especially in the case when some (non-equal) objects resemble each other +by e.g. having common subsequences. This definition is vague but should +be enough to assert that e.g. a constant function is <em>not</em> a good hash +function. + +<p>When the definition of <a href="srfi-69.html#mkh">make-hash-table</a> above talks about an +<q>appropriate</q> hashing function for <var>e</var>, it means a hashing function that +gives decent performance (for the hashing operation) while being both +acceptable and good for <var>e</var>. This definition, too, is intentionally +vague. + +<p>Procedure: <a name="hsh">hash</a> <var>object</var> [ <var>bound</var> ] → <var>integer</var> + +<p>Produces a hash value for <var>object</var> in the range ( 0, <var>bound</var> (. If +<var>bound</var> is not given, the implementation is free to choose any bound, +given that the default bound is greater than the size of any imaginable +hash table in a normal application. (This is so that the implementation +may choose some very big value in fixnum range for the default bound.) +This hash function is acceptable for <tt>equal?</tt>. + +<p>Procedure: <a name="strng">string-hash</a> <var>string</var> [ <var>bound</var> ] → <var>integer</var> + +<p>The same as <a href="srfi-69.html#hsh">hash</a>, except that the argument <var>string</var> must be a string. + +<p>Procedure: <a name="strng19">string-ci-hash</a> <var>string</var> [ <var>bound</var> ] → <var>integer</var> + +<p>The same as <a href="srfi-69.html#strng">string-hash</a>, except that the case of characters in +<var>string</var> does not affect the hash value produced. + +<p>Procedure: <a name="hshb">hash-by-identity</a> <var>object</var> [ <var>bound</var> ] → <var>integer</var> + +<p>The same as <a href="srfi-69.html#hsh">hash</a>, except that this function is only guaranteed to be +acceptable for <tt>eq?</tt>. The reason for providing this function is that +it might be implemented significantly more efficiently than <tt>hash</tt>. +Implementations are encouraged to provide this function as a builtin. + +<h1><a name="mplm">Implementation</a></h1> + +<p>This implementation relies on SRFI-9 for distinctness of the hash table +type, and on SRFI-23 for error reporting. Otherwise, the implementation +is pure R5RS. + +<pre> + +(define *default-bound* (- (expt 2 29) 3)) + +(define (%string-hash s ch-conv bound) + (let ((hash 31) + (len (string-length s))) + (do ((index 0 (+ index 1))) + ((>= index len) (modulo hash bound)) + (set! hash (modulo (+ (* 37 hash) + (char->integer (ch-conv (string-ref s index)))) + *default-bound*))))) + +(define (string-hash s . maybe-bound) + (let ((bound (if (null? maybe-bound) *default-bound* (car maybe-bound)))) + (%string-hash s (lambda (x) x) bound))) + +(define (string-ci-hash s . maybe-bound) + (let ((bound (if (null? maybe-bound) *default-bound* (car maybe-bound)))) + (%string-hash s char-downcase bound))) + +(define (symbol-hash s . maybe-bound) + (let ((bound (if (null? maybe-bound) *default-bound* (car maybe-bound)))) + (%string-hash (symbol->string s) (lambda (x) x) bound))) + +(define (hash obj . maybe-bound) + (let ((bound (if (null? maybe-bound) *default-bound* (car maybe-bound)))) + (cond ((integer? obj) (modulo obj bound)) + ((string? obj) (string-hash obj bound)) + ((symbol? obj) (symbol-hash obj bound)) + ((real? obj) (modulo (+ (numerator obj) (denominator obj)) bound)) + ((number? obj) + (modulo (+ (hash (real-part obj)) (* 3 (hash (imag-part obj)))) + bound)) + ((char? obj) (modulo (char->integer obj) bound)) + ((vector? obj) (vector-hash obj bound)) + ((pair? obj) (modulo (+ (hash (car obj)) (* 3 (hash (cdr obj)))) + bound)) + ((null? obj) 0) + ((not obj) 0) + ((procedure? obj) (error "hash: procedures cannot be hashed" obj)) + (else 1)))) + +(define hash-by-identity hash) + +(define (vector-hash v bound) + (let ((hashvalue 571) + (len (vector-length v))) + (do ((index 0 (+ index 1))) + ((>= index len) (modulo hashvalue bound)) + (set! hashvalue (modulo (+ (* 257 hashvalue) (hash (vector-ref v index))) + *default-bound*))))) + +(define %make-hash-node cons) +(define %hash-node-set-value! set-cdr!) +(define %hash-node-key car) +(define %hash-node-value cdr) + +(define-record-type <srfi-hash-table> + (%make-hash-table size hash compare associate entries) + hash-table? + (size hash-table-size hash-table-set-size!) + (hash hash-table-hash-function) + (compare hash-table-equivalence-function) + (associate hash-table-association-function) + (entries hash-table-entries hash-table-set-entries!)) + +(define *default-table-size* 64) + +(define (appropriate-hash-function-for comparison) + (or (and (eq? comparison eq?) hash-by-identity) + (and (eq? comparison string=?) string-hash) + (and (eq? comparison string-ci=?) string-ci-hash) + hash)) + +(define (make-hash-table . args) + (let* ((comparison (if (null? args) equal? (car args))) + (hash + (if (or (null? args) (null? (cdr args))) + (appropriate-hash-function-for comparison) (cadr args))) + (size + (if (or (null? args) (null? (cdr args)) (null? (cddr args))) + *default-table-size* (caddr args))) + (association + (or (and (eq? comparison eq?) assq) + (and (eq? comparison eqv?) assv) + (and (eq? comparison equal?) assoc) + (letrec + ((associate + (lambda (val alist) + (cond ((null? alist) #f) + ((comparison val (caar alist)) (car alist)) + (else (associate val (cdr alist))))))) + associate)))) + (%make-hash-table 0 hash comparison association (make-vector size '())))) + +(define (make-hash-table-maker comp hash) + (lambda args (apply make-hash-table (cons comp (cons hash args))))) +(define make-symbol-hash-table + (make-hash-table-maker eq? symbol-hash)) +(define make-string-hash-table + (make-hash-table-maker string=? string-hash)) +(define make-string-ci-hash-table + (make-hash-table-maker string-ci=? string-ci-hash)) +(define make-integer-hash-table + (make-hash-table-maker = modulo)) + +(define (%hash-table-hash hash-table key) + ((hash-table-hash-function hash-table) + key (vector-length (hash-table-entries hash-table)))) + +(define (%hash-table-find entries associate hash key) + (associate key (vector-ref entries hash))) + +(define (%hash-table-add! entries hash key value) + (vector-set! entries hash + (cons (%make-hash-node key value) + (vector-ref entries hash)))) + +(define (%hash-table-delete! entries compare hash key) + (let ((entrylist (vector-ref entries hash))) + (cond ((null? entrylist) #f) + ((compare key (caar entrylist)) + (vector-set! entries hash (cdr entrylist)) #t) + (else + (let loop ((current (cdr entrylist)) (previous entrylist)) + (cond ((null? current) #f) + ((compare key (caar current)) + (set-cdr! previous (cdr current)) #t) + (else (loop (cdr current) current)))))))) + +(define (%hash-table-walk proc entries) + (do ((index (- (vector-length entries) 1) (- index 1))) + ((< index 0)) (for-each proc (vector-ref entries index)))) + +(define (%hash-table-maybe-resize! hash-table) + (let* ((old-entries (hash-table-entries hash-table)) + (hash-length (vector-length old-entries))) + (if (> (hash-table-size hash-table) hash-length) + (let* ((new-length (* 2 hash-length)) + (new-entries (make-vector new-length '())) + (hash (hash-table-hash-function hash-table))) + (%hash-table-walk + (lambda (node) + (%hash-table-add! new-entries + (hash (%hash-node-key node) new-length) + (%hash-node-key node) (%hash-node-value node))) + old-entries) + (hash-table-set-entries! hash-table new-entries))))) + +(define (hash-table-ref hash-table key . maybe-default) + (cond ((%hash-table-find (hash-table-entries hash-table) + (hash-table-association-function hash-table) + (%hash-table-hash hash-table key) key) + => %hash-node-value) + ((null? maybe-default) + (error "hash-table-ref: no value associated with" key)) + (else ((car maybe-default))))) + +(define (hash-table-ref/default hash-table key default) + (hash-table-ref hash-table key (lambda () default))) + +(define (hash-table-set! hash-table key value) + (let ((hash (%hash-table-hash hash-table key)) + (entries (hash-table-entries hash-table))) + (cond ((%hash-table-find entries + (hash-table-association-function hash-table) + hash key) + => (lambda (node) (%hash-node-set-value! node value))) + (else (%hash-table-add! entries hash key value) + (hash-table-set-size! hash-table + (+ 1 (hash-table-size hash-table))) + (%hash-table-maybe-resize! hash-table))))) + +(define (hash-table-update! hash-table key function . maybe-default) + (let ((hash (%hash-table-hash hash-table key)) + (entries (hash-table-entries hash-table))) + (cond ((%hash-table-find entries + (hash-table-association-function hash-table) + hash key) + => (lambda (node) + (%hash-node-set-value! + node (function (%hash-node-value node))))) + ((null? maybe-default) + (error "hash-table-update!: no value exists for key" key)) + (else (%hash-table-add! entries hash key + (function ((car maybe-default)))) + (hash-table-set-size! hash-table + (+ 1 (hash-table-size hash-table))) + (%hash-table-maybe-resize! hash-table))))) + +(define (hash-table-update!/default hash-table key function default) + (hash-table-update! hash-table key function (lambda () default))) + +(define (hash-table-delete! hash-table key) + (if (%hash-table-delete! (hash-table-entries hash-table) + (hash-table-equivalence-function hash-table) + (%hash-table-hash hash-table key) key) + (hash-table-set-size! hash-table (- (hash-table-size hash-table) 1)))) + +(define (hash-table-exists? hash-table key) + (and (%hash-table-find (hash-table-entries hash-table) + (hash-table-association-function hash-table) + (%hash-table-hash hash-table key) key) #t)) + +(define (hash-table-walk hash-table proc) + (%hash-table-walk + (lambda (node) (proc (%hash-node-key node) (%hash-node-value node))) + (hash-table-entries hash-table))) + +(define (hash-table-fold hash-table f acc) + (hash-table-walk hash-table + (lambda (key value) (set! acc (f key value acc)))) + acc) + +(define (alist->hash-table alist . args) + (let* ((comparison (if (null? args) equal? (car args))) + (hash + (if (or (null? args) (null? (cdr args))) + (appropriate-hash-function-for comparison) (cadr args))) + (size + (if (or (null? args) (null? (cdr args)) (null? (cddr args))) + (max *default-table-size* (* 2 (length alist))) (caddr args))) + (hash-table (make-hash-table comparison hash size))) + (for-each + (lambda (elem) + (hash-table-update!/default + hash-table (car elem) (lambda (x) x) (cdr elem))) + alist) + hash-table)) + +(define (hash-table->alist hash-table) + (hash-table-fold hash-table + (lambda (key val acc) (cons (cons key val) acc)) '())) + +(define (hash-table-copy hash-table) + (let ((new (make-hash-table (hash-table-equivalence-function hash-table) + (hash-table-hash-function hash-table) + (max *default-table-size* + (* 2 (hash-table-size hash-table)))))) + (hash-table-walk hash-table + (lambda (key value) (hash-table-set! new key value))) + new)) + +(define (hash-table-merge! hash-table1 hash-table2) + (hash-table-walk + hash-table2 + (lambda (key value) (hash-table-set! hash-table1 key value))) + hash-table1) + +(define (hash-table-keys hash-table) + (hash-table-fold hash-table (lambda (key val acc) (cons key acc)) '())) + +(define (hash-table-values hash-table) + (hash-table-fold hash-table (lambda (key val acc) (cons val acc)) '())) + + +</pre> + +<h1><a name="Cpr">Copyright</a></h1> + +<p>Copyright © Panu Kalliokoski (2005). All Rights Reserved. + +<p>Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the +<q>Software</q>), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +<p>The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +<p>THE SOFTWARE IS PROVIDED <q>AS IS</q>, WITHOUT WARRANTY OF ANY KIND, EXPRESS +OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + <hr> + <address>Editor: <a HREF="mailto:srfi minus editors at srfi dot schemers dot org">David Van Horn</a></address> +Last modified: Wed Sep 14 09:54:51 EDT 2005 + +</body> +</html> Added: vendor/misc/srfi-9.html ============================================================================== --- (empty file) +++ vendor/misc/srfi-9.html Sun Jul 22 14:55:12 2007 @@ -0,0 +1,403 @@ +<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 3.2//EN"> +<html> + <head> + <title>SRFI 9: Defining Record Types</title> + </head> + + <body> + +<H1>Title</H1> + +Defining Record Types + +<H1>Author</H1> + +Richard Kelsey + +<H1>Status</H1> + +This SRFI is currently in ``final'' status. To see an explanation of each status that a SRFI can hold, see <A HREF="http://srfi.schemers.org/srfi-process.html";>here</A>. +You can access the discussion via <A HREF="http://srfi.schemers.org/srfi-9/mail-archive/maillist.html";>the archive of the mailing list</A>. +<P><UL> +<LI>Received: 1999/07/01 +<LI>Revised: 1999/08/25 +<LI>Draft: 1999/07/07-1999/09/06 +<LI>Final: 1999/09/09 +</UL> + +<H1>Abstract</H1> + +This SRFI describes syntax for creating new data types, called record types. +A predicate, constructor, and field accessors and modifiers are defined for +each record type. Each new record type is distinct from all existing types, +including other record types and Scheme's predefined types. + +<H1>Rationale</H1> + +Many Scheme implementations provide means for creating new types, + usually called either records or structures. +The <code>DEFINE-RECORD-TYPE</code> syntax described here is a slight + simplification of one written for Scheme 48 by Jonathan Rees. +Unlike many record-defining macros or special forms, it + does not create any new identifiers. +Instead, the names of the + record type, predicate, constructor, and so on are all listed explicitly + in the source. +This has the following advantages: +<UL> +<LI> It can be defined using a simple <code>SYNTAX-RULES</code> macro + in Scheme implementations that provide a procedural interface + for creating record types. +<LI> It does not restrict users to a particular naming convention. +<LI> Tools like <code>grep</code> and GNU Emacs's tag facility will see the + defining occurance of each identifier. +</UL> + +<H1>Specification</H1> + +The syntax of a record-type definition is: + +<PRE> + <command or definition> + -> <record type definition> ; addition to 8.1.6 in R5RS + + <record type definition> + -> (define-record-type <type name> + (<constructor name> <field tag> ...) + <predicate name> + <field spec> ...) + + <field spec> -> (<field tag> <accessor name>) + -> (<field tag> <accessor name> <modifier name>) + + <field tag> -> <identifier> + <... name> -> <identifier> +</PRE> + +<code>DEFINE-RECORD-TYPE</code> is generative: +each use creates a new record type that is distinct from all existing types, +including other record types and Scheme's predefined types. + +Record-type definitions may only occur at top-level (there are two +possible semantics for `internal' record-type definitions, generative +and nongenerative, and no consensus as to which is better). + +<P> +An instance of <code>DEFINE-RECORD-TYPE</code> is equivalent to the following +definitions: +<UL> +<LI> <code><type name></code> is bound to a representation of the record + type itself. Operations on record types, such as defining print + methods, reflection, etc. are left to other SRFIs. + +<LI> <code><constructor name></code> is bound to a procedure that takes + as many arguments as there are <code><field tag></code>s in the + <code>(<constructor name> ...)</code> + subform and returns a new <code><type name></code> record. + Fields whose tags are listed with <code><constructor name></code> + have the corresponding argument as their + initial value. The initial values of all other fields are unspecified. + +<LI> <code><predicate name></code> is a predicate that returns #T when + given a value returned by <code><constructor name></code> and #F + for everything else. + +<LI> Each <code><accessor name></code> is a procedure that takes a record + of type <code><type name></code> and returns the current value of the + corresponding field. + It is an error to pass an accessor a value which is not a record of + the appropriate type. + +<LI> Each <code><modifier name></code> is a procedure that takes a record + of type <code><type name></code> and a value which becomes the new + value of the corresponding field; an unspecified value is returned. + It is an error to pass a modifier a first + argument which is not a record of the appropriate type. +</UL> + +<P> +Records are disjoint from the types listed in Section 4.2 of R5RS. + +<P> +<code>Set!</code>ing the value of any of these identifiers has no + effect on the behavior of any of their original values. + +<P> +The following +<PRE> + (define-record-type :pare + (kons x y) + pare? + (x kar set-kar!) + (y kdr)) +</PRE> +defines <code>KONS</code> to be a constructor, <code>KAR</code> and +<code>KDR</code> to be accessors, <code>SET-KAR!</code> to be a modifier, +and <code>PARE?</code> to be a predicate for <code>:PARE</code>s. + +<PRE> + (pare? (kons 1 2)) --> #t + (pare? (cons 1 2)) --> #f + (kar (kons 1 2)) --> 1 + (kdr (kons 1 2)) --> 2 + (let ((k (kons 1 2))) + (set-kar! k 3) + (kar k)) --> 3 +</PRE> + +<H1>Implementation</H1> + +This code is divided into three layers. In top-down order these are: +<OL> +<LI> Syntax definitions for <code>DEFINE-RECORD-TYPE</code> and an auxillary + macro. +<LI> An implementation of record types with a procedural interface. +Some Scheme implementations already have something close to this. +<LI> Vector-like records implemented in R5RS. This redefines some standard +Scheme procedures and therefor must be loaded before any other code, including +part 2 above. Note that these procedures can be used to break the +record-type abstraction (for example, <code>RECORD-SET!</code> can be used +to modify the type of a record). Access to these procedures should be +restricted. +</OL> + +<H2>Syntax definitions</H2> + +<PRE> +; Definition of DEFINE-RECORD-TYPE + +(define-syntax define-record-type + (syntax-rules () + ((define-record-type type + (constructor constructor-tag ...) + predicate + (field-tag accessor . more) ...) + (begin + (define type + (make-record-type 'type '(field-tag ...))) + (define constructor + (record-constructor type '(constructor-tag ...))) + (define predicate + (record-predicate type)) + (define-record-field type field-tag accessor . more) + ...)))) + +; An auxilliary macro for define field accessors and modifiers. +; This is needed only because modifiers are optional. + +(define-syntax define-record-field + (syntax-rules () + ((define-record-field type field-tag accessor) + (define accessor (record-accessor type 'field-tag))) + ((define-record-field type field-tag accessor modifier) + (begin + (define accessor (record-accessor type 'field-tag)) + (define modifier (record-modifier type 'field-tag)))))) +</PRE> + +<H2>Record types</H2> + +<PRE> +; We define the following procedures: +; +; (make-record-type <type-name <field-names>) -> <record-type> +; (record-constructor <record-type<field-names>) -> <constructor> +; (record-predicate <record-type>) -> <predicate> +; (record-accessor <record-type <field-name>) -> <accessor> +; (record-modifier <record-type <field-name>) -> <modifier> +; where +; (<constructor> <initial-value> ...) -> <record> +; (<predicate> <value>) -> <boolean> +; (<accessor> <record>) -> <value> +; (<modifier> <record> <value>) -> <unspecific> + +; Record types are implemented using vector-like records. The first +; slot of each record contains the record's type, which is itself a +; record. + +(define (record-type record) + (record-ref record 0)) + +;---------------- +; Record types are themselves records, so we first define the type for +; them. Except for problems with circularities, this could be defined as: +; (define-record-type :record-type +; (make-record-type name field-tags) +; record-type? +; (name record-type-name) +; (field-tags record-type-field-tags)) +; As it is, we need to define everything by hand. + +(define :record-type (make-record 3)) +(record-set! :record-type 0 :record-type) ; Its type is itself. +(record-set! :record-type 1 ':record-type) +(record-set! :record-type 2 '(name field-tags)) + +; Now that :record-type exists we can define a procedure for making more +; record types. + +(define (make-record-type name field-tags) + (let ((new (make-record 3))) + (record-set! new 0 :record-type) + (record-set! new 1 name) + (record-set! new 2 field-tags) + new)) + +; Accessors for record types. + +(define (record-type-name record-type) + (record-ref record-type 1)) + +(define (record-type-field-tags record-type) + (record-ref record-type 2)) + +;---------------- +; A utility for getting the offset of a field within a record. + +(define (field-index type tag) + (let loop ((i 1) (tags (record-type-field-tags type))) + (cond ((null? tags) + (error "record type has no such field" type tag)) + ((eq? tag (car tags)) + i) + (else + (loop (+ i 1) (cdr tags)))))) + +;---------------- +; Now we are ready to define RECORD-CONSTRUCTOR and the rest of the +; procedures used by the macro expansion of DEFINE-RECORD-TYPE. + +(define (record-constructor type tags) + (let ((size (length (record-type-field-tags type))) + (arg-count (length tags)) + (indexes (map (lambda (tag) + (field-index type tag)) + tags))) + (lambda args + (if (= (length args) + arg-count) + (let ((new (make-record (+ size 1)))) + (record-set! new 0 type) + (for-each (lambda (arg i) + (record-set! new i arg)) + args + indexes) + new) + (error "wrong number of arguments to constructor" type args))))) + +(define (record-predicate type) + (lambda (thing) + (and (record? thing) + (eq? (record-type thing) + type)))) + +(define (record-accessor type tag) + (let ((index (field-index type tag))) + (lambda (thing) + (if (and (record? thing) + (eq? (record-type thing) + type)) + (record-ref thing index) + (error "accessor applied to bad value" type tag thing))))) + +(define (record-modifier type tag) + (let ((index (field-index type tag))) + (lambda (thing value) + (if (and (record? thing) + (eq? (record-type thing) + type)) + (record-set! thing index value) + (error "modifier applied to bad value" type tag thing))))) +</PRE> + +<H2>Records</H2> + +<PRE> +; This implements a record abstraction that is identical to vectors, +; except that they are not vectors (VECTOR? returns false when given a +; record and RECORD? returns false when given a vector). The following +; procedures are provided: +; (record? <value>) -> <boolean> +; (make-record <size>) -> <record> +; (record-ref <record> <index>) -> <value> +; (record-set! <record> <index> <value>) -> <unspecific> +; +; These can implemented in R5RS Scheme as vectors with a distinguishing +; value at index zero, providing VECTOR? is redefined to be a procedure +; that returns false if its argument contains the distinguishing record +; value. EVAL is also redefined to use the new value of VECTOR?. + +; Define the marker and redefine VECTOR? and EVAL. + +(define record-marker (list 'record-marker)) + +(define real-vector? vector?) + +(define (vector? x) + (and (real-vector? x) + (or (= 0 (vector-length x)) + (not (eq? (vector-ref x 0) + record-marker))))) + +; This won't work if ENV is the interaction environment and someone has +; redefined LAMBDA there. + +(define eval + (let ((real-eval eval)) + (lambda (exp env) + ((real-eval `(lambda (vector?) ,exp)) + vector?)))) + +; Definitions of the record procedures. + +(define (record? x) + (and (real-vector? x) + (< 0 (vector-length x)) + (eq? (vector-ref x 0) + record-marker))) + +(define (make-record size) + (let ((new (make-vector (+ size 1)))) + (vector-set! new 0 record-marker) + new)) + +(define (record-ref record index) + (vector-ref record (+ index 1))) + +(define (record-set! record index value) + (vector-set! record (+ index 1) value)) +</PRE> + +<H1>Copyright</H1> + +<p>Copyright (C) Richard Kelsey (1999). All Rights Reserved. </p> + +<p> +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: +</p> +<p> +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. +</p> +<p> +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +</p> + +<hr> + + <address>Editor: <a href="mailto:srfi-editors at srfi dot schemers dot org">Mike Sperber</a></address> + + </body> +</html>
