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

* eval.c, eval.h, goops.c, goops.h (scm_m_atslot_ref,

Browse source 
scm_m_atslot_set_x, scm_m_atdispatch): Move the declarations and
	definitions of the special goops memoizers from goops.[ch] to
	eval.[ch].  Hmm... it seems that scm_m_atdispatch is not used
	throughout guile.
This commit is contained in:
Dirk Herrmann 2003-04-25 16:22:47 +00:00
parent b9ad392e86
commit b0c5d67b98
5 changed files with 68 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/ChangeLog
View file

@ -1,3 +1,11 @@
2003-04-25 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c, eval.h, goops.c, goops.h (scm_m_atslot_ref,
scm_m_atslot_set_x, scm_m_atdispatch): Move the declarations and
definitions of the special goops memoizers from goops.[ch] to
eval.[ch]. Hmm... it seems that scm_m_atdispatch is not used
throughout guile.
2003-04-24 Mikael Djurfeldt <mdj@kvast.blakulla.net>
* ports.c, ports.h (scm_i_port_table_mutex): New mutex.

56
libguile/eval.c
View file

@ -1149,6 +1149,62 @@ scm_m_atbind (SCM xorig, SCM env)
SCM_CDDR (xorig)));
}
SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_makmmacro, scm_m_atslot_ref);
SCM
scm_m_atslot_ref (SCM xorig, SCM env SCM_UNUSED)
#define FUNC_NAME s_atslot_ref
{
SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 2, scm_s_expression, FUNC_NAME);
SCM_VALIDATE_INUM (SCM_ARG2, SCM_CADR (x));
return scm_cons (SCM_IM_SLOT_REF, x);
}
#undef FUNC_NAME
SCM_SYNTAX (s_atslot_set_x, "@slot-set!", scm_makmmacro, scm_m_atslot_set_x);
SCM
scm_m_atslot_set_x (SCM xorig, SCM env SCM_UNUSED)
#define FUNC_NAME s_atslot_set_x
{
SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 3, scm_s_expression, FUNC_NAME);
SCM_VALIDATE_INUM (SCM_ARG2, SCM_CADR (x));
return scm_cons (SCM_IM_SLOT_SET_X, x);
}
#undef FUNC_NAME
SCM_SYNTAX (s_atdispatch, "@dispatch", scm_makmmacro, scm_m_atdispatch);
SCM_SYMBOL (sym_atdispatch, s_atdispatch);
SCM
scm_m_atdispatch (SCM xorig, SCM env)
#define FUNC_NAME s_atdispatch
{
SCM args, n, v, gf, x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 4, scm_s_expression, FUNC_NAME);
args = SCM_CAR (x);
if (!SCM_CONSP (args) && !SCM_SYMBOLP (args))
SCM_WRONG_TYPE_ARG (SCM_ARG1, args);
x = SCM_CDR (x);
n = SCM_XEVALCAR (x, env);
SCM_VALIDATE_INUM (SCM_ARG2, n);
SCM_ASSERT_RANGE (0, n, SCM_INUM (n) >= 1);
x = SCM_CDR (x);
v = SCM_XEVALCAR (x, env);
SCM_VALIDATE_VECTOR (SCM_ARG3, v);
x = SCM_CDR (x);
gf = SCM_XEVALCAR (x, env);
SCM_VALIDATE_PUREGENERIC (SCM_ARG4, gf);
return scm_list_5 (SCM_IM_DISPATCH, args, n, v, gf);
}
#undef FUNC_NAME
SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_makmmacro, scm_m_at_call_with_values);
SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values);

3
libguile/eval.h
View file

