[patch] subordinate SMOBs with GOOPS superclasses

[patch] subordinate SMOBs with GOOPS superclasses

[Marco Maggi]

[-- Attachment #1: Type: text/plain, Size: 614 bytes --]

The attached patch documents the creation of
a GOOPS class whenever a new SMOB type is
defined and GOOPS has been already loaded.

Additionally it adds a special SMOB type that
dispatches function invocations to a user defined
subordinate SMOB. This allows to overcome the
hard coded limit on SMOB number at the cost
of some functions call.

The subordinate SMOB allows to select a list
of superclasses, so that the sub-SMOB's class
appears to be derived from already existent classes.

A standalone test is included.

If the thing is accepted I can sign and send the
licence piece of paper.



[-- Attachment #2: patch-subsmob --]
[-- Type: application/octet-stream, Size: 27623 bytes --]

diff -Naur guile-1.8.3-original/doc/ref/api-smobs.texi guile-1.8.3-patch-subsmob/doc/ref/api-smobs.texi
--- guile-1.8.3-original/doc/ref/api-smobs.texi	2007-05-09 22:22:03.000000000 +0200
+++ guile-1.8.3-patch-subsmob/doc/ref/api-smobs.texi	2007-11-26 19:43:21.000000000 +0100
@@ -8,6 +8,12 @@
 @node Smobs
 @section Smobs
 
+
+@menu
+* Subsmobs::                    Subordinate smobs.
+@end menu
+
+
 This chapter contains reference information related to defining and
 working with smobs.  See @ref{Defining New Types (Smobs)} for a
 tutorial-like introduction to smobs.
@@ -31,6 +37,11 @@
 immediately followed by calls to one or several of
 @code{scm_set_smob_mark}, @code{scm_set_smob_free},
 @code{scm_set_smob_print}, and/or @code{scm_set_smob_equalp}.
+
+If GOOPS is loaded when @code{scm_make_smob_type} is invoked: a new
+GOOPS class is created, with @code{top} as superclass, to represent the
+smob type. This allows GOOPS to dispatch methods based on the type of
+the smob.
 @end deftypefun
 
 @deftypefn {C Function} void scm_set_smob_mark (scm_t_bits tc, SCM (*mark) (SCM obj))
@@ -193,6 +204,179 @@
 other objects.  This function simply returns @var{x}'s first data word.
 @end deftypefun
 
+
+@c ------------------------------------------------------------
+@node Subsmobs
+@subsection Subordinate smobs
+
+
+A special smob type is implemented to overcome the 255 limit on the
+number of smob types. Its procedures dispatch the call to procedures
+referenced by a subsmob descriptor.
+
+If GOOPS is loaded when @code{scm_make_sub_smob_type} is invoked to
+declare the new subsmob type: a new GOOPS class is created, optionally
+with a list of superclasses, to represent the smob type. This allows
+GOOPS to dispatch methods based on the type of the smob.
+
+
+@deftp {Struct Typedef} scm_sub_smob_descriptor
+The type of subsmob descriptor structure. Public fields:
+
+@table @code
+@item const char * name
+a statically--allocated zero--terminated string representing the subsmob
+identifier; it is used by the print function and to create the GOOPS
+class symbol: if the value is @code{mine}, the class' symbol is
+@code{<mine>};
+
+@item size_t client_data_size;
+analogous to the @var{size} argument to @code{scm_make_smob_type};
+
+@item size_t (* free) (SCM smob)
+pointer to a free function that works like the one of a normal smob; can
+be @code{NULL}, in which case: if @code{client_data_size} is not zero
+@code{scm_gc_free} is used to free the client data structure when the
+smob is garbage collected; the string referenced by @code{name} is used
+as @var{what} argument to @code{scm_gc_free};
+
+@item SCM (* equalp) (SCM smob_a, SCM smob_b)
+pointer to a comparison function that works like the one of a normal
+smob; if it is @code{NULL}: @code{scm_eq_p} is used to compare the
+smobs;
+
+@item SCM (* mark) (SCM smob)
+pointer to a mark function that works like the one of a normal
+smob; can be @code{NULL};
+
+@item int (* print) (SCM smob, SCM s_port, scm_print_state * pstate)
+pointer to a print function that works like the one of a normal smob;
+can be @code{NULL};
+
+@item SCM class
+this field must be initialised to @code{SCM_BOOL_F}; Guile will set it
+to a GOOPS class representing the subsmob type, and will mark it as
+permanent object;
+
+@item SCM list_of_supers
+a list of GOOPS classes to be used as base classes for the subsmob
+class; this field must be initialised to @code{SCM_EOL} when defining
+the structure and, if needed, reset to the list of classes in an
+initialisation function; if it is left to @code{SCM_EOL}: the base class
+of the subsmob type will be @code{<top>}; it is our responsibility to
+mark the list as a permanent object (using @code{scm_permanent_object}).
+@end table
+@end deftp
+
+
+@deftypefun void scm_make_sub_smob_type (scm_sub_smob_descriptor * descriptor)
+Declare a new subsmob type according to the the structure referenced by
+@var{descriptor}.
+@end deftypefun
+
+
+@deftypefn {C Macro} int SCM_SUB_SMOB_PREDICATE (SCM obj)
+Evaluate to true if @var{obj} is a subsmob.
+@end deftypefn
+
+
+@deftypefn {C Macro} {scm_sub_smob_descriptor *} SCM_SUB_SMOB_DESCRIPTOR (SCM obj)
+Return a pointer to the subsmob type descriptor of @var{obj}. @var{obj}
+must be a subsmob.
+@end deftypefn
+
+
+@deftypefn {C Macro} void SCM_NEWSUBSMOB (SCM value, scm_sub_smob_descriptor * type, void * data)
+Make @var{value} contain a subsmob instance of the type with descriptor
+@var{type} and smob data @var{data}.
+@end deftypefn
+
+
+@deftypefn {C Macro} SCM SCM_RETURN_NEWSUBSMOB (scm_sub_smob_descriptor * type, void * data)
+This macro expands to a block of code that creates a smob instance of
+the type descriptor @var{type} and smob data @var{data}, as with
+@code{SCM_NEWSUBSMOB}, etc., and causes the surrounding function to
+return that @code{SCM} value.  It should be the last piece of code in a
+block.
+@end deftypefn
+
+
+@subsubsection Examples: a wrapper for @code{int}
+
+
+@noindent
+Let's say that we want to define a new subordinate smob that wraps an
+integer and has @code{<number>} as base class. We can write the driver
+like this:
+
+@example
+typedef struct client_data_t @{
+  int   n;
+@} client_data_t;
+
+#define MY_INTEGER_DATA(SMOB) ((client_data_t *)SCM_SMOB_DATA(SMOB))
+
+static SCM my_integer_equalp(SCM smob_a, SCM smob_b);
+static int my_integer_print (SCM smob, SCM s_port,
+                             scm_print_state * pstate SCM_UNUSED);
+
+static scm_t_sub_smob_descriptor my_integer_driver = @{
+  .name                 = "my-integer",
+  .client_data_size     = sizeof(client_data_t),
+  .free                 = NULL,
+  .equalp               = my_integer_equalp,
+  .mark                 = NULL,
+  .print                = my_integer_print,
+  .class                = SCM_BOOL_F,
+  .list_of_supers       = SCM_EOL
+@};
+
+SCM
+my_integer_equalp (SCM smob_a, SCM smob_b)
+@{
+  int   a = MY_INTEGER_DATA(smob_a)->n;
+  int   b = MY_INTEGER_DATA(smob_b)->n;
+
+  return scm_from_bool(a == b);
+@}
+int
+my_integer_print (SCM smob, SCM s_port,
+                  scm_print_state * pstate SCM_UNUSED)
+@{
+  scm_puts("#<", s_port);
+  scm_puts(my_integer_driver.name, s_port);
+  scm_puts(" - ", s_port);
+  scm_display(scm_from_int(MY_INTEGER_DATA(smob)->n), s_port);
+  scm_putc('>', s_port);
+  return 1;
+@}
+@end example
+
+@noindent
+we need an initialization function in which we put:
+
+@example
+SCM   s_number_class, s_list_of_supers;
+
+s_number_class   = scm_variable_ref(scm_c_lookup("<number>"));
+s_list_of_supers = scm_list_1(s_number_class);
+s_list_of_supers = scm_permanent_object(s_list_of_supers);
+
+my_integer_driver.list_of_supers = s_list_of_supers;
+scm_make_sub_smob_type(&my_integer_driver);
+scm_c_define(my_integer_driver.name, my_integer_driver.class);
+@end example
+
+The library must be loaded in a module @strong{after} loading GOOPS in
+the same module.  Then we can define methods:
+
+@example
+(define-method (do-something (o <my-integer>))
+  ...)
+@end example
+
+
+
 @c Local Variables:
 @c TeX-master: "guile.texi"
 @c End:
diff -Naur guile-1.8.3-original/libguile/goops.c guile-1.8.3-patch-subsmob/libguile/goops.c
--- guile-1.8.3-original/libguile/goops.c	2007-07-11 00:27:36.000000000 +0200
+++ guile-1.8.3-patch-subsmob/libguile/goops.c	2007-11-26 19:14:20.000000000 +0100
@@ -230,6 +230,13 @@
 
 	case scm_tc7_smob:
 	  {
+	    if (SCM_SMOB_PREDICATE(scm_multi_smob_driver, x))
+	      {
+		SCM class = (SCM_SUB_SMOB_DESCRIPTOR(x))->class;
+
+		if (scm_is_true(class))
+		  return class;
+	      }
 	    scm_t_bits type = SCM_TYP16 (x);
 	    if (type != scm_tc16_port_with_ps)
 	      return scm_smob_class[SCM_TC2SMOBNUM (type)];
@@ -244,7 +251,9 @@
 				 : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
 	case scm_tcs_struct:
 	  if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)
-	    return SCM_CLASS_OF (x);
+	    {
+	      return SCM_CLASS_OF (x);
+	    }
 	  else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
 	    {
 	      /* Goops object */
@@ -252,6 +261,7 @@
 		scm_change_object_class (x,
 					 SCM_CLASS_OF (x),         /* old */
 					 SCM_OBJ_CLASS_REDEF (x)); /* new */
+
 	      return SCM_CLASS_OF (x);
 	    }
 	  else
@@ -2631,6 +2641,17 @@
 					       : scm_class_top),
 				   applicablep);
 }
