diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-03-12 14:34:44 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-03-12 14:34:44 +0000 |
commit | e11208ca72463ef39e25e81d0245637b2e586f60 (patch) | |
tree | 27b4d5fca49f90ab4f5c8395f3dd074c9c869430 | |
parent | d69947f7446701918df01f216e258705acf04cd4 (diff) | |
download | guile-e11208ca72463ef39e25e81d0245637b2e586f60.tar.gz |
* Cleaned up uses and definition of SCM_ASSYNT.
-rw-r--r-- | libguile/ChangeLog | 15 | ||||
-rw-r--r-- | libguile/goops.c | 34 | ||||
-rw-r--r-- | libguile/goops.h | 2 | ||||
-rw-r--r-- | libguile/macros.h | 3 |
4 files changed, 41 insertions, 13 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 7fc9c4d40..320af3503 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,18 @@ +2001-03-12 Dirk Herrmann <D.Herrmann@tu-bs.de> + + * goops.h (SCM_VALIDATE_PUREGENERIC): New macro. + + * goops.c (scm_m_atslot_ref, scm_m_atslot_set_x, + scm_m_atdispatch): Provide definitions for FUNC_NAME. Don't use + SCM_ASSYNT to check for correct argument types. Either use some + SCM_VALIDATE_* macro or an explicit test. + + (scm_make_foreign_object): Don't use SCM_ASSERT to check for + misc-errors. + + * macros.h (SCM_ASSYNT): On assertion failure, issue a misc-error + instead of calling scm_wta. + 2001-03-12 Martin Grabmueller <mgrabmue@cs.tu-berlin.de> * load.c (scm_primitive_load, scm_primitive_load_path), diff --git a/libguile/goops.c b/libguile/goops.c index f3250c210..a79c13fb6 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1866,23 +1866,29 @@ SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_makmmacro, scm_m_atslot_ref); SCM scm_m_atslot_ref (SCM xorig, SCM env) +#define FUNC_NAME s_atslot_ref { SCM x = SCM_CDR (xorig); - SCM_ASSYNT (scm_ilength (x) == 2, xorig, scm_s_expression, s_atslot_ref); - SCM_ASSYNT (SCM_INUMP (SCM_CADR (x)), SCM_CADR (x), SCM_ARG2, s_atslot_ref); + SCM_ASSYNT (scm_ilength (x) == 2, xorig, 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) +#define FUNC_NAME s_atslot_set_x { SCM x = SCM_CDR (xorig); - SCM_ASSYNT (scm_ilength (x) == 3, xorig, scm_s_expression, s_atslot_set_x); - SCM_ASSYNT (SCM_INUMP (SCM_CADR (x)), SCM_CADR (x), SCM_ARG2, s_atslot_set_x); + SCM_ASSYNT (scm_ilength (x) == 3, xorig, 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); @@ -1893,20 +1899,20 @@ 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, xorig, scm_s_expression, s_atdispatch); + SCM_ASSYNT (scm_ilength (x) == 4, xorig, scm_s_expression, FUNC_NAME); args = SCM_CAR (x); - SCM_ASSYNT (SCM_CONSP (args) || SCM_SYMBOLP (args), - args, SCM_ARG1, s_atdispatch); + if (!SCM_CONSP (args) && !SCM_SYMBOLP (args)) + SCM_WRONG_TYPE_ARG (SCM_ARG1, args); x = SCM_CDR (x); n = SCM_XEVALCAR (x, env); - SCM_ASSYNT (SCM_INUMP (n), n, SCM_ARG2, s_atdispatch); + 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_ASSYNT (SCM_VECTORP (v), v, SCM_ARG3, s_atdispatch); + SCM_VALIDATE_VECTOR (SCM_ARG3, v); x = SCM_CDR (x); gf = SCM_XEVALCAR (x, env); - SCM_ASSYNT (SCM_PUREGENERICP (gf), gf, SCM_ARG4, s_atdispatch); + SCM_VALIDATE_PUREGENERIC (SCM_ARG4, gf); return SCM_LIST5 (SCM_IM_DISPATCH, args, n, v, gf); } #undef FUNC_NAME @@ -2432,15 +2438,19 @@ scm_load_goops () scm_resolve_module (scm_read_0str ("(oop goops)")); } + SCM scm_make_foreign_object (SCM class, SCM initargs) +#define FUNC_NAME s_scm_make { void * (*constructor) (SCM) = (void * (*) (SCM)) SCM_SLOT (class, scm_si_constructor); - SCM_ASSERT (constructor != 0, class, "Can't make instances of this class", - s_scm_make); + if (constructor == 0) + SCM_MISC_ERROR ("Can't make instances of class ~S", SCM_LIST1 (class)); return scm_wrap_object (class, constructor (initargs)); } +#undef FUNC_NAME + static size_t scm_free_foreign_object (SCM *class, SCM *data) diff --git a/libguile/goops.h b/libguile/goops.h index 069fbfb38..624ca3075 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -131,6 +131,8 @@ typedef struct scm_method_t { #define SCM_PUREGENERICP(x) \ (SCM_STRUCTP (x) && (SCM_INST_TYPE(x) & SCM_CLASSF_PURE_GENERIC)) +#define SCM_VALIDATE_PUREGENERIC(pos, x) SCM_MAKE_VALIDATE (pos, x, PUREGENERICP) + #define SCM_SIMPLEMETHODP(x) (SCM_INST_TYPE(x) & SCM_CLASSF_SIMPLE_METHOD) #define SCM_ACCESSORP(x) (SCM_INST_TYPE(x) & SCM_CLASSF_ACCESSOR_METHOD) #define SCM_VALIDATE_ACCESSOR(pos, x) SCM_MAKE_VALIDATE (pos, x, ACCESSORP) diff --git a/libguile/macros.h b/libguile/macros.h index af7ee7014..bd22a7b38 100644 --- a/libguile/macros.h +++ b/libguile/macros.h @@ -48,7 +48,8 @@ -#define SCM_ASSYNT(_cond, _arg, _pos, _subr) if(!(_cond))scm_wta(_arg, (char *)_pos, _subr); +#define SCM_ASSYNT(_cond, _arg, _msg, _subr) \ + if (!(_cond)) scm_misc_error (_subr, _msg, SCM_EOL); extern scm_bits_t scm_tc16_macro; |