-/* Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
- gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
\f
-#include <stdio.h>
#include "libguile/_scm.h"
#include "libguile/alist.h"
#include "libguile/hash.h"
#include "libguile/eval.h"
+#include "libguile/root.h"
#include "libguile/vectors.h"
#include "libguile/validate.h"
return scm_c_make_vector (k, SCM_EOL);
}
+
SCM
-scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),void * closure)
+scm_hash_fn_get_handle (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(),void * closure)
+#define FUNC_NAME "scm_hash_fn_get_handle"
{
- unsigned int k;
+ unsigned long k;
SCM h;
- SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_get_handle");
+ SCM_VALIDATE_VECTOR (1, table);
if (SCM_VECTOR_LENGTH (table) == 0)
- return SCM_EOL;
+ return SCM_BOOL_F;
k = hash_fn (obj, SCM_VECTOR_LENGTH (table), closure);
if (k >= SCM_VECTOR_LENGTH (table))
scm_out_of_range ("hash_fn_get_handle", scm_ulong2num (k));
h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
return h;
}
+#undef FUNC_NAME
SCM
-scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned int (*hash_fn)(),
+scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned long (*hash_fn)(),
SCM (*assoc_fn)(),void * closure)
#define FUNC_NAME "scm_hash_fn_create_handle_x"
{
- unsigned int k;
+ unsigned long k;
SCM it;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x");
scm_out_of_range ("hash_fn_create_handle_x", scm_ulong2num (k));
SCM_REDEFER_INTS;
it = assoc_fn (obj, SCM_VELTS (table)[k], closure);
- if (SCM_NIMP (it))
+ if (!SCM_FALSEP (it))
{
SCM_REALLOW_INTS;
return it;
}
- {
- SCM new_bucket;
- SCM old_bucket;
- old_bucket = SCM_VELTS (table)[k];
- new_bucket = scm_acons (obj, init, old_bucket);
- SCM_VELTS(table)[k] = new_bucket;
- SCM_REALLOW_INTS;
- return SCM_CAR (new_bucket);
- }
+ else
+ {
+ SCM new_bucket;
+ SCM old_bucket;
+ old_bucket = SCM_VELTS (table)[k];
+ new_bucket = scm_acons (obj, init, old_bucket);
+ SCM_VELTS(table)[k] = new_bucket;
+ SCM_REALLOW_INTS;
+ return SCM_CAR (new_bucket);
+ }
}
#undef FUNC_NAME
SCM
-scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned int (*hash_fn)(),
+scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned long (*hash_fn)(),
SCM (*assoc_fn)(),void * closure)
{
- SCM it;
-
- it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
- if (SCM_IMP (it))
- return dflt;
- else
+ SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
+ if (SCM_CONSP (it))
return SCM_CDR (it);
+ else
+ return dflt;
}
SCM
-scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned int (*hash_fn)(),
+scm_hash_fn_set_x (SCM table,SCM obj,SCM val,unsigned long (*hash_fn)(),
SCM (*assoc_fn)(),void * closure)
{
SCM it;
SCM
-scm_hash_fn_remove_x (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),
+scm_hash_fn_remove_x (SCM table,SCM obj,unsigned long (*hash_fn)(),SCM (*assoc_fn)(),
SCM (*delete_fn)(),void * closure)
{
- unsigned int k;
+ unsigned long k;
SCM h;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
\f
SCM_DEFINE (scm_hashq_get_handle, "hashq-get-handle", 2, 0, 0,
- (SCM table, SCM obj),
- "This procedure is similar to its @code{-ref} cousin, but returns a\n"
- "@dfn{handle} from the hash table rather than the value associated with\n"
- "@var{key}. By convention, a handle in a hash table is the pair which\n"
- "associates a key with a value. Where @code{hashq-ref table key} returns\n"
- "only a @code{value}, @code{hashq-get-handle table key} returns the pair\n"
- "@code{(key . value)}.")
+ (SCM table, SCM key),
+ "This procedure returns the @code{(key . value)} pair from the\n"
+ "hash table @var{table}. If @var{table} does not hold an\n"
+ "associated value for @var{key}, @code{#f} is returned.\n"
+ "Uses @code{eq?} for equality testing.")
#define FUNC_NAME s_scm_hashq_get_handle
{
- return scm_hash_fn_get_handle (table, obj, scm_ihashq, scm_sloppy_assq, 0);
+ return scm_hash_fn_get_handle (table, key, scm_ihashq, scm_sloppy_assq, 0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hashq_ref, "hashq-ref", 2, 1, 0,
- (SCM table, SCM obj, SCM dflt),
+ (SCM table, SCM key, SCM dflt),
"Look up @var{key} in the hash table @var{table}, and return the\n"
"value (if any) associated with it. If @var{key} is not found,\n"
- "return @var{default} (or @code{#f} if no @var{default} argument is\n"
- "supplied). Uses `eq?' for equality testing.")
+ "return @var{default} (or @code{#f} if no @var{default} argument\n"
+ "is supplied). Uses @code{eq?} for equality testing.")
#define FUNC_NAME s_scm_hashq_ref
{
if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
- return scm_hash_fn_ref (table, obj, dflt, scm_ihashq, scm_sloppy_assq, 0);
+ return scm_hash_fn_ref (table, key, dflt, scm_ihashq, scm_sloppy_assq, 0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hashq_set_x, "hashq-set!", 3, 0, 0,
- (SCM table, SCM obj, SCM val),
- "Find the entry in @var{table} associated with @var{key}, and store\n"
- "@var{value} there. Uses `eq?' for equality testing.")
+ (SCM table, SCM key, SCM val),
+ "Find the entry in @var{table} associated with @var{key}, and\n"
+ "store @var{value} there. Uses @code{eq?} for equality testing.")
#define FUNC_NAME s_scm_hashq_set_x
{
- return scm_hash_fn_set_x (table, obj, val, scm_ihashq, scm_sloppy_assq, 0);
+ return scm_hash_fn_set_x (table, key, val, scm_ihashq, scm_sloppy_assq, 0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0,
- (SCM table, SCM obj),
- "Remove @var{key} (and any value associated with it) from @var{table}.\n"
- "Uses `eq?' for equality tests.")
+ (SCM table, SCM key),
+ "Remove @var{key} (and any value associated with it) from\n"
+ "@var{table}. Uses @code{eq?} for equality tests.")
#define FUNC_NAME s_scm_hashq_remove_x
{
- return scm_hash_fn_remove_x (table, obj, scm_ihashq, scm_sloppy_assq, scm_delq_x, 0);
+ return scm_hash_fn_remove_x (table, key, scm_ihashq, scm_sloppy_assq,
+ scm_delq_x, 0);
}
#undef FUNC_NAME
\f
SCM_DEFINE (scm_hashv_get_handle, "hashv-get-handle", 2, 0, 0,
- (SCM table, SCM obj),
- "This procedure is similar to its @code{-ref} cousin, but returns a\n"
- "@dfn{handle} from the hash table rather than the value associated with\n"
- "@var{key}. By convention, a handle in a hash table is the pair which\n"
- "associates a key with a value. Where @code{hashv-ref table key} returns\n"
- "only a @code{value}, @code{hashv-get-handle table key} returns the pair\n"
- "@code{(key . value)}.")
+ (SCM table, SCM key),
+ "This procedure returns the @code{(key . value)} pair from the\n"
+ "hash table @var{table}. If @var{table} does not hold an\n"
+ "associated value for @var{key}, @code{#f} is returned.\n"
+ "Uses @code{eqv?} for equality testing.")
#define FUNC_NAME s_scm_hashv_get_handle
{
- return scm_hash_fn_get_handle (table, obj, scm_ihashv, scm_sloppy_assv, 0);
+ return scm_hash_fn_get_handle (table, key, scm_ihashv, scm_sloppy_assv, 0);
}
#undef FUNC_NAME
"associates @var{key} with @var{init}.")
#define FUNC_NAME s_scm_hashv_create_handle_x
{
- return scm_hash_fn_create_handle_x (table, key, init, scm_ihashv, scm_sloppy_assv, 0);
+ return scm_hash_fn_create_handle_x (table, key, init, scm_ihashv,
+ scm_sloppy_assv, 0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0,
- (SCM table, SCM obj, SCM dflt),
+ (SCM table, SCM key, SCM dflt),
"Look up @var{key} in the hash table @var{table}, and return the\n"
"value (if any) associated with it. If @var{key} is not found,\n"
- "return @var{default} (or @code{#f} if no @var{default} argument is\n"
- "supplied). Uses `eqv?' for equality testing.")
+ "return @var{default} (or @code{#f} if no @var{default} argument\n"
+ "is supplied). Uses @code{eqv?} for equality testing.")
#define FUNC_NAME s_scm_hashv_ref
{
if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
- return scm_hash_fn_ref (table, obj, dflt, scm_ihashv, scm_sloppy_assv, 0);
+ return scm_hash_fn_ref (table, key, dflt, scm_ihashv, scm_sloppy_assv, 0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hashv_set_x, "hashv-set!", 3, 0, 0,
- (SCM table, SCM obj, SCM val),
- "Find the entry in @var{table} associated with @var{key}, and store\n"
- "@var{value} there. Uses `eqv?' for equality testing.")
+ (SCM table, SCM key, SCM val),
+ "Find the entry in @var{table} associated with @var{key}, and\n"
+ "store @var{value} there. Uses @code{eqv?} for equality testing.")
#define FUNC_NAME s_scm_hashv_set_x
{
- return scm_hash_fn_set_x (table, obj, val, scm_ihashv, scm_sloppy_assv, 0);
+ return scm_hash_fn_set_x (table, key, val, scm_ihashv, scm_sloppy_assv, 0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0,
- (SCM table, SCM obj),
- "Remove @var{key} (and any value associated with it) from @var{table}.\n"
- "Uses `eqv?' for equality tests.")
+ (SCM table, SCM key),
+ "Remove @var{key} (and any value associated with it) from\n"
+ "@var{table}. Uses @code{eqv?} for equality tests.")
#define FUNC_NAME s_scm_hashv_remove_x
{
- return scm_hash_fn_remove_x (table, obj, scm_ihashv, scm_sloppy_assv, scm_delv_x, 0);
+ return scm_hash_fn_remove_x (table, key, scm_ihashv, scm_sloppy_assv,
+ scm_delv_x, 0);
}
#undef FUNC_NAME
\f
SCM_DEFINE (scm_hash_get_handle, "hash-get-handle", 2, 0, 0,
- (SCM table, SCM obj),
- "This procedure is similar to its @code{-ref} cousin, but returns a\n"
- "@dfn{handle} from the hash table rather than the value associated with\n"
- "@var{key}. By convention, a handle in a hash table is the pair which\n"
- "associates a key with a value. Where @code{hash-ref table key} returns\n"
- "only a @code{value}, @code{hash-get-handle table key} returns the pair\n"
- "@code{(key . value)}.")
+ (SCM table, SCM key),
+ "This procedure returns the @code{(key . value)} pair from the\n"
+ "hash table @var{table}. If @var{table} does not hold an\n"
+ "associated value for @var{key}, @code{#f} is returned.\n"
+ "Uses @code{equal?} for equality testing.")
#define FUNC_NAME s_scm_hash_get_handle
{
- return scm_hash_fn_get_handle (table, obj, scm_ihash, scm_sloppy_assoc, 0);
+ return scm_hash_fn_get_handle (table, key, scm_ihash, scm_sloppy_assoc, 0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0,
- (SCM table, SCM obj, SCM dflt),
+ (SCM table, SCM key, SCM dflt),
"Look up @var{key} in the hash table @var{table}, and return the\n"
"value (if any) associated with it. If @var{key} is not found,\n"
- "return @var{default} (or @code{#f} if no @var{default} argument is\n"
- "supplied). Uses `equal?' for equality testing.")
+ "return @var{default} (or @code{#f} if no @var{default} argument\n"
+ "is supplied). Uses @code{equal?} for equality testing.")
#define FUNC_NAME s_scm_hash_ref
{
if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
- return scm_hash_fn_ref (table, obj, dflt, scm_ihash, scm_sloppy_assoc, 0);
+ return scm_hash_fn_ref (table, key, dflt, scm_ihash, scm_sloppy_assoc, 0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hash_set_x, "hash-set!", 3, 0, 0,
- (SCM table, SCM obj, SCM val),
- "Find the entry in @var{table} associated with @var{key}, and store\n"
- "@var{value} there. Uses `equal?' for equality testing.")
+ (SCM table, SCM key, SCM val),
+ "Find the entry in @var{table} associated with @var{key}, and\n"
+ "store @var{value} there. Uses @code{equal?} for equality\n"
+ "testing.")
#define FUNC_NAME s_scm_hash_set_x
{
- return scm_hash_fn_set_x (table, obj, val, scm_ihash, scm_sloppy_assoc, 0);
+ return scm_hash_fn_set_x (table, key, val, scm_ihash, scm_sloppy_assoc, 0);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0,
- (SCM table, SCM obj),
- "Remove @var{key} (and any value associated with it) from @var{table}.\n"
- "Uses `equal?' for equality tests.")
+ (SCM table, SCM key),
+ "Remove @var{key} (and any value associated with it) from\n"
+ "@var{table}. Uses @code{equal?} for equality tests.")
#define FUNC_NAME s_scm_hash_remove_x
{
- return scm_hash_fn_remove_x (table, obj, scm_ihash, scm_sloppy_assoc, scm_delete_x, 0);
+ return scm_hash_fn_remove_x (table, key, scm_ihash, scm_sloppy_assoc,
+ scm_delete_x, 0);
}
#undef FUNC_NAME
\f
-struct scm_ihashx_closure
+typedef struct scm_t_ihashx_closure
{
SCM hash;
SCM assoc;
SCM delete;
-};
+} scm_t_ihashx_closure;
-static unsigned int
-scm_ihashx (SCM obj,unsigned int n,struct scm_ihashx_closure * closure)
+static unsigned long
+scm_ihashx (SCM obj, unsigned long n, scm_t_ihashx_closure *closure)
{
SCM answer;
SCM_DEFER_INTS;
- answer = scm_apply (closure->hash,
- scm_listify (obj, scm_ulong2num ((unsigned long)n), SCM_UNDEFINED),
- SCM_EOL);
+ answer = scm_call_2 (closure->hash, obj, scm_ulong2num ((unsigned long) n));
SCM_ALLOW_INTS;
return SCM_INUM (answer);
}
static SCM
-scm_sloppy_assx (SCM obj,SCM alist,struct scm_ihashx_closure * closure)
+scm_sloppy_assx (SCM obj, SCM alist, scm_t_ihashx_closure *closure)
{
SCM answer;
SCM_DEFER_INTS;
- answer = scm_apply (closure->assoc,
- scm_listify (obj, alist, SCM_UNDEFINED),
- SCM_EOL);
+ answer = scm_call_2 (closure->assoc, obj, alist);
SCM_ALLOW_INTS;
return answer;
}
static SCM
-scm_delx_x (SCM obj,SCM alist,struct scm_ihashx_closure * closure)
+scm_delx_x (SCM obj, SCM alist, scm_t_ihashx_closure *closure)
{
SCM answer;
SCM_DEFER_INTS;
- answer = scm_apply (closure->delete,
- scm_listify (obj, alist, SCM_UNDEFINED),
- SCM_EOL);
+ answer = scm_call_2 (closure->delete, obj, alist);
SCM_ALLOW_INTS;
return answer;
}
SCM_DEFINE (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0,
- (SCM hash, SCM assoc, SCM table, SCM obj),
- "This behaves the same way as the corresponding @code{-get-handle}\n"
- "function, but uses @var{hasher} as a\n"
- "hash function and @var{assoc} to compare keys. @code{hasher} must\n"
- "be a function that takes two arguments, a key to be hashed and a\n"
+ (SCM hash, SCM assoc, SCM table, SCM key),
+ "This behaves the same way as the corresponding\n"
+ "@code{-get-handle} function, but uses @var{hash} as a hash\n"
+ "function and @var{assoc} to compare keys. @code{hash} must be\n"
+ "a function that takes two arguments, a key to be hashed and a\n"
"table size. @code{assoc} must be an associator function, like\n"
"@code{assoc}, @code{assq} or @code{assv}.")
#define FUNC_NAME s_scm_hashx_get_handle
{
- struct scm_ihashx_closure closure;
+ scm_t_ihashx_closure closure;
closure.hash = hash;
closure.assoc = assoc;
- return scm_hash_fn_get_handle (table, obj, scm_ihashx, scm_sloppy_assx, (void *)&closure);
+ return scm_hash_fn_get_handle (table, key, scm_ihashx, scm_sloppy_assx,
+ (void *)&closure);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0,
- (SCM hash, SCM assoc, SCM table, SCM obj, SCM init),
- "This behaves the same way as the corresponding @code{-create-handle}\n"
- "function, but uses @var{hasher} as a\n"
- "hash function and @var{assoc} to compare keys. @code{hasher} must\n"
- "be a function that takes two arguments, a key to be hashed and a\n"
+ (SCM hash, SCM assoc, SCM table, SCM key, SCM init),
+ "This behaves the same way as the corresponding\n"
+ "@code{-create-handle} function, but uses @var{hash} as a hash\n"
+ "function and @var{assoc} to compare keys. @code{hash} must be\n"
+ "a function that takes two arguments, a key to be hashed and a\n"
"table size. @code{assoc} must be an associator function, like\n"
"@code{assoc}, @code{assq} or @code{assv}.")
#define FUNC_NAME s_scm_hashx_create_handle_x
{
- struct scm_ihashx_closure closure;
+ scm_t_ihashx_closure closure;
closure.hash = hash;
closure.assoc = assoc;
- return scm_hash_fn_create_handle_x (table, obj, init, scm_ihashx, scm_sloppy_assx, (void *)&closure);
+ return scm_hash_fn_create_handle_x (table, key, init, scm_ihashx,
+ scm_sloppy_assx, (void *)&closure);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hashx_ref, "hashx-ref", 4, 1, 0,
- (SCM hash, SCM assoc, SCM table, SCM obj, SCM dflt),
+ (SCM hash, SCM assoc, SCM table, SCM key, SCM dflt),
"This behaves the same way as the corresponding @code{ref}\n"
- "function, but uses @var{hasher} as a\n"
- "hash function and @var{assoc} to compare keys. @code{hasher} must\n"
- "be a function that takes two arguments, a key to be hashed and a\n"
- "table size. @code{assoc} must be an associator function, like\n"
- "@code{assoc}, @code{assq} or @code{assv}.\n\n"
- "By way of illustration, @code{hashq-ref table key} is equivalent\n"
- "to @code{hashx-ref hashq assq table key}.")
+ "function, but uses @var{hash} as a hash function and\n"
+ "@var{assoc} to compare keys. @code{hash} must be a function\n"
+ "that takes two arguments, a key to be hashed and a table size.\n"
+ "@code{assoc} must be an associator function, like @code{assoc},\n"
+ "@code{assq} or @code{assv}.\n"
+ "\n"
+ "By way of illustration, @code{hashq-ref table key} is\n"
+ "equivalent to @code{hashx-ref hashq assq table key}.")
#define FUNC_NAME s_scm_hashx_ref
{
- struct scm_ihashx_closure closure;
+ scm_t_ihashx_closure closure;
if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
closure.hash = hash;
closure.assoc = assoc;
- return scm_hash_fn_ref (table, obj, dflt, scm_ihashx, scm_sloppy_assx, (void *)&closure);
+ return scm_hash_fn_ref (table, key, dflt, scm_ihashx, scm_sloppy_assx,
+ (void *)&closure);
}
#undef FUNC_NAME
SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0,
- (SCM hash, SCM assoc, SCM table, SCM obj, SCM val),
+ (SCM hash, SCM assoc, SCM table, SCM key, SCM val),
"This behaves the same way as the corresponding @code{set!}\n"
- "function, but uses @var{hasher} as a\n"
- "hash function and @var{assoc} to compare keys. @code{hasher} must\n"
- "be a function that takes two arguments, a key to be hashed and a\n"
- "table size. @code{assoc} must be an associator function, like\n"
- "@code{assoc}, @code{assq} or @code{assv}.\n\n"
- "By way of illustration, @code{hashq-set! table key} is equivalent\n"
- "to @code{hashx-set! hashq assq table key}.")
+ "function, but uses @var{hash} as a hash function and\n"
+ "@var{assoc} to compare keys. @code{hash} must be a function\n"
+ "that takes two arguments, a key to be hashed and a table size.\n"
+ "@code{assoc} must be an associator function, like @code{assoc},\n"
+ "@code{assq} or @code{assv}.\n"
+ "\n"
+ " By way of illustration, @code{hashq-set! table key} is\n"
+ "equivalent to @code{hashx-set! hashq assq table key}.")
#define FUNC_NAME s_scm_hashx_set_x
{
- struct scm_ihashx_closure closure;
+ scm_t_ihashx_closure closure;
closure.hash = hash;
closure.assoc = assoc;
- return scm_hash_fn_set_x (table, obj, val, scm_ihashx, scm_sloppy_assx, (void *)&closure);
+ return scm_hash_fn_set_x (table, key, val, scm_ihashx, scm_sloppy_assx,
+ (void *)&closure);
}
#undef FUNC_NAME
SCM
-scm_hashx_remove_x (SCM hash,SCM assoc,SCM delete,SCM table,SCM obj)
+scm_hashx_remove_x (SCM hash, SCM assoc, SCM delete, SCM table, SCM obj)
{
- struct scm_ihashx_closure closure;
+ scm_t_ihashx_closure closure;
closure.hash = hash;
closure.assoc = assoc;
closure.delete = delete;
static SCM
fold_proc (void *proc, SCM key, SCM data, SCM value)
{
- return scm_apply (SCM_PACK (proc), SCM_LIST3 (key, data, value), SCM_EOL);
+ return scm_call_3 (SCM_PACK (proc), key, data, value);
}
SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
"and value are successive pairs from the hash table TABLE, and\n"
"prior-result is either INIT (for the first application of PROC)\n"
"or the return value of the previous application of PROC.\n"
- "For example, @code{(hash-fold acons () tab)} will convert a hash\n"
- "table into an a-list of key-value pairs.\n")
+ "For example, @code{(hash-fold acons '() tab)} will convert a hash\n"
+ "table into an a-list of key-value pairs.")
#define FUNC_NAME s_scm_hash_fold
{
SCM_VALIDATE_PROC (1,proc);
SCM
scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
{
- int i, n = SCM_VECTOR_LENGTH (table);
+ long i, n = SCM_VECTOR_LENGTH (table);
SCM result = init;
for (i = 0; i < n; ++i)
{
SCM ls = SCM_VELTS (table)[i], handle;
- while (SCM_NNULLP (ls))
+ while (!SCM_NULLP (ls))
{
SCM_ASSERT (SCM_CONSP (ls),
- table, SCM_ARG1, s_scm_hash_fold);
+ table, SCM_ARG3, s_scm_hash_fold);
handle = SCM_CAR (ls);
SCM_ASSERT (SCM_CONSP (handle),
- table, SCM_ARG1, s_scm_hash_fold);
+ table, SCM_ARG3, s_scm_hash_fold);
result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
ls = SCM_CDR (ls);
}
HCoop / bpt / guile.git / blobdiff