Come up with sillier names for the binaries

I'm not entirely sure, but it looks like some people might not like
jokes about the Holocaust.

On a more serious note, the project has become more serious over
the 7 or so years of its existence.

1 files changed, 2310 insertions, 0 deletions

diff --git a/plugins/xB/script b/plugins/xB/script
new file mode 100755
index 0000000..948e7e5
--- /dev/null
+++ b/plugins/xB/script
@@ -0,0 +1,2310 @@
+#!/usr/bin/tcc -run -lm
+//
+// xB scripting plugin, using a custom stack-based language
+//
+// Copyright 2014 Přemysl Eric Janouch
+// 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 relatively easy to 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>
+#include <math.h>
+
+#define ADDRESS_SPACE_LIMIT (100 * 1024 * 1024)
+#include <sys/resource.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_vprintf (const char *format, va_list ap)
+{
+	va_list aq;
+	va_copy (aq, ap);
+	int size = vsnprintf (NULL, 0, format, aq);
+	va_end (aq);
+	if (size < 0)
+		return NULL;
+
+	char buf[size + 1];
+	size = vsnprintf (buf, sizeof buf, format, ap);
+	if (size < 0)
+		return NULL;
+
+	return strdup (buf);
+}
+
+static char *
+strdup_printf (const char *format, ...)
+{
+	va_list ap;
+	va_start (ap, format);
+	char *result = strdup_vprintf (format, ap);
+	va_end (ap);
+	return result;
+}
+
+// --- Generic buffer ----------------------------------------------------------
+
+struct buffer
+{
+	char *s;                            ///< Buffer data
+	size_t alloc;                       ///< Number of bytes allocated
+	size_t len;                         ///< Number of bytes used
+	bool memory_failure;                ///< Memory allocation failed
+};
+
+#define BUFFER_INITIALIZER { NULL, 0, 0, false }
+
+static bool
+buffer_append (struct buffer *self, const void *s, size_t n)
+{
+	if (self->memory_failure)
+		return false;
+
+	if (!self->s)
+		self->s = malloc (self->alloc = 8);
+	while (self->len + n > self->alloc)
+		self->s = realloc (self->s, self->alloc <<= 1);
+
+	if (!self->s)
+	{
+		self->memory_failure = true;
+		return false;
+	}
+
+	memcpy (self->s + self->len, s, n);
+	self->len += n;
+	return true;
+}
+
+inline static bool
+buffer_append_c (struct buffer *self, char c)
+{
+	return 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 = malloc (size);
+	if (!clone)
+		return NULL;
+
+	memcpy (clone, item, size);
+	if (item->type == ITEM_LIST)
+	{
+		struct item_list *x = (struct item_list *) clone;
+		if (x->head && !(x->head = new_clone_list (x->head)))
+		{
+			free (clone);
+			return NULL;
+		}
+	}
+	clone->next = NULL;
+	return clone;
+}
+
+static struct item *
+new_clone_list (const struct item *item)
+{
+	struct item *head = NULL, *clone;
+	for (struct item **out = &head; item; item = item->next)
+	{
+		if (!(clone = *out = new_clone (item)))
+		{
+			item_free_list (head);
+			return NULL;
+		}
+		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);
+	if (!item)
+		return NULL;
+
+	item->type = ITEM_WORD;
+	return item;
+}
+
+static struct item *
+new_integer (long long value)
+{
+	struct item_integer *item = calloc (1, sizeof *item);
+	if (!item)
+		return NULL;
+
+	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);
+	if (!item)
+		return NULL;
+
+	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);
+	if (!item)
+		return NULL;
+
+	item->type = ITEM_LIST;
+	item->head = head;
+	return (struct item *) item;
+}
+
+// --- Parsing -----------------------------------------------------------------
+
+#define PARSE_ERROR_TABLE(XX)                                                  \
+	XX( OK,                  NULL                                  )           \
+	XX( EOF,                 "unexpected end of input"             )           \
+	XX( INVALID_HEXA_ESCAPE, "invalid hexadecimal escape sequence" )           \
+	XX( INVALID_ESCAPE,      "unrecognized escape sequence"        )           \
+	XX( MEMORY,              "memory allocation failure"           )           \
+	XX( FLOAT_RANGE,         "floating point value out of range"   )           \
+	XX( INTEGER_RANGE,       "integer out of range"                )           \
+	XX( INVALID_INPUT,       "invalid input"                       )           \
+	XX( UNEXPECTED_INPUT,    "unexpected input"                    )
+
+enum tokenizer_error
+{
+#define XX(x, y) PARSE_ERROR_ ## x,
+	PARSE_ERROR_TABLE (XX)
+#undef XX
+	PARSE_ERROR_COUNT
+};
+
+struct tokenizer
+{
+	const char *cursor;
+	enum tokenizer_error 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 = PARSE_ERROR_EOF;
+		return false;
+	case 'x':
+	case 'X':
+		self->cursor++;
+		if (decode_hexa_escape (self, buf))
+			return true;
+
+		self->error = PARSE_ERROR_INVALID_HEXA_ESCAPE;
+		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 = PARSE_ERROR_INVALID_ESCAPE;
+		return false;
+	}
+}
+
+static struct item *
+parse_string (struct tokenizer *self)
+{
+	struct buffer buf = BUFFER_INITIALIZER;
+	struct item *item = NULL;
+	char c;
+
+	while (true)
+	switch ((c = *self->cursor++))
+	{
+	case '\0':
+		self->cursor--;
+		self->error = PARSE_ERROR_EOF;
+		goto end;
+	case '"':
+		if (buf.memory_failure
+		 || !(item = new_string (buf.s, buf.len)))
+			self->error = PARSE_ERROR_MEMORY;
+		goto end;
+	case '\\':
+		if (decode_escape_sequence (self, &buf))
+			break;
+		goto end;
+	default:
+		buffer_append_c (&buf, c);
+	}
+
+end:
+	free (buf.s);
+	return item;
+}
+
+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:
+	struct item *item;
+	if (float_end > int_end)
+	{
+		if (float_errno == ERANGE)
+		{
+			self->error = PARSE_ERROR_FLOAT_RANGE;
+			return NULL;
+		}
+		self->cursor = float_end;
+		if (!(item = new_float (float_value)))
+			self->error = PARSE_ERROR_MEMORY;
+		return item;
+	}
+	else
+	{
+		if (int_errno == ERANGE)
+		{
+			self->error = PARSE_ERROR_INTEGER_RANGE;
+			return NULL;
+		}
+		self->cursor = int_end;
+		if (!(item = new_integer (int_value)))
+			self->error = PARSE_ERROR_MEMORY;
+		return item;
+	}
+}
+
+static struct item *
+parse_word (struct tokenizer *self)
+{
+	struct buffer buf = BUFFER_INITIALIZER;
+	struct item *item = NULL;
+	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--;
+
+	if (buf.memory_failure)
+		self->error = PARSE_ERROR_MEMORY;
+	else if (!buf.len)
+		self->error = PARSE_ERROR_INVALID_INPUT;
+	else if (!(item = new_word (buf.s, buf.len)))
+		self->error = PARSE_ERROR_MEMORY;
+
+	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 = PARSE_ERROR_EOF;
+		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 = PARSE_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, const char **error)
+{
+	struct tokenizer self = { .cursor = s, .error = PARSE_ERROR_OK };
+	struct item *list = parse_item_list (&self);
+	if (!self.error && *self.cursor != '\0')
+	{
+		self.error = PARSE_ERROR_UNEXPECTED_INPUT;
+		item_free_list (list);
+		list = NULL;
+	}
+
+#define XX(x, y) y,
+	static const char *strings[PARSE_ERROR_COUNT] =
+		{ PARSE_ERROR_TABLE (XX) };
+#undef XX
+
+	static char error_buf[128];
+	if (self.error && error)
+	{
+		snprintf (error_buf, sizeof error_buf, "at character %d: %s",
+			(int) (self.cursor - s) + 1, strings[self.error]);
+		*error = error_buf;
+	}
+	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
+	bool memory_failure;                ///< Memory allocation failure
+
+	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->memory_failure = 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 bool
+set_error (struct context *ctx, const char *format, ...)
+{
+	free (ctx->error);
+
+	va_list ap;
+	va_start (ap, format);
+	ctx->error = strdup_vprintf (format, ap);
+	va_end (ap);
+
+	if (!ctx->error)
+		ctx->memory_failure = true;
+	return false;
+}
+
+static bool
+push (struct context *ctx, struct item *item)
+{
+	// The `item' is typically a result from new_<type>(), thus when it is null,
+	// that function must have failed.  This is a shortcut for convenience.
+	if (!item)
+	{
+		ctx->memory_failure = true;
+		return false;
+	}
+
+	assert (item->next == NULL);
+	item->next = ctx->stack;
+	ctx->stack = item;
+	ctx->stack_size++;
+	return true;
+}
+
+static bool
+bump_reductions (struct context *ctx)
+{
+	if (++ctx->reduction_count >= ctx->reduction_limit)
+	{
+		ctx->error_is_fatal = true;
+		return set_error (ctx, "reduction limit reached");
+	}
+	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;
+	return set_error (ctx, "unknown function: %s", name);
+
+found:
+	if (!bump_reductions (ctx))
+		return false;
+
+	if (iter->handler
+		? iter->handler (ctx)
+		: execute (ctx, iter->script))
+		return true;
+
+	// In this case, `error' is NULL
+	if (ctx->memory_failure)
+		return false;
+
+	// This creates some form of a stack trace
+	char *tmp = ctx->error;
+	ctx->error = NULL;
+	set_error (ctx, "%s -> %s", name, tmp);
+	free (tmp);
+	return false;
+}
+
+static void
+free_function (struct fn *fn)
+{
+	item_free_list (fn->script);
+	free (fn);
+}
+
+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;
+			free_function (tmp);
+			break;
+		}
+}
+
+static struct fn *
+prepend_new_fn (const char *name)
+{
+	struct fn *fn = calloc (1, sizeof *fn + strlen (name) + 1);
+	if (!fn)
+		return NULL;
+
+	strcpy (fn->name, name);
+	fn->next = g_functions;
+	return g_functions = fn;
+}
+
+static bool
+register_handler (const char *name, handler_fn handler)
+{
+	unregister_function (name);
+	struct fn *fn = prepend_new_fn (name);
+	if (!fn)
+		return false;
+	fn->handler = handler;
+	return true;
+}
+
+static bool
+register_script (const char *name, struct item *script)
+{
+	unregister_function (name);
+	struct fn *fn = prepend_new_fn (name);
+	if (!fn)
+		return false;
+	fn->script = script;
+	return true;
+}
+
+static bool
+execute (struct context *ctx, struct item *script)
+{
+	for (; script; script = script->next)
+	{
+		if (script->type != ITEM_WORD)
+		{
+			if (!bump_reductions (ctx)
+			 || !push (ctx, new_clone (script)))
+				return false;
+		}
+		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) {                                                 \
+		set_error (ctx, "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;
+
+	return set_error (ctx, "invalid type: expected `%s', got `%s'",
+		item_type_to_str (type), item_type_to_str (item->type));
+}
+
+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:
+		return push (ctx, item);
+
+	case ITEM_FLOAT:
+		value = strdup_printf ("%Lf", get_float (item));
+		break;
+	case ITEM_INTEGER:
+		value = strdup_printf ("%lld", get_integer (item));
+		break;
+
+	default:
+		set_error (ctx, "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);
+	if (!value)
+	{
+		ctx->memory_failure = true;
+		return false;
+	}
+
+	item = new_string (value, -1);
+	free (value);
+	return push (ctx, item);
+}
+
+defn (fn_to_integer)
+{
+	check_stack (1);
+	struct item *item = pop (ctx);
+	long long value;
+
+	switch (item->type)
+	{
+	case ITEM_INTEGER:
+		return push (ctx, item);
+	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;
+
+		item_free (item);
+		return set_error (ctx, "integer conversion error");
+	}
+
+	default:
+		set_error (ctx, "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);
+	return push (ctx, new_integer (value));
+}
+
+defn (fn_to_float)
+{
+	check_stack (1);
+	struct item *item = pop (ctx);
+	long double value;
+
+	switch (item->type)
+	{
+	case ITEM_FLOAT:
+		return push (ctx, item);
+	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;
+
+		item_free (item);
+		return set_error (ctx, "float conversion error");
+	}
+
+	default:
+		set_error (ctx, "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);
+	return push (ctx, new_float (value));
+}
+
+// - - Miscellaneous - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+defn (fn_length)
+{
+	check_stack (1);
+	struct item *item = pop (ctx);
+	bool success = true;
+	switch (item->type)
+	{
+	case ITEM_STRING:
+		success = push (ctx, new_integer (((struct item_string *) item)->len));
+		break;
+	case ITEM_LIST:
+	{
+		long long length = 0;
+		struct item *iter;
+		for (iter = get_list (item); iter; iter = iter->next)
+			length++;
+		success = push (ctx, new_integer (length));
+		break;
+	}
+	default:
+		success = set_error (ctx, "invalid type");
+	}
+	item_free (item);
+	return success;
+}
+
+// - - Stack operations  - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+defn (fn_dup)
+{
+	check_stack (1);
+	return push (ctx, new_clone (ctx->stack));
+}
+
+defn (fn_drop)
+{
+	check_stack (1);
+	item_free (pop (ctx));
+	return true;
+}
+
+defn (fn_swap)
+{
+	check_stack (2);
+	struct item *second = pop (ctx), *first = pop (ctx);
+	return push (ctx, second) && push (ctx, first);
+}
+
+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));
+	item_free (script);
+	if (!success)
+	{
+		item_free (item);
+		return false;
+	}
+	return push (ctx, item);
+}
+
+defn (fn_unit)
+{
+	check_stack (1);
+	struct item *item = pop (ctx);
+	return push (ctx, new_list (item));
+}
+
+defn (fn_cons)
+{
+	check_stack (2);
+	struct item *list = pop (ctx);
+	struct item *item = pop (ctx);
+	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;
+	return push (ctx, list);
+}
+
+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);
+
+	((struct item_list *) scnd)->head = NULL;
+	item_free (scnd);
+	return push (ctx, frst);
+}
+
+defn (fn_uncons)
+{
+	check_stack (1);
+	struct item *list = pop (ctx);
+	if (!check_type (ctx, list, ITEM_LIST))
+		goto fail;
+	struct item *first = get_list (list);
+	if (!first)
+	{
+		set_error (ctx, "list is empty");
+		goto fail;
+	}
+	((struct item_list *) list)->head = first->next;
+	first->next = NULL;
+	return push (ctx, first) && push (ctx, list);
+fail:
+	item_free (list);
+	return false;
+}
+
+// - - Logical - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+static bool
+to_boolean (struct context *ctx, struct item *item, bool *ok)
+{
+	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:
+		return (*ok = set_error (ctx, "cannot convert `%s' to boolean",
+			item_type_to_str (item->type)));
+	}
+}
+
+defn (fn_not)
+{
+	check_stack (1);
+	struct item *item = pop (ctx);
+	bool ok = true;
+	bool result = !to_boolean (ctx, item, &ok);
+	item_free (item);
+	return ok && push (ctx, new_integer (result));
+}
+
+defn (fn_and)
+{
+	check_stack (2);
+	struct item *op1 = pop (ctx);
+	struct item *op2 = pop (ctx);
+	bool ok = true;
+	bool result = to_boolean (ctx, op1, &ok) && to_boolean (ctx, op2, &ok);
+	item_free (op1);
+	item_free (op2);
+	return ok && push (ctx, new_integer (result));
+}
+
+defn (fn_or)
+{
+	check_stack (2);
+	struct item *op1 = pop (ctx);
+	struct item *op2 = pop (ctx);
+	bool ok = true;
+	bool result = to_boolean (ctx, op1, &ok)
+		|| !ok || to_boolean (ctx, op2, &ok);
+	item_free (op1);
+	item_free (op2);
+	return ok && push (ctx, new_integer (result));
+}
+
+// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+defn (fn_if)
+{
+	check_stack (3);
+	struct item *else_ = pop (ctx);
+	struct item *then_ = pop (ctx);
+	struct item *cond_ = pop (ctx);
+
+	bool ok = true;
+	bool condition = to_boolean (ctx, cond_, &ok);
+	item_free (cond_);
+
+	bool success = false;
+	if (ok
+	 && 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->memory_failure || ctx->error_is_fatal)
+			goto fail;
+
+		success = push (ctx, new_string (ctx->error, -1));
+		free (ctx->error);
+		ctx->error = NULL;
+
+		if (success)
+			success = execute (ctx, get_list (catch));
+	}
+
+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)
+	{
+		if (!push (ctx, new_clone (iter))
+		 || !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);
+	item_free (fn);
+	if (!success)
+	{
+		item_free (list);
+		return false;
+	}
+	return push (ctx, list);
+}
+
+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;
+	bool ok = true;
+	struct item *result = NULL, **tail = &result;
+	for (struct item *iter = get_list (list); iter; iter = iter->next)
+	{
+		if (!push (ctx, new_clone (iter))
+		 || !execute (ctx, get_list (fn))
+		 || !check_stack_safe (ctx, 1))
+			goto fail;
+
+		struct item *item = pop (ctx);
+		bool survived = to_boolean (ctx, item, &ok);
+		item_free (item);
+		if (!ok)
+			goto fail;
+		if (!survived)
+			continue;
+
+		if (!(item = new_clone (iter)))
+			goto fail;
+		*tail = item;
+		tail = &item->next;
+	}
+	success = true;
+
+fail:
+	set_list (list, result);
+	item_free (fn);
+	if (!success)
+	{
+		item_free (list);
+		return false;
+	}
+	return push (ctx, list);
+}
+
+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)
+		if (!push (ctx, new_clone (iter))
+		 || !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)
+		if (!push (ctx, new_clone (iter))
+		 || !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)
+		return set_error (ctx, "cannot multiply a string by a negative value");
+
+	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);
+	return push (ctx, item);
+
+allocation_fail:
+	ctx->memory_failure = true;
+	return false;
+}
+
+defn (fn_times)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+
+	bool ok;
+	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_integer (get_integer (op1) * get_integer (op2)));
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float   (get_integer (op1) * get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float   (get_float   (op1) * get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_float   (get_float   (op1) * get_integer (op2)));
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_STRING)
+		ok = push_repeated_string (ctx, op2, op1);
+	else if (op1->type == ITEM_STRING  && op2->type == ITEM_INTEGER)
+		ok = push_repeated_string (ctx, op1, op2);
+	else
+		ok = set_error (ctx, "cannot multiply `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+	item_free (op1);
+	item_free (op2);
+	return ok;
+}
+
+defn (fn_pow)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+
+	bool ok;
+	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+		// TODO: implement this properly, outputting an integer
+		ok = push (ctx, new_float (powl (get_integer (op1), get_integer (op2))));
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float (powl (get_integer (op1), get_float   (op2))));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float (powl (get_float   (op1), get_float   (op2))));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_float (powl (get_float   (op1), get_integer (op2))));
+	else
+		ok = set_error (ctx, "cannot exponentiate `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+	item_free (op1);
+	item_free (op2);
+	return ok;
+}
+
+defn (fn_div)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+
+	bool ok;
+	if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+	{
+		if (get_integer (op2) == 0)
+			ok = set_error (ctx, "division by zero");
+		else
+			ok = push (ctx, new_integer (get_integer (op1) / get_integer (op2)));
+	}
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float (get_integer (op1) / get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float (get_float   (op1) / get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_float (get_float   (op1) / get_integer (op2)));
+	else
+		ok = set_error (ctx, "cannot divide `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+	item_free (op1);
+	item_free (op2);
+	return ok;
+}
+
+defn (fn_mod)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+
+	bool ok;
+	if (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+	{
+		if (get_integer (op2) == 0)
+			ok = set_error (ctx, "division by zero");
+		else
+			ok = push (ctx, new_integer (get_integer (op1) % get_integer (op2)));
+	}
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float (fmodl (get_integer (op1), get_float   (op2))));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float (fmodl (get_float   (op1), get_float   (op2))));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_float (fmodl (get_float   (op1), get_integer (op2))));
+	else
+		ok = set_error (ctx, "cannot divide `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+	item_free (op1);
+	item_free (op2);
+	return ok;
+}
+
+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);
+	return push (ctx, item);
+
+allocation_fail:
+	ctx->memory_failure = true;
+	return false;
+
+}
+
+defn (fn_plus)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+
+	bool ok;
+	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_integer (get_integer (op1) + get_integer (op2)));
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float   (get_integer (op1) + get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float   (get_float   (op1) + get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_float   (get_float   (op1) + get_integer (op2)));
+	else if (op1->type == ITEM_STRING  && op2->type == ITEM_STRING)
+		ok = push_concatenated_string (ctx, op1, op2);
+	else
+		ok = set_error (ctx, "cannot add `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+	item_free (op1);
+	item_free (op2);
+	return ok;
+}
+
+defn (fn_minus)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+
+	bool ok;
+	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_integer (get_integer (op1) - get_integer (op2)));
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float   (get_integer (op1) - get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_float   (get_float   (op1) - get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_float   (get_float   (op1) - get_integer (op2)));
+	else
+		ok = set_error (ctx, "cannot subtract `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+	item_free (op1);
+	item_free (op2);
+	return ok;
+}
+
+// - - 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 ok;
+	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_integer (get_integer (op1) == get_integer (op2)));
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_integer (get_integer (op1) == get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_integer (get_float   (op1) == get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_integer (get_float   (op1) == get_integer (op2)));
+	else if (op1->type == ITEM_LIST    && op2->type == ITEM_LIST)
+		ok = push (ctx, new_integer (compare_lists
+			(get_list (op1), get_list (op2))));
+	else if (op1->type == ITEM_STRING  && op2->type == ITEM_STRING)
+		ok = push (ctx, new_integer (compare_strings
+			((struct item_string *)(op1), (struct item_string *)(op2)) == 0));
+	else
+		ok = set_error (ctx, "cannot compare `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+	item_free (op1);
+	item_free (op2);
+	return ok;
+}
+
+defn (fn_lt)
+{
+	check_stack (2);
+	struct item *op2 = pop (ctx);
+	struct item *op1 = pop (ctx);
+
+	bool ok;
+	if      (op1->type == ITEM_INTEGER && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_integer (get_integer (op1) < get_integer (op2)));
+	else if (op1->type == ITEM_INTEGER && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_integer (get_integer (op1) < get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_FLOAT)
+		ok = push (ctx, new_integer (get_float   (op1) < get_float   (op2)));
+	else if (op1->type == ITEM_FLOAT   && op2->type == ITEM_INTEGER)
+		ok = push (ctx, new_integer (get_float   (op1) < get_integer (op2)));
+	else if (op1->type == ITEM_STRING  && op2->type == ITEM_STRING)
+		ok = push (ctx, new_integer (compare_strings
+			((struct item_string *)(op1), (struct item_string *)(op2)) < 0));
+	else
+		ok = set_error (ctx, "cannot compare `%s' and `%s'",
+			item_type_to_str (op1->type), item_type_to_str (op2->type));
+
+	item_free (op1);
+	item_free (op2);
+	return ok;
+}
+
+// - - Utilities - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+defn (fn_rand)
+{
+	return push (ctx, new_float ((long double) rand ()
+		/ ((long double) RAND_MAX + 1)));
+}
+
+defn (fn_time)
+{
+	return push (ctx, new_integer (time (NULL)));
+}
+
+// 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)
+	{
+		set_error (ctx, "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';
+	success = push (ctx, new_string (buf, -1));
+
+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:
+		if (!(x = strdup_printf ("%lld", get_integer (item))))
+			goto alloc_failure;
+		buffer_append (buf, x, strlen (x));
+		free (x);
+		break;
+	case ITEM_FLOAT:
+		if (!(x = strdup_printf ("%Lf", get_float (item))))
+			goto alloc_failure;
+		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;
+	}
+	return;
+
+alloc_failure:
+	// This is a bit hackish but it simplifies stuff
+	buf->memory_failure = true;
+	free (buf->s);
+	buf->s = NULL;
+}
+
+static void
+item_list_to_str (const struct item *script, struct buffer *buf)
+{
+	if (!script)
+		return;
+
+	item_to_str (script, buf);
+	while ((script = script->next))
+	{
+		buffer_append_c (buf, ' ');
+		item_to_str (script, buf);
+	}
+}
+
+// --- 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))
+			return NULL;
+		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 || msg->n_params <= 0)
+		exit (EXIT_FAILURE);
+	return msg->params[0];
+}
+
+// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+
+// TODO: implement more functions; try to avoid writing them in C
+
+static bool
+init_runtime_library_scripts (void)
+{
+	bool ok = true;
+
+	// 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++)
+	{
+		const 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);
+			ok = false;
+		}
+		else
+			ok &= register_script (scripts[i].name, script);
+	}
+
+	struct context ctx;
+	for (size_t i = 0; i < N_ELEMENTS (scripts); i++)
+	{
+		const 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);
+			ok = false;
+			continue;
+		}
+		context_init (&ctx);
+		execute (&ctx, script);
+		item_free_list (script);
+
+		const char *failure = NULL;
+		if (ctx.memory_failure)
+			failure = "memory allocation failure";
+		else if (ctx.error)
+			failure = ctx.error;
+		else if (ctx.stack_size != 1)
+			failure = "too many results on the stack";
+		else if (ctx.stack->type != ITEM_INTEGER)
+			failure = "result is not an integer";
+		else if (get_integer (ctx.stack) != 1)
+			failure = "wrong test result";
+		if (failure)
+		{
+			printf (BOT_PRINT "error executing unit test for `%s': %s\r\n",
+				scripts[i].name, failure);
+			ok = false;
+		}
+		context_free (&ctx);
+	}
+	return ok;
+}
+
+static bool
+init_runtime_library (void)
+{
+	bool ok = true;
+
+	// Type detection
+	ok &= register_handler ("string?",  fn_is_string);
+	ok &= register_handler ("word?",    fn_is_word);
+	ok &= register_handler ("integer?", fn_is_integer);
+	ok &= register_handler ("float?",   fn_is_float);
+	ok &= register_handler ("list?",    fn_is_list);
+
+	// Type conversion
+	ok &= register_handler (">string",  fn_to_string);
+	ok &= register_handler (">integer", fn_to_integer);
+	ok &= register_handler (">float",   fn_to_float);
+
+	// Miscellaneous
+	ok &= register_handler ("length",   fn_length);
+
+	// Basic stack manipulation
+	ok &= register_handler ("dup",      fn_dup);
+	ok &= register_handler ("drop",     fn_drop);
+	ok &= register_handler ("swap",     fn_swap);
+
+	// Calling stuff
+	ok &= register_handler ("call",     fn_call);
+	ok &= register_handler ("dip",      fn_dip);
+
+	// Control flow
+	ok &= register_handler ("if",       fn_if);
+	ok &= register_handler ("try",      fn_try);
+
+	// List processing
+	ok &= register_handler ("map",      fn_map);
+	ok &= register_handler ("filter",   fn_filter);
+	ok &= register_handler ("fold",     fn_fold);
+	ok &= register_handler ("each",     fn_each);
+
+	// List manipulation
+	ok &= register_handler ("unit",     fn_unit);
+	ok &= register_handler ("cons",     fn_cons);
+	ok &= register_handler ("cat",      fn_cat);
+	ok &= register_handler ("uncons",   fn_uncons);
+
+	// Arithmetic operations
+	ok &= register_handler ("+",        fn_plus);
+	ok &= register_handler ("-",        fn_minus);
+	ok &= register_handler ("*",        fn_times);
+	ok &= register_handler ("^",        fn_pow);
+	ok &= register_handler ("/",        fn_div);
+	ok &= register_handler ("%",        fn_mod);
+
+	// Comparison
+	ok &= register_handler ("=",        fn_eq);
+	ok &= register_handler ("<",        fn_lt);
+
+	// Logical operations
+	ok &= register_handler ("not",      fn_not);
+	ok &= register_handler ("and",      fn_and);
+	ok &= register_handler ("or",       fn_or);
+
+	// Utilities
+	ok &= register_handler ("rand",     fn_rand);
+	ok &= register_handler ("time",     fn_time);
+	ok &= register_handler ("strftime", fn_strftime);
+
+	ok &= init_runtime_library_scripts ();
+	return ok;
+}
+
+static void
+free_runtime_library (void)
+{
+	struct fn *next, *iter;
+	for (iter = g_functions; iter; iter = next)
+	{
+		next = iter->next;
+		free_function (iter);
+	}
+}
+
+// --- 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');
+	if (buf.memory_failure)
+	{
+		ctx->memory_failure = true;
+		return false;
+	}
+
+	if (buf.len > 255)
+		buf.s[255] = '\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 (!msg->prefix
+	 || 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 ("");
+
+	if (!msg_ctx_quote)
+	{
+		printf (BOT_PRINT "%s\r\n", "memory allocation failure");
+		return;
+	}
+
+	struct user_info info;
+	info.ctx = msg_ctx;
+	info.ctx_quote = msg_ctx_quote;
+
+	// Finally parse and execute the macro
+	const 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);
+		goto end;
+	}
+
+	struct context ctx;
+	context_init (&ctx);
+	ctx.user_data = &info;
+	execute (&ctx, script);
+	item_free_list (script);
+
+	const char *failure = NULL;
+	if (ctx.memory_failure)
+		failure = "memory allocation failure";
+	else if (ctx.error)
+		failure = ctx.error;
+	if (failure)
+		printf ("PRIVMSG %s :%s%s: %s\r\n",
+			msg_ctx, msg_ctx_quote, "runtime error", failure);
+	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);
+
+	struct rlimit limit =
+	{
+		.rlim_cur = ADDRESS_SPACE_LIMIT,
+		.rlim_max = ADDRESS_SPACE_LIMIT
+	};
+
+	// Lower the memory limits to something sensible to prevent abuse
+	(void) setrlimit (RLIMIT_AS, &limit);
+
+	read_db ();
+	if (!init_runtime_library ()
+	 || !register_handler (".", fn_dot))
+		printf (BOT_PRINT "%s\r\n", "runtime library initialization failed");
+
+	g_prefix = strdup (get_config ("prefix"));
+	printf ("ZYKLONB register\r\n");
+	struct message *msg;
+	while ((msg = read_message ()))
+		process_message (msg);
+
+	free_runtime_library ();
+	free (g_prefix);
+	return 0;
+}
+