@ -199,6 +199,9 @@ SCM_API SCM scm_m_nil_cond (SCM xorig, SCM env);
SCM_API SCM scm_m_atfop (SCM xorig, SCM env);
#endif /* SCM_ENABLE_ELISP */
SCM_API SCM scm_m_atbind (SCM xorig, SCM env);
SCM_API SCM scm_m_atslot_ref (SCM xorig, SCM env);
SCM_API SCM scm_m_atslot_set_x (SCM xorig, SCM env);
SCM_API SCM scm_m_atdispatch (SCM xorig, SCM env);
SCM_API SCM scm_m_at_call_with_values (SCM xorig, SCM env);
SCM_API int scm_badargsp (SCM formals, SCM args);
SCM_API SCM scm_ceval (SCM x, SCM env);

56
libguile/goops.c
View file

@ -2001,62 +2001,6 @@ scm_sys_compute_applicable_methods (SCM gf, SCM args)
SCM_SYMBOL (sym_compute_applicable_methods, "compute-applicable-methods");
SCM_VARIABLE_INIT (var_compute_applicable_methods, "compute-applicable-methods", scm_c_define_gsubr (s_sys_compute_applicable_methods, 2, 0, 0, scm_sys_compute_applicable_methods));
SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_makmmacro, scm_m_atslot_ref);
SCM
scm_m_atslot_ref (SCM xorig, SCM env SCM_UNUSED)
#define FUNC_NAME s_atslot_ref
{
SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 2, scm_s_expression, FUNC_NAME);
SCM_VALIDATE_INUM (SCM_ARG2, SCM_CADR (x));
return scm_cons (SCM_IM_SLOT_REF, x);
}
#undef FUNC_NAME
SCM_SYNTAX (s_atslot_set_x, "@slot-set!", scm_makmmacro, scm_m_atslot_set_x);
SCM
scm_m_atslot_set_x (SCM xorig, SCM env SCM_UNUSED)
#define FUNC_NAME s_atslot_set_x
{
SCM x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 3, scm_s_expression, FUNC_NAME);
SCM_VALIDATE_INUM (SCM_ARG2, SCM_CADR (x));
return scm_cons (SCM_IM_SLOT_SET_X, x);
}
#undef FUNC_NAME
SCM_SYNTAX (s_atdispatch, "@dispatch", scm_makmmacro, scm_m_atdispatch);
SCM_SYMBOL (sym_atdispatch, s_atdispatch);
SCM
scm_m_atdispatch (SCM xorig, SCM env)
#define FUNC_NAME s_atdispatch
{
SCM args, n, v, gf, x = SCM_CDR (xorig);
SCM_ASSYNT (scm_ilength (x) == 4, scm_s_expression, FUNC_NAME);
args = SCM_CAR (x);
if (!SCM_CONSP (args) && !SCM_SYMBOLP (args))
SCM_WRONG_TYPE_ARG (SCM_ARG1, args);
x = SCM_CDR (x);
n = SCM_XEVALCAR (x, env);
SCM_VALIDATE_INUM (SCM_ARG2, n);
SCM_ASSERT_RANGE (0, n, SCM_INUM (n) >= 1);
x = SCM_CDR (x);
v = SCM_XEVALCAR (x, env);
SCM_VALIDATE_VECTOR (SCM_ARG3, v);
x = SCM_CDR (x);
gf = SCM_XEVALCAR (x, env);
SCM_VALIDATE_PUREGENERIC (SCM_ARG4, gf);
return scm_list_5 (SCM_IM_DISPATCH, args, n, v, gf);
}
#undef FUNC_NAME
static void
lock_cache_mutex (void *m)
{

3
libguile/goops.h
View file

@ -231,9 +231,6 @@ SCM_API SCM scm_slot_set_x (SCM obj, SCM slot_name, SCM value);
SCM_API SCM scm_compute_applicable_methods (SCM gf, SCM args, long len, int scm_find_method);
SCM_API SCM scm_sys_compute_applicable_methods (SCM gf, SCM args);
SCM_API SCM scm_m_atslot_ref (SCM xorig, SCM env);
SCM_API SCM scm_m_atslot_set_x (SCM xorig, SCM env);
SCM_API SCM scm_m_atdispatch (SCM xorig, SCM env);
#ifdef GUILE_DEBUG
SCM_API SCM scm_pure_generic_p (SCM obj);
#endif