* validate.h, deprecated.h (SCM_VALIDATE_INUM, SCM_VALIDATE_INUM_COPY,
[bpt/guile.git] / libguile / goops.c
index 5425bdb..29a1f06 100644 (file)
@@ -1,4 +1,5 @@
-/* Copyright (C) 1998,1999,2000,2001, 2002, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004
+ * 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
 #define SCM_OBJ_CLASS_REDEF(x) (SCM_STRUCT_VTABLE_DATA(x)[scm_si_redefined])
 */
 
-#define TEST_CHANGE_CLASS(obj, class)                                        \
-       {                                                                     \
-         class = SCM_CLASS_OF (obj);                                         \
-          if (SCM_OBJ_CLASS_REDEF (obj) != SCM_BOOL_F)                               \
-           scm_change_object_class (obj, class, SCM_OBJ_CLASS_REDEF (obj));  \
+#define TEST_CHANGE_CLASS(obj, class)                                 \
+       {                                                              \
+         class = SCM_CLASS_OF (obj);                                  \
+          if (scm_is_true (SCM_OBJ_CLASS_REDEF (obj)))                \
+           {                                                          \
+             scm_change_object_class (obj, class, SCM_OBJ_CLASS_REDEF (obj));\
+             class = SCM_CLASS_OF (obj);                              \
+           }                                                          \
        }
 
 #define NXT_MTHD_METHODS(m)    (SCM_VELTS (m)[1])
@@ -178,7 +182,7 @@ filter_cpl (SCM ls)
   while (!SCM_NULLP (ls))
     {
       SCM el = SCM_CAR (ls);
-      if (SCM_FALSEP (scm_c_memq (el, res)))
+      if (scm_is_false (scm_c_memq (el, res)))
        res = scm_cons (el, res);
       ls = SCM_CDR (ls);
     }
@@ -217,7 +221,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen)
   if (!SCM_SYMBOLP (tmp))
     scm_misc_error ("%compute-slots", "bad slot name ~S", scm_list_1 (tmp));
 
-  if (SCM_FALSEP (scm_c_memq (tmp, slots_already_seen))) {
+  if (scm_is_false (scm_c_memq (tmp, slots_already_seen))) {
     res               = scm_cons (SCM_CAR (l), res);
     slots_already_seen = scm_cons (tmp, slots_already_seen);
   }
@@ -294,15 +298,19 @@ compute_getters_n_setters (SCM slots)
        {
          init = scm_get_keyword (k_init_value, options, 0);
          if (init)
-           init = scm_closure (scm_list_2 (SCM_EOL,
-                                           scm_list_2 (scm_sym_quote, init)),
-                               SCM_EOL);
+            {
+              init = scm_i_eval_x (scm_list_3 (scm_sym_lambda,
+                                               SCM_EOL,
+                                               scm_list_2 (scm_sym_quote,
+                                                           init)),
+                                   SCM_EOL);
+            }
          else
            init = scm_get_keyword (k_init_thunk, options, SCM_BOOL_F);
        }
       *cdrloc = scm_cons (scm_cons (SCM_CAAR (slots),
                                    scm_cons (init,
-                                             SCM_MAKINUM (i++))),
+                                             SCM_I_MAKINUM (i++))),
                          SCM_EOL);
       cdrloc = SCM_CDRLOC (*cdrloc);
     }
@@ -423,7 +431,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_is_true (tmp))
            {
              slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set));
              if (SCM_GOOPS_UNBOUNDP (slot_value))
@@ -442,6 +450,22 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+/* NOTE: The following macros are interdependent with code
+ *       in goops.scm:compute-getters-n-setters
+ */
+#define SCM_GNS_INSTANCE_ALLOCATED_P(gns)      \
+  (SCM_INUMP (SCM_CDDR (gns))                  \
+   || (SCM_CONSP (SCM_CDDR (gns))              \
+       && SCM_CONSP (SCM_CDDDR (gns))          \
+       && SCM_CONSP (SCM_CDDDDR (gns))))
+#define SCM_GNS_INDEX(gns)                     \
+  (SCM_INUMP (SCM_CDDR (gns))                  \
+   ? SCM_INUM (SCM_CDDR (gns))                 \
+   : SCM_INUM (SCM_CAR (SCM_CDDDDR (gns))))
+#define SCM_GNS_SIZE(gns)                      \
+  (SCM_INUMP (SCM_CDDR (gns))                  \
+   ? 1                                         \
+   : SCM_INUM (SCM_CADR (SCM_CDDDDR (gns))))
 
 SCM_KEYWORD (k_class, "class");
 SCM_KEYWORD (k_allocation, "allocation");
