build: Tell `gen-scmconfig' whether the system has `struct timespec'.
[bpt/guile.git] / libguile / goops.c
index e951309..9a40277 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011
+/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -169,6 +169,7 @@ static SCM class_vm_cont;
 static SCM class_bytevector;
 static SCM class_uvec;
 static SCM class_array;
+static SCM class_bitvector;
 
 static SCM vtable_class_map = SCM_BOOL_F;
 static scm_i_pthread_mutex_t vtable_class_map_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
@@ -291,6 +292,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
             return class_uvec;
        case scm_tc7_array:
           return class_array;
+       case scm_tc7_bitvector:
+          return class_bitvector;
        case scm_tc7_string:
          return scm_class_string;
         case scm_tc7_number:
@@ -979,7 +982,7 @@ create_basic_classes (void)
   /**** <class> ****/
   SCM cs = scm_from_locale_string (SCM_CLASS_CLASS_LAYOUT);
   SCM name = scm_from_latin1_symbol ("<class>");
-  scm_class_class = scm_make_vtable_vtable (cs, SCM_INUM0, SCM_EOL);
+  scm_class_class = scm_i_make_vtable_vtable (cs);
   SCM_SET_CLASS_FLAGS (scm_class_class, (SCM_CLASSF_GOOPS_OR_VALID
                                         | SCM_CLASSF_METACLASS));
 
@@ -2528,6 +2531,8 @@ create_standard_classes (void)
               scm_class_class, class_bytevector,          SCM_EOL);
   make_stdcls (&class_array,              "<array>",
               scm_class_class, scm_class_top,             SCM_EOL);
+  make_stdcls (&class_bitvector,           "<bitvector>",
+              scm_class_class, scm_class_top,             SCM_EOL);
   make_stdcls (&scm_class_number,         "<number>",
               scm_class_class, scm_class_top,             SCM_EOL);
   make_stdcls (&scm_class_complex,        "<complex>",
@@ -2760,13 +2765,21 @@ SCM_KEYWORD (k_getter, "getter");
 SCM
 scm_ensure_accessor (SCM name)
 {
-  SCM gf = scm_call_2 (SCM_TOP_LEVEL_LOOKUP_CLOSURE, name, SCM_BOOL_F);
+  SCM var, gf;
+
+  var = scm_module_variable (scm_current_module (), name);
+  if (SCM_VARIABLEP (var) && !SCM_UNBNDP (SCM_VARIABLE_REF (var)))
+    gf = SCM_VARIABLE_REF (var);
+  else
+    gf = SCM_BOOL_F;
+
   if (!SCM_IS_A_P (gf, scm_class_accessor))
     {
       gf = scm_make (scm_list_3 (scm_class_generic, k_name, name));
       gf = scm_make (scm_list_5 (scm_class_accessor,
                                 k_name, name, k_setter, gf));
     }
+
   return gf;
 }