script: improvements

- fixed cons
 - added missing arithmetic operators
 - added min/max/xor/all?/any?/nip/curry/reverse/over
 - added a few functional tests
This commit is contained in:
Přemysl Eric Janouch 2014-07-31 22:49:07 +02:00
parent 2735756dbd
commit 8fde2e72aa
1 changed files with 285 additions and 118 deletions

View File

@ -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;
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)