script: improvements

 - fixed cons
 - added missing arithmetic operators
 - added min/max/xor/all?/any?/nip/curry/reverse/over
 - added a few functional tests

1 files changed, 285 insertions, 118 deletions

diff --git a/plugins/script b/plugins/script
index 55b35b3..c81aaa6 100755
--- a/plugins/script
+++ b/plugins/script
@@ -1,4 +1,4 @@
-#!/usr/bin/tcc -run
+#!/usr/bin/tcc -run -lm
 //
 // ZyklonB scripting plugin, using a custom stack-based language
 //
@@ -30,6 +30,7 @@
 #include <time.h>
 #include <stdbool.h>
 #include <strings.h>
+#include <math.h>
 
 #if defined __GNUC__
 #define ATTRIBUTE_PRINTF(x, y) __attribute__ ((format (printf, x, y)))
@@ -1003,14 +1004,16 @@ defn (fn_cons)
 	check_stack (2);
 	struct item *list = pop (ctx);
 	struct item *item = pop (ctx);
-	bool success = check_type (ctx, list, ITEM_LIST);
+	if (!check_type (ctx, list, ITEM_LIST))
+	{
+		item_free (list);
+		item_free (item);
+		return false;
+	}
 	item->next = get_list (list);
 	((struct item_list *) list)->head = item;
-	if (success)
-		push (ctx, list);
-	else
-		item_free (list);
-	return success;
+	push (ctx, list);
+	return true;
 }
 
 defn (fn_cat)
@@ -1358,8 +1361,8 @@ allocation_fail:
 defn (fn_times)
 {
 	check_stack (2);
-	struct item *op1 = pop (ctx);
 	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
 	bool success = true;
 
 	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
@@ -1386,6 +1389,104 @@ defn (fn_times)
 	return success;
 }
 
+defn (fn_pow)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+	bool success = true;
+
+	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+		// TODO: implement this properly, outputting an integer
+		push (ctx, new_float (powl (get_integer (op1), get_integer (op2))));
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		push (ctx, new_float (powl (get_integer (op1), get_float   (op2))));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		push (ctx, new_float (powl (get_float   (op1), get_float   (op2))));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		push (ctx, new_float (powl (get_float   (op1), get_integer (op2))));
+	else
+	{
+		ctx->error = strdup_printf ("cannot exponentiate `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+		success = false;
+	}
+
+	item_free (op1);
+	item_free (op2);
+	return success;
+}
+
+defn (fn_div)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+	bool success = true;
+
+	if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+	{
+		if (get_integer (op2) == 0)
+		{
+			ctx->error = strdup ("division by zero");
+			success = false;
+		}
+		else
+			push (ctx, new_integer (get_integer (op1) / get_integer (op2)));
+	}
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		push (ctx, new_float (get_integer (op1) / get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		push (ctx, new_float (get_float   (op1) / get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		push (ctx, new_float (get_float   (op1) / get_integer (op2)));
+	else
+	{
+		ctx->error = strdup_printf ("cannot divide `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+		success = false;
+	}
+
+	item_free (op1);
+	item_free (op2);
+	return success;
+}
+
+defn (fn_mod)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+	bool success = true;
+
+	if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+	{
+		if (get_integer (op2) == 0)
+		{
+			ctx->error = strdup ("division by zero");
+			success = false;
+		}
+		else
+			push (ctx, new_integer (get_integer (op1) % get_integer (op2)));
+	}
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		push (ctx, new_float (fmodl (get_integer (op1), get_float   (op2))));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		push (ctx, new_float (fmodl (get_float   (op1), get_float   (op2))));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		push (ctx, new_float (fmodl (get_float   (op1), get_integer (op2))));
+	else
+	{
+		ctx->error = strdup_printf ("cannot divide `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+		success = false;
+	}
+
+	item_free (op1);
+	item_free (op2);
+	return success;
+}
+
 static bool
 push_concatenated_string (struct context *ctx,
 	struct item *op1, struct item *op2)
@@ -1424,8 +1525,8 @@ allocation_fail:
 defn (fn_plus)
 {
 	check_stack (2);
-	struct item *op1 = pop (ctx);
 	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
 	bool success = true;
 
 	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
@@ -1437,7 +1538,7 @@ defn (fn_plus)
 	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
 		push (ctx, new_float   (get_float   (op1) + get_integer (op2)));
 	else if (op1->type == ITEM_STRING  && op2->type == ITEM_STRING)
-		success = push_concatenated_string (ctx, op2, op1);
+		success = push_concatenated_string (ctx, op1, op2);
 	else
 	{
 		ctx->error = strdup_printf ("cannot add `%s' and `%s'",
@@ -1450,6 +1551,33 @@ defn (fn_plus)
 	return success;
 }
 
+defn (fn_minus)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+	bool success = true;
+
+	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+		push (ctx, new_integer (get_integer (op1) - get_integer (op2)));
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		push (ctx, new_float   (get_integer (op1) - get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		push (ctx, new_float   (get_float   (op1) - get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		push (ctx, new_float   (get_float   (op1) - get_integer (op2)));
+	else
+	{
+		ctx->error = strdup_printf ("cannot subtract `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+		success = false;
+	}
+
+	item_free (op1);
+	item_free (op2);
+	return success;
+}
+
 // - - Comparison  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
 static int
@@ -1680,114 +1808,6 @@ item_list_to_str (const struct item *script, struct buffer *buf)
 	}
 }
 
-// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-// TODO: implement more functions; try to avoid writing it in C
-//   -, /, %, ** -- arithmetic
-//   at { value index -- sub-value } -- get n-th subvalue of a string/list
-
-static void
-init_runtime_library_scripts (void)
-{
-	struct script
-	{
-		const char *name;
-		const char *definition;
-	}
-	scripts[] =
-	{
-		{ "swons",  "swap cons"                                              },
-		{ "first",  "uncons drop"                                            },
-		{ "rest",   "uncons swap drop"                                       },
-
-		{ ">",      "swap <"                                                 },
-		{ "!=",     "= not"                                                  },
-		{ "<=",     "> not"                                                  },
-		{ ">=",     "< not"                                                  },
-
-		// XXX: this is a bit crazy and does not work with an empty list
-		{ "join",   "[uncons] dip swap [[dup] dip swap [+ +] dip] each drop" },
-	};
-
-	for (size_t i = 0; i < N_ELEMENTS (scripts); i++)
-	{
-		char *error = NULL;
-		struct item *script = parse (scripts[i].definition, &error);
-		if (error)
-		{
-			fprintf (stderr, "error parsing internal script `%s': %s\n",
-				scripts[i].definition, error);
-			free (error);
-			exit (EXIT_FAILURE);
-		}
-		register_script (scripts[i].name, script);
-	}
-}
-
-static void
-init_runtime_library (void)
-{
-	init_runtime_library_scripts ();
-
-	// Type detection
-	register_handler ("string?",  fn_is_string);
-	register_handler ("word?",    fn_is_word);
-	register_handler ("integer?", fn_is_integer);
-	register_handler ("float?",   fn_is_float);
-	register_handler ("list?",    fn_is_list);
-
-	// Type conversion
-	register_handler (">string",  fn_to_string);
-	register_handler (">integer", fn_to_integer);
-	register_handler (">float",   fn_to_float);
-
-	// Miscellaneous
-	register_handler ("length",   fn_length);
-
-	// Basic stack manipulation
-	register_handler ("dup",      fn_dup);
-	register_handler ("drop",     fn_drop);
-	register_handler ("swap",     fn_swap);
-
-	// Calling stuff
-	register_handler ("call",     fn_call);
-	register_handler ("dip",      fn_dip);
-
-	// Control flow
-	register_handler ("if",       fn_if);
-	register_handler ("try",      fn_try);
-
-	// List processing
-	register_handler ("map",      fn_map);
-	register_handler ("filter",   fn_filter);
-	register_handler ("fold",     fn_fold);
-	register_handler ("each",     fn_each);
-
-	// List manipulation
-	register_handler ("unit",     fn_unit);
-	register_handler ("cons",     fn_cons);
-	register_handler ("cat",      fn_cat);
-	register_handler ("uncons",   fn_uncons);
-
-	// Arithmetic operations
-	register_handler ("*",        fn_times);
-	register_handler ("+",        fn_plus);
-
-	// Comparison
-	register_handler ("=",        fn_eq);
-	register_handler ("<",        fn_lt);
-
-	// Logical operations
-	register_handler ("not",      fn_not);
-	register_handler ("and",      fn_and);
-	register_handler ("or",       fn_or);
-
-	// Utilities
-	register_handler ("rand",     fn_rand);
-	register_handler ("time",     fn_time);
-	register_handler ("strftime", fn_strftime);
-}
-
 // --- IRC protocol ------------------------------------------------------------
 
 struct message
@@ -1887,6 +1907,153 @@ get_config (const char *key)
 	return msg->params[0];
 }
 
+// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+// TODO: implement more functions; try to avoid writing them in C
+
+static void
+init_runtime_library_scripts (void)
+{
+	// It's much cheaper (and more fun) to define functions in terms of other
+	// ones.  The "unit tests" serve a secondary purpose of showing the usage.
+	struct script
+	{
+		const char *name;               ///< Name of the function
+		const char *definition;         ///< The defining script
+		const char *unit_test;          ///< Trivial unit test, must return 1
+	}
+	scripts[] =
+	{
+		{ "nip",     "swap drop",                    "1 2 nip 2 ="            },
+		{ "over",    "[dup] dip swap",               "1 2 over nip nip 1 ="   },
+		{ "swons",   "swap cons",                    "[2] 1 swons [1 2] ="    },
+		{ "first",   "uncons drop",                  "[1 2 3] first 1 ="      },
+		{ "rest",    "uncons swap drop",             "[1 2 3] rest [2 3] ="   },
+		{ "reverse", "[] swap [swap cons] each",     "[1 2] reverse [2 1] ="  },
+		{ "curry",   "cons",                         "1 2 [+] curry call 3 =" },
+
+		{ "xor",     "not swap not + 1 =",           "1 1 xor 0 ="            },
+		{ "min",     "over over < [drop] [nip] if",  "1 2 min 1 ="            },
+		{ "max",     "over over > [drop] [nip] if",  "1 2 max 2 ="            },
+
+		{ "all?",    "[and] cat 1 swap fold",        "[3 4 5] [> 3] all? 0 =" },
+		{ "any?",    "[or] cat 0 swap fold",         "[3 4 5] [> 3] any? 1 =" },
+
+		{ ">",       "swap <",                       "1 2 > 0 ="              },
+		{ "!=",      "= not",                        "1 2 != 1 ="             },
+		{ "<=",      "> not",                        "1 2 <= 1 ="             },
+		{ ">=",      "< not",                        "1 2 >= 0 ="             },
+
+		// XXX: this is a bit crazy and does not work with an empty list
+		{ "join",   "[uncons] dip swap [[dup] dip swap [+ +] dip] each drop",
+		  "[1 2 3] [>string] map \" -> \" join \"1 -> 2 -> 3\" ="             },
+	};
+
+	for (size_t i = 0; i < N_ELEMENTS (scripts); i++)
+	{
+		char *error = NULL;
+		struct item *script = parse (scripts[i].definition, &error);
+		if (error)
+		{
+			printf (BOT_PRINT "error parsing internal script `%s': %s\r\n",
+				scripts[i].definition, error);
+			free (error);
+			continue;
+		}
+		register_script (scripts[i].name, script);
+	}
+
+	struct context ctx;
+	for (size_t i = 0; i < N_ELEMENTS (scripts); i++)
+	{
+		char *error = NULL;
+		struct item *script = parse (scripts[i].unit_test, &error);
+		if (error)
+		{
+			printf (BOT_PRINT "error parsing unit test for `%s': %s\r\n",
+				scripts[i].name, error);
+			free (error);
+			continue;
+		}
+		context_init (&ctx);
+		execute (&ctx, script);
+		item_free_list (script);
+		if (ctx.error || ctx.stack_size != 1
+		 || ctx.stack->type != ITEM_INTEGER || get_integer (ctx.stack) != 1)
+			printf (BOT_PRINT "error executing unit test for `%s': %s\r\n",
+				scripts[i].name, ctx.error ? ctx.error : "wrong test result");
+		context_free (&ctx);
+	}
+}
+
+static void
+init_runtime_library (void)
+{
+	// Type detection
+	register_handler ("string?",  fn_is_string);
+	register_handler ("word?",    fn_is_word);
+	register_handler ("integer?", fn_is_integer);
+	register_handler ("float?",   fn_is_float);
+	register_handler ("list?",    fn_is_list);
+
+	// Type conversion
+	register_handler (">string",  fn_to_string);
+	register_handler (">integer", fn_to_integer);
+	register_handler (">float",   fn_to_float);
+
+	// Miscellaneous
+	register_handler ("length",   fn_length);
+
+	// Basic stack manipulation
+	register_handler ("dup",      fn_dup);
+	register_handler ("drop",     fn_drop);
+	register_handler ("swap",     fn_swap);
+
+	// Calling stuff
+	register_handler ("call",     fn_call);
+	register_handler ("dip",      fn_dip);
+
+	// Control flow
+	register_handler ("if",       fn_if);
+	register_handler ("try",      fn_try);
+
+	// List processing
+	register_handler ("map",      fn_map);
+	register_handler ("filter",   fn_filter);
+	register_handler ("fold",     fn_fold);
+	register_handler ("each",     fn_each);
+
+	// List manipulation
+	register_handler ("unit",     fn_unit);
+	register_handler ("cons",     fn_cons);
+	register_handler ("cat",      fn_cat);
+	register_handler ("uncons",   fn_uncons);
+
+	// Arithmetic operations
+	register_handler ("+",        fn_plus);
+	register_handler ("-",        fn_minus);
+	register_handler ("*",        fn_times);
+	register_handler ("^",        fn_pow);
+	register_handler ("/",        fn_div);
+	register_handler ("%",        fn_mod);
+
+	// Comparison
+	register_handler ("=",        fn_eq);
+	register_handler ("<",        fn_lt);
+
+	// Logical operations
+	register_handler ("not",      fn_not);
+	register_handler ("and",      fn_and);
+	register_handler ("or",       fn_or);
+
+	// Utilities
+	register_handler ("rand",     fn_rand);
+	register_handler ("time",     fn_time);
+	register_handler ("strftime", fn_strftime);
+
+	init_runtime_library_scripts ();
+}
+
 // --- Function database -------------------------------------------------------
 
 // TODO: a global variable storing the various procedures (db)