racket/collects/mzscheme/examples/makeadder.c
2005-05-27 18:56:37 +00:00

66 lines
1.7 KiB
C

/*
Defines make-adder:
(define (make-adder n)
(lambda (m) (+ m n)))
which illustrates closure-creation, looking up Scheme
definitions, and calling Scheme procedures from C.
*/
#include "escheme.h"
/* The inner lambda, which must close over `n'. A closure function is
like a regular Scheme-procedure function, except that it takes an
extra argument containing the closure data. The closre data can be
any format that we want. */
static Scheme_Object *sch_inner(void *closure_data, int argc, Scheme_Object **argv)
{
/* We only close over one value, so our closure data reprsentation
is just thaht value: */
Scheme_Object *n = (Scheme_Object *)closure_data;
Scheme_Object *plus;
Scheme_Object *a[2];
plus = scheme_lookup_global(scheme_intern_symbol("+"),
scheme_get_env(NULL));
/* return the result of summing m and n: */
a[0] = n;
a[1] = argv[0]; /* m */
return _scheme_apply(plus, 2, a);
/* Actually, that's not quite right. In the Scheme code, (+ m n) is
a tail call. The following would be better:
return _scheme_tail_apply(plus, 2, a); */
}
static Scheme_Object *sch_make_adder(int argc, Scheme_Object **argv)
{
return scheme_make_closed_prim_w_arity(sch_inner,
argv[0],
"adder",
1, 1);
}
Scheme_Object *scheme_reload(Scheme_Env *env)
{
scheme_add_global("make-adder",
scheme_make_prim_w_arity(sch_make_adder,
"make-adder",
1, 1),
env);
return scheme_void;
}
Scheme_Object *scheme_initialize(Scheme_Env *env)
{
/* First load is same as every load: */
return scheme_reload(env);
}
Scheme_Object *scheme_module_name()
{
/* This extension doesn't define a module: */
return scheme_false;
}