deprecate scm_struct_table

* libguile/goops.h:
* libguile/goops.c (scm_i_define_class_for_vtable): New internal helper,
  defines a class for a vtable, relying on the name slot being set
  correctly.
  (scm_class_of, create_struct_classes): Use the local vtable-to-class
  map instead of scm_struct_table.

* libguile/struct.h (SCM_STRUCT_TABLE_NAME, SCM_SET_STRUCT_TABLE_NAME)
  (SCM_STRUCT_TABLE_CLASS, SCM_SET_STRUCT_TABLE_CLASS, scm_struct_table)
  (scm_struct_create_handle): Deprecate these internals of the map
  between structs and classes.

* libguile/deprecated.h:
* libguile/deprecated.c (scm_struct_create_handle): Deprecated code over
  here now.

libguile/deprecated.c

@@ -2561,10 +2561,24 @@ scm_whash_insert (SCM whash, SCM key, SCM obj)
 
 
 
+SCM scm_struct_table = SCM_BOOL_F;
+
+SCM
+scm_struct_create_handle (SCM obj)
+{
+  scm_c_issue_deprecation_warning
+    ("`scm_struct_create_handle' is deprecated, and has no effect.");
+  
+  return scm_cons (obj, scm_cons (SCM_BOOL_F, SCM_BOOL_F));
+}
+
+
+
 void
 scm_i_init_deprecated ()
 {
   properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED);
+  scm_struct_table = scm_make_hash_table (SCM_UNDEFINED);
 #include "libguile/deprecated.x"
 }
 

libguile/deprecated.h

@@ -768,6 +768,19 @@ SCM_DEPRECATED SCM scm_whash_lookup (SCM whash, SCM obj);
 SCM_DEPRECATED void scm_whash_insert (SCM whash, SCM key, SCM obj);
 
 
+
+
+/* No need for a table for names, and the struct->class mapping is
+   maintained by GOOPS now.  */
+#define SCM_STRUCT_TABLE_NAME(X) SCM_CAR (X)
+#define SCM_SET_STRUCT_TABLE_NAME(X, NAME) SCM_SETCAR (X, NAME)
+#define SCM_STRUCT_TABLE_CLASS(X) SCM_CDR (X)
+#define SCM_SET_STRUCT_TABLE_CLASS(X, CLASS) SCM_SETCDR (X, CLASS)
+
+SCM_DEPRECATED SCM scm_struct_table;
+SCM_DEPRECATED SCM scm_struct_create_handle (SCM obj);
+
+
 
 
 void scm_i_init_deprecated (void);

libguile/goops.c

@@ -169,6 +169,8 @@ static SCM class_vm_cont;
 static SCM class_bytevector;
 static SCM class_uvec;
 
+static SCM vtable_class_map = SCM_BOOL_F;
+
 /* Port classes.  Allocate 3 times the maximum number of port types so that
    input ports, output ports, and in/out ports can be stored at different
    offsets.  See `SCM_IN_PCLASS_INDEX' et al.  */
@@ -189,6 +191,41 @@ static SCM scm_sys_goops_loaded (void);
 static SCM scm_make_extended_class_from_symbol (SCM type_name_sym, 
 						int applicablep);
 
+
+SCM
+scm_i_define_class_for_vtable (SCM vtable)
+{
+  SCM class;
+
+  if (scm_is_false (vtable_class_map))
+    vtable_class_map = scm_make_weak_key_hash_table (SCM_UNDEFINED);
+  
+  if (scm_is_false (scm_struct_vtable_p (vtable)))
+    abort ();
+
+  class = scm_hashq_ref (vtable_class_map, vtable, SCM_BOOL_F);
+  
+  if (scm_is_false (class))
+    {
+      if (SCM_UNPACK (scm_class_class))
+        {
+          SCM name = SCM_VTABLE_NAME (vtable);
+          if (!scm_is_symbol (name))
+            name = scm_string_to_symbol (scm_nullstr);
+
+          class = scm_make_extended_class_from_symbol
+            (name, SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_APPLICABLE));
+        }
+      else
+        /* `create_struct_classes' will fill this in later.  */
+        class = SCM_BOOL_F;
+        
+      scm_hashq_set_x (vtable_class_map, vtable, class);
+    }
+
+  return class;
+}
+
 /* This function is used for efficient type dispatch.  */
 SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	    (SCM x),
