Implement if, for, map, filter

author: Přemysl Janouch <p.janouch@gmail.com> 2017-05-20 21:24:11 +0200
committer: Přemysl Janouch <p.janouch@gmail.com> 2017-05-21 13:19:47 +0200
commit: d2155031d07a44e33ee229178a3a73d2408a5098 (patch)
tree: aeb237aff54251af71bcae5a9e9819b3e8c4b851
parent: f0337aa4819df5ef097837dc02e9a4746da79467 (diff)
download: ell-d2155031d07a44e33ee229178a3a73d2408a5098.tar.gz
ell-d2155031d07a44e33ee229178a3a73d2408a5098.tar.xz
ell-d2155031d07a44e33ee229178a3a73d2408a5098.zip
2 files changed, 185 insertions, 37 deletions
diff --git a/README.adoc b/README.adoc
index 376edfc..e1b663c 100644
--- a/README.adoc
+++ b/README.adoc
@@ -10,6 +10,8 @@ reasonably comfortable to use.
 This package is an implementation of said language, meant to be self-contained,
 portable and reusable.  Performance is specifically not an intent.
 
+The project is currently in a "working proof of concept" stage.
+
 Syntax
 ------
 Owing to its Scheme heritage, 'ell' is homoiconic, that is a program can be
@@ -70,17 +72,37 @@ from the outer scope.
 
 Standard library
 ----------------
+`set <name> [<value>]`
+
+Retrieves or sets a named variable.
+
+`list`
+
+Returns a list of parameters.  The syntax sugar for lists is `[]`.
+
 `if <cond> <body> [elif <cond> <body>]... [else <body>]`
 
 Conditional evaluation, strings evaluate to themselves.
 
-`funargs`
+`for <list> <body>`
 
-Returns arguments to the current evaluation context as a list.
+Run the body for each element.
 
-`list`
+`map <list> <body>`
 
-Returns a list of parameters.  The syntax sugar for lists is `[]`.
+Transform each element with the given function.
+
+`filter <list> <body>`
+
+Return a new list consisting of matching elements only.
+
+`.. [<string>]...`
+
+Concatenates strings.
+
+`print [<item>]...`
+
+Prints all items in sequence--strings directly, lists as source code.
 
 Contributing and Support
 ------------------------
diff --git a/ell.c b/ell.c
index 68a5427..ef02127 100755
--- a/ell.c
+++ b/ell.c
@@ -26,7 +26,6 @@
 #include <assert.h>
 #include <time.h>
 #include <stdbool.h>
-#include <math.h>
 #include <setjmp.h>
 
 #if defined __GNUC__
@@ -768,7 +767,7 @@ execute_args (struct context *ctx, struct item *args, struct item **res) {
 // TODO: we should probably maintain arguments in a separate list,
 //   either that or at least remember the count so that we can reset them
 static bool
-execute_args_and_set (struct context *ctx, struct item *following) {
+execute_and_set_args (struct context *ctx, struct item *following) {
 	struct item *args = NULL;
 	if (!execute_args (ctx, following, &args)) {
 		item_free_list (args);
@@ -833,7 +832,8 @@ execute_statement
 		if (check (ctx, (*result = new_clone (body))))
 			return true;
 	} else {
-		if (execute_args_and_set (ctx, following)
+		// FIXME: this creates a confusing backtrace for argument evaluation
+		if (execute_and_set_args (ctx, following)
 		 && execute (ctx, body->head, result))
 			return true;
 	}
@@ -866,31 +866,9 @@ execute (struct context *ctx, struct item *body, struct item **result) {
 	(struct context *ctx, struct item *args, struct item **result)
 
 static bool
-init_runtime_library_scripts (struct context *ctx) {
-	bool ok = true;
-
-	struct {
-		const char *name;               ///< Name of the function
-		const char *definition;         ///< The defining script
-	} functions[] = {
-		// TODO: try to think of something useful
-	};
-
-	for (size_t i = 0; i < N_ELEMENTS (functions); i++) {
-		struct parser parser;
-		parser_init (&parser,
-			functions[i].definition, strlen (functions[i].definition));
-		const char *e = NULL;
-		struct item *body = parser_run (&parser, &e);
-		if (e) {
-			printf ("error parsing internal function `%s': %s\n",
-				functions[i].name, e);
-			ok = false;
-		} else
-			ok &= set (ctx, functions[i].name, body);
-		parser_free (&parser);
-	}
-	return ok;
+truthy (struct item *item) {
+	return item
+		&& ((item->type == ITEM_STRING && item->len != 0) || item->head);
 }
 
 defn (fn_set) {
@@ -915,6 +893,114 @@ defn (fn_list) {
 	return check (ctx, (*result = new_list (values)));
 }
 
+defn (fn_if) {
+	struct item *cond, *body, *keyword;
+	for (cond = args; ; cond = keyword->next) {
+		if (!cond)
+			return set_error (ctx, "missing condition");
+		if (!(body = cond->next))
+			return set_error (ctx, "missing body");
+
+		struct item *res = NULL;
+		if (!execute_statement (ctx, cond, &res))
+			return false;
+		bool match = truthy (res);
+		item_free_list (res);
+		if (match)
+			return execute_statement (ctx, body, result);
+
+		if (!(keyword = body->next))
+			break;
+		if (keyword->type != ITEM_STRING)
+			return set_error (ctx, "expected keyword, got list");
+
+		if (!strcmp (keyword->value, "else")) {
+			if (!(body = keyword->next))
+				return set_error (ctx, "missing body");
+			return execute_statement (ctx, body, result);
+		}
+		if (strcmp (keyword->value, "elif"))
+			return set_error (ctx, "invalid keyword: %s", keyword->value);
+	}
+	return true;
+}
+
+// TODO: how to break out of the loop?  Catchable error?  Special value?
+defn (fn_for) {
+	struct item *list = args, *body;
+	if (!list || list->type != ITEM_LIST)
+		return set_error (ctx, "first argument must be a list");
+	if (!(body = list->next) || body->type != ITEM_LIST)
+		return set_error (ctx, "second argument must be a function");
+
+	(void) result;
+	for (struct item *iter = list->head; iter; iter = iter->next) {
+		struct item *copy;
+		if (!check (ctx, (copy = new_clone (iter))))
+			return false;
+
+		struct item *res = NULL;
+		// FIXME: wrong thing is executed, see fn_map
+		bool ok = execute_statement (ctx, body, &res);
+		item_free_list (res);
+		if (!ok)
+			return false;
+	}
+	return true;
+}
+
+defn (fn_map) {
+	struct item *body = args, *values;
+	if (!body || body->type != ITEM_LIST)
+		return set_error (ctx, "first argument must be a function");
+	if (!(values = body->next) || values->type != ITEM_LIST)
+		return set_error (ctx, "second argument must be a list");
+
+	struct item *res = NULL, **out = &res;
+	for (struct item *v = values->head; v; v = v->next) {
+		// FIXME: wrong thing is executed
+		//   -> either temporarily append the value to the body
+		//   -> or modify execute_statement()
+		if (!execute_statement (ctx, v, out)) {
+			item_free_list (res);
+			return false;
+		}
+		while (*out && (*out)->next)
+			out = &(*out)->next;
+	}
+	return check (ctx, (*result = new_list (res)));
+}
+
+defn (fn_filter) {
+	struct item *body = args, *values;
+	if (!body || body->type != ITEM_LIST)
+		return set_error (ctx, "first argument must be a function");
+	if (!(values = body->next) || values->type != ITEM_LIST)
+		return set_error (ctx, "second argument must be a list");
+
+	struct item *res = NULL, **out = &res;
+	for (struct item *v = values->head; v; v = v->next) {
+		struct item *res = NULL;
+		// FIXME: wrong thing is executed, see fn_map
+		if (!execute_statement (ctx, body, &res)) {
+			item_free_list (res);
+			return false;
+		}
+		bool match = truthy (res);
+		item_free_list (res);
+		if (!match)
+			continue;
+
+		struct item *copy;
+		if (!check (ctx, (copy = new_clone (v)))) {
+			item_free_list (res);
+			return false;
+		}
+		out = &(*out = copy)->next;
+	}
+	return check (ctx, (*result = new_list (res)));
+}
+
 defn (fn_print) {
 	(void) result;
 	for (; args; args = args->next) {
@@ -944,17 +1030,23 @@ defn (fn_concatenate) {
 	return ok;
 }
 
+// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
 static bool
-init_runtime_library (void)
+init_native_library (void)
 {
 	return native_register ("set",    fn_set)
 		&& native_register ("list",   fn_list)
+		&& native_register ("if",     fn_if)
+		&& native_register ("for",    fn_for)
+		&& native_register ("map",    fn_map)
+		&& native_register ("filter", fn_filter)
 		&& native_register ("print",  fn_print)
 		&& native_register ("..",     fn_concatenate);
 }
 
 static void
-free_runtime_library (void) {
+free_native_library (void) {
 	struct native_fn *next, *iter;
 	for (iter = g_native; iter; iter = next) {
 		next = iter->next;
@@ -962,6 +1054,40 @@ free_runtime_library (void) {
 	}
 }
 
+// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+static bool
+init_runtime_library (struct context *ctx) {
+	bool ok = true;
+
+	struct {
+		const char *name;               ///< Name of the function
+		const char *definition;         ///< The defining script
+	} functions[] = {
+		// TODO: try to think of something useful
+		// XXX: should we add a ';' token to substitute newlines?
+		// FIXME: this "unless" is probably not going to work
+		{ "unless", "arg cond body\nif (not (eval @cond)) @body" },
+	};
+
+	for (size_t i = 0; i < N_ELEMENTS (functions); i++) {
+		struct parser parser;
+		parser_init (&parser,
+			functions[i].definition, strlen (functions[i].definition));
+		const char *e = NULL;
+		struct item *body = parser_run (&parser, &e);
+		if (e) {
+			printf ("error parsing internal function `%s': %s\n",
+				functions[i].name, e);
+			ok = false;
+		} else
+			ok &= set (ctx, functions[i].name, body);
+		item_free_list (body);
+		parser_free (&parser);
+	}
+	return ok;
+}
+
 // --- Main --------------------------------------------------------------------
 
 int
@@ -998,8 +1124,8 @@ main (int argc, char *argv[]) {
 
 	struct context ctx;
 	context_init (&ctx);
-	if (!init_runtime_library ()
-	 || !init_runtime_library_scripts (&ctx))
+	if (!init_native_library ()
+	 || !init_runtime_library (&ctx))
 		printf ("%s\n", "runtime library initialization failed");
 
 	struct item *result = NULL;
@@ -1014,7 +1140,7 @@ main (int argc, char *argv[]) {
 		printf ("%s: %s\n", "runtime error", failure);
 	context_free (&ctx);
 
-	free_runtime_library ();
+	free_native_library ();
 	return 0;
 }
author	Přemysl Janouch <p.janouch@gmail.com>	2017-05-20 21:24:11 +0200
committer	Přemysl Janouch <p.janouch@gmail.com>	2017-05-21 13:19:47 +0200
commit	d2155031d07a44e33ee229178a3a73d2408a5098 (patch)
tree	aeb237aff54251af71bcae5a9e9819b3e8c4b851
parent	f0337aa4819df5ef097837dc02e9a4746da79467 (diff)
download	ell-d2155031d07a44e33ee229178a3a73d2408a5098.tar.gz ell-d2155031d07a44e33ee229178a3a73d2408a5098.tar.xz ell-d2155031d07a44e33ee229178a3a73d2408a5098.zip