From 8fde2e72aac7a8be0de94431e1e29639929e77bf Mon Sep 17 00:00:00 2001 From: Přemysl Janouch Date: Thu, 31 Jul 2014 22:49:07 +0200 Subject: script: improvements - fixed cons - added missing arithmetic operators - added min/max/xor/all?/any?/nip/curry/reverse/over - added a few functional tests --- plugins/script | 403 ++++++++++++++++++++++++++++++++++++++++----------------- 1 file 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 #include #include +#include #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) -- cgit v1.2.3-70-g09d2