@@ -288,26 +325,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	      return SCM_CLASS_OF (x);
 	    }
 	  else
-	    {
+            return scm_i_define_class_for_vtable (SCM_CLASS_OF (x));
-	      /* ordinary struct */
-	      SCM handle = scm_struct_create_handle (SCM_STRUCT_VTABLE (x));
-	      if (scm_is_true (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle))))
-		return SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle));
-	      else
-		{
-		  SCM class, name;
-
-		  name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
-		  if (!scm_is_symbol (name))
-		    name = scm_string_to_symbol (scm_nullstr);
-
-		  class =
-		    scm_make_extended_class_from_symbol (name,
-							 SCM_STRUCT_APPLICABLE_P (x));
-		  SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
-		  return class;
-		}
-	    }
 	default:
 	  if (scm_is_pair (x))
 	    return scm_class_pair;
@@ -2628,23 +2646,16 @@ static SCM
 make_struct_class (void *closure SCM_UNUSED,
 		   SCM vtable, SCM data, SCM prev SCM_UNUSED)
 {
-  SCM sym = SCM_STRUCT_TABLE_NAME (data);
+  if (scm_is_false (data))
-  if (scm_is_true (sym))
+    scm_i_define_class_for_vtable (vtable);
-    {
-      int applicablep = SCM_CLASS_FLAGS (vtable) & SCM_VTABLE_FLAG_APPLICABLE;
-
-      SCM_SET_STRUCT_TABLE_CLASS (data, 
-				  scm_make_extended_class_from_symbol (sym, applicablep));
-    }
-
-  scm_remember_upto_here_2 (data, vtable);
   return SCM_UNSPECIFIED;
 }
 
 static void
 create_struct_classes (void)
 {
-  scm_internal_hash_fold (make_struct_class, 0, SCM_BOOL_F, scm_struct_table);
+  scm_internal_hash_fold (make_struct_class, 0, SCM_BOOL_F,
+                          vtable_class_map);
 }
 
 /**********************************************************************

libguile/goops.h

@@ -3,7 +3,7 @@
 #ifndef SCM_GOOPS_H
 #define SCM_GOOPS_H
 
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2011 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 License
@@ -307,6 +307,8 @@ SCM_API SCM scm_apply_generic (SCM gf, SCM args);
 */
 SCM_API SCM scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3);
 
+SCM_INTERNAL SCM scm_i_define_class_for_vtable (SCM vtable);
+
 
 SCM_INTERNAL SCM scm_init_goops_builtins (void);
 SCM_INTERNAL void scm_init_goops (void);

libguile/struct.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011 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 License
@@ -54,7 +54,6 @@
 static SCM required_vtable_fields = SCM_BOOL_F;
 static SCM required_applicable_fields = SCM_BOOL_F;
 static SCM required_applicable_with_setter_fields = SCM_BOOL_F;
-SCM scm_struct_table = SCM_BOOL_F;
 SCM scm_applicable_struct_vtable_vtable;
 SCM scm_applicable_struct_with_setter_vtable_vtable;
 SCM scm_standard_vtable_vtable;
@@ -946,27 +945,13 @@ scm_struct_ihashq (SCM obj, unsigned long n, void *closure)
   return SCM_UNPACK (obj) % n;
 }
 
