diff options
author | Robin Templeton <robin@terpri.org> | 2013-07-30 22:50:24 -0400 |
---|---|---|
committer | Christine Lemmer-Webber <cwebber@dustycloud.org> | 2021-10-19 18:09:59 -0400 |
commit | 433fc448ddb018767906f8808203c9668c68cd83 (patch) | |
tree | 5c6894d9137598f761289bd7739fab52fe5d6a78 | |
parent | 51bd3086db5a398d840334197bcc9f4062758945 (diff) | |
download | guile-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.c | 97 | ||||
-rw-r--r-- | libguile/symbols.h | 6 |
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); |