From 8466d8cfa486fb30d1755c4261b781135083787b Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:29 -0800
Subject: Import Upstream version 3a1

---
 hashtab.scm | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 71 insertions(+), 7 deletions(-)

(limited to 'hashtab.scm')

diff --git a/hashtab.scm b/hashtab.scm
index de46d47..6656ca4 100644
--- a/hashtab.scm
+++ b/hashtab.scm
@@ -1,5 +1,5 @@
 ; "hashtab.scm", hash tables for Scheme.
-; Copyright (c) 1992, 1993 Aubrey Jaffer
+; Copyright (c) 1992, 1993, 2003 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -8,7 +8,7 @@
 ;1.  Any copy made of this software must include this copyright notice
 ;in full.
 ;
-;2.  I have made no warrantee or representation that the operation of
+;2.  I have made no warranty or representation that the operation of
 ;this software will be error-free, and I am under no obligation to
 ;provide any services, by way of maintenance, update, or otherwise.
 ;
@@ -20,6 +20,15 @@
 (require 'hash)
 (require 'alist)
 
+;;@code{(require 'hash-table)}
+;;@ftindex hash-table
+
+;;@body
+;;Returns a hash function (like @code{hashq}, @code{hashv}, or
+;;@code{hash}) corresponding to the equality predicate @var{pred}.
+;;@var{pred} should be @code{eq?}, @code{eqv?}, @code{equal?}, @code{=},
+;;@code{char=?}, @code{char-ci=?}, @code{string=?}, or
+;;@code{string-ci=?}.
 (define (predicate->hash pred)
   (cond ((eq? pred eq?) hashq)
 	((eq? pred eqv?) hashv)
@@ -31,22 +40,47 @@
 	((eq? pred string-ci=?) hash)
 	(else (slib:error "unknown predicate for hash" pred))))
 
+;;@noindent
+;;A hash table is a vector of association lists.
+
+;;@body
+;;Returns a vector of @var{k} empty (association) lists.
 (define (make-hash-table k) (make-vector k '()))
 
+;;@noindent
+;;Hash table functions provide utilities for an associative database.
+;;These functions take an equality predicate, @var{pred}, as an argument.
+;;@var{pred} should be @code{eq?}, @code{eqv?}, @code{equal?}, @code{=},
+;;@code{char=?}, @code{char-ci=?}, @code{string=?}, or
+;;@code{string-ci=?}.
+
+;;@body
+;;Returns a hash association function of 2 arguments, @var{key} and
+;;@var{hashtab}, corresponding to @var{pred}.  The returned function
+;;returns a key-value pair whose key is @var{pred}-equal to its first
+;;argument or @code{#f} if no key in @var{hashtab} is @var{pred}-equal to
+;;the first argument.
 (define (predicate->hash-asso pred)
   (let ((hashfun (predicate->hash pred))
 	(asso (predicate->asso pred)))
     (lambda (key hashtab)
       (asso key
 	    (vector-ref hashtab (hashfun key (vector-length hashtab)))))))
-
+;;@body
+;;Returns a procedure of 2 arguments, @var{hashtab} and @var{key}, which
+;;returns the value associated with @var{key} in @var{hashtab} or
+;;@code{#f} if @var{key} does not appear in @var{hashtab}.
 (define (hash-inquirer pred)
   (let ((hashfun (predicate->hash pred))
 	(ainq (alist-inquirer pred)))
     (lambda (hashtab key)
       (ainq (vector-ref hashtab (hashfun key (vector-length hashtab)))
 	    key))))
-
+;;@body
+;;Returns a procedure of 3 arguments, @var{hashtab}, @var{key}, and
+;;@var{value}, which modifies @var{hashtab} so that @var{key} and
+;;@var{value} associated.  Any previous value associated with @var{key}
+;;will be lost.
 (define (hash-associator pred)
   (let ((hashfun (predicate->hash pred))
 	(asso (alist-associator pred)))
@@ -55,7 +89,10 @@
 	(vector-set! hashtab num
 		     (asso (vector-ref hashtab num) key val)))
       hashtab)))
-
+;;@body
+;;Returns a procedure of 2 arguments, @var{hashtab} and @var{key}, which
+;;modifies @var{hashtab} so that the association whose key is @var{key} is
+;;removed.
 (define (hash-remover pred)
   (let ((hashfun (predicate->hash pred))
 	(arem (alist-remover pred)))
@@ -64,7 +101,10 @@
 	(vector-set! hashtab num
 		     (arem (vector-ref hashtab num) key)))
       hashtab)))
-
+;;@args proc hash-table
+;;Returns a new hash table formed by mapping @var{proc} over the
+;;keys and values of @var{hash-table}.  @var{proc} must be a function of 2
+;;arguments which returns the new value part.
 (define (hash-map proc ht)
   (define nht (make-vector (vector-length ht)))
   (do ((i (+ -1 (vector-length ht)) (+ -1 i)))
@@ -72,8 +112,32 @@
     (vector-set!
      nht i
      (alist-map proc (vector-ref ht i)))))
-
+;;@args proc hash-table
+;;Applies @var{proc} to each pair of keys and values of @var{hash-table}.
+;;@var{proc} must be a function of 2 arguments.  The returned value is
+;;unspecified.
 (define (hash-for-each proc ht)
   (do ((i (+ -1 (vector-length ht)) (+ -1 i)))
       ((negative? i))
     (alist-for-each proc (vector-ref ht i))))
+;;@body
+;;@0 accepts a hash table predicate and returns a function of two
+;;arguments @var{hashtab} and @var{new-k} which is specialized for
+;;that predicate.
+;;
+;;This function is used for nondestrutively resizing a hash table.
+;;@var{hashtab} should be an existing hash-table using @1, @var{new-k}
+;;is the size of a new hash table to be returned.  The new hash table
+;;will have all of the associations of the old hash table.
+(define (hash-rehasher pred)
+  (let ((hashfun (predicate->hash pred)))
+    (lambda (hashtab newk)
+      (let ((newtab (make-hash-table newk)))
+	(hash-for-each
+	 (lambda (key value)
+	   (let ((num (hashfun key newk)))
+	     (vector-set! newtab num
+			  (cons (cons key value)
+				(vector-ref newtab num)))))
+	 hashtab)
+	newtab))))
-- 
cgit v1.2.3