(#345) Enclose native functions with custom parameters

diff --git a/src/script/builtins.c b/src/script/builtins.c
index 3d445792a00eca39c8a80da8cc13a0f6d62d9882..a60792bcc3431b6ab911451bd23cd6b65e81e527 100644 (file)
--- a/src/script/builtins.c
+++ b/src/script/builtins.c
@@ -26,7 +26,8 @@ static bool equal_atoms(struct Atom *atom1, struct Atom *atom2)
         return strcmp(atom1->str, atom2->str) == 0;
 
     case ATOM_NATIVE:
-        return atom1->fun == atom2->fun;
+        return atom1->native.fun == atom2->native.fun
+            && atom1->native.param == atom2->native.param;
     }
 
     return false;

diff --git a/src/script/expr.c b/src/script/expr.c
index 620ddd8e1978b79a4ec98e188d8685c88cc4ff8b..021138dcfc7e02e783fdce35d462b5396bd23ee8 100644 (file)
--- a/src/script/expr.c
+++ b/src/script/expr.c
@@ -240,7 +240,7 @@ error:
     return NULL;
 }
 
-struct Atom *create_native_atom(Gc *gc, NativeFunction fun)
+struct Atom *create_native_atom(Gc *gc, NativeFunction fun, void *param)
 {
     struct Atom *atom = malloc(sizeof(struct Atom));
 
@@ -249,7 +249,8 @@ struct Atom *create_native_atom(Gc *gc, NativeFunction fun)
     }
 
     atom->type = ATOM_NATIVE;
-    atom->fun = fun;
+    atom->native.fun = fun;
+    atom->native.param = param;
 
     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
         goto error;

diff --git a/src/script/expr.h b/src/script/expr.h
index 73812e3bee9fa3071d4c3b0aca9295dcbdbd2a31..7c64f07d9174497b8dcadc348db0d8abb57f6946 100644 (file)
--- a/src/script/expr.h
+++ b/src/script/expr.h
@@ -13,7 +13,7 @@ struct Atom;
 #define NUMBER(G, X) atom_as_expr(create_number_atom(G, X))
 #define STRING(G, S) atom_as_expr(create_string_atom(G, S, NULL))
 #define SYMBOL(G, S) atom_as_expr(create_symbol_atom(G, S, NULL))
-#define NATIVE(G, F) atom_as_expr(create_native_atom(G, F))
+#define NATIVE(G, F, P) atom_as_expr(create_native_atom(G, F, P))
 #define CONS(G, CAR, CDR) cons_as_expr(create_cons(G, CAR, CDR))
 #define NIL(G) SYMBOL(G, "nil")
 
@@ -47,8 +47,15 @@ struct EvalResult
     struct Expr expr;
 };
 
+
 typedef struct EvalResult (*NativeFunction)(void *param, Gc *gc, struct Scope *scope, struct Expr args);
 
+struct Native
+{
+    NativeFunction fun;
+    void *param;
+};
+
 enum AtomType
 {
     ATOM_SYMBOL = 0,
@@ -66,14 +73,14 @@ struct Atom
         long int num;           // ATOM_NUMBER
         char *sym;              // ATOM_SYMBOL
         char *str;              // ATOM_STRING
-        NativeFunction fun;     // ATOM_NATIVE
+        struct Native native;   // ATOM_NATIVE
     };
 };
 
 struct Atom *create_number_atom(Gc *gc, long int num);
 struct Atom *create_string_atom(Gc *gc, const char *str, const char *str_end);
 struct Atom *create_symbol_atom(Gc *gc, const char *sym, const char *sym_end);
-struct Atom *create_native_atom(Gc *gc, NativeFunction fun);
+struct Atom *create_native_atom(Gc *gc, NativeFunction fun, void *param);
 void destroy_atom(struct Atom *atom);
 void print_atom_as_sexpr(struct Atom *atom);
 

diff --git a/src/script/interpreter.c b/src/script/interpreter.c
index c9dccc3657cad64aba51b36a9c3cbeb5723919ee..b67382ddf53649e01d0395edec92e13065522918 100644 (file)
--- a/src/script/interpreter.c
+++ b/src/script/interpreter.c
@@ -175,7 +175,7 @@ static struct EvalResult call_callable(Gc *gc,
                                        struct Expr callable,
                                        struct Expr args) {
     if (callable.type == EXPR_ATOM && callable.atom->type == ATOM_NATIVE) {
-        return ((NativeFunction)callable.atom->fun)((void*)((long int) callable.atom->fun), gc, scope, args);
+        return ((NativeFunction)callable.atom->native.fun)(callable.atom->native.param, gc, scope, args);
     }
 
     return call_lambda(gc, scope, callable, args);

diff --git a/src/script/repl.c b/src/script/repl.c
index 437b9383ccca48d3828f73f2846957d12b9ff4e2..2e794bbc745efe7e5d2521604cc5df7b428c6aa8 100644 (file)
--- a/src/script/repl.c
+++ b/src/script/repl.c
@@ -31,7 +31,7 @@ int main(int argc, char *argv[])
         .expr = CONS(gc, NIL(gc), NIL(gc))
     };
 
-    set_scope_value(gc, &scope, SYMBOL(gc, "quit"), NATIVE(gc, quit));
+    set_scope_value(gc, &scope, SYMBOL(gc, "quit"), NATIVE(gc, quit, NULL));
 
     while (true) {
         printf("> ");