Re: make-vtable

[Kevin Ryde]

I'm looking at the code below for my new `make-vtable'.  I'm still not
completely convinced it's a great idea, but it does at least find a
use in stacks.c, so it can't be all bad!

--- struct.c.~1.111.2.6.~       2007-03-06 11:19:49.000000000 +1100
+++ struct.c    2007-03-06 11:20:55.000000000 +1100
@@ -560,6 +560,28 @@
 #undef FUNC_NAME
 
 
+static SCM scm_i_vtable_vtable_no_extra_fields;
+
+SCM_DEFINE (scm_make_vtable, "make-vtable", 1, 1, 0,
+            (SCM fields, SCM printer),
+           "Create a vtable, for creating structures with the given\n"
+           "@var{fields}.\n"
+           "\n"
+           "The optional @var{printer} argument is a function to be called\n"
+           "@code{(@var{printer} struct port)} on the structures created.\n"
+           "It should look at @var{struct} and write to @var{port}.")
+#define FUNC_NAME s_scm_struct_vtable_tag
+{
+  if (SCM_UNBNDP (printer))
+    printer = SCM_BOOL_F;
+
+  return scm_make_struct (scm_i_vtable_vtable_no_extra_fields, SCM_INUM0,
+                          scm_list_2 (scm_make_struct_layout (fields),
+                                      printer));
+}
+#undef FUNC_NAME
+
+
 /* Return true if S1 and S2 are equal structures, i.e., if their vtable and
    contents are the same.  Field protections are honored.  Thus, it is an
    error to test the equality of structures that contain opaque fields.  */
@@ -879,6 +901,11 @@
     = scm_permanent_object (scm_make_weak_key_hash_table (scm_from_int (31)));
   required_vtable_fields = scm_from_locale_string ("prsrpw");
   scm_permanent_object (required_vtable_fields);
+
+  scm_i_vtable_vtable_no_extra_fields =
+    scm_permanent_object
+    (scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL));
+
   scm_c_define ("vtable-index-layout", scm_from_int (scm_vtable_index_layout));
   scm_c_define ("vtable-index-vtable", scm_from_int (scm_vtable_index_vtable));
   scm_c_define ("vtable-index-printer",

--- stacks.c.~1.83.2.1.~        2006-02-14 08:59:02.000000000 +1100
+++ stacks.c    2007-03-06 11:21:05.000000000 +1100
@@ -1,5 +1,5 @@
 /* Representation of stack frame debug information
- * Copyright (C) 1996,1997,2000,2001, 2006 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001, 2006, 2007 Free Software Foundation
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -740,14 +740,10 @@
 void
 scm_init_stacks ()
 {
-  SCM vtable;
-  SCM stack_layout
-    = scm_make_struct_layout (scm_from_locale_string (SCM_STACK_LAYOUT));
-  vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
-  scm_stack_type
-    = scm_permanent_object (scm_make_struct (vtable, SCM_INUM0,
-                                            scm_cons (stack_layout,
-                                                      SCM_EOL)));
+  scm_stack_type =
+    scm_permanent_object
+    (scm_make_vtable (scm_from_locale_string (SCM_STACK_LAYOUT),
+                      SCM_UNDEFINED));
   scm_set_struct_vtable_name_x (scm_stack_type,
                                scm_from_locale_symbol ("stack"));
 #include "libguile/stacks.x"