Back to index

plt-scheme  4.2.1
makeadder.c
Go to the documentation of this file.
00001 /* 
00002    Defines make-adder:
00003      (define (make-adder n)
00004        (lambda (m) (+ m n)))
00005    which illustrates closure-creation, looking up Scheme
00006    definitions, and calling Scheme procedures from C.
00007 */
00008 
00009 #include "escheme.h"
00010 
00011 /* The inner lambda, which must close over `n'. A closure function is
00012    like a regular Scheme-procedure function, except that it takes an
00013    extra argument containing the closure data. The closre data can be
00014    any format that we want. */
00015 static Scheme_Object *sch_inner(void *closure_data, int argc, Scheme_Object **argv)
00016 {
00017   /* We only close over one value, so our closure data reprsentation
00018      is just thaht value: */
00019   Scheme_Object *n = (Scheme_Object *)closure_data;
00020   Scheme_Object *plus;
00021   Scheme_Object *a[2];
00022 
00023   plus = scheme_lookup_global(scheme_intern_symbol("+"), 
00024                            scheme_get_env(NULL));
00025 
00026   /* return the result of summing m and n: */
00027   a[0] = n;
00028   a[1] = argv[0]; /* m */
00029   return _scheme_apply(plus, 2, a); 
00030 
00031   /* Actually, that's not quite right. In the Scheme code, (+ m n) is
00032      a tail call. The following would be better:
00033      return _scheme_tail_apply(plus, 2, a); */
00034 }
00035 
00036 static Scheme_Object *sch_make_adder(int argc, Scheme_Object **argv)
00037 {
00038   return scheme_make_closed_prim_w_arity(sch_inner,
00039                                     argv[0],
00040                                     "adder",
00041                                     1, 1);
00042 }
00043 
00044 Scheme_Object *scheme_reload(Scheme_Env *env)
00045 {
00046   scheme_add_global("make-adder",
00047                   scheme_make_prim_w_arity(sch_make_adder,
00048                                         "make-adder", 
00049                                         1, 1),
00050                   env);
00051 
00052   return scheme_void;
00053 }
00054 
00055 Scheme_Object *scheme_initialize(Scheme_Env *env)
00056 {
00057   /* First load is same as every load: */
00058   return scheme_reload(env);
00059 }
00060 
00061 Scheme_Object *scheme_module_name()
00062 {
00063   /* This extension doesn't define a module: */
00064   return scheme_false;
00065 }