@@ -452,12 +476,13 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
            "")
 #define FUNC_NAME s_scm_sys_prep_layout_x
 {
-  SCM slots, nfields;
+  SCM slots, getters_n_setters, nfields;
   unsigned long int n, i;
   char *s;
 
   SCM_VALIDATE_INSTANCE (1, class);
   slots = SCM_SLOT (class, scm_si_slots);
+  getters_n_setters = SCM_SLOT (class, scm_si_getters_n_setters);
   nfields = SCM_SLOT (class, scm_si_nfields);
   if (!SCM_INUMP (nfields) || SCM_INUM (nfields) < 0)
     SCM_MISC_ERROR ("bad value in nfields slot: ~S",
@@ -469,60 +494,79 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
                    scm_list_1 (nfields));
 
   s = n > 0 ? scm_malloc (n) : 0;
-  for (i = 0; i < n; i += 2)
+  i = 0;
+  while (SCM_CONSP (getters_n_setters))
     {
-      long len;
-      SCM type, allocation;
-      char p, a;
-
-      if (!SCM_CONSP (slots))
-       SCM_MISC_ERROR ("too few slot definitions", SCM_EOL);
-      len = scm_ilength (SCM_CDAR (slots));
-      allocation = scm_i_get_keyword (k_allocation, SCM_CDAR (slots),
-                                     len, k_instance, FUNC_NAME);
-      while (!SCM_EQ_P (allocation, k_instance))
+      if (SCM_GNS_INSTANCE_ALLOCATED_P (SCM_CAR (getters_n_setters)))
        {
-         slots = SCM_CDR (slots);
+         SCM type;
+         int len, index, size;
+         char p, a;
+
+         if (i >= n || !SCM_CONSP (slots))
+           goto inconsistent;
+         
+         /* extract slot type */
          len = scm_ilength (SCM_CDAR (slots));
-         allocation = scm_i_get_keyword (k_allocation, SCM_CDAR (slots),
-                                         len, k_instance, FUNC_NAME);
-       }
-      type = scm_i_get_keyword (k_class, SCM_CDAR (slots),
-                               len, SCM_BOOL_F, FUNC_NAME);
-      if (SCM_FALSEP (type))
-       {
-         p = 'p';
-         a = 'w';
-       }
-      else
-       {
-         if (!SCM_CLASSP (type))
-           SCM_MISC_ERROR ("bad slot class", SCM_EOL);
-         else if (SCM_SUBCLASSP (type, scm_class_foreign_slot))
+         type = scm_i_get_keyword (k_class, SCM_CDAR (slots),
+                                   len, SCM_BOOL_F, FUNC_NAME);
+         /* determine slot GC protection and access mode */
+         if (scm_is_false (type))
            {
-             if (SCM_SUBCLASSP (type, scm_class_self))
-               p = 's';
-             else if (SCM_SUBCLASSP (type, scm_class_protected))
-               p = 'p';
-             else
-               p = 'u';
-
-             if (SCM_SUBCLASSP (type, scm_class_opaque))
-               a = 'o';
-             else if (SCM_SUBCLASSP (type, scm_class_read_only))
-               a = 'r';
-             else
-               a = 'w';
+             p = 'p';
+             a = 'w';
            }
          else
            {
-             p = 'p';
-             a = 'w';
+             if (!SCM_CLASSP (type))
+               {
+                 if (s)
+                   free (s);
+                 SCM_MISC_ERROR ("bad slot class", SCM_EOL);
+               }
+             else if (SCM_SUBCLASSP (type, scm_class_foreign_slot))
+               {
+                 if (SCM_SUBCLASSP (type, scm_class_self))
+                   p = 's';
+                 else if (SCM_SUBCLASSP (type, scm_class_protected))
+                   p = 'p';
+                 else
+                   p = 'u';
+
+                 if (SCM_SUBCLASSP (type, scm_class_opaque))
+                   a = 'o';
+                 else if (SCM_SUBCLASSP (type, scm_class_read_only))
+                   a = 'r';
+                 else
+                   a = 'w';
+               }
+             else
+               {
+                 p = 'p';
+                 a = 'w';
+               }
+           }
+      
+         index = SCM_GNS_INDEX (SCM_CAR (getters_n_setters));
+         if (index != (i >> 1))
+           goto inconsistent;
+         size = SCM_GNS_SIZE (SCM_CAR (getters_n_setters));
+         while (size)
+           {
+             s[i++] = p;
+             s[i++] = a;
+             --size;
            }
        }
-      s[i] = p;
-      s[i + 1] = a;
       slots = SCM_CDR (slots);
+      getters_n_setters = SCM_CDR (getters_n_setters);
+    }
+  if (!SCM_NULLP (slots))
+    {
+    inconsistent:
+      if (s)
+       free (s);
+      SCM_MISC_ERROR ("inconsistent getters-n-setters", SCM_EOL);
     }
   SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n));
   if (s)
