X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/0c95b57d77efbe82bb0ade78df5d78d6d0f2a641..bb628794524769ec017b9b7e0b21ed530463c4a8:/libguile/hashtab.c diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 8f7d17472..dd5856232 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -45,13 +45,14 @@ #include -#include "_scm.h" -#include "alist.h" -#include "hash.h" -#include "eval.h" - -#include "scm_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" @@ -164,17 +165,14 @@ scm_hash_fn_remove_x (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn -GUILE_PROC (scm_hashq_get_handle, "hashq-get-handle", 2, 0, 0, +SCM_DEFINE (scm_hashq_get_handle, "hashq-get-handle", 2, 0, 0, (SCM table, SCM obj), -"@deffnx primitive hashv-get-handle table key -@deffnx primitive hash-get-handle table key -@deffnx primitive hashx-get-handle hasher assoc table key -These procedures are similar to their @code{-ref} cousins, but return a -@dfn{handle} from the hash table rather than the value associated with -@var{key}. By convention, a handle in a hash table is the pair which -associates a key with a value. Where @code{hashq-ref table key} returns -only a @code{value}, @code{hashq-get-handle table key} returns the pair -@code{(key . value)}.") + "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)}.") #define FUNC_NAME s_scm_hashq_get_handle { return scm_hash_fn_get_handle (table, obj, scm_ihashq, scm_sloppy_assq, 0); @@ -182,32 +180,27 @@ only a @code{value}, @code{hashq-get-handle table key} returns the pair #undef FUNC_NAME -GUILE_PROC (scm_hashq_create_handle_x, "hashq-create-handle!", 3, 0, 0, - (SCM table, SCM obj, SCM init), -"@deffnx primitive hashv-create-handle! table key init -@deffnx primitive hash-create-handle! table key init -@deffnx primitive hashx-create-handle! hasher assoc table key init -These functions look up @var{key} in @var{table} and return its handle, -If @var{key} is not already present, a new handle is created which -associates @var{key} with @var{init}.") +SCM_DEFINE (scm_hashq_create_handle_x, "hashq-create-handle!", 3, 0, 0, + (SCM table, SCM key, SCM init), + "This function looks up @var{key} in @var{table} and returns its handle.\n" + "If @var{key} is not already present, a new handle is created which\n" + "associates @var{key} with @var{init}.") #define FUNC_NAME s_scm_hashq_create_handle_x { - return scm_hash_fn_create_handle_x (table, obj, init, scm_ihashq, scm_sloppy_assq, 0); + return scm_hash_fn_create_handle_x (table, key, init, scm_ihashq, scm_sloppy_assq, 0); } #undef FUNC_NAME -GUILE_PROC (scm_hashq_ref, "hashq-ref", 2, 1, 0, +SCM_DEFINE (scm_hashq_ref, "hashq-ref", 2, 1, 0, (SCM table, SCM obj, SCM dflt), -"@deffnx primitive hashv-ref table key [default] -@deffnx primitive hash-ref table key [default] -Look up @var{key} in the hash table @var{table}, and return the -value (if any) associated with it. If @var{key} is not found, -return @var{default} (or @code{#f} if no @var{default} argument is -supplied).") + "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.") #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); } @@ -215,12 +208,10 @@ supplied).") -GUILE_PROC (scm_hashq_set_x, "hashq-set!", 3, 0, 0, +SCM_DEFINE (scm_hashq_set_x, "hashq-set!", 3, 0, 0, (SCM table, SCM obj, SCM val), -"@deffnx primitive hashv-set! table key value -@deffnx primitive hash-set! table key value -Find the entry in @var{table} associated with @var{key}, and store -@var{value} there.") + "Find the entry in @var{table} associated with @var{key}, and store\n" + "@var{value} there. Uses `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); @@ -229,11 +220,10 @@ Find the entry in @var{table} associated with @var{key}, and store -GUILE_PROC (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0, +SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0, (SCM table, SCM obj), -"@deffnx primitive hashv-remove! table key -@deffnx primitive hash-remove! table key -Remove @var{key} (and any value associated with it) from @var{table}.") + "Remove @var{key} (and any value associated with it) from @var{table}.\n" + "Uses `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); @@ -243,9 +233,14 @@ Remove @var{key} (and any value associated with it) from @var{table}.") -GUILE_PROC (scm_hashv_get_handle, "hashv-get-handle", 2, 0, 0, +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)}.") #define FUNC_NAME s_scm_hashv_get_handle { return scm_hash_fn_get_handle (table, obj, scm_ihashv, scm_sloppy_assv, 0); @@ -253,22 +248,27 @@ GUILE_PROC (scm_hashv_get_handle, "hashv-get-handle", 2, 0, 0, #undef FUNC_NAME -GUILE_PROC (scm_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0, - (SCM table, SCM obj, SCM init), -"") +SCM_DEFINE (scm_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0, + (SCM table, SCM key, SCM init), + "This function looks up @var{key} in @var{table} and returns its handle.\n" + "If @var{key} is not already present, a new handle is created which\n" + "associates @var{key} with @var{init}.") #define FUNC_NAME s_scm_hashv_create_handle_x { - return scm_hash_fn_create_handle_x (table, obj, 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 -GUILE_PROC (scm_hashv_ref, "hashv-ref", 2, 1, 0, +SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0, (SCM table, SCM obj, 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.") #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); } @@ -276,9 +276,10 @@ GUILE_PROC (scm_hashv_ref, "hashv-ref", 2, 1, 0, -GUILE_PROC (scm_hashv_set_x, "hashv-set!", 3, 0, 0, +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.") #define FUNC_NAME s_scm_hashv_set_x { return scm_hash_fn_set_x (table, obj, val, scm_ihashv, scm_sloppy_assv, 0); @@ -286,9 +287,10 @@ GUILE_PROC (scm_hashv_set_x, "hashv-set!", 3, 0, 0, #undef FUNC_NAME -GUILE_PROC (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0, +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.") #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); @@ -297,9 +299,14 @@ GUILE_PROC (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0, -GUILE_PROC (scm_hash_get_handle, "hash-get-handle", 2, 0, 0, +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)}.") #define FUNC_NAME s_scm_hash_get_handle { return scm_hash_fn_get_handle (table, obj, scm_ihash, scm_sloppy_assoc, 0); @@ -307,22 +314,27 @@ GUILE_PROC (scm_hash_get_handle, "hash-get-handle", 2, 0, 0, #undef FUNC_NAME -GUILE_PROC (scm_hash_create_handle_x, "hash-create-handle!", 3, 0, 0, - (SCM table, SCM obj, SCM init), -"") +SCM_DEFINE (scm_hash_create_handle_x, "hash-create-handle!", 3, 0, 0, + (SCM table, SCM key, SCM init), + "This function looks up @var{key} in @var{table} and returns its handle.\n" + "If @var{key} is not already present, a new handle is created which\n" + "associates @var{key} with @var{init}.") #define FUNC_NAME s_scm_hash_create_handle_x { - return scm_hash_fn_create_handle_x (table, obj, init, scm_ihash, scm_sloppy_assoc, 0); + return scm_hash_fn_create_handle_x (table, key, init, scm_ihash, scm_sloppy_assoc, 0); } #undef FUNC_NAME -GUILE_PROC (scm_hash_ref, "hash-ref", 2, 1, 0, +SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0, (SCM table, SCM obj, 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.") #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); } @@ -330,9 +342,10 @@ GUILE_PROC (scm_hash_ref, "hash-ref", 2, 1, 0, -GUILE_PROC (scm_hash_set_x, "hash-set!", 3, 0, 0, +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.") #define FUNC_NAME s_scm_hash_set_x { return scm_hash_fn_set_x (table, obj, val, scm_ihash, scm_sloppy_assoc, 0); @@ -341,9 +354,10 @@ GUILE_PROC (scm_hash_set_x, "hash-set!", 3, 0, 0, -GUILE_PROC (scm_hash_remove_x, "hash-remove!", 2, 0, 0, +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.") #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); @@ -366,11 +380,11 @@ static unsigned int 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); } @@ -380,11 +394,11 @@ static SCM 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; } @@ -395,19 +409,24 @@ static SCM 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; } -GUILE_PROC (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0, +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" + "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; @@ -418,9 +437,14 @@ GUILE_PROC (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0, #undef FUNC_NAME -GUILE_PROC (scm_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0, +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" + "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; @@ -432,23 +456,20 @@ GUILE_PROC (scm_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0, -GUILE_PROC (scm_hashx_ref, "hashx-ref", 4, 1, 0, +SCM_DEFINE (scm_hashx_ref, "hashx-ref", 4, 1, 0, (SCM hash,SCM assoc,SCM table,SCM obj,SCM dflt), -"@deffnx primitive hashx-set! hasher assoc table key value -@deffnx primitive hashx-remove! hasher assoc table key -These behave the same way as the corresponding @code{ref} and -@code{set!} functions described above, but use @var{hasher} as a -hash function and @var{assoc} to compare keys. @code{hasher} must -be a function that takes two arguments, a key to be hashed and a -table size. @code{assoc} must be an associator function, like -@code{assoc}, @code{assq} or @code{assv}. - -By way of illustration, @code{hashq-ref table key} is equivalent -to @code{hashx-ref hashq assq table key}.") + "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}.") #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; @@ -459,9 +480,16 @@ to @code{hashx-ref hashq assq table key}.") -GUILE_PROC (scm_hashx_set_x, "hashx-set!", 5, 0, 0, +SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0, (SCM hash, SCM assoc, SCM table, SCM obj, 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}.") #define FUNC_NAME s_scm_hashx_set_x { struct scm_ihashx_closure closure; @@ -486,17 +514,24 @@ scm_hashx_remove_x (SCM hash,SCM assoc,SCM delete,SCM table,SCM obj) 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); } -GUILE_PROC (scm_hash_fold, "hash-fold", 3, 0, 0, +SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, (SCM proc, SCM init, SCM table), -"") + "An iterator over hash-table elements.\n" + "Accumulates and returns a result by applying PROC successively.\n" + "The arguments to PROC are \"(key value prior-result)\" where key\n" + "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") #define FUNC_NAME s_scm_hash_fold { - SCM_VALIDATE_PROC(1,proc); - SCM_VALIDATE_VECTOR(3,table); - return scm_internal_hash_fold (fold_proc, (void *) proc, init, table); + SCM_VALIDATE_PROC (1,proc); + SCM_VALIDATE_VECTOR (3,table); + return scm_internal_hash_fold (fold_proc, (void *) SCM_UNPACK (proc), init, table); } #undef FUNC_NAME @@ -528,5 +563,11 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table) void scm_init_hashtab () { -#include "hashtab.x" +#include "libguile/hashtab.x" } + +/* + Local Variables: + c-file-style: "gnu" + End: +*/