The purpose of this patch is to make guile's internal memoizers

[bpt/guile.git] / libguile / goops.c

diff --git a/libguile/goops.c b/libguile/goops.c
index 6eac27e..1a2bb73 100644 (file)
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1,4 +1,4 @@
-/* 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
@@ -94,7 +94,7 @@
 #define TEST_CHANGE_CLASS(obj, class)                                 \
        {                                                              \
          class = SCM_CLASS_OF (obj);                                  \
-          if (SCM_OBJ_CLASS_REDEF (obj) != SCM_BOOL_F)                \
+          if (!SCM_FALSEP (SCM_OBJ_CLASS_REDEF (obj)))                \
            {                                                          \
              scm_change_object_class (obj, class, SCM_OBJ_CLASS_REDEF (obj));\
              class = SCM_CLASS_OF (obj);                              \
@@ -426,7 +426,7 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
        {
          /* set slot to its :init-form if it exists */
          tmp = SCM_CADAR (get_n_set);
-         if (tmp != SCM_BOOL_F)
+         if (!SCM_FALSEP (tmp))
            {
              slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set));
              if (SCM_GOOPS_UNBOUNDP (slot_value))
@@ -1102,6 +1102,10 @@ SCM_DEFINE (scm_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0,
 #undef FUNC_NAME
 
 
+SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_i_makbimacro, scm_m_atslot_ref);
+SCM_SYNTAX (s_atslot_set_x, "@slot-set!", scm_i_makbimacro, scm_m_atslot_set_x);
+
+
 /** Utilities **/
 
 /* In the future, this function will return the effective slot
@@ -1614,6 +1618,7 @@ static SCM list_of_no_method;
 
 SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
 
+
 SCM
 scm_make_method_cache (SCM gf)
 {
@@ -2001,62 +2006,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)
 {