* Cleaned up uses and definition of SCM_ASSYNT.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 7fc9c4d..320af35 100644 (file)
--- 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 f3250c2..a79c13f 100644 (file)
--- 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 069fbfb..624ca30 100644 (file)
--- 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 af7ee70..bd22a7b 100644 (file)
--- a/libguile/macros.h
+++ b/libguile/macros.h
@@ -48,7 +48,8 @@
 
 \f
 
-#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;