summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRobin Templeton <robin@terpri.org>2013-07-30 22:50:24 -0400
committerChristine Lemmer-Webber <cwebber@dustycloud.org>2021-10-19 18:09:59 -0400
commit433fc448ddb018767906f8808203c9668c68cd83 (patch)
tree5c6894d9137598f761289bd7739fab52fe5d6a78
parent51bd3086db5a398d840334197bcc9f4062758945 (diff)
downloadguile-433fc448ddb018767906f8808203c9668c68cd83.tar.gz
multiple obarrays
* libguile/symbols.c (lookup_uninterned_symbol) (lookup_interned_latin1_symbol, lookup_interned_utf8_symbol) (scm_i_str2symbol): Take an `obarray' argument. All callers changed. (scm_make_obarray, scm_find_symbol, scm_intern, scm_unintern) (scm_obarray_for_each): New functions.
-rw-r--r--libguile/symbols.c97
-rw-r--r--libguile/symbols.h6
2 files changed, 87 insertions, 16 deletions
diff --git a/libguile/symbols.c b/libguile/symbols.c
index b9d575778..67918c633 100644
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -102,14 +102,14 @@ string_lookup_predicate_fn (SCM sym, void *closure)
}
static SCM
-lookup_interned_symbol (SCM name, unsigned long raw_hash)
+lookup_interned_symbol (SCM name, unsigned long raw_hash, SCM obarray)
{
struct string_lookup_data data;
data.string = name;
data.string_hash = raw_hash;
- return scm_c_weak_set_lookup (symbols, raw_hash,
+ return scm_c_weak_set_lookup (obarray, raw_hash,
string_lookup_predicate_fn,
&data, SCM_BOOL_F);
}
@@ -134,7 +134,8 @@ latin1_lookup_predicate_fn (SCM sym, void *closure)
static SCM
lookup_interned_latin1_symbol (const char *str, size_t len,
- unsigned long raw_hash)
+ unsigned long raw_hash,
+ SCM obarray)
{
struct latin1_lookup_data data;
@@ -142,7 +143,7 @@ lookup_interned_latin1_symbol (const char *str, size_t len,
data.len = len;
data.string_hash = raw_hash;
- return scm_c_weak_set_lookup (symbols, raw_hash,
+ return scm_c_weak_set_lookup (obarray, raw_hash,
latin1_lookup_predicate_fn,
&data, SCM_BOOL_F);
}
@@ -201,7 +202,8 @@ utf8_lookup_predicate_fn (SCM sym, void *closure)
static SCM
lookup_interned_utf8_symbol (const char *str, size_t len,
- unsigned long raw_hash)
+ unsigned long raw_hash,
+ SCM obarray)
{
struct utf8_lookup_data data;
@@ -209,7 +211,7 @@ lookup_interned_utf8_symbol (const char *str, size_t len,
data.len = len;
data.string_hash = raw_hash;
- return scm_c_weak_set_lookup (symbols, raw_hash,
+ return scm_c_weak_set_lookup (obarray, raw_hash,
utf8_lookup_predicate_fn,
&data, SCM_BOOL_F);
}
@@ -236,12 +238,12 @@ symbol_lookup_predicate_fn (SCM sym, void *closure)
}
static SCM
-scm_i_str2symbol (SCM str)
+scm_i_str2symbol (SCM str, SCM obarray)
{
SCM symbol;
size_t raw_hash = scm_i_string_hash (str);
- symbol = lookup_interned_symbol (str, raw_hash);
+ symbol = lookup_interned_symbol (str, raw_hash, obarray);
if (scm_is_true (symbol))
return symbol;
else
@@ -252,7 +254,7 @@ scm_i_str2symbol (SCM str)
/* Might return a different symbol, if another one was interned at
the same time. */
- return scm_c_weak_set_add_x (symbols, raw_hash,
+ return scm_c_weak_set_add_x (obarray, raw_hash,
symbol_lookup_predicate_fn,
SCM_UNPACK_POINTER (symbol), symbol);
}
@@ -359,7 +361,7 @@ SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0,
#define FUNC_NAME s_scm_string_to_symbol
{
SCM_VALIDATE_STRING (1, string);
- return scm_i_str2symbol (string);
+ return scm_i_str2symbol (string, symbols);
}
#undef FUNC_NAME
@@ -376,6 +378,69 @@ SCM_DEFINE (scm_string_ci_to_symbol, "string-ci->symbol", 1, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_make_obarray, "make-obarray", 0, 0, 0,
+ (void),
+ "Return a fresh obarray.")
+#define FUNC_NAME s_scm_make_obarray
+{
+ return scm_c_make_weak_set (0);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_find_symbol, "find-symbol", 1, 1, 0,
+ (SCM string, SCM obarray),
+ "Return the symbol named @var{string} if it is present in\n"
+ "@var{obarray}. Return false otherwise.")
+#define FUNC_NAME s_scm_find_symbol
+{
+ if (SCM_UNBNDP (obarray))
+ obarray = symbols;
+
+ return lookup_interned_symbol (string,
+ scm_i_string_hash (string),
+ obarray);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_intern, "intern", 1, 1, 0,
+ (SCM string, SCM obarray),
+ "Intern @var{string} in @var{obarray}.")
+#define FUNC_NAME s_scm_intern
+{
+ if (SCM_UNBNDP (obarray))
+ obarray = symbols;
+
+ SCM_VALIDATE_STRING (1, string);
+ return scm_i_str2symbol (string, obarray);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_unintern, "unintern", 1, 1, 0,
+ (SCM symbol, SCM obarray),
+ "Unintern @var{symbol} from @var{obarray}.")
+#define FUNC_NAME s_scm_unintern
+{
+ if (SCM_UNBNDP (obarray))
+ obarray = symbols;
+
+ scm_weak_set_remove_x (obarray, symbol);
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_obarray_for_each, "obarray-for-each", 1, 1, 0,
+ (SCM proc, SCM obarray),
+ "")
+#define FUNC_NAME s_scm_obarray_for_each
+{
+ if (SCM_UNBNDP (obarray))
+ obarray = symbols;
+
+ scm_weak_set_for_each (proc, obarray);
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
/* The default prefix for `gensym'd symbols. */
static SCM default_gensym_prefix;
@@ -477,7 +542,7 @@ SCM
scm_from_locale_symboln (const char *sym, size_t len)
{
SCM str = scm_from_locale_stringn (sym, len);
- return scm_i_str2symbol (str);
+ return scm_i_str2symbol (str, symbols);
}
SCM
@@ -486,7 +551,7 @@ scm_take_locale_symboln (char *sym, size_t len)
SCM str;
str = scm_take_locale_stringn (sym, len);
- return scm_i_str2symbol (str);
+ return scm_i_str2symbol (str, symbols);
}
SCM
@@ -511,11 +576,11 @@ scm_from_latin1_symboln (const char *sym, size_t len)
len = strlen (sym);
hash = scm_i_latin1_string_hash (sym, len);
- ret = lookup_interned_latin1_symbol (sym, len, hash);
+ ret = lookup_interned_latin1_symbol (sym, len, hash, symbols);
if (scm_is_false (ret))
{
SCM str = scm_from_latin1_stringn (sym, len);
- ret = scm_i_str2symbol (str);
+ ret = scm_i_str2symbol (str, symbols);
}
return ret;
@@ -537,11 +602,11 @@ scm_from_utf8_symboln (const char *sym, size_t len)
len = strlen (sym);
hash = scm_i_utf8_string_hash (sym, len);
- ret = lookup_interned_utf8_symbol (sym, len, hash);
+ ret = lookup_interned_utf8_symbol (sym, len, hash, symbols);
if (scm_is_false (ret))
{
SCM str = scm_from_utf8_stringn (sym, len);
- ret = scm_i_str2symbol (str);
+ ret = scm_i_str2symbol (str, symbols);
}
return ret;
diff --git a/libguile/symbols.h b/libguile/symbols.h
index e2a1d173f..d7b67b7e5 100644
--- a/libguile/symbols.h
+++ b/libguile/symbols.h
@@ -100,6 +100,12 @@ SCM_API SCM scm_symbol_to_string (SCM s);
SCM_API SCM scm_string_to_symbol (SCM s);
SCM_API SCM scm_string_ci_to_symbol (SCM s);
+SCM_API SCM scm_make_obarray (void);
+SCM_API SCM scm_intern (SCM s, SCM obarray);
+SCM_API SCM scm_unintern (SCM s, SCM obarray);
+SCM_API SCM scm_find_symbol (SCM s, SCM obarray);
+SCM_API SCM scm_obarray_for_each (SCM proc, SCM obarray);
+
SCM_API SCM scm_symbol_fref (SCM s);
SCM_API SCM scm_symbol_pref (SCM s);
SCM_API SCM scm_symbol_fset_x (SCM s, SCM val);