mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Deprecate scm_get_keyword

Browse source 
* libguile/deprecated.c (scm_get_keyword): Deprecate.
* libguile/deprecated.h:
* libguile/goops.c:
* libguile/goops.h:
This commit is contained in:
Andy Wingo 2015-01-11 00:21:58 +01:00
parent 4a28ef1086
commit 2b5812c64d
4 changed files with 15 additions and 56 deletions
Download patch file Download diff file Expand all files Collapse all files

14
libguile/deprecated.c
View file

@ -95,6 +95,8 @@ scm_memory_error (const char *subr)
SCM scm_no_applicable_method = SCM_BOOL_F;
SCM var_get_keyword = SCM_BOOL_F;
SCM scm_class_boolean, scm_class_char, scm_class_pair;
SCM scm_class_procedure, scm_class_string, scm_class_symbol;
SCM scm_class_primitive_generic;
@ -131,6 +133,8 @@ scm_init_deprecated_goops (void)
scm_no_applicable_method =
scm_variable_ref (scm_c_lookup ("no-applicable-method"));
var_get_keyword = scm_c_lookup ("get-keyword");
scm_class_class = scm_variable_ref (scm_c_lookup ("<class>"));
scm_class_top = scm_variable_ref (scm_c_lookup ("<top>"));
scm_class_object = scm_variable_ref (scm_c_lookup ("<object>"));
@ -192,6 +196,16 @@ scm_init_deprecated_goops (void)
scm_smob_class = scm_i_smob_class;
}
SCM
scm_get_keyword (SCM kw, SCM initargs, SCM default_value)
{
scm_c_issue_deprecation_warning
("scm_get_keyword is deprecated. Use `kw-arg-ref' from Scheme instead.");
return scm_call_3 (scm_variable_ref (var_get_keyword),
kw, initargs, default_value);
}
#define BUFFSIZE 32 /* big enough for most uses */
#define SPEC_OF(x) \
(scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("specializers"))))

1
libguile/deprecated.h
View file

@ -211,6 +211,7 @@ SCM_INTERNAL void scm_init_deprecated_goops (void);
SCM_DEPRECATED SCM scm_compute_applicable_methods (SCM gf, SCM args, long len, int scm_find_method);
SCM_DEPRECATED SCM scm_find_method (SCM l);
SCM_DEPRECATED SCM scm_basic_make_class (SCM c, SCM name, SCM dsupers, SCM dslots);
SCM_DEPRECATED SCM scm_get_keyword (SCM kw, SCM initargs, SCM default_value);

53
libguile/goops.c
View file

@ -279,59 +279,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
}
#undef FUNC_NAME
/******************************************************************************
*
* initialize-object
*
******************************************************************************/
/*fixme* Manufacture keywords in advance */
SCM
scm_i_get_keyword (SCM key, SCM l, long len, SCM default_value, const char *subr)
{
long i;
for (i = 0; i != len; i += 2)
{
SCM obj = SCM_CAR (l);
if (!scm_is_keyword (obj))
scm_misc_error (subr, "bad keyword: ~S", scm_list_1 (obj));
else if (scm_is_eq (obj, key))
return SCM_CADR (l);
else
l = SCM_CDDR (l);
}
return default_value;
}
SCM_DEFINE (scm_get_keyword, "get-keyword", 3, 0, 0,
(SCM key, SCM l, SCM default_value),
"Determine an associated value for the keyword @var{key} from\n"
"the list @var{l}. The list @var{l} has to consist of an even\n"
"number of elements, where, starting with the first, every\n"
"second element is a keyword, followed by its associated value.\n"
"If @var{l} does not hold a value for @var{key}, the value\n"
"@var{default_value} is returned.")
#define FUNC_NAME s_scm_get_keyword
{
long len;
SCM_ASSERT (scm_is_keyword (key), key, SCM_ARG1, FUNC_NAME);
len = scm_ilength (l);
if (len < 0 || len % 2 == 1)
scm_misc_error (FUNC_NAME, "Bad keyword-value list: ~S", scm_list_1 (l));
return scm_i_get_keyword (key, l, len, default_value, FUNC_NAME);
}
#undef FUNC_NAME
SCM_KEYWORD (k_init_keyword, "init-keyword");
SCM_DEFINE (scm_sys_init_layout_x, "%init-layout!", 2, 0, 0,
(SCM class, SCM layout),
"")

3
libguile/goops.h
View file

@ -133,9 +133,6 @@ SCM_API SCM scm_slot_ref (SCM obj, SCM slot_name);
SCM_API SCM scm_slot_set_x (SCM obj, SCM slot_name, SCM value);
SCM_INTERNAL void scm_i_inherit_applicable (SCM c);
SCM_INTERNAL SCM scm_i_get_keyword (SCM key, SCM l, long len,
SCM default_value, const char *subr);
SCM_API SCM scm_get_keyword (SCM key, SCM l, SCM default_value);
SCM_API SCM scm_sys_inherit_magic_x (SCM c, SCM dsupers);
SCM_API SCM scm_instance_p (SCM obj);
SCM_API int scm_is_generic (SCM x);