xK/plugins/script

1923 lines
43 KiB
Plaintext
Raw Normal View History

#!/usr/bin/tcc -run
//
// ZyklonB scripting plugin, using a custom stack-based language
//
// Copyright 2014 Přemysl Janouch. All rights reserved.
// See the file LICENSE for licensing information.
//
// Just compile this file as usual (sans #!) if you don't feel like using TCC.
// It is a very basic and portable C99 application. It's not supposed to be
// very sophisticated, for it'd get extremely big.
//
// The main influences of the language were Factor and Joy, stripped of all
// even barely complex stuff. In its current state, it's only really useful as
// a calculator but it's got great potential for extending.
//
// If you don't like something, just change it; this is just an experiment.
//
// NOTE: it is really easy to crash and abuse. Be careful.
//
#define _XOPEN_SOURCE 500
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <errno.h>
#include <stdarg.h>
#include <assert.h>
#include <time.h>
#include <stdbool.h>
#include <strings.h>
#if defined __GNUC__
#define ATTRIBUTE_PRINTF(x, y) __attribute__ ((format (printf, x, y)))
#else // ! __GNUC__
#define ATTRIBUTE_PRINTF(x, y)
#endif // ! __GNUC__
#define N_ELEMENTS(a) (sizeof (a) / sizeof ((a)[0]))
// --- Utilities ---------------------------------------------------------------
static char *strdup_printf (const char *format, ...) ATTRIBUTE_PRINTF (1, 2);
static char *
strdup_printf (const char *format, ...)
{
va_list ap;
va_start (ap, format);
int size = vsnprintf (NULL, 0, format, ap);
va_end (ap);
if (size < 0)
return NULL;
char buf[size + 1];
va_start (ap, format);
size = vsnprintf (buf, sizeof buf, format, ap);
va_end (ap);
if (size < 0)
return NULL;
return strdup (buf);
}
// --- Generic buffer ----------------------------------------------------------
struct buffer
{
char *s; ///< Buffer data
size_t alloc; ///< Number of bytes allocated
size_t len; ///< Number of bytes used
};
#define BUFFER_INITIALIZER {NULL, 0, 0}
static void
buffer_append (struct buffer *self, const void *s, size_t n)
{
if (!self->s)
self->s = malloc (self->alloc = 8);
while (self->len + n > self->alloc)
self->s = realloc (self->s, self->alloc <<= 1);
memcpy (self->s + self->len, s, n);
self->len += n;
}
inline static void
buffer_append_c (struct buffer *self, char c)
{
buffer_append (self, &c, 1);
}
// --- Data types --------------------------------------------------------------
enum item_type
{
ITEM_STRING,
ITEM_WORD,
ITEM_INTEGER,
ITEM_FLOAT,
ITEM_LIST
};
struct item
{
#define ITEM_HEADER \
enum item_type type; /**< The type of this object */ \
struct item *next; /**< Next item on the list/stack */
ITEM_HEADER
};
struct item_string
{
ITEM_HEADER
size_t len; ///< Length of the string (sans '\0')
char value[]; ///< The null-terminated string value
};
#define get_string(item) \
(assert ((item)->type == ITEM_STRING), \
((struct item_string *)(item))->value)
/// It looks like a string but it doesn't quack like a string
#define item_word item_string
#define get_word(item) \
(assert ((item)->type == ITEM_WORD), \
((struct item_word *)(item))->value)
struct item_integer
{
ITEM_HEADER
long long value; ///< The integer value
};
#define get_integer(item) \
(assert ((item)->type == ITEM_INTEGER), \
((struct item_integer *)(item))->value)
struct item_float
{
ITEM_HEADER
long double value; ///< The floating point value
};
#define get_float(item) \
(assert ((item)->type == ITEM_FLOAT), \
((struct item_float *)(item))->value)
struct item_list
{
ITEM_HEADER
struct item *head; ///< The head of the list
};
#define get_list(item) \
(assert ((item)->type == ITEM_LIST), \
((struct item_list *)(item))->head)
#define set_list(item, head_) \
(assert ((item)->type == ITEM_LIST), \
item_free_list (((struct item_list *)(item))->head), \
((struct item_list *)(item))->head = (head_))
const char *
item_type_to_str (enum item_type type)
{
switch (type)
{
case ITEM_STRING: return "string";
case ITEM_WORD: return "word";
case ITEM_INTEGER: return "integer";
case ITEM_FLOAT: return "float";
case ITEM_LIST: return "list";
}
abort ();
}
// --- Item management ---------------------------------------------------------
static void item_free_list (struct item *);
static struct item *new_clone_list (const struct item *);
static void
item_free (struct item *item)
{
if (item->type == ITEM_LIST)
item_free_list (get_list (item));
free (item);
}
static void
item_free_list (struct item *item)
{
while (item)
{
struct item *link = item;
item = item->next;
item_free (link);
}
}
static struct item *
new_clone (const struct item *item)
{
size_t size;
switch (item->type)
{
case ITEM_STRING:
case ITEM_WORD:
{
const struct item_string *x = (const struct item_string *) item;
size = sizeof *x + x->len + 1;
break;
}
case ITEM_INTEGER: size = sizeof (struct item_integer); break;
case ITEM_FLOAT: size = sizeof (struct item_float); break;
case ITEM_LIST: size = sizeof (struct item_list); break;
}
struct item *clone = memcpy (malloc (size), item, size);
if (item->type == ITEM_LIST)
{
struct item_list *x = (struct item_list *) clone;
x->head = new_clone_list (x->head);
}
clone->next = NULL;
return clone;
}
static struct item *
new_clone_list (const struct item *item)
{
struct item *head = NULL;
for (struct item **out = &head; item; item = item->next)
{
struct item *clone = *out = new_clone (item);
clone->next = NULL;
out = &clone->next;
}
return head;
}
static struct item *
new_string (const char *s, ssize_t len)
{
if (len < 0)
len = strlen (s);
struct item_string *item = calloc (1, sizeof *item + len + 1);
if (!item)
return NULL;
item->type = ITEM_STRING;
item->len = len;
memcpy (item->value, s, len);
item->value[len] = '\0';
return (struct item *) item;
}
static struct item *
new_word (const char *s, ssize_t len)
{
struct item *item = new_string (s, len);
item->type = ITEM_WORD;
return item;
}
static struct item *
new_integer (long long value)
{
struct item_integer *item = calloc (1, sizeof *item);
item->type = ITEM_INTEGER;
item->value = value;
return (struct item *) item;
}
static struct item *
new_float (long double value)
{
struct item_float *item = calloc (1, sizeof *item);
item->type = ITEM_FLOAT;
item->value = value;
return (struct item *) item;
}
static struct item *
new_list (struct item *head)
{
struct item_list *item = calloc (1, sizeof *item);
item->type = ITEM_LIST;
item->head = head;
return (struct item *) item;
}
// --- Parsing -----------------------------------------------------------------
struct tokenizer
{
const char *cursor;
const char *error;
};
static bool
decode_hexa_escape (struct tokenizer *self, struct buffer *buf)
{
int i;
char c, code = 0;
for (i = 0; i < 2; i++)
{
c = tolower (*self->cursor);
if (c >= '0' && c <= '9')
code = (code << 4) | (c - '0');
else if (c >= 'a' && c <= 'f')
code = (code << 4) | (c - 'a' + 10);
else
break;
self->cursor++;
}
if (!i)
return false;
buffer_append_c (buf, code);
return true;
}
static bool
decode_octal_escape (struct tokenizer *self, struct buffer *buf)
{
int i;
char c, code = 0;
for (i = 0; i < 3; i++)
{
c = *self->cursor;
if (c < '0' || c > '7')
break;
code = (code << 3) | (c - '0');
self->cursor++;
}
if (!i)
return false;
buffer_append_c (buf, code);
return true;
}
static bool
decode_escape_sequence (struct tokenizer *self, struct buffer *buf)
{
// Support some basic escape sequences from the C language
char c;
switch ((c = *self->cursor))
{
case '\0':
self->error = "unexpected end of input";
return false;
case 'x':
case 'X':
self->cursor++;
if (decode_hexa_escape (self, buf))
return true;
self->error = "invalid hexadecimal escape sequence";
return false;
default:
if (decode_octal_escape (self, buf))
return true;
self->cursor++;
const char *from = "abfnrtv\"\\", *to = "\a\b\f\n\r\t\v\"\\", *x;
if ((x = strchr (from, c)))
{
buffer_append_c (buf, to[x - from]);
return true;
}
self->error = "unrecognized escape sequence";
return false;
}
}
static struct item *
parse_string (struct tokenizer *self)
{
struct buffer buf = BUFFER_INITIALIZER;
char c;
while (true)
switch ((c = *self->cursor++))
{
case '\0':
self->cursor--;
self->error = "unexpected end of input";
goto fail;
case '"':
{
struct item *item = new_string (buf.s, buf.len);
free (buf.s);
return item;
}
case '\\':
if (!decode_escape_sequence (self, &buf))
goto fail;
break;
default:
buffer_append_c (&buf, c);
}
fail:
free (buf.s);
return NULL;
}
static struct item *
try_parse_number (struct tokenizer *self)
{
// These two standard library functions can digest a lot of various inputs,
// including NaN and +/- infinity. That may get a bit confusing.
char *float_end;
errno = 0;
long double float_value = strtold (self->cursor, &float_end);
int float_errno = errno;
char *int_end;
errno = 0;
long long int_value = strtoll (self->cursor, &int_end, 10);
int int_errno = errno;
// If they both fail, then this is most probably not a number.
if (float_end == int_end && float_end == self->cursor)
return NULL;
// Only use the floating point result if it parses more characters:
if (float_end > int_end)
{
if (float_errno == ERANGE)
{
self->error = "floating point value out of range";
return NULL;
}
self->cursor = float_end;
return new_float (float_value);
}
else
{
if (int_errno == ERANGE)
{
self->error = "integer out of range";
return NULL;
}
self->cursor = int_end;
return new_integer (int_value);
}
}
static struct item *
parse_word (struct tokenizer *self)
{
struct buffer buf = BUFFER_INITIALIZER;
char c;
// Here we accept almost anything that doesn't break the grammar...
while (!strchr (" []\"", (c = *self->cursor++)) && (unsigned char) c > ' ')
buffer_append_c (&buf, c);
self->cursor--;
// ...so an empty word can only mean a bug within our caller.
assert (buf.len != 0);
struct item *item = new_word (buf.s, buf.len);
free (buf.s);
return item;
}
static struct item *parse_item_list (struct tokenizer *);
static struct item *
parse_list (struct tokenizer *self)
{
struct item *list = parse_item_list (self);
if (self->error)
{
assert (list == NULL);
return NULL;
}
if (!*self->cursor)
{
self->error = "unexpected end of input";
item_free_list (list);
return NULL;
}
assert (*self->cursor == ']');
self->cursor++;
return new_list (list);
}
static struct item *
parse_item (struct tokenizer *self)
{
char c;
switch ((c = *self->cursor++))
{
case '[': return parse_list (self);
case '"': return parse_string (self);
default:;
}
self->cursor--;
struct item *item = try_parse_number (self);
if (!item && !self->error)
item = parse_word (self);
return item;
}
static struct item *
parse_item_list (struct tokenizer *self)
{
struct item *head = NULL;
struct item **tail = &head;
char c;
bool expected = true;
while ((c = *self->cursor) && c != ']')
{
if (isspace (c))
{
self->cursor++;
expected = true;
continue;
}
else if (!expected)
{
self->error = "unexpected input";
goto fail;
}
if (!(*tail = parse_item (self)))
goto fail;
tail = &(*tail)->next;
expected = false;
}
return head;
fail:
item_free_list (head);
return NULL;
}
static struct item *
parse (const char *s, char **error)
{
struct tokenizer self;
self.cursor = s;
self.error = NULL;
struct item *list = parse_item_list (&self);
if (!self.error && *self.cursor != '\0')
{
self.error = "unexpected input";
item_free_list (list);
list = NULL;
}
if (self.error && error)
*error = strdup_printf ("at character %d: %s",
(int) (self.cursor - s) + 1, self.error);
return list;
}
// --- Runtime -----------------------------------------------------------------
// TODO: try to think of a _simple_ way to do preemptive multitasking
struct context
{
struct item *stack; ///< The current top of the stack
size_t stack_size; ///< Number of items on the stack
size_t reduction_count; ///< # of function calls so far
size_t reduction_limit; ///< The hard limit on function calls
char *error; ///< Error information
bool error_is_fatal; ///< Whether the error can be catched
void *user_data; ///< User data
};
/// Internal handler for a function
typedef bool (*handler_fn) (struct context *);
struct fn
{
struct fn *next; ///< The next link in the chain
handler_fn handler; ///< Internal C handler, or NULL
struct item *script; ///< Alternatively runtime code
char name[]; ///< The name of the function
};
struct fn *g_functions; ///< Maps words to functions
static void
context_init (struct context *ctx)
{
ctx->stack = NULL;
ctx->stack_size = 0;
ctx->reduction_count = 0;
ctx->reduction_limit = 2000;
ctx->error = NULL;
ctx->error_is_fatal = false;
ctx->user_data = NULL;
}
static void
context_free (struct context *ctx)
{
item_free_list (ctx->stack);
ctx->stack = NULL;
free (ctx->error);
ctx->error = NULL;
}
static void
push (struct context *ctx, struct item *item)
{
assert (item->next == NULL);
item->next = ctx->stack;
ctx->stack = item;
ctx->stack_size++;
}
static bool
bump_reductions (struct context *ctx)
{
if (++ctx->reduction_count >= ctx->reduction_limit)
{
ctx->error = strdup ("reduction limit reached");
ctx->error_is_fatal = true;
return false;
}
return true;
}
static bool execute (struct context *, struct item *);
static bool
call_function (struct context *ctx, const char *name)
{
struct fn *iter;
for (iter = g_functions; iter; iter = iter->next)
if (!strcmp (name, iter->name))
goto found;
ctx->error = strdup_printf ("unknown function: %s", name);
return false;
found:
if (!bump_reductions (ctx))
return false;
if (iter->handler
? iter->handler (ctx)
: execute (ctx, iter->script))
return true;
// This creates some form of a stack trace
char *error = strdup_printf ("%s -> %s", name, ctx->error);
free (ctx->error);
ctx->error = error;
return false;
}
static void
unregister_function (const char *name)
{
for (struct fn **iter = &g_functions; *iter; iter = &(*iter)->next)
if (!strcmp ((*iter)->name, name))
{
struct fn *tmp = *iter;
*iter = tmp->next;
if (tmp->script)
item_free_list (tmp->script);
free (tmp);
break;
}
}
static struct fn *
prepend_new_fn (const char *name)
{
struct fn *fn = calloc (1, sizeof *fn + strlen (name) + 1);
strcpy (fn->name, name);
fn->next = g_functions;
return g_functions = fn;
}
static void
register_handler (const char *name, handler_fn handler)
{
unregister_function (name);
prepend_new_fn (name)->handler = handler;
}
static void
register_script (const char *name, struct item *script)
{
unregister_function (name);
prepend_new_fn (name)->script = script;
}
static bool
execute (struct context *ctx, struct item *script)
{
for (; script; script = script->next)
{
if (script->type != ITEM_WORD)
{
if (!bump_reductions (ctx))
return false;
push (ctx, new_clone (script));
}
else if (!call_function (ctx, get_word (script)))
return false;
}
return true;
}
// --- Runtime library ---------------------------------------------------------
#define defn(name) static bool name (struct context *ctx)
#define check_stack(n) \
if (ctx->stack_size < n) { \
ctx->error = strdup ("stack underflow"); \
return 0; \
}
inline static bool
check_stack_safe (struct context *ctx, size_t n)
{
check_stack (n);
return true;
}
static bool
check_type (struct context *ctx, const void *item_, enum item_type type)
{
const struct item *item = item_;
if (item->type == type)
return true;
ctx->error = strdup_printf ("invalid type: expected `%s', got `%s'",
item_type_to_str (type), item_type_to_str (item->type));
return false;
}
static struct item *
pop (struct context *ctx)
{
check_stack (1);
struct item *top = ctx->stack;
ctx->stack = top->next;
top->next = NULL;
ctx->stack_size--;
return top;
}
// - - Types - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#define defn_is_type(name, item_type) \
defn (fn_is_##name) { \
check_stack (1); \
struct item *top = pop (ctx); \
push (ctx, new_integer (top->type == (item_type))); \
item_free (top); \
return true; \
}
defn_is_type (string, ITEM_STRING)
defn_is_type (word, ITEM_WORD)
defn_is_type (integer, ITEM_INTEGER)
defn_is_type (float, ITEM_FLOAT)
defn_is_type (list, ITEM_LIST)
defn (fn_to_string)
{
check_stack (1);
struct item *item = pop (ctx);
char *value;
switch (item->type)
{
case ITEM_WORD:
item->type = ITEM_STRING;
case ITEM_STRING:
push (ctx, item);
return true;
case ITEM_FLOAT:
value = strdup_printf ("%Lf", get_float (item));
break;
case ITEM_INTEGER:
value = strdup_printf ("%lld", get_integer (item));
break;
default:
ctx->error = strdup_printf ("cannot convert `%s' to `%s'",
item_type_to_str (item->type), item_type_to_str (ITEM_STRING));
item_free (item);
return false;
}
item_free (item);
item = new_string (value, -1);
free (value);
push (ctx, item);
return true;
}
defn (fn_to_integer)
{
check_stack (1);
struct item *item = pop (ctx);
long long value;
switch (item->type)
{
case ITEM_INTEGER:
push (ctx, item);
return true;
case ITEM_FLOAT:
value = get_float (item);
break;
case ITEM_STRING:
{
char *end;
const char *s = get_string (item);
value = strtoll (s, &end, 10);
if (end != s && *s == '\0')
break;
ctx->error = strdup ("integer conversion error");
item_free (item);
return false;
}
default:
ctx->error = strdup_printf ("cannot convert `%s' to `%s'",
item_type_to_str (item->type), item_type_to_str (ITEM_INTEGER));
item_free (item);
return false;
}
item_free (item);
push (ctx, new_integer (value));
return true;
}
defn (fn_to_float)
{
check_stack (1);
struct item *item = pop (ctx);
long double value;
switch (item->type)
{
case ITEM_FLOAT:
push (ctx, item);
return true;
case ITEM_INTEGER:
value = get_integer (item);
break;
case ITEM_STRING:
{
char *end;
const char *s = get_string (item);
value = strtold (s, &end);
if (end != s && *s == '\0')
break;
ctx->error = strdup ("float conversion error");
item_free (item);
return false;
}
default:
ctx->error = strdup_printf ("cannot convert `%s' to `%s'",
item_type_to_str (item->type), item_type_to_str (ITEM_FLOAT));
item_free (item);
return false;
}
item_free (item);
push (ctx, new_float (value));
return true;
}
// - - Stack operations - - - - - - - - - - - - - - - - - - - - - - - - - - - -
defn (fn_dup)
{
check_stack (1);
push (ctx, new_clone (ctx->stack));
return true;
}
defn (fn_drop)
{
check_stack (1);
item_free (pop (ctx));
return true;
}
defn (fn_swap)
{
check_stack (2);
struct item *second = pop (ctx);
struct item *first = pop (ctx);
push (ctx, second);
push (ctx, first);
return true;
}
defn (fn_call)
{
check_stack (1);
struct item *script = pop (ctx);
bool success = check_type (ctx, script, ITEM_LIST)
&& execute (ctx, get_list (script));
item_free (script);
return success;
}
defn (fn_dip)
{
check_stack (2);
struct item *script = pop (ctx);
struct item *item = pop (ctx);
bool success = check_type (ctx, script, ITEM_LIST)
&& execute (ctx, get_list (script));
if (success)
push (ctx, item);
else
item_free (item);
item_free (script);
return success;
}
defn (fn_unit)
{
check_stack (1);
struct item *item = pop (ctx);
push (ctx, new_list (item));
return true;
}
defn (fn_cons)
{
check_stack (2);
struct item *list = pop (ctx);
struct item *item = pop (ctx);
bool success = check_type (ctx, list, ITEM_LIST);
item->next = get_list (list);
((struct item_list *) list)->head = item;
if (success)
push (ctx, list);
else
item_free (list);
return success;
}
defn (fn_cat)
{
check_stack (2);
struct item *scnd = pop (ctx);
struct item *frst = pop (ctx);
if (!check_type (ctx, frst, ITEM_LIST)
|| !check_type (ctx, scnd, ITEM_LIST))
{
item_free (frst);
item_free (scnd);
return false;
}
// XXX: we shouldn't have to do this in O(n)
struct item **tail = &((struct item_list *) frst)->head;
while (*tail)
tail = &(*tail)->next;
*tail = get_list (scnd);
push (ctx, frst);
((struct item_list *) scnd)->head = NULL;
item_free (scnd);
return true;
}
// - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
static bool
to_boolean (struct context *ctx, struct item *item)
{
switch (item->type)
{
case ITEM_STRING:
return *get_string (item) != '\0';
case ITEM_INTEGER:
return get_integer (item) != 0;
case ITEM_FLOAT:
return get_float (item) != 0.;
default:
ctx->error = strdup_printf ("cannot convert `%s' to boolean",
item_type_to_str (item->type));
return false;
}
}
defn (fn_not)
{
check_stack (1);
struct item *item = pop (ctx);
bool result = !to_boolean (ctx, item);
item_free (item);
if (ctx->error)
return false;
push (ctx, new_integer (result));
return true;
}
defn (fn_and)
{
check_stack (2);
struct item *op1 = pop (ctx);
struct item *op2 = pop (ctx);
bool result = to_boolean (ctx, op1) && to_boolean (ctx, op2);
item_free (op1);
item_free (op2);
push (ctx, new_integer (result));
return !ctx->error;
}
defn (fn_or)
{
check_stack (2);
struct item *op1 = pop (ctx);
struct item *op2 = pop (ctx);
bool result = to_boolean (ctx, op1) || ctx->error || to_boolean (ctx, op2);
item_free (op1);
item_free (op2);
if (ctx->error)
return false;
push (ctx, new_integer (result));
return true;
}
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
defn (fn_if)
{
check_stack (3);
struct item *else_ = pop (ctx);
struct item *then_ = pop (ctx);
struct item *cond_ = pop (ctx);
bool condition = to_boolean (ctx, cond_);
item_free (cond_);
bool success = false;
if (!ctx->error
&& check_type (ctx, then_, ITEM_LIST)
&& check_type (ctx, else_, ITEM_LIST))
success = execute (ctx, condition
? get_list (then_)
: get_list (else_));
item_free (then_);
item_free (else_);
return success;
}
defn (fn_try)
{
check_stack (2);
struct item *catch = pop (ctx);
struct item *try = pop (ctx);
bool success = false;
if (!check_type (ctx, try, ITEM_LIST)
|| !check_type (ctx, catch, ITEM_LIST))
goto fail;
if (!execute (ctx, get_list (try)))
{
if (ctx->error_is_fatal)
goto fail;
push (ctx, new_string (ctx->error, -1));
free (ctx->error);
ctx->error = NULL;
if (!execute (ctx, get_list (catch)))
goto fail;
}
success = true;
fail:
item_free (try);
item_free (catch);
return success;
}
defn (fn_map)
{
check_stack (2);
struct item *fn = pop (ctx);
struct item *list = pop (ctx);
if (!check_type (ctx, fn, ITEM_LIST)
|| !check_type (ctx, list, ITEM_LIST))
{
item_free (fn);
item_free (list);
return false;
}
bool success = false;
struct item *result = NULL, **tail = &result;
for (struct item *iter = get_list (list); iter; iter = iter->next)
{
push (ctx, new_clone (iter));
if (!execute (ctx, get_list (fn))
|| !check_stack_safe (ctx, 1))
goto fail;
struct item *item = pop (ctx);
*tail = item;
tail = &item->next;
}
success = true;
fail:
set_list (list, result);
if (success)
push (ctx, list);
else
item_free (list);
item_free (fn);
return success;
}
defn (fn_filter)
{
check_stack (2);
struct item *fn = pop (ctx);
struct item *list = pop (ctx);
if (!check_type (ctx, fn, ITEM_LIST)
|| !check_type (ctx, list, ITEM_LIST))
{
item_free (fn);
item_free (list);
return false;
}
bool success = false;
struct item *result = NULL, **tail = &result;
for (struct item *iter = get_list (list); iter; iter = iter->next)
{
push (ctx, new_clone (iter));
if (!execute (ctx, get_list (fn))
|| !check_stack_safe (ctx, 1))
goto fail;
struct item *item = pop (ctx);
bool survived = to_boolean (ctx, item);
item_free (item);
if (ctx->error)
goto fail;
if (!survived)
continue;
item = new_clone (iter);
*tail = item;
tail = &item->next;
}
success = true;
fail:
set_list (list, result);
if (success)
push (ctx, list);
else
item_free (list);
item_free (fn);
return success;
}
defn (fn_fold)
{
check_stack (3);
struct item *op = pop (ctx);
struct item *null = pop (ctx);
struct item *list = pop (ctx);
bool success = false;
if (!check_type (ctx, op, ITEM_LIST)
|| !check_type (ctx, list, ITEM_LIST))
{
item_free (null);
goto fail;
}
push (ctx, null);
for (struct item *iter = get_list (list); iter; iter = iter->next)
{
push (ctx, new_clone (iter));
if (!execute (ctx, get_list (op)))
goto fail;
}
success = true;
fail:
item_free (op);
item_free (list);
return success;
}
defn (fn_each)
{
check_stack (2);
struct item *op = pop (ctx);
struct item *list = pop (ctx);
bool success = false;
if (!check_type (ctx, op, ITEM_LIST)
|| !check_type (ctx, list, ITEM_LIST))
goto fail;
for (struct item *iter = get_list (list); iter; iter = iter->next)
{
push (ctx, new_clone (iter));
if (!execute (ctx, get_list (op)))
goto fail;
}
success = true;
fail:
item_free (op);
item_free (list);
return success;
}
// - - Arithmetic - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
// XXX: why not a `struct item_string *` argument?
static bool
push_repeated_string (struct context *ctx, struct item *op1, struct item *op2)
{
struct item_string *string = (struct item_string *) op1;
struct item_integer *repeat = (struct item_integer *) op2;
assert (string->type == ITEM_STRING);
assert (repeat->type == ITEM_INTEGER);
if (repeat->value < 0)
{
ctx->error = strdup ("cannot multiply a string by a negative value");
return false;
}
char *buf = NULL;
size_t len = string->len * repeat->value;
if (len < string->len && repeat->value != 0)
goto allocation_fail;
buf = malloc (len);
if (!buf)
goto allocation_fail;
for (size_t i = 0; i < len; i += string->len)
memcpy (buf + i, string->value, string->len);
struct item *item = new_string (buf, len);
free (buf);
if (!item)
goto allocation_fail;
push (ctx, item);
return true;
allocation_fail:
// TODO: resolve the memory issues correctly, watch _all_ allocations
ctx->error = strdup ("memory allocation failed");
return false;
}
defn (fn_times)
{
check_stack (2);
struct item *op1 = pop (ctx);
struct item *op2 = 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 if (op1->type == ITEM_INTEGER && op2->type == ITEM_STRING)
success = push_repeated_string (ctx, op2, op1);
else if (op1->type == ITEM_STRING && op2->type == ITEM_INTEGER)
success = push_repeated_string (ctx, op1, op2);
else
{
ctx->error = strdup_printf ("cannot multiply `%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)
{
struct item_string *s1 = (struct item_string *) op1;
struct item_string *s2 = (struct item_string *) op2;
assert (s1->type == ITEM_STRING);
assert (s2->type == ITEM_STRING);
char *buf = NULL;
size_t len = s1->len + s2->len;
if (len < s1->len || len < s2->len)
goto allocation_fail;
buf = malloc (len);
if (!buf)
goto allocation_fail;
memcpy (buf, s1->value, s1->len);
memcpy (buf + s1->len, s2->value, s2->len);
struct item *item = new_string (buf, len);
free (buf);
if (!item)
goto allocation_fail;
push (ctx, item);
return true;
allocation_fail:
// TODO: resolve the memory issues correctly, watch _all_ allocations
ctx->error = strdup ("memory allocation failed");
return false;
}
defn (fn_plus)
{
check_stack (2);
struct item *op1 = pop (ctx);
struct item *op2 = 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 if (op1->type == ITEM_STRING && op2->type == ITEM_STRING)
success = push_concatenated_string (ctx, op2, op1);
else
{
ctx->error = strdup_printf ("cannot add `%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
compare_strings (struct item_string *s1, struct item_string *s2)
{
// XXX: not entirely correct wrt. null bytes
size_t len = (s1->len < s2->len ? s1->len : s2->len) + 1;
return memcmp (s1->value, s2->value, len);
}
static bool compare_lists (struct item *, struct item *);
static bool
compare_list_items (struct item *op1, struct item *op2)
{
if (op1->type != op2->type)
return false;
switch (op1->type)
{
case ITEM_STRING:
case ITEM_WORD:
return !compare_strings ((struct item_string *) op1,
(struct item_string *) op2);
case ITEM_FLOAT:
return get_float (op1) == get_float (op2);
case ITEM_INTEGER:
return get_integer (op1) == get_integer (op2);
case ITEM_LIST:
return compare_lists (get_list (op1), get_list (op2));
}
abort ();
}
static bool
compare_lists (struct item *op1, struct item *op2)
{
while (op1 && op2)
{
if (!compare_list_items (op1, op2))
return false;
op1 = op1->next;
op2 = op2->next;
}
return !op1 && !op2;
}
defn (fn_eq)
{
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_integer (get_integer (op1) == get_float (op2)));
else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
push (ctx, new_integer (get_float (op1) == get_float (op2)));
else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
push (ctx, new_integer (get_float (op1) == get_integer (op2)));
else if (op1->type == ITEM_LIST && op2->type == ITEM_LIST)
push (ctx, new_integer (compare_lists
(get_list (op1), get_list (op2))));
else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING)
push (ctx, new_integer (compare_strings
((struct item_string *)(op1), (struct item_string *)(op2)) == 0));
else
{
ctx->error = strdup_printf ("cannot compare `%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_lt)
{
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_integer (get_integer (op1) < get_float (op2)));
else if (op1->type == ITEM_FLOAT && op2->type == ITEM_FLOAT)
push (ctx, new_integer (get_float (op1) < get_float (op2)));
else if (op1->type == ITEM_FLOAT && op2->type == ITEM_INTEGER)
push (ctx, new_integer (get_float (op1) < get_integer (op2)));
else if (op1->type == ITEM_STRING && op2->type == ITEM_STRING)
push (ctx, new_integer (compare_strings
((struct item_string *)(op1), (struct item_string *)(op2)) < 0));
else
{
ctx->error = strdup_printf ("cannot compare `%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;
}
// - - Utilities - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
defn (fn_rand)
{
push (ctx, new_float ((long double) rand ()
/ ((long double) RAND_MAX + 1)));
return true;
}
defn (fn_time)
{
push (ctx, new_integer (time (NULL)));
return true;
}
// XXX: this is a bit too constrained; combines strftime() with gmtime()
defn (fn_strftime)
{
check_stack (2);
struct item *format = pop (ctx);
struct item *time_ = pop (ctx);
bool success = false;
if (!check_type (ctx, time_, ITEM_INTEGER)
|| !check_type (ctx, format, ITEM_STRING))
goto fail;
if (get_integer (time_) < 0)
{
ctx->error = strdup ("invalid time value");
goto fail;
}
char buf[128];
time_t time__ = get_integer (time_);
struct tm tm;
gmtime_r (&time__, &tm);
buf[strftime (buf, sizeof buf, get_string (format), &tm)] = '\0';
push (ctx, new_string (buf, -1));
success = true;
fail:
item_free (time_);
item_free (format);
return success;
}
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
static void item_list_to_str (const struct item *, struct buffer *);
static void
string_to_str (const struct item_string *string, struct buffer *buf)
{
buffer_append_c (buf, '"');
for (size_t i = 0; i < string->len; i++)
{
char c = string->value[i];
if (c == '\n') buffer_append (buf, "\\\n", 2);
else if (c == '\r') buffer_append (buf, "\\\r", 2);
else if (c == '\t') buffer_append (buf, "\\\t", 2);
else if (!isprint (c))
{
char tmp[8];
snprintf (tmp, sizeof tmp, "\\x%02x", (unsigned char) c);
buffer_append (buf, tmp, strlen (tmp));
}
else if (c == '\\') buffer_append (buf, "\\\\", 2);
else if (c == '"') buffer_append (buf, "\\\"", 2);
else buffer_append_c (buf, c);
}
buffer_append_c (buf, '"');
}
static void
item_to_str (const struct item *item, struct buffer *buf)
{
switch (item->type)
{
char *x;
case ITEM_STRING:
string_to_str ((struct item_string *) item, buf);
break;
case ITEM_WORD:
{
struct item_word *word = (struct item_word *) item;
buffer_append (buf, word->value, word->len);
break;
}
case ITEM_INTEGER:
x = strdup_printf ("%lld", get_integer (item));
buffer_append (buf, x, strlen (x));
free (x);
break;
case ITEM_FLOAT:
x = strdup_printf ("%Lf", get_float (item));
buffer_append (buf, x, strlen (x));
free (x);
break;
case ITEM_LIST:
buffer_append_c (buf, '[');
item_list_to_str (get_list (item), buf);
buffer_append_c (buf, ']');
break;
}
}
static void
item_list_to_str (const struct item *script, struct buffer *buf)
{
bool first = true;
for (; script; script = script->next)
{
if (!first)
buffer_append_c (buf, ' ');
item_to_str (script, buf);
first = false;
}
}
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
// TODO: implement more functions; try to avoid writing it in C
//
// join { list delim -- string } -- string join -> script this
//
// -, /, %, ** -- arithmetic
// >, !=, <=, >= -- comparison
// first -- first character of a string, first element in a list
// rest -- [1:] of a string, the "tail" in a list
// at { value index -- sub-value } -- get n-th subvalue of a string/list
// <each> step { value program } -- foreach
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);
// 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);
// 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
{
char *prefix; ///< Message prefix
char *command; ///< IRC command
char *params[16]; ///< Command parameters (0-terminated)
size_t n_params; ///< Number of parameters present
};
inline static char *
cut_word (char **s)
{
char *start = *s, *end = *s + strcspn (*s, " ");
*s = end + strspn (end, " ");
*end = '\0';
return start;
}
static bool
parse_message (char *s, struct message *msg)
{
memset (msg, 0, sizeof *msg);
// Ignore IRC 3.2 message tags, if present
if (*s == '@')
{
s += strcspn (s, " ");
s += strspn (s, " ");
}
// Prefix
if (*s == ':')
msg->prefix = cut_word (&s) + 1;
// Command
if (!*(msg->command = cut_word (&s)))
return false;
// Parameters
while (*s)
{
size_t n = msg->n_params++;
if (msg->n_params >= N_ELEMENTS (msg->params))
return false;
if (*s == ':')
{
msg->params[n] = ++s;
break;
}
msg->params[n] = cut_word (&s);
}
return true;
}
static struct message *
read_message (void)
{
static bool discard = false;
static char buf[1025];
static struct message msg;
bool discard_this;
do
{
if (!fgets (buf, sizeof buf, stdin))
exit (EXIT_SUCCESS);
size_t len = strlen (buf);
// Just to be on the safe side, if the line overflows our buffer,
// ignore everything up until the next line.
discard_this = discard;
if (len >= 2 && !strcmp (buf + len - 2, "\r\n"))
{
buf[len -= 2] = '\0';
discard = false;
}
else
discard = true;
}
// Invalid messages are silently ignored
while (discard_this || !parse_message (buf, &msg));
return &msg;
}
// --- Interfacing with the bot ------------------------------------------------
#define BOT_PRINT "ZYKLONB print :script: "
static const char *
get_config (const char *key)
{
printf ("ZYKLONB get_config :%s\r\n", key);
struct message *msg = read_message ();
if (msg->n_params <= 0)
exit (EXIT_FAILURE);
return msg->params[0];
}
// --- Function database -------------------------------------------------------
// TODO: a global variable storing the various procedures (db)
// XXX: defining procedures would ideally need some kind of an ACL
static void
read_db (void)
{
// TODO
}
static void
write_db (void)
{
// TODO
}
// --- Main --------------------------------------------------------------------
static char *g_prefix;
struct user_info
{
char *ctx; ///< Context: channel or user
char *ctx_quote; ///< Reply quotation
};
defn (fn_dot)
{
check_stack (1);
struct item *item = pop (ctx);
struct user_info *info = ctx->user_data;
struct buffer buf = BUFFER_INITIALIZER;
item_to_str (item, &buf);
item_free (item);
buffer_append_c (&buf, '\0');
printf ("PRIVMSG %s :%s%s\r\n", info->ctx, info->ctx_quote, buf.s);
free (buf.s);
return true;
}
static void
process_message (struct message *msg)
{
if (strcasecmp (msg->command, "PRIVMSG") || msg->n_params < 2)
return;
char *line = msg->params[1];
// Filter out only our commands
size_t prefix_len = strlen (g_prefix);
if (strncmp (line, g_prefix, prefix_len))
return;
line += prefix_len;
char *command = cut_word (&line);
if (strcasecmp (command, "script"))
return;
// Retrieve information on how to respond back
char *msg_ctx = msg->prefix, *x;
if ((x = strchr (msg_ctx, '!')))
*x = '\0';
char *msg_ctx_quote;
if (strchr ("#+&!", *msg->params[0]))
{
msg_ctx_quote = strdup_printf ("%s: ", msg_ctx);
msg_ctx = msg->params[0];
}
else
msg_ctx_quote = strdup ("");
struct user_info info;
info.ctx = msg_ctx;
info.ctx_quote = msg_ctx_quote;
// Finally parse and execute the macro
char *error = NULL;
struct item *script = parse (line, &error);
if (error)
{
printf ("PRIVMSG %s :%s%s: %s\r\n",
msg_ctx, msg_ctx_quote, "parse error", error);
free (error);
goto end;
}
struct context ctx;
context_init (&ctx);
ctx.user_data = &info;
execute (&ctx, script);
item_free_list (script);
if (ctx.error)
printf ("PRIVMSG %s :%s%s: %s\r\n",
msg_ctx, msg_ctx_quote, "runtime error", ctx.error);
context_free (&ctx);
end:
free (msg_ctx_quote);
}
int
main (int argc, char *argv[])
{
freopen (NULL, "rb", stdin); setvbuf (stdin, NULL, _IOLBF, BUFSIZ);
freopen (NULL, "wb", stdout); setvbuf (stdout, NULL, _IOLBF, BUFSIZ);
read_db ();
init_runtime_library ();
register_handler (".", fn_dot);
g_prefix = strdup (get_config ("prefix"));
printf ("ZYKLONB register\r\n");
while (true)
{
struct message *msg = read_message ();
process_message (msg);
}
return 0;
}