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
*/
_______________________________________________
Cmdist mailing list
Cmdist@ccrma.stanford.edu
https://cm-mail.stanford.edu/mailman/listinfo/cmdist
