commit cf5e22d

Evaluate user defined functions, add expl context struct

  1@@ -14,6 +14,11 @@ typedef struct function function;
  2 typedef struct environment environment;
  3 typedef struct parser parser;
  4 
  5+struct expl {
  6+	environment* env;
  7+	expl_node*   programs;
  8+};
  9+
 10 struct function {
 11 	expl_native native;
 12 	expl_node*  args;
 13@@ -40,6 +45,8 @@ static expl_node* value(parser* p, expl_type type);
 14 
 15 static expl_value eval(expl_node* n, environment** env);
 16 static expl_value eval_call(expl_node* args, environment** env);
 17+static expl_value eval_fn(expl_node* args, environment** env);
 18+static expl_value eval_user(function* f, int argc, expl_value* argv, environment** env);
 19 static int register_native(environment** env, const char* name, expl_native fn);
 20 
 21 static void skip_space(parser* p);
 22@@ -50,6 +57,25 @@ static expl_node* new_node(expl_type type);
 23 static void free_node(expl_node* node);
 24 static void free_environment(environment* env);
 25 
 26+static expl_value
 27+add(int argc, const expl_value* argv)
 28+{
 29+	expl_value result = { 0 };
 30+	expl_value fail = { 0 };
 31+	int i;
 32+
 33+	result.type = EXPL_VALUE_NUMBER;
 34+
 35+	for (i = 0; i < argc; i++) {
 36+		if (argv[i].type != EXPL_VALUE_NUMBER)
 37+			return fail;
 38+
 39+		result.as.number += argv[i].as.number;
 40+	}
 41+
 42+	return result;
 43+}
 44+
 45 static int
 46 define(environment** env, const char* name, expl_value value)
 47 {
 48@@ -237,35 +263,109 @@ eval_call(expl_node* n, environment** env)
 49 	expl_value* fn = NULL;
 50 	expl_value* argv = NULL;
 51 	expl_node* arg = NULL;
 52+	function* f = NULL;
 53 	int argc = 0;
 54+	int i = 0;
 55 
 56 	if (!n->child || n->child->type != EXPL_TYPE_ATOM)
 57 		return result;
 58+	
 59+	/* defined function */
 60+	if (!strcmp(n->child->value, "fn"))
 61+		return eval_fn(n->child->next, env);	
 62 
 63 	fn = lookup(*env, n->child->value);
 64 	if (!fn || fn->type != EXPL_VALUE_FUNCTION)
 65 		return result;
 66 
 67-	/* count args */
 68 	for (arg = n->child->next; arg; arg = arg->next)
 69 		argc++;
 70 
 71-	argv = argc ? malloc(argc * sizeof(*argv)) : NULL;
 72-	if (argc && !argv)
 73-		return result;
 74+	/* allocate argv */
 75+	if (argc) {
 76+		argv = malloc(argc * sizeof(*argv));
 77+		if (!argv)
 78+			return result;
 79+	}
 80 
 81-	argc = 0;
 82+	/* evaluate arguments */
 83 	for (arg = n->child->next; arg; arg = arg->next)
 84-		argv[argc++] = eval(arg, env);
 85+		argv[i++] = eval(arg, env);
 86 
 87-	/* call native fn if it exists */
 88-	if (((function*)fn->as.function)->native)
 89-		result = ((function*)fn->as.function)->native(argc, argv);
 90+	/* call */
 91+	f = fn->as.function;
 92+	if (f->native)
 93+		result = f->native(argc, argv);
 94+	else
 95+		result = eval_user(f, argc, argv, env);
 96 
 97 	free(argv);
 98 	return result;
 99 }
100 
101+static expl_value
102+eval_fn(expl_node* args, environment** env)
103+{
104+	expl_value result = { 0 };
105+	expl_node* name = NULL;
106+	function* f = NULL;
107+
108+	name = args;
109+	if (!name || name->type != EXPL_TYPE_ATOM ||
110+	    !name->next || !name->next->next ||
111+	    name->next->type != EXPL_TYPE_LIST)
112+		return result;
113+
114+	f = malloc(sizeof(*f));
115+	if (!f)
116+		return result;
117+
118+	f->native = NULL;
119+	f->args = name->next->child;
120+	f->body = name->next->next;
121+
122+	result.type = EXPL_VALUE_FUNCTION;
123+	result.as.function = f;
124+
125+	if (!define(env, name->value, result)) {
126+		free(f);
127+		result.type = EXPL_VALUE_NIL;
128+	}
129+
130+	return result;
131+}
132+
133+static expl_value
134+eval_user(function* f, int argc, expl_value* argv, environment** env)
135+{
136+	environment* local = *env;
137+	expl_node* param = f->args;
138+	environment* next = NULL;
139+	expl_node* body = NULL;
140+	expl_value result = { 0 };
141+	int i;
142+
143+	for (i = 0; i < argc && param; i++) {
144+		if (!define(&local, param->value, argv[i]))
145+			break;
146+		param = param->next;
147+	}
148+
149+	if (i == argc && !param) {
150+		for (body = f->body; body; body = body->next)
151+			result = eval(body, &local);
152+	}
153+
154+	while (local != *env) {
155+		next = local->next;
156+		free(local->name);
157+		free(local);
158+		local = next;
159+	}
160+
161+	return result;
162+}
163+
164 static int
165 register_native(environment** env, const char* name, expl_native fn)
166 {
167@@ -393,6 +493,12 @@ free_environment(environment* env)
168 	}
169 }
170 
171+expl* expl_init(void);
172+void expl_close(expl* ctx);
173+int expl_register(expl* ctx, const char* name, expl_native fn);
174+expl_value expl_run(expl* ctx, const char* source);
175+void expl_print(const expl_node* node, int depth);
176+
177 expl_node*
178 expl_parse(const char* source)
179 {
180@@ -451,9 +557,24 @@ expl_print(const expl_node* node, int depth)
181 int
182 main(void)
183 {
184-	expl_node* node = expl_parse("(fn square (x \"hi\") (* x x))");
185-	expl_print(node, 0);
186-	free_node(node);
187+	environment* env = NULL;
188+	expl_node* program = NULL;
189+	expl_node* n = NULL;
190+	expl_value result = { 0 };
191+
192+	if (!register_native(&env, "+", add))
193+		return EXIT_FAILURE;
194+
195+	program = expl_parse(
196+		"(fn add (x y) (+ x y))\n"
197+		"(add 10 20)"
198+	);
199+
200+	for (n = program; n; n = n->next)
201+		result = eval(n, &env);
202+
203+	printf("%g\n", result.as.number);
204+
205 	return EXIT_SUCCESS;
206 }
207 #endif

 1@@ -35,6 +35,7 @@ typedef enum {
 2 
 3 typedef struct expl_node expl_node;
 4 typedef struct expl_value expl_value;
 5+typedef struct expl expl;
 6 
 7 typedef expl_value (*expl_native)(int argc, const expl_value* argv);
 8 
 9@@ -54,8 +55,11 @@ struct expl_value {
10 	} as;
11 };
12 
13+expl* expl_init(void);
14+void expl_close(expl* ctx);
15+int expl_register(expl* ctx, const char* name, expl_native fn);
16+expl_value expl_run(expl* ctx, const char* source);
17 void expl_print(const expl_node* node, int depth);
18-expl_node* expl_parse(const char* source);
19 
20 #endif /* EXPL_H */
21