user_data-style closures from c

user_data-style closures from c

[William Morgan]

Dear all,

As Marius and others have suggested, I've been looking into applicable
smobs as a way to implement a simple user_data-style C "closure"
mechanism.

Here is the simplest thing I could come up with:

--- cut here ---
#include <libguile.h>

static
SCM
cclosure_smob_equalp (SCM a,
		      SCM b)
{
  return (SCM_SMOB_DATA(a) == SCM_SMOB_DATA(b) ? SCM_BOOL_T : SCM_BOOL_F);
}

scm_t_bits
make_cclosure_func (SCM (*func) (),
		    unsigned int req,
		    unsigned int opt,
		    unsigned int rst,
		    SCM (*mark) (SCM),
		    size_t (*free) (SCM))
{
  scm_t_bits smob_tag = scm_make_smob_type("cclosure", sizeof(void*));
  
  if(free) scm_set_smob_free(smob_tag, free);
  if(mark) scm_set_smob_mark(smob_tag, mark);
  scm_set_smob_equalp(smob_tag, cclosure_smob_equalp);
  scm_set_smob_apply(smob_tag, func, req, opt, rst);
  
  return smob_tag;
}

SCM
make_cclosure (scm_t_bits tag,
	       void* user_data)
{
  SCM_RETURN_NEWSMOB(tag, user_data);
}
--- cut here ---

I have attached (inline) a .c file which uses this in a small example.
Please let me know what you think.

The biggest drawback that I see so far of this approach is that the C function
is not passed a straight void*, but rather a SMOB which it must unwrap.
But maybe this is not such a big issue, and certainly it seems like
changing that would require much more code.

I look forward to your comments.

--- cut here ---
#include <stdio.h>
#include <libguile.h>

/* c closure-making functions */

static
SCM
cclosure_smob_equalp (SCM a,
		      SCM b)
{
  return (SCM_SMOB_DATA(a) == SCM_SMOB_DATA(b) ? SCM_BOOL_T : SCM_BOOL_F);
}

scm_t_bits
make_cclosure_func (SCM (*func) (),
		    unsigned int req,
		    unsigned int opt,
		    unsigned int rst,
		    SCM (*mark) (SCM),
		    size_t (*free) (SCM))
{
  scm_t_bits smob_tag = scm_make_smob_type("cclosure", sizeof(void*));
  
  if(free) scm_set_smob_free(smob_tag, free);
  if(mark) scm_set_smob_mark(smob_tag, mark);
  scm_set_smob_equalp(smob_tag, cclosure_smob_equalp);
  scm_set_smob_apply(smob_tag, func, req, opt, rst);
  
  return smob_tag;
}

SCM
make_cclosure (scm_t_bits tag,
	       void* user_data)
{
  SCM_RETURN_NEWSMOB(tag, user_data);
}

/* that was it. now, for the example code that uses these, i will make an
   amazing object: a vport that prints out to stderr the exact number of
   bytes that have been printed, at each output call. */

struct counting_port_data {
  int count;
  SCM port;
};

static
SCM
counting_port_output_char (SCM s_pdata,
			   SCM s_c)
#define FUNC_NAME "counting-port-output-char"
{
  char c;
  struct counting_port_data* pdata;

  SCM_VALIDATE_CHAR_COPY(2, s_c, c);
  pdata = (struct counting_port_data*)SCM_SMOB_DATA(s_pdata);

  pdata->count++;
  scm_putc(c, pdata->port);

  fprintf(stderr, "wrote 1 byte\n");
  return SCM_BOOL_T;
}
#undef FUNC_NAME

static
SCM
counting_port_output_string (SCM s_pdata,
			     SCM s_string)
#define FUNC_NAME "couting-port-output-string"
{
  char* string;
  struct counting_port_data* pdata;
  int len;

  SCM_VALIDATE_STRING_COPY(2, s_string, string);
  pdata = (struct counting_port_data*)SCM_SMOB_DATA(s_pdata);
  len = strlen(string);

  pdata->count += len;
  scm_puts(string, pdata->port);

  fprintf(stderr, "wrote %d bytes\n", len);
  return SCM_BOOL_T;
}
#undef FUNC_NAME

static
SCM
counting_port_mark (SCM user_data) {
  struct counting_port_data* pdata = (struct counting_port_data*)SCM_SMOB_DATA(user_data);
  
  scm_gc_mark(pdata->port);

  return SCM_BOOL_F;
}

static
size_t
counting_port_free (SCM user_data) {
  struct counting_port_data* pdata = (struct counting_port_data*)SCM_SMOB_DATA(user_data);
  
  fprintf(stderr, "freeing port data at %p\n", pdata);
  free(pdata);

  return 0;
}

SCM_DEFINE(make_counting_port, "make-counting-port", 1, 0, 0, (SCM port),
           "Makes a counting output port from another output port.")
#define FUNC_NAME "make-counting-port"
{
  SCM vec = scm_c_make_vector(5, SCM_BOOL_F);
  struct counting_port_data* pdata;

  SCM_VALIDATE_PORT(1, port);

  pdata = (struct counting_port_data*)malloc(sizeof(struct counting_port_data));
  pdata->count = 0;
  pdata->port = port;
    
  scm_vector_set_x(vec,
		   scm_uint2num(0),
		   make_cclosure(make_cclosure_func(counting_port_output_char,
						    1, 0, 0,
						    counting_port_mark,
						    counting_port_free),
				 pdata));
  scm_vector_set_x(vec,
		   scm_uint2num(1),
		   make_cclosure(make_cclosure_func(counting_port_output_string,
						    1, 0, 0,
						    counting_port_mark,
						    NULL), /* wouldn't
							      want to
							      free the
							      same
							      thing
							      twice. */
				 pdata));

  return scm_make_soft_port(vec, scm_mem2string("w", 1));
}
#undef FUNC_NAME

void real_main(void *closure, int argc, char** argv) {
#include "test.x"
  scm_shell(argc, argv);
}

int main(int argc, char* argv[]) {
  scm_boot_guile(argc, argv, real_main, NULL);
  return 0; /* never reached */
}

--- cut here ---

-- 
William <wmorgan-guile@masanjin.net>


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