libguile/hashtab.c

   1 /*      Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
  43    gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
  44
  45 \f
  46
  47 #include <stdio.h>
  48 #include "_scm.h"
  49 #include "alist.h"
  50 #include "hash.h"
  51 #include "eval.h"
  52 #include "vectors.h"
  53
  54 #include "validate.h"
  55 #include "hashtab.h"
  56 \f
  57
  58
  59 SCM
  60 scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),void * closure)
  61 {
  62   unsigned int k;
  63   SCM h;
  64
  65   SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_get_handle");
  66   if (SCM_LENGTH (table) == 0)
  67     return SCM_EOL;
  68   k = hash_fn (obj, SCM_LENGTH (table), closure);
  69   SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
  70               scm_ulong2num (k),
  71               SCM_OUTOFRANGE,
  72               "hash_fn_get_handle");
  73   h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
  74   return h;
  75 }
  76
  77
  78
  79 SCM
  80 scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned int (*hash_fn)(),
  81                              SCM (*assoc_fn)(),void * closure)
  82 {
  83   unsigned int k;
  84   SCM it;
  85
  86   SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x");
  87   if (SCM_LENGTH (table) == 0)
  88     return SCM_EOL;
  89   k = hash_fn (obj, SCM_LENGTH (table), closure);
  90   SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
  91               scm_ulong2num (k),
  92               SCM_OUTOFRANGE,
  93               "hash_fn_create_handle_x");
  94   SCM_REDEFER_INTS;
  95   it = assoc_fn (obj, SCM_VELTS (table)[k], closure);
  96   if (SCM_NIMP (it))
  97     {
  98       return it;
  99     }
 100   {
 101     SCM new_bucket;
 102     SCM old_bucket;
 103     old_bucket = SCM_VELTS (table)[k];
 104     new_bucket = scm_acons (obj, init, old_bucket);
 105     SCM_VELTS(table)[k] = new_bucket;
 106     SCM_REALLOW_INTS;
 107     return SCM_CAR (new_bucket);
 108   }
 109 }
 110
 111
 112
 113
 114 SCM
 115 scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned int (*hash_fn)(),
 116                  SCM (*assoc_fn)(),void * closure)
 117 {
 118   SCM it;
 119
 120   it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
 121   if (SCM_IMP (it))
 122     return dflt;
 123   else
 124     return SCM_CDR (it);
 125 }
 126
 127
 128
 129
 130 SCM
 131 scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned int (*hash_fn)(),
 132                    SCM (*assoc_fn)(),void * closure)
 133 {
 134   SCM it;
 135
 136   it = scm_hash_fn_create_handle_x (table, obj, SCM_BOOL_F, hash_fn, assoc_fn, closure);
 137   SCM_SETCDR (it, val);
 138   return val;
 139 }
 140
 141
 142
 143
 144
 145 SCM
 146 scm_hash_fn_remove_x (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),
 147                       SCM (*delete_fn)(),void * closure)
 148 {
 149   unsigned int k;
 150   SCM h;
 151
 152   SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
 153   if (SCM_LENGTH (table) == 0)
 154     return SCM_EOL;
 155   k = hash_fn (obj, SCM_LENGTH (table), closure);
 156   SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
 157               scm_ulong2num (k),
 158               SCM_OUTOFRANGE,
 159               "hash_fn_remove_x");
 160   h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
 161   SCM_VELTS(table)[k] = delete_fn (h, SCM_VELTS(table)[k]);
 162   return h;
 163 }
 164
 165
 166 \f
 167
 168 SCM_DEFINE (scm_hashq_get_handle, "hashq-get-handle", 2, 0, 0,
 169             (SCM table, SCM obj),
 170             "This procedure is similar to its @code{-ref} cousin, but returns a\n"
 171             "@dfn{handle} from the hash table rather than the value associated with\n"
 172             "@var{key}.  By convention, a handle in a hash table is the pair which\n"
 173             "associates a key with a value.  Where @code{hashq-ref table key} returns\n"
 174             "only a @code{value}, @code{hashq-get-handle table key} returns the pair\n"
 175             "@code{(key . value)}.")
 176 #define FUNC_NAME s_scm_hashq_get_handle
 177 {
 178   return scm_hash_fn_get_handle (table, obj, scm_ihashq, scm_sloppy_assq, 0);
 179 }
 180 #undef FUNC_NAME
 181
 182
 183 SCM_DEFINE (scm_hashq_create_handle_x, "hashq-create-handle!", 3, 0, 0,
 184             (SCM table, SCM key, SCM init),
 185             "This function looks up @var{key} in @var{table} and returns its handle.\n"
 186             "If @var{key} is not already present, a new handle is created which\n"
 187             "associates @var{key} with @var{init}.")
 188 #define FUNC_NAME s_scm_hashq_create_handle_x
 189 {
 190   return scm_hash_fn_create_handle_x (table, key, init, scm_ihashq, scm_sloppy_assq, 0);
 191 }
 192 #undef FUNC_NAME
 193
 194
 195 SCM_DEFINE (scm_hashq_ref, "hashq-ref", 2, 1, 0,
 196             (SCM table, SCM obj, SCM dflt),
 197             "Look up @var{key} in the hash table @var{table}, and return the\n"
 198             "value (if any) associated with it.  If @var{key} is not found,\n"
 199             "return @var{default} (or @code{#f} if no @var{default} argument is\n"
 200             "supplied).  Uses `eq?' for equality testing.")
 201 #define FUNC_NAME s_scm_hashq_ref
 202 {
 203   if (dflt == SCM_UNDEFINED)
 204     dflt = SCM_BOOL_F;
 205   return scm_hash_fn_ref (table, obj, dflt, scm_ihashq, scm_sloppy_assq, 0);
 206 }
 207 #undef FUNC_NAME
 208
 209
 210
 211 SCM_DEFINE (scm_hashq_set_x, "hashq-set!", 3, 0, 0,
 212             (SCM table, SCM obj, SCM val),
 213             "Find the entry in @var{table} associated with @var{key}, and store\n"
 214             "@var{value} there. Uses `eq?' for equality testing.")
 215 #define FUNC_NAME s_scm_hashq_set_x
 216 {
 217   return scm_hash_fn_set_x (table, obj, val, scm_ihashq, scm_sloppy_assq, 0);
 218 }
 219 #undef FUNC_NAME
 220
 221
 222
 223 SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0,
 224             (SCM table, SCM obj),
 225             "Remove @var{key} (and any value associated with it) from @var{table}.\n"
 226             "Uses `eq?' for equality tests.")
 227 #define FUNC_NAME s_scm_hashq_remove_x
 228 {
 229   return scm_hash_fn_remove_x (table, obj, scm_ihashq, scm_sloppy_assq, scm_delq_x, 0);
 230 }
 231 #undef FUNC_NAME
 232
 233
 234 \f
 235
 236 SCM_DEFINE (scm_hashv_get_handle, "hashv-get-handle", 2, 0, 0,
 237             (SCM table, SCM obj),
 238             "This procedure is similar to its @code{-ref} cousin, but returns a\n"
 239             "@dfn{handle} from the hash table rather than the value associated with\n"
 240             "@var{key}.  By convention, a handle in a hash table is the pair which\n"
 241             "associates a key with a value.  Where @code{hashv-ref table key} returns\n"
 242             "only a @code{value}, @code{hashv-get-handle table key} returns the pair\n"
 243             "@code{(key . value)}.")
 244 #define FUNC_NAME s_scm_hashv_get_handle
 245 {
 246   return scm_hash_fn_get_handle (table, obj, scm_ihashv, scm_sloppy_assv, 0);
 247 }
 248 #undef FUNC_NAME
 249
 250
 251 SCM_DEFINE (scm_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0,
 252             (SCM table, SCM key, SCM init),
 253             "This function looks up @var{key} in @var{table} and returns its handle.\n"
 254             "If @var{key} is not already present, a new handle is created which\n"
 255             "associates @var{key} with @var{init}.")
 256 #define FUNC_NAME s_scm_hashv_create_handle_x
 257 {
 258   return scm_hash_fn_create_handle_x (table, key, init, scm_ihashv, scm_sloppy_assv, 0);
 259 }
 260 #undef FUNC_NAME
 261
 262
 263 SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0,
 264             (SCM table, SCM obj, SCM dflt),
 265             "Look up @var{key} in the hash table @var{table}, and return the\n"
 266             "value (if any) associated with it.  If @var{key} is not found,\n"
 267             "return @var{default} (or @code{#f} if no @var{default} argument is\n"
 268             "supplied).  Uses `eqv?' for equality testing.")
 269 #define FUNC_NAME s_scm_hashv_ref
 270 {
 271   if (dflt == SCM_UNDEFINED)
 272     dflt = SCM_BOOL_F;
 273   return scm_hash_fn_ref (table, obj, dflt, scm_ihashv, scm_sloppy_assv, 0);
 274 }
 275 #undef FUNC_NAME
 276
 277
 278
 279 SCM_DEFINE (scm_hashv_set_x, "hashv-set!", 3, 0, 0,
 280             (SCM table, SCM obj, SCM val),
 281             "Find the entry in @var{table} associated with @var{key}, and store\n"
 282             "@var{value} there. Uses `eqv?' for equality testing.")
 283 #define FUNC_NAME s_scm_hashv_set_x
 284 {
 285   return scm_hash_fn_set_x (table, obj, val, scm_ihashv, scm_sloppy_assv, 0);
 286 }
 287 #undef FUNC_NAME
 288
 289
 290 SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0,
 291             (SCM table, SCM obj),
 292             "Remove @var{key} (and any value associated with it) from @var{table}.\n"
 293             "Uses `eqv?' for equality tests.")
 294 #define FUNC_NAME s_scm_hashv_remove_x
 295 {
 296   return scm_hash_fn_remove_x (table, obj, scm_ihashv, scm_sloppy_assv, scm_delv_x, 0);
 297 }
 298 #undef FUNC_NAME
 299
 300 \f
 301
 302 SCM_DEFINE (scm_hash_get_handle, "hash-get-handle", 2, 0, 0,
 303             (SCM table, SCM obj),
 304             "This procedure is similar to its @code{-ref} cousin, but returns a\n"
 305             "@dfn{handle} from the hash table rather than the value associated with\n"
 306             "@var{key}.  By convention, a handle in a hash table is the pair which\n"
 307             "associates a key with a value.  Where @code{hash-ref table key} returns\n"
 308             "only a @code{value}, @code{hash-get-handle table key} returns the pair\n"
 309             "@code{(key . value)}.")
 310 #define FUNC_NAME s_scm_hash_get_handle
 311 {
 312   return scm_hash_fn_get_handle (table, obj, scm_ihash, scm_sloppy_assoc, 0);
 313 }
 314 #undef FUNC_NAME
 315
 316
 317 SCM_DEFINE (scm_hash_create_handle_x, "hash-create-handle!", 3, 0, 0,
 318             (SCM table, SCM key, SCM init),
 319             "This function looks up @var{key} in @var{table} and returns its handle.\n"
 320             "If @var{key} is not already present, a new handle is created which\n"
 321             "associates @var{key} with @var{init}.")
 322 #define FUNC_NAME s_scm_hash_create_handle_x
 323 {
 324   return scm_hash_fn_create_handle_x (table, key, init, scm_ihash, scm_sloppy_assoc, 0);
 325 }
 326 #undef FUNC_NAME
 327
 328
 329 SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0,
 330             (SCM table, SCM obj, SCM dflt),
 331             "Look up @var{key} in the hash table @var{table}, and return the\n"
 332             "value (if any) associated with it.  If @var{key} is not found,\n"
 333             "return @var{default} (or @code{#f} if no @var{default} argument is\n"
 334             "supplied).  Uses `equal?' for equality testing.")
 335 #define FUNC_NAME s_scm_hash_ref
 336 {
 337   if (dflt == SCM_UNDEFINED)
 338     dflt = SCM_BOOL_F;
 339   return scm_hash_fn_ref (table, obj, dflt, scm_ihash, scm_sloppy_assoc, 0);
 340 }
 341 #undef FUNC_NAME
 342
 343
 344
 345 SCM_DEFINE (scm_hash_set_x, "hash-set!", 3, 0, 0,
 346             (SCM table, SCM obj, SCM val),
 347             "Find the entry in @var{table} associated with @var{key}, and store\n"
 348             "@var{value} there. Uses `equal?' for equality testing.")
 349 #define FUNC_NAME s_scm_hash_set_x
 350 {
 351   return scm_hash_fn_set_x (table, obj, val, scm_ihash, scm_sloppy_assoc, 0);
 352 }
 353 #undef FUNC_NAME
 354
 355
 356
 357 SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0,
 358             (SCM table, SCM obj),
 359             "Remove @var{key} (and any value associated with it) from @var{table}.\n"
 360             "Uses `equal?' for equality tests.")
 361 #define FUNC_NAME s_scm_hash_remove_x
 362 {
 363   return scm_hash_fn_remove_x (table, obj, scm_ihash, scm_sloppy_assoc, scm_delete_x, 0);
 364 }
 365 #undef FUNC_NAME
 366
 367 \f
 368
 369
 370 struct scm_ihashx_closure
 371 {
 372   SCM hash;
 373   SCM assoc;
 374   SCM delete;
 375 };
 376
 377
 378
 379 static unsigned int
 380 scm_ihashx (SCM obj,unsigned int n,struct scm_ihashx_closure * closure)
 381 {
 382   SCM answer;
 383   SCM_ALLOW_INTS;
 384   answer = scm_apply (closure->hash,
 385                       scm_listify (obj, scm_ulong2num ((unsigned long)n), SCM_UNDEFINED),
 386                       SCM_EOL);
 387   SCM_DEFER_INTS;
 388   return SCM_INUM (answer);
 389 }
 390
 391
 392
 393 static SCM
 394 scm_sloppy_assx (SCM obj,SCM alist,struct scm_ihashx_closure * closure)
 395 {
 396   SCM answer;
 397   SCM_ALLOW_INTS;
 398   answer = scm_apply (closure->assoc,
 399                       scm_listify (obj, alist, SCM_UNDEFINED),
 400                       SCM_EOL);
 401   SCM_DEFER_INTS;
 402   return answer;
 403 }
 404
 405
 406
 407
 408 static SCM
 409 scm_delx_x (SCM obj,SCM alist,struct scm_ihashx_closure * closure)
 410 {
 411   SCM answer;
 412   SCM_ALLOW_INTS;
 413   answer = scm_apply (closure->delete,
 414                       scm_listify (obj, alist, SCM_UNDEFINED),
 415                       SCM_EOL);
 416   SCM_DEFER_INTS;
 417   return answer;
 418 }
 419
 420
 421
 422 SCM_DEFINE (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0,
 423             (SCM hash, SCM assoc, SCM table, SCM obj),
 424             "This behaves the same way as the corresponding @code{-get-handle}\n"
 425             "function, but uses @var{hasher} as a\n"
 426             "hash function and @var{assoc} to compare keys.  @code{hasher} must\n"
 427             "be a function that takes two arguments, a key to be hashed and a\n"
 428             "table size.  @code{assoc} must be an associator function, like\n"
 429             "@code{assoc}, @code{assq} or @code{assv}.")
 430 #define FUNC_NAME s_scm_hashx_get_handle
 431 {
 432   struct scm_ihashx_closure closure;
 433   closure.hash = hash;
 434   closure.assoc = assoc;
 435   return scm_hash_fn_get_handle (table, obj, scm_ihashx, scm_sloppy_assx, (void *)&closure);
 436 }
 437 #undef FUNC_NAME
 438
 439
 440 SCM_DEFINE (scm_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0,
 441             (SCM hash,SCM assoc,SCM table,SCM obj,SCM init),
 442             "This behaves the same way as the corresponding @code{-create-handle}\n"
 443             "function, but uses @var{hasher} as a\n"
 444             "hash function and @var{assoc} to compare keys.  @code{hasher} must\n"
 445             "be a function that takes two arguments, a key to be hashed and a\n"
 446             "table size.  @code{assoc} must be an associator function, like\n"
 447             "@code{assoc}, @code{assq} or @code{assv}.")
 448 #define FUNC_NAME s_scm_hashx_create_handle_x
 449 {
 450   struct scm_ihashx_closure closure;
 451   closure.hash = hash;
 452   closure.assoc = assoc;
 453   return scm_hash_fn_create_handle_x (table, obj, init, scm_ihashx, scm_sloppy_assx, (void *)&closure);
 454 }
 455 #undef FUNC_NAME
 456
 457
 458
 459 SCM_DEFINE (scm_hashx_ref, "hashx-ref", 4, 1, 0,
 460             (SCM hash,SCM assoc,SCM table,SCM obj,SCM dflt),
 461             "This behaves the same way as the corresponding @code{ref}\n"
 462             "function, but uses @var{hasher} as a\n"
 463             "hash function and @var{assoc} to compare keys.  @code{hasher} must\n"
 464             "be a function that takes two arguments, a key to be hashed and a\n"
 465             "table size.  @code{assoc} must be an associator function, like\n"
 466             "@code{assoc}, @code{assq} or @code{assv}.\n\n"
 467             "By way of illustration, @code{hashq-ref table key} is equivalent\n"
 468             "to @code{hashx-ref hashq assq table key}.")
 469 #define FUNC_NAME s_scm_hashx_ref
 470 {
 471   struct scm_ihashx_closure closure;
 472   if (dflt == SCM_UNDEFINED)
 473     dflt = SCM_BOOL_F;
 474   closure.hash = hash;
 475   closure.assoc = assoc;
 476   return scm_hash_fn_ref (table, obj, dflt, scm_ihashx, scm_sloppy_assx, (void *)&closure);
 477 }
 478 #undef FUNC_NAME
 479
 480
 481
 482
 483 SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0,
 484             (SCM hash, SCM assoc, SCM table, SCM obj, SCM val),
 485             "This behaves the same way as the corresponding @code{set!}\n"
 486             "function, but uses @var{hasher} as a\n"
 487             "hash function and @var{assoc} to compare keys.  @code{hasher} must\n"
 488             "be a function that takes two arguments, a key to be hashed and a\n"
 489             "table size.  @code{assoc} must be an associator function, like\n"
 490             "@code{assoc}, @code{assq} or @code{assv}.\n\n"
 491             "By way of illustration, @code{hashq-set! table key} is equivalent\n"
 492             "to @code{hashx-set! hashq assq table key}.")
 493 #define FUNC_NAME s_scm_hashx_set_x
 494 {
 495   struct scm_ihashx_closure closure;
 496   closure.hash = hash;
 497   closure.assoc = assoc;
 498   return scm_hash_fn_set_x (table, obj, val, scm_ihashx, scm_sloppy_assx, (void *)&closure);
 499 }
 500 #undef FUNC_NAME
 501
 502
 503
 504 SCM
 505 scm_hashx_remove_x (SCM hash,SCM assoc,SCM delete,SCM table,SCM obj)
 506 {
 507   struct scm_ihashx_closure closure;
 508   closure.hash = hash;
 509   closure.assoc = assoc;
 510   closure.delete = delete;
 511   return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx, scm_delx_x, 0);
 512 }
 513
 514 static SCM
 515 fold_proc (void *proc, SCM key, SCM data, SCM value)
 516 {
 517   return scm_apply ((SCM) proc, SCM_LIST3 (key, data, value), SCM_EOL);
 518 }
 519
 520 SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
 521             (SCM proc, SCM init, SCM table),
 522             "An iterator over hash-table elements.\n"
 523             "Accumulates and returns a result by applying PROC successively.\n"
 524             "The arguments to PROC are \"(key value prior-result)\" where key\n"
 525             "and value are successive pairs from the hash table TABLE, and\n"
 526             "prior-result is either INIT (for the first application of PROC)\n"
 527             "or the return value of the previous application of PROC.\n"
 528             "For example, @code{(hash-fold acons () tab)} will convert a hash\n"
 529             "table into an a-list of key-value pairs.\n")
 530 #define FUNC_NAME s_scm_hash_fold
 531 {
 532   SCM_VALIDATE_PROC (1,proc);
 533   SCM_VALIDATE_VECTOR (3,table);
 534   return scm_internal_hash_fold (fold_proc, (void *) proc, init, table);
 535 }
 536 #undef FUNC_NAME
 537
 538 SCM
 539 scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
 540 {
 541   int i, n = SCM_LENGTH (table);
 542   SCM result = init;
 543   for (i = 0; i < n; ++i)
 544     {
 545       SCM ls = SCM_VELTS (table)[i], handle;
 546       while (SCM_NNULLP (ls))
 547         {
 548           SCM_ASSERT (SCM_CONSP (ls),
 549                       table, SCM_ARG1, s_scm_hash_fold);
 550           handle = SCM_CAR (ls);
 551           SCM_ASSERT (SCM_CONSP (handle),
 552                       table, SCM_ARG1, s_scm_hash_fold);
 553           result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
 554           ls = SCM_CDR (ls);
 555         }
 556     }
 557   return result;
 558 }
 559
 560 \f
 561
 562
 563 void
 564 scm_init_hashtab ()
 565 {
 566 #include "hashtab.x"
 567 }