+SCM
+scm_make_extended_class_with_supers (char const *type_name, SCM list_of_supers)
+{
+  return make_class_from_template ("<%s>",
+				   type_name,
+				   ((SCM_UNSPECIFIED != list_of_supers) &&
+				    (SCM_EOL         != list_of_supers))
+				   ? list_of_supers
+				   : scm_list_1(scm_class_top),
+				   0);
+}
 
 void
 scm_i_inherit_applicable (SCM c)
diff -Naur guile-1.8.3-original/libguile/objects.h guile-1.8.3-patch-subsmob/libguile/objects.h
--- guile-1.8.3-original/libguile/objects.h	2007-05-09 22:22:03.000000000 +0200
+++ guile-1.8.3-patch-subsmob/libguile/objects.h	2007-11-14 18:10:31.000000000 +0100
@@ -181,6 +181,7 @@
 
 /* Goops functions. */
 SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep);
+SCM_API SCM scm_make_extended_class_with_supers (char const *type_name, SCM list_of_supers);
 SCM_API void scm_i_inherit_applicable (SCM c);
 SCM_API void scm_make_port_classes (long ptobnum, char *type_name);
 SCM_API void scm_change_object_class (SCM, SCM, SCM);
diff -Naur guile-1.8.3-original/libguile/smob.c guile-1.8.3-patch-subsmob/libguile/smob.c
--- guile-1.8.3-original/libguile/smob.c	2007-05-09 22:22:03.000000000 +0200
+++ guile-1.8.3-patch-subsmob/libguile/smob.c	2007-11-26 16:49:22.000000000 +0100
@@ -30,6 +30,7 @@
 #include "libguile/objects.h"
 #include "libguile/goops.h"
 #include "libguile/ports.h"
+#include "libguile/eq.h"
 
 #ifdef HAVE_MALLOC_H
 #include <malloc.h>
@@ -49,6 +50,8 @@
 long scm_numsmob;
 scm_smob_descriptor scm_smobs[MAX_SMOB_COUNT];
 
+scm_t_bits scm_multi_smob_driver;
+
 /* Lower 16 bit of data must be zero. 
 */
 void
@@ -315,6 +318,16 @@
 }
 #undef FUNC_NAME
 
+void
+scm_make_sub_smob_type (scm_t_sub_smob_descriptor * descriptor)
+#define FUNC_NAME "scm_make_sub_smob_type"
+{
+  /* Make a class object if Goops is present. */
+  if (scm_smob_class)
+    descriptor->class =
+      scm_permanent_object(scm_make_extended_class_with_supers(descriptor->name, descriptor->list_of_supers));
+}
+#undef FUNC_NAME
 
 void
 scm_set_smob_mark (scm_t_bits tc, SCM (*mark) (SCM))
@@ -485,6 +498,62 @@
   return 1;
 }
 
+\f
+/* Multi-SMOB functions */
+
+static size_t
+multi_smob_free (SCM smob)
+{
+  scm_t_sub_smob_descriptor *	driver = SCM_SUB_SMOB_DESCRIPTOR(smob);
+
+  if (driver->free)
+    return driver->free(smob);
+  else if (driver->client_data_size) {
+    void *	data = (void *)SCM_SMOB_DATA(smob);
+    scm_gc_free(data, driver->client_data_size, driver->name);
+  }
+  return 0;
+}
+static SCM
+multi_smob_equalp (SCM smob_a, SCM smob_b)
+{
+  scm_t_sub_smob_descriptor *	driver_a = SCM_SUB_SMOB_DESCRIPTOR(smob_a);
+  scm_t_sub_smob_descriptor *	driver_b = SCM_SUB_SMOB_DESCRIPTOR(smob_b);
+
+  if (driver_a == driver_b)
+    return (driver_a->equalp)? driver_a->equalp(smob_a, smob_b) : scm_eq_p(smob_a, smob_b);
+  else
+    return SCM_BOOL_F;
+}
+static SCM
+multi_smob_mark (SCM smob)
+{
+  scm_t_sub_smob_descriptor *	driver = SCM_SUB_SMOB_DESCRIPTOR(smob);
+
+  return (driver->mark)? driver->mark(smob) : SCM_BOOL_F;
+}
+static int
+multi_smob_print (SCM smob, SCM s_port, scm_print_state * pstate)
+{
+  scm_t_sub_smob_descriptor *	driver = SCM_SUB_SMOB_DESCRIPTOR(smob);
+
+  if (driver->print)
+    return driver->print(smob, s_port, pstate);
+  else
+    {
+      scm_puts("#<", s_port);
+      scm_puts(driver->name, s_port);
+      scm_puts(" - ", s_port);
+      scm_display(scm_from_long(SCM_SMOBNUM(smob)), s_port);
+      scm_puts(" ", s_port);
+      scm_display(scm_from_ulong((unsigned long)smob), s_port);
+      scm_putc('>', s_port);
+      return 1;
+    }
+}
+
+\f
+
 void
 scm_smob_prehistory ()
 {
@@ -511,8 +580,15 @@
   /* WARNING: This scm_make_smob_type call must be done first.  */
   tc = scm_make_smob_type ("free", 0);
   scm_set_smob_print (tc, free_print);
+
+  scm_multi_smob_driver = scm_make_smob_type("MultiSMOB", 0);
+  scm_set_smob_free	(scm_multi_smob_driver, multi_smob_free);
+  scm_set_smob_equalp	(scm_multi_smob_driver, multi_smob_equalp);
+  scm_set_smob_mark	(scm_multi_smob_driver, multi_smob_mark);
+  scm_set_smob_print	(scm_multi_smob_driver, multi_smob_print);
 }
 
+
 /*
   Local Variables:
   c-file-style: "gnu"
diff -Naur guile-1.8.3-original/libguile/smob.h guile-1.8.3-patch-subsmob/libguile/smob.h
--- guile-1.8.3-original/libguile/smob.h	2007-05-09 22:22:03.000000000 +0200
+++ guile-1.8.3-patch-subsmob/libguile/smob.h	2007-11-15 17:51:23.000000000 +0100
@@ -119,6 +119,35 @@
 
 \f
 
+typedef struct scm_t_sub_smob_descriptor {
+  const char *	name;
+  size_t	client_data_size;
+  size_t	(* free) (SCM obj);
+  SCM		(* equalp) (SCM obj_a, SCM obj_b);
+  SCM		(* mark) (SCM obj);
+  int		(* print) (SCM smob, SCM s_port, scm_print_state * pstate);
+  SCM		class;
+  SCM		list_of_supers;
+} scm_t_sub_smob_descriptor;
+
+#define SCM_SUB_SMOB_DESCRIPTOR(SMOB)	((scm_t_sub_smob_descriptor *)SCM_SMOB_DATA_2(SMOB))
+
+SCM_API scm_t_bits scm_multi_smob_driver;
+
+#define SCM_SUB_SMOB_PREDICATE(SMOB)		\
+		SCM_SMOB_PREDICATE(scm_multi_smob_driver, SMOB)
+
+#define SCM_NEWSUBSMOB(SMOB,DESCRIPTOR,DATA)	\
+		SCM_NEWSMOB2((SMOB), scm_multi_smob_driver, (DATA), (DESCRIPTOR));
+
+#define SCM_RETURN_NEWSUBSMOB(DESCRIPTOR,DATA) \
+  do { SCM __SCM_smob_answer; \
+       SCM_NEWSUBSMOB (__SCM_smob_answer, (DESCRIPTOR), (DATA)); \
+       return __SCM_smob_answer; \
+  } while (0)
+
+\f
+
 SCM_API SCM scm_mark0 (SCM ptr);
 SCM_API SCM scm_markcdr (SCM ptr);
 SCM_API size_t scm_free0 (SCM ptr);
@@ -134,6 +163,7 @@
  */
 
 SCM_API scm_t_bits scm_make_smob_type (char const *name, size_t size);
+SCM_API void scm_make_sub_smob_type (scm_t_sub_smob_descriptor * descriptor);
 
 SCM_API void scm_set_smob_mark (scm_t_bits tc, SCM (*mark) (SCM));
 SCM_API void scm_set_smob_free (scm_t_bits tc, size_t (*free) (SCM));
diff -Naur guile-1.8.3-original/test-suite/standalone/Makefile.am guile-1.8.3-patch-subsmob/test-suite/standalone/Makefile.am
--- guile-1.8.3-original/test-suite/standalone/Makefile.am	2007-10-10 22:17:45.000000000 +0200
+++ guile-1.8.3-patch-subsmob/test-suite/standalone/Makefile.am	2007-11-26 16:03:48.000000000 +0100
@@ -107,6 +107,16 @@
 check_SCRIPTS += test-use-srfi
 TESTS += test-use-srfi
 
+# test-subsmob
+noinst_LTLIBRARIES += libtest-subsmob.la
+libtest_subsmob_la_SOURCES = test-subsmob-lib.c test-subsmob-lib.x
+libtest_subsmob_la_CFLAGS = ${test_cflags}
+libtest_subsmob_la_LDFLAGS = -no-undefined -rpath `pwd` # so libtool will really build an .so
+libtest_subsmob_la_LIBADD = ${top_builddir}/libguile/libguile.la
+BUILT_SOURCES += test-subsmob-lib.x
+check_SCRIPTS += test-subsmob
+TESTS += test-subsmob
+
 all-local:
 	cd ${srcdir} && chmod u+x ${check_SCRIPTS}
 
diff -Naur guile-1.8.3-original/test-suite/standalone/test-subsmob guile-1.8.3-patch-subsmob/test-suite/standalone/test-subsmob
--- guile-1.8.3-original/test-suite/standalone/test-subsmob	1970-01-01 01:00:00.000000000 +0100
+++ guile-1.8.3-patch-subsmob/test-suite/standalone/test-subsmob	2007-11-26 19:40:09.000000000 +0100
@@ -0,0 +1,160 @@
+#!/bin/sh
+exec guile -s "$0" "$@"
+!#
+
+;;To run only this test: from the top source directory of Guile:
+;;
+;;	$ make ; (cd test-suite/standalone ; make check)
+;;
+
+(use-modules (oop goops)
+	     (ice-9 regex)
+	     (ice-9 pretty-print))
+
+(load-extension "libtest-subsmob" "libtest_subsmob_init")
+
+;; ------------------------------------------------------------
+
+(define-method (upon-number (o <top>))
+  #f)
+
+(define-method (upon-number (o <number>))
+  #t)
+
+(define-method (upon-integer (o <top>))
+  #f)
+
+(define-method (upon-double (o <top>))
+  #f)
+
+(define-method (upon-wrapper (o <top>))
+  #f)
+
+;; ------------------------------------------------------------
+
+; (pretty-print <my-integer>)
+; (pretty-print (class-precedence-list <my-integer>))
+
+(define-method (upon-integer (o <my-integer>))
+  #t)
+
+(let ((a	(make-my-integer 123))
+      (b	(make-my-integer 123))
+      (c	(make-my-integer 456)))
+
+  ;;Forcing GC causes the mark function to be invoked.
+  (gc)
+
+  (if (not (equal? a b))
+      (error 'should-be-equal "error in equalp"))
+  (if (equal? a c)
+      (error 'should-be-not-equal "error in equalp"))
+
+  (if (not (string= "#<my-integer - 123>" (object->string a display)))
+      (error 'bad-string-rep "error in my-integer print function"))
+
+  (if (not (eq? (class-of a) <my-integer>))
+      (error 'bad-smob-class "error in my-integer class-of"))
+
+  (if (not (is-a? a <my-integer>))
+      (error 'bad-smob-class "error in my-integer class"))
+
+  (if (not (is-a? a <number>))
+      (error 'bad-smob-class "error in my-integer supers"))
+
+  (if (not (upon-number a))
+      (error 'bad-method-dispatch "error in dispatching for <number>"))
+
+  (if (not (upon-integer a))
+      (error 'bad-method-dispatch "error in dispatching for <my-integer>")))
+
+;;Forcing GC causes the free function to be invoked.
+(gc)
+(gc)
+
+;; ------------------------------------------------------------
+
+; (pretty-print <my-double>)
+; (pretty-print (class-precedence-list <my-double>))
+
+(define-method (upon-double (o <my-double>))
+  #t)
+
+(let ((a	(make-my-double 123))
+      (b	(make-my-double 123))
+      (c	(make-my-double 456)))
+
+  ;;Forcing GC causes the mark function to be invoked.
+  (gc)
+
+  (if (equal? a b)
+      (error 'should-be-not-equal "error in equalp"))
+  (if (not (equal? a a))
+      (error 'should-be-equal "error in equalp"))
+
+  (if (not (string-match "#<my-double - [0-9a-f]+ [0-9a-f]+>" (object->string a display)))
+      (error 'bad-string-rep "error in my-double print function"))
+
+  (if (not (eq? (class-of a) <my-double>))
+      (error 'bad-smob-class "error in my-double class-of"))
+
+  (if (not (is-a? a <my-double>))
+      (error 'bad-smob-class "error in my-double class"))
+
+  (if (not (is-a? a <number>))
+      (error 'bad-smob-class "error in my-double supers"))
+
+  (if (not (upon-number a))
+      (error 'bad-method-dispatch "error in dispatching for <number>"))
+
+  (if (not (upon-double a))
+      (error 'bad-method-dispatch "error in dispatching for <my-double>")))
+
+;;Forcing GC causes the free function to be invoked.
+(gc)
+(gc)
+
+;; ------------------------------------------------------------
+
+; (pretty-print <my-wrapper>)
+; (pretty-print (class-precedence-list <my-wrapper>))
+
+(define-method (upon-wrapper (o <my-wrapper>))
+  #t)
+
+(let ((a	(make-my-wrapper 123))
+      (b	(make-my-wrapper 123))
+      (c	(make-my-wrapper 456)))
+
+  ;;Forcing GC causes the mark function to be invoked.
+  (gc)
+
+  (if (not (equal? a b))
+      (error 'should-be-equal "error in equalp"))
+  (if (equal? a c)
+      (error 'should-be-not-equal "error in equalp"))
+
+  (if (not (string= "#<my-wrapper - 123>" (object->string a display)))
+      (error 'bad-string-rep "error in my-wrapper print function"))
+
+  (if (not (eq? (class-of a) <my-wrapper>))
+      (error 'bad-smob-class "error in my-wrapper class-of"))
+
+  (if (not (is-a? a <my-wrapper>))
+      (error 'bad-smob-class "error in my-wrapper class"))
+
+  (if (is-a? a <number>)
+      (error 'bad-smob-class "error in my-wrapper supers"))
+
+  (if (not (upon-wrapper a))
+      (error 'bad-method-dispatch "error in dispatching for <my-wrapper>")))
+
+;;Forcing GC causes the free function to be invoked.
+(gc)
+(gc)
+
+
+
+;; Local Variables:
+;; mode: scheme
+;; End:
diff -Naur guile-1.8.3-original/test-suite/standalone/test-subsmob-lib.c guile-1.8.3-patch-subsmob/test-suite/standalone/test-subsmob-lib.c
--- guile-1.8.3-original/test-suite/standalone/test-subsmob-lib.c	1970-01-01 01:00:00.000000000 +0100
+++ guile-1.8.3-patch-subsmob/test-suite/standalone/test-subsmob-lib.c	2007-11-26 19:41:30.000000000 +0100
@@ -0,0 +1,248 @@
+/* Copyright (C) 2007 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 as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ */
+
+\f
+/** ------------------------------------------------------------
+ ** Headers.
+ ** ----------------------------------------------------------*/
+
+#include "libguile.h"
+#include <stdio.h>
+
+void libtest_subsmob_init (void);
+
+SCM subsmob_make_my_integer (SCM s_integer);
+SCM subsmob_make_my_double  (SCM s_double);
+SCM subsmob_make_my_wrapper (SCM smob);
+
+/* ------------------------------------------------------------ */
+
+#define MY_INTEGER_DATA(SMOB)	((my_integer_client_data_t *)SCM_SMOB_DATA(SMOB))
+#define MY_DOUBLE_DATA(SMOB)	((my_double_client_data_t  *)SCM_SMOB_DATA(SMOB))
+#define MY_WRAPPER_DATA(SMOB)	((my_wrapper_client_data_t *)SCM_SMOB_DATA(SMOB))
+
+/* ------------------------------------------------------------ */
+
+\f
+/** ------------------------------------------------------------
+ ** SMOB driver: my integer.
+ ** ----------------------------------------------------------*/
+
+typedef struct my_integer_client_data_t {
+  int	n;
+} my_integer_client_data_t;
+
+static size_t	my_integer_free		(SCM smob);
+static SCM	my_integer_equalp	(SCM smob_a, SCM smob_b);
+static int	my_integer_print	(SCM smob, SCM s_port, scm_print_state * pstate SCM_UNUSED);
+
+/* Here we use all the custom functions but mark. */
+static scm_t_sub_smob_descriptor my_integer_driver = {
+  .name			= "my-integer",
+  .client_data_size	= 0,
+  .free			= my_integer_free,
+  .equalp		= my_integer_equalp,
+  .mark			= NULL,
+  .print		= my_integer_print,
+  .class		= SCM_BOOL_F,
+  .list_of_supers	= SCM_EOL
+};
+
+/* ------------------------------------------------------------ */
+
+size_t
+my_integer_free (SCM smob)
+{
+  my_integer_client_data_t *	data = MY_INTEGER_DATA(smob);
+
+  scm_gc_free(data, sizeof(my_integer_client_data_t), my_integer_driver.name);
+  return 0;
+}
+SCM
+my_integer_equalp (SCM smob_a, SCM smob_b)
+{
+  int	a = MY_INTEGER_DATA(smob_a)->n;
+  int	b = MY_INTEGER_DATA(smob_b)->n;
+
+  return scm_from_bool(a == b);
+}
+static int
+my_integer_print (SCM smob, SCM s_port, scm_print_state * pstate SCM_UNUSED)
+{
+  scm_puts("#<", s_port);
+  scm_puts(my_integer_driver.name, s_port);
+  scm_puts(" - ", s_port);
+  scm_display(scm_from_int(MY_INTEGER_DATA(smob)->n), s_port);
+  scm_putc('>', s_port);
+  return 1;
+}
+
+/* ------------------------------------------------------------ */
+
+\f
+/** ------------------------------------------------------------
+ ** SMOB driver: my double.
+ ** ----------------------------------------------------------*/
+
+typedef struct my_double_client_data_t {
+  double	n;
+} my_double_client_data_t;
+
+/* Here we use all the default functions. */
+static scm_t_sub_smob_descriptor my_double_driver = {
+  .name			= "my-double",
+  .client_data_size	= sizeof(my_double_client_data_t),
+  .free			= NULL,
+  .equalp		= NULL,
+  .mark			= NULL,
+  .print		= NULL,
+  .class		= SCM_BOOL_F,
+  .list_of_supers	= SCM_EOL
+};
+
+/* ------------------------------------------------------------ */
+
+\f
+/** ------------------------------------------------------------
+ ** SMOB driver: wrapper.
+ ** ----------------------------------------------------------*/
+
+typedef struct my_wrapper_client_data_t {
+  SCM	wrapped;
+} my_wrapper_client_data_t;
+
+static size_t	my_wrapper_free		(SCM smob);
+static SCM	my_wrapper_equalp	(SCM smob_a, SCM smob_b);
+static SCM	my_wrapper_mark		(SCM smob);
+static int	my_wrapper_print	(SCM smob, SCM s_port, scm_print_state * pstate SCM_UNUSED);
+
+/* Here we use mark function, too. */
+static scm_t_sub_smob_descriptor my_wrapper_driver = {
+  .name			= "my-wrapper",
+  .client_data_size	= 0,
+  .free			= my_wrapper_free,
+  .equalp		= my_wrapper_equalp,
+  .mark			= my_wrapper_mark,
+  .print		= my_wrapper_print,
+  .class		= SCM_BOOL_F,
+  .list_of_supers	= SCM_EOL
+};
+
+/* ------------------------------------------------------------ */
+
+size_t
+my_wrapper_free (SCM smob)
+{
+  my_wrapper_client_data_t *	data = MY_WRAPPER_DATA(smob);
+
+  scm_gc_free(data, sizeof(my_wrapper_client_data_t), my_wrapper_driver.name);
+  return 0;
+}
+SCM
+my_wrapper_equalp (SCM smob_a, SCM smob_b)
+{
+  SCM	a = MY_WRAPPER_DATA(smob_a)->wrapped;
+  SCM	b = MY_WRAPPER_DATA(smob_b)->wrapped;
+
+  return scm_eq_p(a, b);
+}
+SCM
+my_wrapper_mark (SCM smob)
+{
+  SCM	x = MY_WRAPPER_DATA(smob)->wrapped;
+
+  scm_gc_mark(x);
+  return SCM_BOOL_T;
+}
+int
+my_wrapper_print (SCM smob, SCM s_port, scm_print_state * pstate SCM_UNUSED)
+{
+  scm_puts("#<", s_port);
+  scm_puts(my_wrapper_driver.name, s_port);
+  scm_puts(" - ", s_port);
+  scm_display(MY_WRAPPER_DATA(smob)->wrapped, s_port);
+  scm_putc('>', s_port);
+  return 1;
+}
+
+/* ------------------------------------------------------------ */
+
+\f
+/** ------------------------------------------------------------
+ ** SMOB makers.
+ ** ----------------------------------------------------------*/
+
+SCM_DEFINE(subsmob_make_my_integer, "make-my-integer",
+	   1, 0, 0, (SCM s_integer), "")
+{
+  my_integer_client_data_t *	data;
+
+  data = scm_gc_malloc(sizeof(my_integer_client_data_t), my_integer_driver.name);
+  data->n = scm_to_int(s_integer);
+  SCM_RETURN_NEWSUBSMOB(&my_integer_driver, data);
+}
+SCM_DEFINE(subsmob_make_my_double, "make-my-double",
+	   1, 0, 0, (SCM s_double), "")
+{
+  my_double_client_data_t *	data;
+
+  data = scm_gc_malloc(sizeof(my_double_client_data_t), my_double_driver.name);
+  data->n = scm_to_double(s_double);
+  SCM_RETURN_NEWSUBSMOB(&my_double_driver, data);
+}
+SCM_DEFINE(subsmob_make_my_wrapper, "make-my-wrapper",
+	   1, 0, 0, (SCM smob), "")
+{
+  my_wrapper_client_data_t *	data;
+
+  data = scm_gc_malloc(sizeof(my_wrapper_client_data_t), my_wrapper_driver.name);
+  data->wrapped = smob;
+  SCM_RETURN_NEWSUBSMOB(&my_wrapper_driver, data);
+}
+
+/* ------------------------------------------------------------ */
+
+\f
+/** ------------------------------------------------------------
+ ** Library initialisation.
+ ** ----------------------------------------------------------*/
+
+void
+libtest_subsmob_init (void)
+{
+  SCM	s_number_class;
+
+
+  s_number_class = scm_variable_ref(scm_c_lookup("<number>"));
+  my_integer_driver.list_of_supers = scm_permanent_object(scm_list_1(s_number_class));
+  my_double_driver.list_of_supers  = scm_permanent_object(scm_list_1(s_number_class));
+  /* The wrapper smob has no supers. */
+
+  scm_make_sub_smob_type(&my_integer_driver);
+  scm_make_sub_smob_type(&my_double_driver);
+  scm_make_sub_smob_type(&my_wrapper_driver);
+  
+  scm_c_define(my_integer_driver.name, my_integer_driver.class);
+  scm_c_define(my_double_driver.name,  my_double_driver.class);
+  scm_c_define(my_wrapper_driver.name, my_wrapper_driver.class);
+
+#ifndef SCM_MAGIC_SNARFER
+# include "test-subsmob-lib.x"
+#endif
+}
+
+/* end of file */

[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Andy Wingo]

Hi Marco,

What follows is a review by an ignorant individual!

On Tue 27 Nov 2007 07:57, "Marco Maggi" <marco.maggi-ipsu@poste.it> writes:

> The attached patch documents the creation of
> a GOOPS class whenever a new SMOB type is
> defined and GOOPS has been already loaded.

Excellent! Would be nice if the mime type of your patch were noted as
text. Anyway, this behavior is confusing, and it's nice that you're
documenting it.

+If GOOPS is loaded when @code{scm_make_smob_type} is invoked: a new

You probably wanted a comma there.

+A special smob type is implemented to overcome the 255 limit on the
+number of smob types. Its procedures dispatch the call to procedures
+referenced by a subsmob descriptor.

Sounds really byzantine. The tagging system has that aspect to it, yes,
but perhaps there's a point where the complexity is too much. Why
wouldn't you use structs or something, specializing allocate-instance in
GOOPS to give you some kind of structure that can hold a variable number
of raw machine words? That's probably a better foundation for wrapping
N > 255 C types.

Anyway, just a thought.

Cheers,

Andy
-- 
http://wingolog.org/


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Ludovic Courtès]

Hi,

Andy Wingo <wingo@pobox.com> writes:

> On Tue 27 Nov 2007 07:57, "Marco Maggi" <marco.maggi-ipsu@poste.it> writes:

> +A special smob type is implemented to overcome the 255 limit on the
> +number of smob types. Its procedures dispatch the call to procedures
> +referenced by a subsmob descriptor.
>
> Sounds really byzantine. The tagging system has that aspect to it, yes,
> but perhaps there's a point where the complexity is too much.

That was my reaction too.

I don't have any clear idea on how to solve it in the short term.  In
the longer term, my feeling is that we could have a Scheme-level FFI (in
the spirit of what Jon Wilson posted some time ago [0]) that would allow
the creation of subrs (aka. "primitive procedures") at run-time through
a simple API.  We'd have only one "SMOB" for opaque C pointers, which
bindings for C libraries would wrap in structs, records or classes to
provide the required type safety.

I reckon it doesn't help much in the short term, but I'm a bit wary
about adding more complexity to the thing.

Thanks,
Ludovic.

[0] http://article.gmane.org/gmane.lisp.guile.user/6062



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Andreas Rottmann]

ludo@gnu.org (Ludovic Courtès) writes:

> Hi,
>
> Andy Wingo <wingo@pobox.com> writes:
>
>> On Tue 27 Nov 2007 07:57, "Marco Maggi" <marco.maggi-ipsu@poste.it> writes:
>
>> +A special smob type is implemented to overcome the 255 limit on the
>> +number of smob types. Its procedures dispatch the call to procedures
>> +referenced by a subsmob descriptor.
>>
>> Sounds really byzantine. The tagging system has that aspect to it, yes,
>> but perhaps there's a point where the complexity is too much.
>
> That was my reaction too.
>
> I don't have any clear idea on how to solve it in the short term.  In
> the longer term, my feeling is that we could have a Scheme-level FFI (in
> the spirit of what Jon Wilson posted some time ago [0]) that would allow
> the creation of subrs (aka. "primitive procedures") at run-time through
> a simple API.
>
You should probably also have a look at the Scheme-Level FFI of PLT
Scheme[1], and my reimplementation for Scheme 48[2].

[...]
> [0] http://article.gmane.org/gmane.lisp.guile.user/6062

[1] http://download.plt-scheme.org/doc/371/html/foreign/
    http://repository.readscheme.org/ftp/papers/sw2004/barzilay.pdf
[2] http://download.gna.org/spells/darcs/s42/ scheme/ffi, c/ffi42.[hc]

HTH, Rotty
-- 
Andreas Rottmann         | Rotty@ICQ      | 118634484@ICQ | a.rottmann@gmx.at
http://rotty.uttx.net    | GnuPG Key: http://rotty.uttx.net/gpg.asc
Fingerprint              | C38A 39C5 16D7 B69F 33A3  6993 22C8 27F7 35A9 92E7
v2sw7MYChw5pr5OFma7u7Lw2m5g/l7Di6e6t5BSb7en6g3/5HZa2Xs6MSr1/2p7 hackerkey.com

Any technology not indistinguishable from magic is insufficiently advanced.
   -- Terry Pratchett


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Ludovic Courtès]

Hi Andreas,

Andreas Rottmann <a.rottmann@gmx.at> writes:

> You should probably also have a look at the Scheme-Level FFI of PLT
> Scheme[1], and my reimplementation for Scheme 48[2].

Thanks for the links, that's the kind of think I had in mind.  Perhaps
you'd like to port S42 to Guile as well?  :-)

BTW, there's one small potential issue with the dynamic construction of
function calls like this: it's almost impossible to catch API/ABI
inconsistencies beforehand.

For instance, if one wraps `strcmp' from Scheme as if it were, say,
"char *strcmp (int, double, float)", it's impossible to catch the
problem before actually calling the wrapped `strcmp'.  Symbol versioning
could help in some cases, but I don't think it's readily usable (and
probably not portably).  Conversely, good old C wrappers (be they
generated or not) would most likely catch such problems at
compilation-time.

Any thoughts about this?

Thanks,
Ludovic.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Klaus Schilling]

From: ludo@gnu.org (Ludovic Courtès)
Subject: Re: [patch] subordinate SMOBs with GOOPS superclasses
Date: Tue, 11 Dec 2007 16:02:37 +0100

> Hi Andreas,
> 
> Andreas Rottmann <a.rottmann@gmx.at> writes:
> 
> > You should probably also have a look at the Scheme-Level FFI of PLT
> > Scheme[1], and my reimplementation for Scheme 48[2].
> 
> Thanks for the links, that's the kind of think I had in mind.  Perhaps
> you'd like to port S42 to Guile as well?  :-)
> 
> BTW, there's one small potential issue with the dynamic construction of
> function calls like this: it's almost impossible to catch API/ABI
> inconsistencies beforehand.

this makes the whole FFI stuff absurd.
There's absolutely no alternative to an elaborate C API
as guile's, and hand-written library wrappers.

   Klaus Schilling


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Neil Jerram]

ludo@gnu.org (Ludovic Courtès) writes:

> Hi Andreas,
>
> Andreas Rottmann <a.rottmann@gmx.at> writes:
>
>> You should probably also have a look at the Scheme-Level FFI of PLT
>> Scheme[1], and my reimplementation for Scheme 48[2].
>
> Thanks for the links, that's the kind of think I had in mind.  Perhaps
> you'd like to port S42 to Guile as well?  :-)

From a _very_ quick look, my impression is that the PLT FFI is about
equivalent in complexity and function to what the code generation side
of G-Wrap provides.

If that's correct, then the key practical difference is that G-Wrap
does everything at build/compile time, where PLT FFI does everything
at runtime -- in which case, surely G-Wrap is the better option?

Regards,
        Neil



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Clinton Ebadi]

Neil Jerram <neil@ossau.uklinux.net> writes:

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Hi Andreas,
>>
>> Andreas Rottmann <a.rottmann@gmx.at> writes:
>>
>>> You should probably also have a look at the Scheme-Level FFI of PLT
>>> Scheme[1], and my reimplementation for Scheme 48[2].
>>
>> Thanks for the links, that's the kind of think I had in mind.  Perhaps
>> you'd like to port S42 to Guile as well?  :-)
>
> From a _very_ quick look, my impression is that the PLT FFI is about
> equivalent in complexity and function to what the code generation side
> of G-Wrap provides.
>
> If that's correct, then the key practical difference is that G-Wrap
> does everything at build/compile time, where PLT FFI does everything
> at runtime -- in which case, surely G-Wrap is the better option?

I think doing things at runtime is a better idea--it fits more with
the interactive compile-one-expression-at-a-time nature of Lisp. 

UFFI and CFFI in the Common Lisp world work this way, and generally
bindings to C libraries are solid. There may be an increased risk of
crashing the system during the initial development stage, but once
speced out the data type specifications rarely change. Any strange
issues that occur when interfacing with C this way should also be
trappable and transformed into a Guile exception that could be caught
and not abort the entire system. At least in SBCL it takes a lot of
abuse before a C library can crash anything.

Perhaps G-Wrap could be modified to work at runtime? A few utilities
from it would be of general use--e.g. the sublanguage for specifying
the layout of C structs could be used for generating high level
interfaces to network protocols without painful manual munging or
resorting to C.

-- 
          Who will tend the garden when the snake swallows the light?          
         Who will eat the decay when the worms have lost their sight?          
           Who will rape the weak when there's nothing left to gain?           
             Who will till the soil of these barren black remains?             


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Klaus Schilling]

From: Clinton Ebadi <clinton@unknownlamer.org>
Subject: Re: [patch] subordinate SMOBs with GOOPS superclasses
Date: Wed, 12 Dec 2007 15:38:03 -0500
> and not abort the entire system. At least in SBCL it takes a lot of
> abuse before a C library can crash anything.

That's completely illicit, as SBCL 
 is of no use whatsoever as an embeddable extension library.

    Klaus Schilling


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Ludovic Courtès]

Hi,

Neil Jerram <neil@ossau.uklinux.net> writes:

> From a _very_ quick look, my impression is that the PLT FFI is about
> equivalent in complexity and function to what the code generation side
> of G-Wrap provides.
>
> If that's correct, then the key practical difference is that G-Wrap
> does everything at build/compile time, where PLT FFI does everything
> at runtime -- in which case, surely G-Wrap is the better option?

I don't know about the complexity of PLT's FFI, but I do know about that
of G-Wrap.  ;-)

First, code generation in G-Wrap is complex (spread over a number of
places, each of which as to be somewhat aware of what the others do) and
fragile too.  Second, to accommodate different use cases, such as
different memory management schemes, G-Wrap has to build in a lot of
tricks: the `caller-owned', `callee-owned' and `aggregated' typespecs,
not to mention `out' arguments.  All these contribute to the code
generation complexity.

With a Scheme-level FFI, you could implement these semantics (and
possibly others) in Scheme.  For example, `caller-owned' and
`callee-owned' are easily handled by calling libc's `strdup' et al. or
whatever it takes to do the right thing.  The `aggregated' typespec can
be achieved using guardians, for instance.  The FFI could simply provide
a "C pointer" SMOB; typing can then be done by the bindings themselves,
e.g., by wrapping C pointers into structs of whatever.

This way, the FFI would only provide basic mechanisms, on top of which a
variety of bindings can be implemented in Scheme.

Thanks,
Ludovic.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Ludovic Courtès]

Hi,

Clinton Ebadi <clinton@unknownlamer.org> writes:

> Perhaps G-Wrap could be modified to work at runtime? A few utilities
> from it would be of general use--e.g. the sublanguage for specifying
> the layout of C structs could be used for generating high level
> interfaces to network protocols without painful manual munging or
> resorting to C.

Actually, G-Wrap already does a number of things at run-time: it
maintains a run-time representation of wrapped types and functions and
constructs functions calls with `libffi' when that is possible.

However, it does so *in addition* to what it does at compile-time.  So
you get the worst of both worlds: compile-time complexity, and added
run-time dependency and overhead.  ;-)

Thanks,
Ludovic.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: [patch] subordinate SMOBs with GOOPS superclasses

[Kjetil S. Matheussen]

[-- Attachment #1: Type: TEXT/PLAIN, Size: 2676 bytes --]


Clinton Ebadi:
>
> Neil Jerram <neil@ossau.uklinux.net> writes:
>
>> ludo@gnu.org (Ludovic Courtès) writes:
>>
>>> Hi Andreas,
>>>
>>> Andreas Rottmann <a.rottmann@gmx.at> writes:
>>>
>>>> You should probably also have a look at the Scheme-Level FFI of PLT
>>>> Scheme[1], and my reimplementation for Scheme 48[2].
>>>
>>> Thanks for the links, that's the kind of think I had in mind.  Perhaps
>>> you'd like to port S42 to Guile as well?  :-)
>>
>> From a _very_ quick look, my impression is that the PLT FFI is about
>> equivalent in complexity and function to what the code generation side
>> of G-Wrap provides.
>>
>> If that's correct, then the key practical difference is that G-Wrap
>> does everything at build/compile time, where PLT FFI does everything
>> at runtime -- in which case, surely G-Wrap is the better option?
>
> I think doing things at runtime is a better idea--it fits more with
> the interactive compile-one-expression-at-a-time nature of Lisp.
>
> UFFI and CFFI in the Common Lisp world work this way, and generally
> bindings to C libraries are solid. There may be an increased risk of
> crashing the system during the initial development stage, but once
> speced out the data type specifications rarely change. Any strange
> issues that occur when interfacing with C this way should also be
> trappable and transformed into a Guile exception that could be caught
> and not abort the entire system. At least in SBCL it takes a lot of
> abuse before a C library can crash anything.
>
> Perhaps G-Wrap could be modified to work at runtime? A few utilities
> from it would be of general use--e.g. the sublanguage for specifying
> the layout of C structs could be used for generating high level
> interfaces to network protocols without painful manual munging or
> resorting to C.

Its not quite the same thing, but eval-c works at runtime,
and perhaps some tips can be picked up from its code:

(load "eval-c.scm")
(eval-c "-lgmp"
 	"#include <gmp.h>"
 	(proto->public
 	 "void mpz_init (mpz_t integer);"
 	 "void mpz_set_ui (mpz_t rop, unsigned long op);"
 	 "void mpz_add (mpz_t rop, mpz_t op1, mpz_t op2);"
          "unsigned long mpz_get_ui (mpz_t op);")
 	(public
 	 (<mpz_t-*> new-mpz (lambda ()
 			      (return (calloc 1 (sizeof <mpz_t>)))))
 	 (<void> delete-mpz (lambda ((<mpz_t> var))
 			      (free var)))))

(let ((a (new-mpz))
       (b (new-mpz)))
   (mpz_init a)
   (mpz_init b)
   (mpz_set_ui a 50)
   (mpz_set_ui b 60)
   (mpz_add a a b)
   (let ((res (mpz_get_ui a)))
     (delete-mpz a)
     (delete-mpz b)
     res))
=> 110


Code at http://snd.sf.net

[-- Attachment #2: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel