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:
parent
2735756dbd
commit
8fde2e72aa
403
plugins/script
403
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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue