[CM] s7 C functions and environments

[bil at ccrma.Stanford.EDU]

Here's an idea:

/* tfunc.c */
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "s7.h"

s7_pointer g_f(s7_scheme *sc, s7_pointer args) /* (f f 12) */
{
   s7_pointer let = s7_function_let(sc, s7_car(args));
   s7_pointer x = s7_symbol_local_value(sc, s7_make_symbol(sc, "x"), 
let);
   return(s7_make_integer(sc, s7_integer(x) + 
s7_integer(s7_cadr(args))));
}

s7_pointer make_f(s7_scheme *sc, s7_pointer args) /* (make-f 1) */
{
   s7_pointer let = s7_sublet(sc, s7_curlet(sc), s7_nil(sc));
   s7_pointer old_curlet = s7_set_curlet(sc, let);
   s7_define(sc, let, s7_make_symbol(sc, "x"), s7_car(args));
   s7_pointer f = s7_make_typed_function_with_environment(sc, NULL, g_f, 
2, 0, false, "f", NULL, let);
   s7_set_curlet(sc, old_curlet);
   return(f);
}

int main(int argc, char **argv)
{
   char buffer[512];
   char response[1024];
   s7_scheme *s7 = s7_init();
   s7_define_function(s7, "make-f", make_f, 1, 0, false, NULL);
   while (1)
     {
       fprintf(stdout, "\n> ");
       fgets(buffer, 512, stdin);
       if ((buffer[0] != '\n') ||
	  (strlen(buffer) > 1))
	{
	  sprintf(response, "(write %s)", buffer);
	  s7_eval_c_string(s7, response);
	}}
}

/*
The "g_f" function called in C has no idea which value returned by 
make-f is calling it.
So we can get around that by passing it as an argument ("self"?):

gcc tfunc.c -o tfunc -I. -g3 s7.o -ldl -lm -Wl,-export-dynamic

tfunc
> (define f1 (make-f 1))
#<c-function> ; NULL as name above = anonymous function
> (define f2 (make-f 2))
#<c-function>
> (f1 f1 3)
4
> (f2 f2 3)
5
*/