-/* Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1998, 1999, 2000 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
\f
#include <stdio.h>
-#include "_scm.h"
-#include "alist.h"
-#include "hash.h"
-#include "eval.h"
-
-#include "validate.h"
-#include "hashtab.h"
+#include "libguile/_scm.h"
+#include "libguile/alist.h"
+#include "libguile/hash.h"
+#include "libguile/eval.h"
+#include "libguile/vectors.h"
+
+#include "libguile/validate.h"
+#include "libguile/hashtab.h"
\f
SCM h;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_get_handle");
- if (SCM_LENGTH (table) == 0)
+ if (SCM_VECTOR_LENGTH (table) == 0)
return SCM_EOL;
- k = hash_fn (obj, SCM_LENGTH (table), closure);
- SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
- scm_ulong2num (k),
- SCM_OUTOFRANGE,
- "hash_fn_get_handle");
+ 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;
}
-
SCM
scm_hash_fn_create_handle_x (SCM table,SCM obj,SCM init,unsigned int (*hash_fn)(),
SCM (*assoc_fn)(),void * closure)
+#define FUNC_NAME "scm_hash_fn_create_handle_x"
{
unsigned int k;
SCM it;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x");
- if (SCM_LENGTH (table) == 0)
- return SCM_EOL;
- k = hash_fn (obj, SCM_LENGTH (table), closure);
- SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
- scm_ulong2num (k),
- SCM_OUTOFRANGE,
- "hash_fn_create_handle_x");
+ if (SCM_VECTOR_LENGTH (table) == 0)
+ SCM_MISC_ERROR ("void hashtable", SCM_EOL);
+
+ k = hash_fn (obj, SCM_VECTOR_LENGTH (table), closure);
+ if (k >= SCM_VECTOR_LENGTH (table))
+ 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))
{
+ SCM_REALLOW_INTS;
return it;
}
{
return SCM_CAR (new_bucket);
}
}
-
-
+#undef FUNC_NAME
SCM
SCM h;
SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
- if (SCM_LENGTH (table) == 0)
+ if (SCM_VECTOR_LENGTH (table) == 0)
return SCM_EOL;
- k = hash_fn (obj, SCM_LENGTH (table), closure);
- SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
- scm_ulong2num (k),
- SCM_OUTOFRANGE,
- "hash_fn_remove_x");
+ k = hash_fn (obj, SCM_VECTOR_LENGTH (table), closure);
+ if (k >= SCM_VECTOR_LENGTH (table))
+ scm_out_of_range ("hash_fn_remove_x", scm_ulong2num (k));
h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
SCM_VELTS(table)[k] = delete_fn (h, SCM_VELTS(table)[k]);
return h;
"supplied). Uses `eq?' for equality testing.")
#define FUNC_NAME s_scm_hashq_ref
{
- if (dflt == SCM_UNDEFINED)
+ if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
return scm_hash_fn_ref (table, obj, dflt, scm_ihashq, scm_sloppy_assq, 0);
}
"supplied). Uses `eqv?' for equality testing.")
#define FUNC_NAME s_scm_hashv_ref
{
- if (dflt == SCM_UNDEFINED)
+ if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
return scm_hash_fn_ref (table, obj, dflt, scm_ihashv, scm_sloppy_assv, 0);
}
"supplied). Uses `equal?' for equality testing.")
#define FUNC_NAME s_scm_hash_ref
{
- if (dflt == SCM_UNDEFINED)
+ if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
return scm_hash_fn_ref (table, obj, dflt, scm_ihash, scm_sloppy_assoc, 0);
}
scm_ihashx (SCM obj,unsigned int n,struct scm_ihashx_closure * closure)
{
SCM answer;
- SCM_ALLOW_INTS;
+ SCM_DEFER_INTS;
answer = scm_apply (closure->hash,
scm_listify (obj, scm_ulong2num ((unsigned long)n), SCM_UNDEFINED),
SCM_EOL);
- SCM_DEFER_INTS;
+ SCM_ALLOW_INTS;
return SCM_INUM (answer);
}
scm_sloppy_assx (SCM obj,SCM alist,struct scm_ihashx_closure * closure)
{
SCM answer;
- SCM_ALLOW_INTS;
+ SCM_DEFER_INTS;
answer = scm_apply (closure->assoc,
scm_listify (obj, alist, SCM_UNDEFINED),
SCM_EOL);
- SCM_DEFER_INTS;
+ SCM_ALLOW_INTS;
return answer;
}
scm_delx_x (SCM obj,SCM alist,struct scm_ihashx_closure * closure)
{
SCM answer;
- SCM_ALLOW_INTS;
+ SCM_DEFER_INTS;
answer = scm_apply (closure->delete,
scm_listify (obj, alist, SCM_UNDEFINED),
SCM_EOL);
- SCM_DEFER_INTS;
+ SCM_ALLOW_INTS;
return answer;
}
SCM_DEFINE (scm_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0,
- (SCM hash,SCM assoc,SCM table,SCM obj,SCM init),
+ (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"
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 obj, 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"
#define FUNC_NAME s_scm_hashx_ref
{
struct scm_ihashx_closure closure;
- if (dflt == SCM_UNDEFINED)
+ if (SCM_UNBNDP (dflt))
dflt = SCM_BOOL_F;
closure.hash = hash;
closure.assoc = assoc;
static SCM
fold_proc (void *proc, SCM key, SCM data, SCM value)
{
- return scm_apply ((SCM) proc, SCM_LIST3 (key, data, value), SCM_EOL);
+ return scm_apply (SCM_PACK (proc), SCM_LIST3 (key, data, value), SCM_EOL);
}
SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0,
{
SCM_VALIDATE_PROC (1,proc);
SCM_VALIDATE_VECTOR (3,table);
- return scm_internal_hash_fold (fold_proc, (void *) proc, init, table);
+ return scm_internal_hash_fold (fold_proc, (void *) SCM_UNPACK (proc), init, table);
}
#undef FUNC_NAME
SCM
scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
{
- int i, n = SCM_LENGTH (table);
+ int i, n = SCM_VECTOR_LENGTH (table);
SCM result = init;
for (i = 0; i < n; ++i)
{
void
scm_init_hashtab ()
{
-#include "hashtab.x"
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/hashtab.x"
+#endif
}
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff