mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

* symbols.h (SCM_SET_SYMBOL_HASH): Removed.

Browse source 
(SCM_SYMBOL_INTERNED_P): New.
* symbols.c (scm_symbol_hash): Use scm_ulong2num instead of
SCM_MAKINUM since hash values can well be bignums.
(scm_mem2symbol): Only use hash values below SCM_T_BITS_MAX/2.
This signals a interned symbol.
(scm_mem2uninterned_symbol, scm_symbol_interned_p,
scm_make_symbol): New.
This commit is contained in:
Marius Vollmer 2002-02-03 22:49:06 +00:00
parent e3f394f391
commit ac48757b5e
2 changed files with 47 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

44
libguile/symbols.c
View file

@ -87,7 +87,7 @@ SCM_DEFINE (scm_sys_symbols, "%symbols", 0, 0, 0,
SCM
scm_mem2symbol (const char *name, size_t len)
{
size_t raw_hash = scm_string_hash ((const unsigned char *) name, len);
size_t raw_hash = scm_string_hash ((const unsigned char *) name, len)/2;
size_t hash = raw_hash % SCM_VECTOR_LENGTH (symbols);
{
@ -139,6 +139,19 @@ scm_mem2symbol (const char *name, size_t len)
}
}
SCM
scm_mem2uninterned_symbol (const char *name, size_t len)
{
size_t raw_hash = (scm_string_hash ((const unsigned char *) name, len)/2
+ SCM_T_BITS_MAX/2 + 1);
return scm_alloc_double_cell (SCM_MAKE_SYMBOL_TAG (len),
(scm_t_bits) scm_must_strndup (name, len),
raw_hash,
SCM_UNPACK (scm_cons (SCM_BOOL_F,
SCM_EOL)));
}
SCM
scm_str2symbol (const char *str)
{
@ -155,6 +168,33 @@ SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 1, 0, 0,
(SCM symbol),
"Return @code{#t} if @var{symbol} is interned, otherwise return\n"
"@code{#f}.")
#define FUNC_NAME s_scm_symbol_interned_p
{
SCM_VALIDATE_SYMBOL (1, symbol);
return SCM_BOOL (SCM_SYMBOL_INTERNED_P (symbol));
}
#undef FUNC_NAME
SCM_DEFINE (scm_make_symbol, "make-symbol", 1, 0, 0,
(SCM name),
"Return a new uninterned symbol with the name @var{name}. "
"The returned symbol is guaranteed to be unique and future "
"calls to @code{string->symnbol} will not return it.")
#define FUNC_NAME s_scm_make_symbol
{
SCM sym;
SCM_VALIDATE_STRING (1, name);
sym = scm_mem2uninterned_symbol (SCM_STRING_CHARS (name),
SCM_STRING_LENGTH (name));
scm_remember_upto_here_1 (name);
return sym;
}
#undef FUNC_NAME
SCM_DEFINE (scm_symbol_to_string, "symbol->string", 1, 0, 0,
(SCM s),
"Return the name of @var{symbol} as a string. If the symbol was\n"
@ -270,7 +310,7 @@ SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0,
#define FUNC_NAME s_scm_symbol_hash
{
SCM_VALIDATE_SYMBOL (1, symbol);
return SCM_MAKINUM (SCM_SYMBOL_HASH (symbol));
return scm_ulong2num (SCM_SYMBOL_HASH (symbol));
}
#undef FUNC_NAME

6
libguile/symbols.h
View file

@ -51,6 +51,10 @@
/* SCM_SYMBOL_LENGTH(SYM) is the length of SYM's name in characters, and
* SCM_SYMBOL_CHARS(SYM) is the address of the first character of SYM's name.
*
* SCM_SYMBOL_HASH is a hash value for the symbol. It is also used to
* encode whether the symbol is interned or not. See
* SCM_SYMBOL_INTERNED_P.
*/
#define SCM_SYMBOLP(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_symbol))
@ -60,7 +64,7 @@
#define SCM_SYMBOL_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x)))
#define SCM_SET_SYMBOL_CHARS(s, c) (SCM_SET_CELL_WORD_1 ((s), (c)))
#define SCM_SYMBOL_HASH(X) ((unsigned long) SCM_CELL_WORD_2 (X))
#define SCM_SET_SYMBOL_HASH(X, v) (SCM_SET_CELL_WORD_2 ((X), (v)))
#define SCM_SYMBOL_INTERNED_P(X) (SCM_SYMBOL_HASH(X) <= (SCM_T_BITS_MAX/2))
#define SCM_PROP_SLOTS(X) (SCM_CELL_OBJECT_3 (X))
#define SCM_SET_PROP_SLOTS(X, v) (SCM_SET_CELL_OBJECT_3 ((X), (v)))