@@ -582,7 +626,7 @@ SCM_DEFINE (scm_sys_inherit_magic_x, "%inherit-magic!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-void
+static void
 prep_hashsets (SCM class)
 {
   unsigned int i;
@@ -605,7 +649,7 @@ scm_basic_basic_make_class (SCM class, SCM name, SCM dsupers, SCM dslots)
   SCM_SET_SLOT (z, scm_si_direct_supers, dsupers);
   cpl   = compute_cpl (z);
   slots = build_slots_list (maplist (dslots), cpl);
-  nfields = SCM_MAKINUM (scm_ilength (slots));
+  nfields = SCM_I_MAKINUM (scm_ilength (slots));
   g_n_s = compute_getters_n_setters (slots);
 
   SCM_SET_SLOT (z, scm_si_name, name);
@@ -735,7 +779,7 @@ create_basic_classes (void)
   SCM_SET_SLOT (scm_class_class, scm_si_direct_methods, SCM_EOL);
   SCM_SET_SLOT (scm_class_class, scm_si_cpl, SCM_EOL);  /* will be changed */
   /* SCM_SET_SLOT (scm_class_class, scm_si_slots, slots_of_class); */
-  SCM_SET_SLOT (scm_class_class, scm_si_nfields, SCM_MAKINUM (SCM_N_CLASS_SLOTS));
+  SCM_SET_SLOT (scm_class_class, scm_si_nfields, SCM_I_MAKINUM (SCM_N_CLASS_SLOTS));
   /* SCM_SET_SLOT (scm_class_class, scm_si_getters_n_setters,
                    compute_getters_n_setters (slots_of_class)); */
   SCM_SET_SLOT (scm_class_class, scm_si_redefined, SCM_BOOL_F);
@@ -778,7 +822,7 @@ SCM_DEFINE (scm_instance_p, "instance?", 1, 0, 0,
            "Return @code{#t} if @var{obj} is an instance.")
 #define FUNC_NAME s_scm_instance_p
 {
-  return SCM_BOOL (SCM_INSTANCEP (obj));
+  return scm_from_bool (SCM_INSTANCEP (obj));
 }
 #undef FUNC_NAME
 
@@ -1033,12 +1077,8 @@ SCM_DEFINE (scm_sys_fast_slot_ref, "%fast-slot-ref", 2, 0, 0,
   unsigned long int i;
 
   SCM_VALIDATE_INSTANCE (1, obj);
-  SCM_VALIDATE_INUM (2, index);
-  SCM_ASSERT_RANGE (2, index, SCM_INUM (index) >= 0);
-  i = SCM_INUM (index);
-  SCM_ASSERT_RANGE (2, index, i < SCM_NUMBER_OF_SLOTS (obj));
-
-  return scm_at_assert_bound_ref (obj, index);
+  i = scm_to_unsigned_integer (index, 0, SCM_NUMBER_OF_SLOTS(obj)-1);
+  return SCM_SLOT (obj, i);
 }
 #undef FUNC_NAME
 
@@ -1051,10 +1091,7 @@ SCM_DEFINE (scm_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0,
   unsigned long int i;
 
   SCM_VALIDATE_INSTANCE (1, obj);
-  SCM_VALIDATE_INUM (2, index);
-  SCM_ASSERT_RANGE (2, index, SCM_INUM (index) >= 0);
-  i = SCM_INUM (index);
-  SCM_ASSERT_RANGE (2, index, i < SCM_NUMBER_OF_SLOTS (obj));
+  i = scm_to_unsigned_integer (index, 0, SCM_NUMBER_OF_SLOTS(obj)-1);
 
   SCM_SET_SLOT (obj, i, value);
 
@@ -1063,6 +1100,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
@@ -1112,7 +1153,7 @@ static SCM
 get_slot_value_using_name (SCM class, SCM obj, SCM slot_name)
 {
   SCM slotdef = slot_definition_using_name (class, slot_name);
-  if (!SCM_FALSEP (slotdef))
+  if (scm_is_true (slotdef))
     return get_slot_value (class, obj, slotdef);
   else
     return CALL_GF3 ("slot-missing", class, obj, slot_name);
@@ -1153,7 +1194,7 @@ static SCM
 set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value)
 {
   SCM slotdef = slot_definition_using_name (class, slot_name);
-  if (!SCM_FALSEP (slotdef))
+  if (scm_is_true (slotdef))
     return set_slot_value (class, obj, slotdef, value);
   else
     return CALL_GF4 ("slot-missing", class, obj, slot_name, value);
@@ -1573,14 +1614,15 @@ SCM_SYMBOL (sym_no_method, "no-method");
 
 static SCM list_of_no_method;
 
-SCM_SYMBOL (scm_sym_args, "args");
+SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
+
 
 SCM
 scm_make_method_cache (SCM gf)
 {
   return scm_list_5 (SCM_IM_DISPATCH,
                     scm_sym_args,
-                    SCM_MAKINUM (1),
+                    SCM_I_MAKINUM (1),
                     scm_c_make_vector (SCM_INITIAL_MCACHE_SIZE,
                                        list_of_no_method),
                     gf);
@@ -1602,7 +1644,7 @@ SCM_DEFINE (scm_sys_invalidate_method_cache_x, "%invalidate-method-cache!", 1, 0
   SCM used_by;
   SCM_ASSERT (SCM_PUREGENERICP (gf), gf, SCM_ARG1, FUNC_NAME);
   used_by = SCM_SLOT (gf, scm_si_used_by);
-  if (!SCM_FALSEP (used_by))
+  if (scm_is_true (used_by))
     {
       SCM methods = SCM_SLOT (gf, scm_si_methods);
       for (; SCM_CONSP (used_by); used_by = SCM_CDR (used_by))
@@ -1625,7 +1667,7 @@ SCM_DEFINE (scm_generic_capability_p, "generic-capability?", 1, 0, 0,
            "")
 #define FUNC_NAME s_scm_generic_capability_p
 {
-  SCM_ASSERT (!SCM_FALSEP (scm_procedure_p (proc)),
+  SCM_ASSERT (scm_is_true (scm_procedure_p (proc)),
              proc, SCM_ARG1, FUNC_NAME);
   return (scm_subr_p (proc) && SCM_SUBR_GENERIC (proc)
          ? SCM_BOOL_T
@@ -1743,7 +1785,7 @@ static int
 applicablep (SCM actual, SCM formal)
 {
   /* We already know that the cpl is well formed. */
-  return !SCM_FALSEP (scm_c_memq (formal, SCM_SLOT (actual, scm_si_cpl)));
+  return scm_is_true (scm_c_memq (formal, SCM_SLOT (actual, scm_si_cpl)));
 }
 
 static int
@@ -1962,62 +2004,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)
 {
@@ -2042,7 +2028,7 @@ call_memoize_method (void *a)
    * the cache miss and locking the mutex.
    */
   SCM cmethod = scm_mcache_lookup_cmethod (x, SCM_CDDR (args));
-  if (!SCM_FALSEP (cmethod))
+  if (scm_is_true (cmethod))
     return cmethod;
   /*fixme* Use scm_apply */
   return CALL_GF3 ("memoize-method!", gf, SCM_CDDR (args), x);
@@ -2108,7 +2094,7 @@ SCM_DEFINE (scm_make, "make",  0, 0, 1,
       if (class == scm_class_accessor)
        {
          SCM setter = scm_get_keyword (k_setter, args, SCM_BOOL_F);
-         if (!SCM_FALSEP (setter))
+         if (scm_is_true (setter))
            scm_sys_set_object_setter_x (z, setter);
        }
     }
@@ -2224,7 +2210,7 @@ fix_cpl (SCM c, SCM before, SCM after)
   SCM cpl = SCM_SLOT (c, scm_si_cpl);
   SCM ls = scm_c_memq (after, cpl);
   SCM tail = scm_delq1_x (before, SCM_CDR (ls));
-  if (SCM_FALSEP (ls))
+  if (scm_is_false (ls))
     /* if this condition occurs, fix_cpl should not be applied this way */
     abort ();
   SCM_SETCAR (ls, before);
@@ -2268,6 +2254,10 @@ create_standard_classes (void)
                                              k_init_keyword,
                                              k_slot_definition));
   SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex"));
+  SCM mutex_closure = scm_i_eval_x (scm_list_3 (scm_sym_lambda,
+                                                SCM_EOL,
+                                                mutex_slot),
+                                    SCM_EOL);
   SCM gf_slots = scm_list_5 (scm_str2symbol ("methods"),
                             scm_list_3 (scm_str2symbol ("n-specialized"),
                                         k_init_value,
@@ -2277,9 +2267,7 @@ create_standard_classes (void)
                                         SCM_BOOL_F),
                             scm_list_3 (scm_str2symbol ("cache-mutex"),
                                         k_init_thunk,
-                                        scm_closure (scm_list_2 (SCM_EOL,
-                                                                 mutex_slot),
-                                                     SCM_EOL)),
+                                         mutex_closure),
                             scm_list_3 (scm_str2symbol ("extended-by"),
                                         k_init_value,
                                         SCM_EOL));
@@ -2418,6 +2406,8 @@ create_standard_classes (void)
               scm_class_class, scm_class_complex,         SCM_EOL);
   make_stdcls (&scm_class_integer,        "<integer>",
               scm_class_class, scm_class_real,            SCM_EOL);
+  make_stdcls (&scm_class_fraction,       "<fraction>",
+              scm_class_class, scm_class_real,            SCM_EOL);
   make_stdcls (&scm_class_keyword,        "<keyword>",
               scm_class_class, scm_class_top,             SCM_EOL);
   make_stdcls (&scm_class_unknown,        "<unknown>",
@@ -2447,7 +2437,7 @@ create_standard_classes (void)
  **********************************************************************/
 
 static SCM
-make_class_from_template (char *template, char *type_name, SCM supers, int applicablep)
+make_class_from_template (char const *template, char const *type_name, SCM supers, int applicablep)
 {
   SCM class, name;
   if (type_name)
@@ -2468,13 +2458,13 @@ make_class_from_template (char *template, char *type_name, SCM supers, int appli
 
   /* Only define name if doesn't already exist. */
   if (!SCM_GOOPS_UNBOUNDP (name)
-      && SCM_FALSEP (scm_call_2 (scm_goops_lookup_closure, name, SCM_BOOL_F)))
+      && scm_is_false (scm_call_2 (scm_goops_lookup_closure, name, SCM_BOOL_F)))
     DEFVAR (name, class);
   return class;
 }
 
 SCM
-scm_make_extended_class (char *type_name, int applicablep)
+scm_make_extended_class (char const *type_name, int applicablep)
 {
   return make_class_from_template ("<%s>",
                                   type_name,
@@ -2493,7 +2483,7 @@ scm_i_inherit_applicable (SCM c)
       SCM cpl = SCM_SLOT (c, scm_si_cpl);
       /* patch scm_class_applicable into direct-supers */
       SCM top = scm_c_memq (scm_class_top, dsupers);
-      if (SCM_FALSEP (top))
+      if (scm_is_false (top))
        dsupers = scm_append (scm_list_2 (dsupers,
                                          scm_list_1 (scm_class_applicable)));
       else
@@ -2504,7 +2494,7 @@ scm_i_inherit_applicable (SCM c)
       SCM_SET_SLOT (c, scm_si_direct_supers, dsupers);
       /* patch scm_class_applicable into cpl */
       top = scm_c_memq (scm_class_top, cpl);
-      if (SCM_FALSEP (top))
+      if (scm_is_false (top))
        abort ();
       else
        {
@@ -2528,9 +2518,6 @@ create_smob_classes (void)
   for (i = 0; i < 255; ++i)
     scm_smob_class[i] = 0;
 
-  scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_big)] = scm_class_integer;
-  scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_real)] = scm_class_real;
-  scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_complex)] = scm_class_complex;
   scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_keyword)] = scm_class_keyword;
 
   for (i = 0; i < scm_numsmob; ++i)
@@ -2584,7 +2571,7 @@ static SCM
 make_struct_class (void *closure SCM_UNUSED,
                   SCM vtable, SCM data, SCM prev SCM_UNUSED)
 {
-  if (!SCM_FALSEP (SCM_STRUCT_TABLE_NAME (data)))
+  if (scm_is_true (SCM_STRUCT_TABLE_NAME (data)))
     SCM_SET_STRUCT_TABLE_CLASS (data,
                                scm_make_extended_class
                                (SCM_SYMBOL_CHARS (SCM_STRUCT_TABLE_NAME (data)),
@@ -2685,12 +2672,19 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class,
     SCM get = scm_c_make_subr ("goops:get", scm_tc7_subr_1, getter);
     SCM set = scm_c_make_subr ("goops:set", scm_tc7_subr_2,
                               setter ? setter : default_setter);
-    SCM getm = scm_closure (scm_list_2 (scm_list_1 (sym_o),
-                                       scm_list_2 (get, sym_o)),
-                           SCM_EOL);
-    SCM setm = scm_closure (scm_list_2 (scm_list_2 (sym_o, sym_x),
-                                       scm_list_3 (set, sym_o, sym_x)),
-                           SCM_EOL);
+
+    /* Dirk:FIXME:: The following two expressions make use of the fact that
+     * the memoizer will accept a subr-object in the place of a function.
+     * This is not guaranteed to stay this way.  */
+    SCM getm = scm_i_eval_x (scm_list_3 (scm_sym_lambda,
+                                         scm_list_1 (sym_o),
+                                         scm_list_2 (get, sym_o)),
+                             SCM_EOL);
+    SCM setm = scm_i_eval_x (scm_list_3 (scm_sym_lambda,
+                                         scm_list_2 (sym_o, sym_x),
+                                         scm_list_3 (set, sym_o, sym_x)),
+                             SCM_EOL);
+
     {
       SCM name = scm_str2symbol (slot_name);
       SCM aname = scm_str2symbol (accessor_name);
@@ -2700,8 +2694,6 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class,
                             slot_class,
                             setter ? k_accessor : k_getter,
                             gf);
-      SCM gns = scm_list_4 (name, SCM_BOOL_F, get, set);
-
       scm_add_method (gf, scm_make (scm_list_5 (scm_class_accessor_method,
                                                k_specializers,
                                                scm_list_1 (class),
@@ -2718,16 +2710,16 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class,
       SCM_SET_SLOT (class, scm_si_slots,
                    scm_append_x (scm_list_2 (SCM_SLOT (class, scm_si_slots),
                                              scm_list_1 (slot))));
-      SCM_SET_SLOT (class, scm_si_getters_n_setters,
-                   scm_append_x (scm_list_2 (SCM_SLOT (class, scm_si_getters_n_setters),
-                                             scm_list_1 (gns))));
+      {
+       SCM n = SCM_SLOT (class, scm_si_nfields);
+       SCM gns = scm_list_n (name, SCM_BOOL_F, get, set, n, SCM_I_MAKINUM (1));
+       SCM_SET_SLOT (class, scm_si_getters_n_setters,
+                     scm_append_x (scm_list_2 (SCM_SLOT (class, scm_si_getters_n_setters),
+                                               scm_list_1 (gns))));
+       SCM_SET_SLOT (class, scm_si_nfields, SCM_I_MAKINUM (SCM_INUM (n) + 1));
+      }
     }
   }
-  {
-    long n = SCM_INUM (SCM_SLOT (class, scm_si_nfields));
-
-    SCM_SET_SLOT (class, scm_si_nfields, SCM_MAKINUM (n + 1));
-  }
 }
 
 SCM
@@ -2785,7 +2777,7 @@ SCM_DEFINE (scm_pure_generic_p, "pure-generic?", 1, 0, 0,
            "Return @code{#t} if @var{obj} is a pure generic.")
 #define FUNC_NAME s_scm_pure_generic_p
 {
-  return SCM_BOOL (SCM_PUREGENERICP (obj));
+  return scm_from_bool (SCM_PUREGENERICP (obj));
 }
 #undef FUNC_NAME
 
@@ -2824,7 +2816,7 @@ scm_init_goops_builtins (void)
   scm_permanent_object (scm_goops_lookup_closure);
 
   scm_components = scm_permanent_object (scm_make_weak_key_hash_table
-                                        (SCM_MAKINUM (37)));
+                                        (SCM_I_MAKINUM (37)));
 
   goops_rstate = scm_c_make_rstate ("GOOPS", 5);