-SCM
-scm_struct_create_handle (SCM obj)
-{
-  SCM handle = scm_hash_fn_create_handle_x (scm_struct_table,
-					    obj,
-					    SCM_BOOL_F,
-					    scm_struct_ihashq,
-					    (scm_t_assoc_fn) scm_sloppy_assq,
-					    0);
-  if (scm_is_false (SCM_CDR (handle)))
-    SCM_SETCDR (handle, scm_cons (SCM_BOOL_F, SCM_BOOL_F));
-  return handle;
-}
-
 SCM_DEFINE (scm_struct_vtable_name, "struct-vtable-name", 1, 0, 0, 
             (SCM vtable),
 	    "Return the name of the vtable @var{vtable}.")
 #define FUNC_NAME s_scm_struct_vtable_name
 {
   SCM_VALIDATE_VTABLE (1, vtable);
-  return SCM_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)));
+  return SCM_VTABLE_NAME (vtable);
 }
 #undef FUNC_NAME
 
@@ -977,8 +962,10 @@ SCM_DEFINE (scm_set_struct_vtable_name_x, "set-struct-vtable-name!", 2, 0, 0,
 {
   SCM_VALIDATE_VTABLE (1, vtable);
   SCM_VALIDATE_SYMBOL (2, name);
-  SCM_SET_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)),
+  SCM_SET_VTABLE_NAME (vtable, name);
-			     name);
+  /* FIXME: remove this, and implement proper struct classes instead.
+     (Vtables *are* classes.)  */
+  scm_i_define_class_for_vtable (vtable);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1047,7 +1034,6 @@ scm_init_struct ()
      OBJ once OBJ has undergone class redefinition.  */
   GC_REGISTER_DISPLACEMENT (2 * sizeof (scm_t_bits));
 
-  scm_struct_table = scm_make_weak_key_hash_table (scm_from_int (31));
   required_vtable_fields = scm_from_locale_string (SCM_VTABLE_BASE_LAYOUT);
   required_applicable_fields = scm_from_locale_string (SCM_APPLICABLE_BASE_LAYOUT);
   required_applicable_with_setter_fields = scm_from_locale_string (SCM_APPLICABLE_WITH_SETTER_BASE_LAYOUT);

libguile/struct.h

@@ -3,7 +3,7 @@
 #ifndef SCM_STRUCT_H
 #define SCM_STRUCT_H
 
-/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011 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 License
@@ -165,12 +165,6 @@ typedef void (*scm_t_struct_finalize) (SCM obj);
 #define SCM_STRUCT_SETTER(X)            (SCM_STRUCT_SLOT_REF (X, scm_applicable_struct_index_setter))
 #define SCM_SET_STRUCT_SETTER(X,P) 	(SCM_STRUCT_SLOT_SET (X, scm_applicable_struct_index_setter, P))
 
-#define SCM_STRUCT_TABLE_NAME(X) SCM_CAR (X)
-#define SCM_SET_STRUCT_TABLE_NAME(X, NAME) SCM_SETCAR (X, NAME)
-#define SCM_STRUCT_TABLE_CLASS(X) SCM_CDR (X)
-#define SCM_SET_STRUCT_TABLE_CLASS(X, CLASS) SCM_SETCDR (X, CLASS)
-SCM_API SCM scm_struct_table;
-
 SCM_API SCM scm_standard_vtable_vtable;
 SCM_API SCM scm_applicable_struct_vtable_vtable;
 SCM_API SCM scm_applicable_struct_with_setter_vtable_vtable;
@@ -191,7 +185,6 @@ SCM_API SCM scm_struct_ref (SCM handle, SCM pos);
 SCM_API SCM scm_struct_set_x (SCM handle, SCM pos, SCM val);
 SCM_API SCM scm_struct_vtable (SCM handle);
 SCM_API SCM scm_struct_vtable_tag (SCM handle);
-SCM_API SCM scm_struct_create_handle (SCM obj);
 SCM_API SCM scm_struct_vtable_name (SCM vtable);
 SCM_API SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name);
 SCM_API void scm_print_struct (SCM exp, SCM port, scm_print_state *);