diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 98470a4e6..ece1e9e99 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,11 @@ +2003-04-25 Dirk Herrmann + + * 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 * ports.c, ports.h (scm_i_port_table_mutex): New mutex. diff --git a/libguile/eval.c b/libguile/eval.c index decad0af9..37c820765 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -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); diff --git a/libguile/eval.h b/libguile/eval.h index 69ab43155..92c53d224 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -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); diff --git a/libguile/goops.c b/libguile/goops.c index 18df9fcdd..f271ef7ef 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -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) { diff --git a/libguile/goops.h b/libguile/goops.h index fb1e313f5..599d6944f 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -3,7 +3,7 @@ #ifndef SCM_GOOPS_H #define SCM_GOOPS_H -/* Copyright (C) 1998,1999,2000,2001, 2002, 2003 Free Software Foundation, Inc. +/* Copyright (C) 1998,1999,2000,2001,2002,2003 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -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