From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: William Morgan Newsgroups: gmane.lisp.guile.devel Subject: user_data-style closures from c Date: Sat, 8 Feb 2003 11:07:50 -0500 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <20030208160750.GC32411@masanjin.net> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1044720228 27860 80.91.224.249 (8 Feb 2003 16:03:48 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sat, 8 Feb 2003 16:03:48 +0000 (UTC) Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 18hXSC-0007F5-00 for ; Sat, 08 Feb 2003 17:03:44 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 18hXTF-0000Lz-03 for guile-devel@m.gmane.org; Sat, 08 Feb 2003 11:04:49 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10.13) id 18hXT1-0000JE-00 for guile-devel@gnu.org; Sat, 08 Feb 2003 11:04:35 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10.13) id 18hXSz-0000FO-00 for guile-devel@gnu.org; Sat, 08 Feb 2003 11:04:34 -0500 Original-Received: from rwcrmhc53.attbi.com ([204.127.198.39]) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 18hXSy-0000BH-00 for guile-devel@gnu.org; Sat, 08 Feb 2003 11:04:33 -0500 Original-Received: from lux (h0060976e2b56.ne.client2.attbi.com[65.96.180.211]) by rwcrmhc53.attbi.com (rwcrmhc53) with ESMTP id <2003020816043105300q5pnqe>; Sat, 8 Feb 2003 16:04:31 +0000 Original-Received: from wmorgan by lux with local (Exim 3.35 #1 (Debian)) id 18hXWB-0000qE-00 for ; Sat, 08 Feb 2003 11:07:51 -0500 Original-To: guile-devel@gnu.org Mail-Followup-To: guile-devel@gnu.org Content-Disposition: inline User-Agent: Mutt/1.4i X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1b5 Precedence: list List-Id: Developers list for Guile, the GNU extensibility library List-Help: List-Post: List-Subscribe: , List-Archive: List-Unsubscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:1902 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:1902 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 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 #include /* 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 _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel