diff options
author | Marius Vollmer <mvo@zagadka.de> | 2004-08-19 17:19:44 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2004-08-19 17:19:44 +0000 |
commit | cc95e00ac63820cbc03ca858ff6b8e1015c9d168 (patch) | |
tree | 31ed97062f17f16438e0674bd963454f22fa6754 /libguile/goops.c | |
parent | f76c6bb2342534158769cc55ce40edd17492f9c4 (diff) | |
download | guile-cc95e00ac63820cbc03ca858ff6b8e1015c9d168.tar.gz |
* strings.h, strings.c: (scm_i_string_chars, scm_i_string_length,
scm_i_string_writable_chars, scm_i_string_stop_writing): New, to
replace SCM_I_STRING_CHARS and SCM_I_STRING_LENGTH. Updated all
uses.
(scm_i_make_string, scm_c_make_string): New, to replace
scm_allocate_string. Updated all uses.
(SCM_STRINGP, SCM_STRING_CHARS, SCM_STRING_UCHARS,
SCM_STRING_LENGTH): Deprecated.
(scm_allocate_string, scm_take_str, scm_take0str, scm_mem2string,
scm_str2string, scm_makfrom0str, scm_makfrom0str_opt):
Discouraged. Replaced all uses with scm_from_locale_string or
similar, as appropriate.
(scm_c_string_length, scm_c_string_ref, scm_c_string_set_x,
scm_c_substring, scm_c_substring_shared, scm_c_substring_copy,
scm_substring_shared, scm_substring_copy): New.
* symbols.c, symbols.h (SCM_SYMBOLP, SCM_SYMBOL_FUNC,
SCM_SET_SYMBOL_FUNC, SCM_SYMBOL_PROPS, SCM_SET_SYMBOL_PROPS,
SCM_SYMBOL_HASH, SCM_SYMBOL_INTERNED_P, scm_mem2symbol,
scm_str2symbol, scm_mem2uninterned_symbol): Discouraged.
(SCM_SYMBOL_LENGTH, SCM_SYMBOL_CHARS, scm_c_symbol2str):
Deprecated.
(SCM_MAKE_SYMBOL_TAG, SCM_SET_SYMBOL_LENGTH, SCM_SET_SYMBOL_CHARS,
SCM_PROP_SLOTS, SCM_SET_PROP_SLOTS): Removed.
(scm_is_symbol, scm_from_locale_symbol, scm_from_locale_symboln):
New, to replace scm_str2symbol and scm_mem2symbol, respectively.
Updated all uses.
(scm_gensym): Generate only the number suffix in the buffer, just
string-append the prefix.
Diffstat (limited to 'libguile/goops.c')
-rw-r--r-- | libguile/goops.c | 86 |
1 files changed, 40 insertions, 46 deletions
diff --git a/libguile/goops.c b/libguile/goops.c index cc4c98e04..6a595f9d0 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -61,13 +61,14 @@ (v), SCM_BOOL_F))) /* Fixme: Should use already interned symbols */ -#define CALL_GF1(name, a) (scm_call_1 (GETVAR (scm_str2symbol (name)), \ + +#define CALL_GF1(name, a) (scm_call_1 (GETVAR (scm_from_locale_symbol (name)), \ a)) -#define CALL_GF2(name, a, b) (scm_call_2 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF2(name, a, b) (scm_call_2 (GETVAR (scm_from_locale_symbol (name)), \ a, b)) -#define CALL_GF3(name, a, b, c) (scm_call_3 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF3(name, a, b, c) (scm_call_3 (GETVAR (scm_from_locale_symbol (name)), \ a, b, c)) -#define CALL_GF4(name, a, b, c, d) (scm_call_4 (GETVAR (scm_str2symbol (name)), \ +#define CALL_GF4(name, a, b, c, d) (scm_call_4 (GETVAR (scm_from_locale_symbol (name)), \ a, b, c, d)) /* Class redefinition protocol: @@ -218,7 +219,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen) return res; tmp = SCM_CAAR (l); - if (!SCM_SYMBOLP (tmp)) + if (!scm_is_symbol (tmp)) scm_misc_error ("%compute-slots", "bad slot name ~S", scm_list_1 (tmp)); if (scm_is_false (scm_c_memq (tmp, slots_already_seen))) { @@ -479,6 +480,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, SCM slots, getters_n_setters, nfields; unsigned long int n, i; char *s; + SCM layout; SCM_VALIDATE_INSTANCE (1, class); slots = SCM_SLOT (class, scm_si_slots); @@ -493,7 +495,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, SCM_MISC_ERROR ("class object doesn't have enough fields: ~S", scm_list_1 (nfields)); - s = n > 0 ? scm_malloc (n) : 0; + layout = scm_i_make_string (n, &s); i = 0; while (SCM_CONSP (getters_n_setters)) { @@ -519,11 +521,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, else { if (!SCM_CLASSP (type)) - { - if (s) - free (s); - SCM_MISC_ERROR ("bad slot class", SCM_EOL); - } + SCM_MISC_ERROR ("bad slot class", SCM_EOL); else if (SCM_SUBCLASSP (type, scm_class_foreign_slot)) { if (SCM_SUBCLASSP (type, scm_class_self)) @@ -564,13 +562,9 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0, if (!SCM_NULLP (slots)) { inconsistent: - if (s) - free (s); SCM_MISC_ERROR ("inconsistent getters-n-setters", SCM_EOL); } - SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n)); - if (s) - free (s); + SCM_SET_SLOT (class, scm_si_layout, scm_string_to_symbol (layout)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -763,9 +757,9 @@ create_basic_classes (void) /* SCM slots_of_class = build_class_class_slots (); */ /**** <scm_class_class> ****/ - SCM cs = scm_makfrom0str (SCM_CLASS_CLASS_LAYOUT - + 2 * scm_vtable_offset_user); - SCM name = scm_str2symbol ("<class>"); + SCM cs = scm_from_locale_string (SCM_CLASS_CLASS_LAYOUT + + 2 * scm_vtable_offset_user); + SCM name = scm_from_locale_symbol ("<class>"); scm_class_class = scm_permanent_object (scm_make_vtable_vtable (cs, SCM_INUM0, SCM_EOL)); @@ -791,7 +785,7 @@ create_basic_classes (void) DEFVAR(name, scm_class_class); /**** <scm_class_top> ****/ - name = scm_str2symbol ("<top>"); + name = scm_from_locale_symbol ("<top>"); scm_class_top = scm_permanent_object (scm_basic_make_class (scm_class_class, name, SCM_EOL, @@ -800,7 +794,7 @@ create_basic_classes (void) DEFVAR(name, scm_class_top); /**** <scm_class_object> ****/ - name = scm_str2symbol ("<object>"); + name = scm_from_locale_symbol ("<object>"); scm_class_object = scm_permanent_object (scm_basic_make_class (scm_class_class, name, scm_list_1 (scm_class_top), @@ -977,7 +971,7 @@ SCM_DEFINE (scm_method_generic_function, "method-generic-function", 1, 0, 0, #define FUNC_NAME s_scm_method_generic_function { SCM_VALIDATE_METHOD (1, obj); - return scm_slot_ref (obj, scm_str2symbol ("generic-function")); + return scm_slot_ref (obj, scm_from_locale_symbol ("generic-function")); } #undef FUNC_NAME @@ -987,7 +981,7 @@ SCM_DEFINE (scm_method_specializers, "method-specializers", 1, 0, 0, #define FUNC_NAME s_scm_method_specializers { SCM_VALIDATE_METHOD (1, obj); - return scm_slot_ref (obj, scm_str2symbol ("specializers")); + return scm_slot_ref (obj, scm_from_locale_symbol ("specializers")); } #undef FUNC_NAME @@ -1007,7 +1001,7 @@ SCM_DEFINE (scm_accessor_method_slot_definition, "accessor-method-slot-definitio #define FUNC_NAME s_scm_accessor_method_slot_definition { SCM_VALIDATE_ACCESSOR (1, obj); - return scm_slot_ref (obj, scm_str2symbol ("slot-definition")); + return scm_slot_ref (obj, scm_from_locale_symbol ("slot-definition")); } #undef FUNC_NAME @@ -2139,7 +2133,7 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1, scm_i_get_keyword (k_name, args, len - 1, - scm_str2symbol ("???"), + scm_from_locale_symbol ("???"), FUNC_NAME)); SCM_SET_SLOT (z, scm_si_direct_supers, scm_i_get_keyword (k_dsupers, @@ -2234,7 +2228,7 @@ fix_cpl (SCM c, SCM before, SCM after) static void make_stdcls (SCM *var, char *name, SCM meta, SCM super, SCM slots) { - SCM tmp = scm_str2symbol (name); + SCM tmp = scm_from_locale_symbol (name); *var = scm_permanent_object (scm_basic_make_class (meta, tmp, @@ -2252,32 +2246,32 @@ static void create_standard_classes (void) { SCM slots; - SCM method_slots = scm_list_4 (scm_str2symbol ("generic-function"), - scm_str2symbol ("specializers"), + SCM method_slots = scm_list_4 (scm_from_locale_symbol ("generic-function"), + scm_from_locale_symbol ("specializers"), sym_procedure, - scm_str2symbol ("code-table")); - SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("slot-definition"), + scm_from_locale_symbol ("code-table")); + SCM amethod_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("slot-definition"), k_init_keyword, k_slot_definition)); - SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex")); + SCM mutex_slot = scm_list_1 (scm_from_locale_symbol ("make-mutex")); SCM mutex_closure = scm_i_eval_x (scm_list_3 (scm_sym_lambda, SCM_EOL, mutex_slot), SCM_EOL); - SCM gf_slots = scm_list_5 (scm_str2symbol ("methods"), - scm_list_3 (scm_str2symbol ("n-specialized"), + SCM gf_slots = scm_list_5 (scm_from_locale_symbol ("methods"), + scm_list_3 (scm_from_locale_symbol ("n-specialized"), k_init_value, SCM_INUM0), - scm_list_3 (scm_str2symbol ("used-by"), + scm_list_3 (scm_from_locale_symbol ("used-by"), k_init_value, SCM_BOOL_F), - scm_list_3 (scm_str2symbol ("cache-mutex"), + scm_list_3 (scm_from_locale_symbol ("cache-mutex"), k_init_thunk, mutex_closure), - scm_list_3 (scm_str2symbol ("extended-by"), + scm_list_3 (scm_from_locale_symbol ("extended-by"), k_init_value, SCM_EOL)); - SCM egf_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("extends"), + SCM egf_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("extends"), k_init_value, SCM_EOL)); /* Foreign class slot classes */ @@ -2320,10 +2314,10 @@ create_standard_classes (void) make_stdcls (&scm_class_foreign_class, "<foreign-class>", scm_class_class, scm_class_class, - scm_list_2 (scm_list_3 (scm_str2symbol ("constructor"), + scm_list_2 (scm_list_3 (scm_from_locale_symbol ("constructor"), k_class, scm_class_opaque), - scm_list_3 (scm_str2symbol ("destructor"), + scm_list_3 (scm_from_locale_symbol ("destructor"), k_class, scm_class_opaque))); make_stdcls (&scm_class_foreign_object, "<foreign-object>", @@ -2450,7 +2444,7 @@ make_class_from_template (char const *template, char const *type_name, SCM super { char buffer[100]; sprintf (buffer, template, type_name); - name = scm_str2symbol (buffer); + name = scm_from_locale_symbol (buffer); } else name = SCM_GOOPS_UNBOUND; @@ -2580,7 +2574,7 @@ make_struct_class (void *closure SCM_UNUSED, if (scm_is_true (SCM_STRUCT_TABLE_NAME (data))) SCM_SET_STRUCT_TABLE_CLASS (data, scm_make_extended_class - (SCM_SYMBOL_CHARS (SCM_STRUCT_TABLE_NAME (data)), + (scm_i_symbol_chars (SCM_STRUCT_TABLE_NAME (data)), SCM_CLASS_FLAGS (vtable) & SCM_CLASSF_OPERATOR)); return SCM_UNSPECIFIED; } @@ -2632,7 +2626,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size, size_t (*destructor) (void *)) { SCM name, class; - name = scm_str2symbol (s_name); + name = scm_from_locale_symbol (s_name); if (SCM_NULLP (supers)) supers = scm_list_1 (scm_class_foreign_object); class = scm_basic_basic_make_class (meta, name, supers, SCM_EOL); @@ -2649,7 +2643,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size, SCM_SET_CLASS_INSTANCE_SIZE (class, size); } - SCM_SET_SLOT (class, scm_si_layout, scm_str2symbol ("")); + SCM_SET_SLOT (class, scm_si_layout, scm_from_locale_symbol ("")); SCM_SET_SLOT (class, scm_si_constructor, (SCM) constructor); return class; @@ -2692,8 +2686,8 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class, SCM_EOL); { - SCM name = scm_str2symbol (slot_name); - SCM aname = scm_str2symbol (accessor_name); + SCM name = scm_from_locale_symbol (slot_name); + SCM aname = scm_from_locale_symbol (accessor_name); SCM gf = scm_ensure_accessor (aname); SCM slot = scm_list_5 (name, k_class, @@ -2840,7 +2834,7 @@ scm_init_goops_builtins (void) create_port_classes (); { - SCM name = scm_str2symbol ("no-applicable-method"); + SCM name = scm_from_locale_symbol ("no-applicable-method"); scm_no_applicable_method = scm_permanent_object (scm_make (scm_list_3 (scm_class_generic, k_name, |