~brenns10/funlisp

fb70c3fcfd8bc748c26ffaf360a9bc3681348f9e — Stephen Brennan 2 years ago 4c540ff + 8fbac21
Merge branch 'feature/error_handling', closes #12
M doc/api.rst => doc/api.rst +6 -0
@@ 44,3 44,9 @@ Embedding Tools

.. doxygengroup:: embed
   :content-only:

Error Handling
-----------------------

.. doxygengroup:: error
   :content-only:

M doc/embedding.rst => doc/embedding.rst +16 -2
@@ 66,7 66,8 @@ steps:
3. Parse the input. Parsed code is simply a :c:type:`lisp_value` like any other
   language object.
4. Evaluate the input within the global scope.
5. Print the output, and a trailing newline.
5. If an error occurred, print it and continue. If nothing of interest is
   returned, do nothing. Otherwise, print the output, and a trailing newline.
6. Mark everything in scope, then sweep unreachable objects.
7. Repeat steps 2-7 for each line of input.
8. Destroy the language runtime to finish cleaning up memory.


@@ 78,6 79,11 @@ without any custom functions. It uses the ``editline`` implementation of the
.. literalinclude:: ../tools/repl.c
  :language: C

Notice here that :c:func:`lisp_eval()` returns NULL in case of an error. If that
happens, then you can use :c:func:`lisp_print_error()` to print a user-facing
error message, and :c:func:`lisp_clear_error()` to clear the error from the
interpreter state.

The Script Runner
-----------------



@@ 119,6 125,15 @@ can do this individually with the :c:func:`lisp_eval()` function, or just
evaluate the whole list of arguments with the :c:func:`lisp_eval_list()`
function.

.. warning::

  As we've noticed in the previous example programs, evaluating code can return
  ``NULL`` if an error (e.g. an exception of some sort) occurs. A well-behaved
  builtin will test the result of all calls to :c:func:`lisp_eval()` and
  :c:func:`lisp_call()` using the macro ``lisp_error_check()`` in order to
  propagate those errors back to the user. :c:func:`lisp_eval_list()` propagates
  errors back, and so it should be error checked as well.

The one exception to evaluating all of your arguments is if you're defining some
sort of syntactic construct. An example of this is the if-statement. The if
statement looks like ``(if condition expr-if-true expr-if-false)``. It is


@@ 139,7 154,6 @@ characters are:
- ``s``: for symbol
- ``S``: for string
- ``o``: for scope
- ``e``: for error
- ``b``: for builtin
- ``t``: for type
- ``*``: for anything

M inc/funlisp.h => inc/funlisp.h +79 -30
@@ 117,14 117,6 @@ typedef struct lisp_scope lisp_scope;
typedef struct lisp_symbol lisp_symbol;

/**
 * Error is a lisp type returned whenever (shockingly) an error occurs. This is
 * a bit of a hack to enable a base support for error handling. Errors may have
 * a string message.
 * @ingroup types
 */
typedef struct lisp_error lisp_error;

/**
 * ::lisp_integer contains an int object of whatever size the C implementation
 * supports.
 * @ingroup types


@@ 176,20 168,30 @@ void lisp_print(FILE *f, lisp_value *value);
 * others.  For example, evaluating a scope will not work. However, evaluating a
 * symbol will look it up in the current scope, and evaluating list ``l`` will
 * attempt to call ``(car l)`` with arguments ``(cdr l)``.
 * @param rt runtime associated with scope and value @param scope the scope to
 * use for evaluation (used when looking up symbols) @param value the value
 * (code generally) to evaluate @return the result of evaluating value in scope
 *
 * When an error occurs during execution, this function returns NULL and sets
 * the internal error details within the runtime.
 *
 * @param rt runtime associated with scope and value
 * @param scope the scope to use for evaluation (used when looking up symbols)
 * @param value the value to evaluate
 * @return the result of evaluating @a value in @a scope
 * @retval NULL when an error occurs
 */
lisp_value *lisp_eval(lisp_runtime *rt, lisp_scope *scope, lisp_value *value);

/**
 * Call a callable object with a list of arguments. Many data types are not
 * callable, in which case a ::lisp_error is returned.
 * callable, in which case a NULL is returned and an error is set within the
 * runtime.
 * @param rt runtime
 * @param scope scope in which we are being evaluated
 * @param callable value to call
 * @param arguments a ::lisp_list containing arguments (which *have not yet been
 * evaluated*)
 * @return the result of calling @a callable with args @a arguments in scope @a
 * scope.
 * @retval NULL when an error occurs
 */
lisp_value *lisp_call(lisp_runtime *rt, lisp_scope *scope, lisp_value *callable,
                      lisp_value *arguments);


@@ 259,11 261,11 @@ void lisp_scope_bind(lisp_scope *scope, lisp_symbol *symbol, lisp_value *value);
/**
 * Look up a symbol within a scope. If it is not found in this scope, look
 * within the parent scope etc, until it is found. If it is not found at all,
 * return a ::lisp_error object.
 * return NULL and set an error within the interpreter.
 * @param rt runtime
 * @param scope scope to look in
 * @param symbol symbol to look up
 * @return value found, or a ::lisp_error when not found
 * @return value found, or a NULL when not found
 */
lisp_value *lisp_scope_lookup(lisp_runtime *rt, lisp_scope *scope,
                              lisp_symbol *symbol);


@@ 273,7 275,7 @@ lisp_value *lisp_scope_lookup(lisp_runtime *rt, lisp_scope *scope,
 * @param rt runtime
 * @param scope scope to look in
 * @param name string name to look up
 * @return value found, or a ::lisp_error when not found
 * @return value found, or NULL when not found
 */
lisp_value *lisp_scope_lookup_string(lisp_runtime *rt, lisp_scope *scope, char *name);



@@ 392,12 394,6 @@ int lisp_nil_p(lisp_value *l);
extern lisp_type *type_symbol;

/**
 * Type object of ::lisp_error, for type checking.
 * @sa lisp_is()
 */
extern lisp_type *type_error;

/**
 * Type object of ::lisp_integer, for type checking.
 * @sa lisp_is()
 */


@@ 486,14 482,7 @@ char *lisp_symbol_get(lisp_symbol *s);
 * @param message message to use for creating the error
 * @return a new error
 */
lisp_error  *lisp_error_new(lisp_runtime *rt, char *message);

/**
 * Return the message from an error.
 * @param e the error to retrieve the message from
 * @return the message contained in the error
 */
char *lisp_error_get(lisp_error *e);
lisp_value  *lisp_error_new(lisp_runtime *rt, char *message);

/**
 * Create a new integer.


@@ 563,6 552,7 @@ void lisp_scope_add_builtin(lisp_runtime *rt, lisp_scope *scope, char *name,
 * @param scope scope to evaluate within
 * @param list list of un-evaluated function arguments
 * @return list of evaluated function arguments
 * @retval NULL if an error occured during evaluation
 */
lisp_value *lisp_eval_list(lisp_runtime *rt, lisp_scope *scope, lisp_value *list);



@@ 638,7 628,8 @@ lisp_value *lisp_load_file(lisp_runtime *rt, lisp_scope *scope, FILE *input);
 * @param argc number of arguments
 * @param argv NULL-terminated argument list
 * @returns result of evaluation
 * @retval NULL if no main function existed
 * @retval a nil list when there is no main symbol
 * @retval NULL on error
 */
lisp_value *lisp_run_main_if_exists(lisp_runtime *rt, lisp_scope *scope,
                                    int argc, char **argv);


@@ 690,6 681,64 @@ lisp_value *lisp_quote(lisp_runtime *rt, lisp_value *value);

/**
 * @}
 * @defgroup error Error Handling
 * @{
 */

/**
 * Dump the execution stack to a file. This is useful if you want to print a
 * stack trace at your current location. This functionality can also be accessed
 * via the ``dump-stack`` builtin function.
 * @param rt runtime
 * @param stack When NULL, the runtime's execution stack is used. When non-NULL,
 * the @a stack argument is used to specify what stack to dump.
 * @param file where to dump stack trace to
 */
void lisp_dump_stack(lisp_runtime *rt, lisp_list *stack, FILE *file);

/**
 * A macro for error checking the return value of a lisp_eval() or lisp_call()
 * function. This will return NULL when its argumnet is NULL, helping functions
 * short-circuit in the case of an error.
 *
 * @code
 * lisp_value *v = lisp_eval(rt, my_code, my_scope);
 * lisp_error_check(v);
 * // continue using v
 * @endcode
 *
 * @param value value to error check
 */
#define lisp_error_check(value) do { \
		if (!value) { \
			return NULL; \
		} \
	} while (0)

/**
 * Prints the last error reported to the runtime, on @a file. If there is no
 * error, this prints a loud BUG message to FILE, indicating that an error was
 * expected but not found.
 * @param rt runtime
 * @param file file to print error to (usually stderr)
 */
void lisp_print_error(lisp_runtime *rt, FILE *file);

/**
 * Returns the error text of the current error registered with the runtime.
 * @param rt runtime
 * @return error string
 */
char *lisp_get_error(lisp_runtime *rt);

/**
 * Clears the error in the runtime.
 * @param rt runtime
 */
void lisp_clear_error(lisp_runtime *rt);

/**
 * @}
 */

#endif

M src/builtins.c => src/builtins.c +62 -27
@@ 4,6 4,8 @@
 * Stephen Brennan <stephen@brennan.io>
 */

#include <stdio.h>

#include "funlisp_internal.h"

static lisp_value *lisp_builtin_eval(lisp_runtime *rt, lisp_scope *scope,


@@ 11,8 13,8 @@ static lisp_value *lisp_builtin_eval(lisp_runtime *rt, lisp_scope *scope,
{
	(void) user; /* unused */
	lisp_list *evald = (lisp_list*)lisp_eval_list(rt, scope, arguments);
	lisp_value *result = lisp_eval(rt, scope, evald->left);
	return result;
	lisp_error_check(evald);
	return lisp_eval(rt, scope, evald->left);
}

static lisp_value *lisp_builtin_car(lisp_runtime *rt, lisp_scope *scope,


@@ 21,11 23,12 @@ static lisp_value *lisp_builtin_car(lisp_runtime *rt, lisp_scope *scope,
	(void) user; /* unused */
	lisp_list *firstarg;
	lisp_list *arglist = (lisp_list*) lisp_eval_list(rt, scope, a);
	lisp_error_check(arglist);
	if (!lisp_get_args(arglist, "l", &firstarg)) {
		return (lisp_value*)lisp_error_new(rt, "wrong arguments to car");
		return lisp_error_new(rt, "wrong arguments to car");
	}
	if (lisp_list_length(firstarg) == 0) {
		return (lisp_value*)lisp_error_new(rt, "expected at least one item");
		return lisp_error_new(rt, "expected at least one item");
	}
	return firstarg->left;
}


@@ 36,8 39,9 @@ static lisp_value *lisp_builtin_cdr(lisp_runtime *rt, lisp_scope *scope,
	(void) user; /* unused */
	lisp_list *firstarg;
	lisp_list *arglist = (lisp_list*) lisp_eval_list(rt, scope, a);
	lisp_error_check(arglist);
	if (!lisp_get_args(arglist, "l", &firstarg)) {
		return (lisp_value*) lisp_error_new(rt, "wrong arguments to cdr");
		return lisp_error_new(rt, "wrong arguments to cdr");
	}
	/* save rv because firstarg may be deleted after decref */
	return firstarg->right;


@@ 51,7 55,7 @@ static lisp_value *lisp_builtin_quote(lisp_runtime *rt, lisp_scope *scope,
	lisp_value *firstarg;
	lisp_list *arglist = (lisp_list*) a;
	if (!lisp_get_args(arglist, "*", &firstarg)) {
		return (lisp_value*) lisp_error_new(rt, "wrong arguments to quote");
		return lisp_error_new(rt, "wrong arguments to quote");
	}
	return arglist->left;
}


@@ 63,8 67,9 @@ static lisp_value *lisp_builtin_cons(lisp_runtime *rt, lisp_scope *scope,
	lisp_value *a1;
	lisp_value *l;
	lisp_list *arglist = (lisp_list*) lisp_eval_list(rt, scope, a);
	lisp_error_check(arglist);
	if (!lisp_get_args(arglist, "**", &a1, &l)) {
		return (lisp_value*) lisp_error_new(rt, "wrong arguments to cons");
		return lisp_error_new(rt, "wrong arguments to cons");
	}
	lisp_list *new = (lisp_list*)lisp_new(rt, type_list);
	new->left = a1;


@@ 82,13 87,13 @@ static lisp_value *lisp_builtin_lambda(lisp_runtime *rt, lisp_scope *scope,
	(void)scope;

	if (!lisp_get_args(our_args, "l*", &argnames, &code)) {
		return (lisp_value*) lisp_error_new(rt, "expected argument list and code");
		return lisp_error_new(rt, "expected argument list and code");
	}

	lisp_list *it = argnames;
	while (!lisp_nil_p((lisp_value*)it)) {
		if (it->left->type != type_symbol) {
			return (lisp_value*) lisp_error_new(rt, "argument names must be symbols");
			return lisp_error_new(rt, "argument names must be symbols");
		}
		it = (lisp_list*) it->right;
	}


@@ 108,10 113,11 @@ static lisp_value *lisp_builtin_define(lisp_runtime *rt, lisp_scope *scope,
	lisp_value *expr;

	if (!lisp_get_args((lisp_list*)a, "s*", &s, &expr)) {
		return (lisp_value*) lisp_error_new(rt, "expected name and expression");
		return lisp_error_new(rt, "expected name and expression");
	}

	lisp_value *evald = lisp_eval(rt, scope, expr);
	lisp_error_check(evald);
	lisp_scope_bind(scope, s, evald);
	return evald;
}


@@ 122,11 128,12 @@ static lisp_value *lisp_builtin_plus(lisp_runtime *rt, lisp_scope *scope,
	(void) user; /* unused */
	lisp_integer *i;
	lisp_list *args = (lisp_list*)lisp_eval_list(rt, scope, a);
	lisp_error_check(args);
	int sum = 0;

	while (!lisp_nil_p((lisp_value*)args)) {
		if (args->left->type != type_integer) {
			return (lisp_value*) lisp_error_new(rt, "expect integers for addition");
			return lisp_error_new(rt, "expect integers for addition");
		}
		i = (lisp_integer*) args->left;
		sum += i->x;


@@ 144,11 151,12 @@ static lisp_value *lisp_builtin_minus(lisp_runtime *rt, lisp_scope *scope,
	(void) user; /* unused */
	lisp_integer *i;
	lisp_list *args = (lisp_list*)lisp_eval_list(rt, scope, a);
	lisp_error_check(args);
	int val = 0;
	int len = lisp_list_length(args);

	if (len < 1) {
		return (lisp_value*) lisp_error_new(rt, "expected at least one arg");
		return lisp_error_new(rt, "expected at least one arg");
	} else if (len == 1) {
		i = (lisp_integer*) args->left;
		val = - i->x;


@@ 158,7 166,7 @@ static lisp_value *lisp_builtin_minus(lisp_runtime *rt, lisp_scope *scope,
		args = (lisp_list*)args->right;
		while (!lisp_nil_p((lisp_value*)args)) {
			if (args->left->type != type_integer) {
				return (lisp_value*)lisp_error_new(rt, "expected integer");
				return lisp_error_new(rt, "expected integer");
			}
			i = (lisp_integer*) args->left;
			val -= i->x;


@@ 177,11 185,12 @@ static lisp_value *lisp_builtin_multiply(lisp_runtime *rt, lisp_scope *scope,
	(void) user; /* unused */
	lisp_integer *i;
	lisp_list *args = (lisp_list*) lisp_eval_list(rt, scope, a);
	lisp_error_check(args);
	int product = 1;

	while (!lisp_nil_p((lisp_value*)args)) {
		if (args->left->type != type_integer) {
			return (lisp_value*) lisp_error_new(rt, "expect integers for multiplication");
			return lisp_error_new(rt, "expect integers for multiplication");
		}
		i = (lisp_integer*) args->left;
		product *= i->x;


@@ 199,22 208,23 @@ static lisp_value *lisp_builtin_divide(lisp_runtime *rt, lisp_scope *scope,
	(void) user; /* unused */
	lisp_integer *i;
	lisp_list *args = (lisp_list*)lisp_eval_list(rt, scope, a);
	lisp_error_check(args);
	int val = 0;
	int len = lisp_list_length(args);

	if (len < 1) {
		return (lisp_value*) lisp_error_new(rt, "expected at least one arg");
		return lisp_error_new(rt, "expected at least one arg");
	}
	i = (lisp_integer*) args->left;
	val = i->x;
	args = (lisp_list*)args->right;
	while (!lisp_nil_p((lisp_value*)args)) {
		if (args->left->type != type_integer) {
			return (lisp_value*)lisp_error_new(rt, "expected integer");
			return lisp_error_new(rt, "expected integer");
		}
		i = (lisp_integer*) args->left;
		if (i->x == 0) {
			return (lisp_value*) lisp_error_new(rt, "divide by zero");
			return lisp_error_new(rt, "divide by zero");
		}
		val /= i->x;
		args = (lisp_list*) args->right;


@@ 231,9 241,10 @@ static lisp_value *lisp_builtin_cmp_util(lisp_runtime *rt, lisp_scope *scope,
	(void) user; /* unused */
	lisp_integer *first, *second;
	lisp_list *args = (lisp_list*) lisp_eval_list(rt, scope, a);
	lisp_error_check(args);

	if (!lisp_get_args((lisp_list*)args, "dd", &first, &second)) {
		return (lisp_value*) lisp_error_new(rt, "expected two integers");
		return lisp_error_new(rt, "expected two integers");
	}

	lisp_integer *result = (lisp_integer*)lisp_new(rt, type_integer);


@@ 246,6 257,7 @@ static lisp_value *lisp_builtin_eq(lisp_runtime *rt, lisp_scope *scope,
{
	(void) user; /* unused */
	lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a, user);
	lisp_error_check(v);
	if (v->type == type_integer) {
		v->x = (v->x == 0);
	}


@@ 257,6 269,7 @@ static lisp_value *lisp_builtin_gt(lisp_runtime *rt, lisp_scope *scope,
{
	(void) user; /* unused */
	lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a, user);
	lisp_error_check(v);
	if (v->type == type_integer) {
		v->x = (v->x > 0);
	}


@@ 268,6 281,7 @@ static lisp_value *lisp_builtin_ge(lisp_runtime *rt, lisp_scope *scope,
{
	(void) user; /* unused */
	lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a, user);
	lisp_error_check(v);
	if (v->type == type_integer) {
		v->x = (v->x >= 0);
	}


@@ 279,6 293,7 @@ static lisp_value *lisp_builtin_lt(lisp_runtime *rt, lisp_scope *scope,
{
	(void) user; /* unused */
	lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a, user);
	lisp_error_check(v);
	if (v->type == type_integer) {
		v->x = (v->x < 0);
	}


@@ 290,6 305,7 @@ static lisp_value *lisp_builtin_le(lisp_runtime *rt, lisp_scope *scope,
{
	(void) user; /* unused */
	lisp_integer *v = (lisp_integer*)lisp_builtin_cmp_util(rt, scope, a, user);
	lisp_error_check(v);
	if (v->type == type_integer) {
		v->x = (v->x <= 0);
	}


@@ 303,10 319,11 @@ static lisp_value *lisp_builtin_if(lisp_runtime *rt, lisp_scope *scope,
	lisp_value *condition, *body_true, *body_false;

	if (!lisp_get_args((lisp_list*)a, "***", &condition, &body_true, &body_false)) {
		return (lisp_value*) lisp_error_new(rt, "expected condition and two bodies");
		return lisp_error_new(rt, "expected condition and two bodies");
	}

	condition = lisp_eval(rt, scope, condition);
	lisp_error_check(condition);
	if (condition->type == type_integer && ((lisp_integer*)condition)->x) {
		return lisp_eval(rt, scope, body_true);
	} else {


@@ 320,9 337,10 @@ static lisp_value *lisp_builtin_null_p(lisp_runtime *rt, lisp_scope *scope,
	(void) user; /* unused */
	lisp_value *v;
	lisp_list *args = (lisp_list*) lisp_eval_list(rt, scope, a);
	lisp_error_check(args);

	if (!lisp_get_args(args, "*", &v)) {
		return (lisp_value*) lisp_error_new(rt, "expected one argument");
		return lisp_error_new(rt, "expected one argument");
	}

	lisp_integer *result = (lisp_integer*) lisp_new(rt, type_integer);


@@ 387,11 405,12 @@ static lisp_value *lisp_builtin_map(lisp_runtime *rt, lisp_scope *scope,
	lisp_value *f;
	lisp_list *ret = NULL, *args, *rv;
	lisp_list *map_args = (lisp_list *) lisp_eval_list(rt, scope, a);
	lisp_error_check(map_args);

	/* Get the function from the first argument in the list. */
	f = map_args->left;
	if (map_args->right->type != type_list) {
		return (lisp_value*) lisp_error_new(rt, "need at least two arguments");
		return lisp_error_new(rt, "need at least two arguments");
	}
	map_args = (lisp_list*) map_args->right;
	while ((args = get_quoted_left_items(rt, map_args)) != NULL) {


@@ 403,6 422,7 @@ static lisp_value *lisp_builtin_map(lisp_runtime *rt, lisp_scope *scope,
			ret = (lisp_list*) ret->right;
		}
		ret->left = lisp_call(rt, scope, f, (lisp_value*)args);
		lisp_error_check(ret->left);
		map_args = advance_lists(rt, map_args);
	}
	ret->right = lisp_nil_new(rt);


@@ 424,33 444,35 @@ static lisp_value *lisp_builtin_reduce(lisp_runtime *rt, lisp_scope *scope, lisp
{
	(void) user; /* unused */
	lisp_list *args = (lisp_list*) lisp_eval_list(rt, scope, a);
	lisp_error_check(args);
	int length = lisp_list_length(args);
	lisp_value *callable, *initializer;
	lisp_list *list;

	if (length == 2) {
		if (!lisp_get_args(args, "*l", &callable, &list)) {
			return (lisp_value*) lisp_error_new(rt, "reduce: callable and list required");
			return lisp_error_new(rt, "reduce: callable and list required");
		}
		if (lisp_list_length(list) < 2) {
			return (lisp_value*) lisp_error_new(rt, "reduce: list must have at least 2 entries");
			return lisp_error_new(rt, "reduce: list must have at least 2 entries");
		}
		initializer = list->left;
		list = (lisp_list*)list->right;
	} else if (length == 3) {
		if (!lisp_get_args(args, "**l", &callable, &initializer, &list)) {
			return (lisp_value*) lisp_error_new(rt, "reduce: callable, initializer, and list required");
			return lisp_error_new(rt, "reduce: callable, initializer, and list required");
		}
		if (lisp_list_length(list) < 1) {
			return (lisp_value*) lisp_error_new(rt, "reduce: list must have at least 1 entry");
			return lisp_error_new(rt, "reduce: list must have at least 1 entry");
		}
	} else {
		return (lisp_value*) lisp_error_new(rt, "reduce: 2 or 3 arguments required");
		return lisp_error_new(rt, "reduce: 2 or 3 arguments required");
	}

	while (!lisp_nil_p((lisp_value*)list)) {
		initializer = lisp_call(rt, scope, callable,
		                        (lisp_value*) lisp_new_pair_list(rt, initializer, list->left));
		lisp_error_check(initializer);
		list = (lisp_list*) list->right;
	}
	return initializer;


@@ 461,9 483,10 @@ static lisp_value *lisp_builtin_print(lisp_runtime *rt, lisp_scope *scope, lisp_
	(void) user; /* unused */
	lisp_value *v;
	lisp_list *args = (lisp_list*) lisp_eval_list(rt, scope, a);
	lisp_error_check(args);

	if (!lisp_get_args(args, "*", &v)) {
		return (lisp_value*) lisp_error_new(rt, "expected one argument");
		return lisp_error_new(rt, "expected one argument");
	}

	lisp_print(stdout, v);


@@ 471,6 494,17 @@ static lisp_value *lisp_builtin_print(lisp_runtime *rt, lisp_scope *scope, lisp_
	return lisp_nil_new(rt);
}

static lisp_value *lisp_builtin_dump_stack(lisp_runtime *rt, lisp_scope *scope,
                                           lisp_value *a, void *user)
{
	/* NB: This is very debugging oriented. We don't even eval arguments! */
	(void) scope; /* unused args */
	(void) a;
	(void) user;
	lisp_dump_stack(rt, NULL, stderr);
	return lisp_nil_new(rt);
}

void lisp_scope_populate_builtins(lisp_runtime *rt, lisp_scope *scope)
{
	lisp_scope_add_builtin(rt, scope, "eval", lisp_builtin_eval, NULL);


@@ 495,4 529,5 @@ void lisp_scope_populate_builtins(lisp_runtime *rt, lisp_scope *scope)
	lisp_scope_add_builtin(rt, scope, "map", lisp_builtin_map, NULL);
	lisp_scope_add_builtin(rt, scope, "reduce", lisp_builtin_reduce, NULL);
	lisp_scope_add_builtin(rt, scope, "print", lisp_builtin_print, NULL);
	lisp_scope_add_builtin(rt, scope, "dump-stack", lisp_builtin_dump_stack, NULL);
}

M src/funlisp_internal.h => src/funlisp_internal.h +25 -5
@@ 35,14 35,36 @@ struct lisp_value {

/* A lisp_runtime is NOT a lisp_value! */
struct lisp_runtime {
	/* Maintains a list of all lisp values allocated with this runtime, so
	 * that we can do garbage collection with mark-and-sweep.
	 */
	lisp_value *head;
	lisp_value *tail;
	void *user;

	/* Some special values we don't want to lose track of */
	/* This is used as a stack/queue for traversing objects during garbage
	 * collection. It's allocated ahead of time to try to avoid allocating
	 * memory as we do garbage collection
	 */
	struct ringbuf rb;
	int has_marked;

	/* Nil is used so much that we keep a global instance and don't bother
	 * ever freeing it. */
	lisp_value *nil;

	struct ringbuf rb;
	/* Some data the user may want to keep track of. */
	void *user;

	/* Data we use for reporting errors. This is very single-threaded of me,
	 * but it works for now.
	 */
	char *error;
	unsigned int error_line;
	lisp_list *error_stack;

	/* Maintain a stack as we go, can dump it at any time if we want. */
	lisp_list *stack;
	unsigned int stack_depth;
};

/* The below ARE lisp_values! */


@@ 111,8 133,6 @@ void lisp_destroy(lisp_runtime *rt);

/* Shortcuts for type operations. */
void lisp_free(lisp_value *value);
lisp_value *lisp_call(lisp_runtime *rt, lisp_scope *scope, lisp_value *callable,
                      lisp_value *arguments);
lisp_value *lisp_new(lisp_runtime *rt, lisp_type *typ);

#endif

M src/gc.c => src/gc.c +39 -0
@@ 17,10 17,16 @@ void lisp_init(lisp_runtime *rt)
	rt->tail = rt->nil;
	rt->user = NULL;
	rb_init(&rt->rb, sizeof(lisp_value*), 16);
	rt->error= NULL;
	rt->error_line = 0;
	rt->error_stack = NULL;
	rt->stack = (lisp_list *) rt->nil;
	rt->stack_depth = 0;
}

void lisp_destroy(lisp_runtime *rt)
{
	rt->has_marked = 0; /* ensure we sweep all */
	lisp_sweep(rt);
	rb_destroy(&rt->rb);
	lisp_free(rt->nil);


@@ 29,6 35,7 @@ void lisp_destroy(lisp_runtime *rt)
void lisp_mark(lisp_runtime *rt, lisp_value *v)
{
	rb_push_back(&rt->rb, &v);
	rt->has_marked = 1;

	while (rt->rb.count > 0) {
		rb_pop_front(&rt->rb, &v);


@@ 45,10 52,41 @@ void lisp_mark(lisp_runtime *rt, lisp_value *v)
	}
}

/*
 * The interpreter contains references to several important objects which we
 * must mark to avoid freeing accidentally. We mark them here. See lisp_sweep()
 * to understand when this is called.
 */
static void lisp_mark_basics(lisp_runtime *rt)
{
	if (rt->error_stack)
		lisp_mark(rt, (lisp_value *) rt->error_stack);
	lisp_mark(rt, (lisp_value *) rt->stack);
}

void lisp_sweep(lisp_runtime *rt)
{
	lisp_value *curr = rt->head;

	/*
	 * When a user has called lisp_mark() before calling lisp_sweep(), we
	 * know that they intend to continue using the interpreter. Conversely,
	 * when a user does not call lisp_mark(), and then calls lisp_sweep(),
	 * we know they are clearing all the interpreter data, and we are safe
	 * to clobber the internal interpreter data.
	 *
	 * So, mark some basic data when stuff has already been marked. But, if
	 * nothing has been marked, then reset internal state and leave the
	 * basic data unmarked.
	 */
	if (rt->has_marked) {
		lisp_mark_basics(rt);
	} else {
		lisp_clear_error(rt);
		rt->stack = (lisp_list*)rt->nil;
		rt->stack_depth = 0;
	}

	while (curr->next) {
		if (curr->next->mark != GC_MARKED) {
			lisp_value *tmp = curr->next->next;


@@ 62,4 100,5 @@ void lisp_sweep(lisp_runtime *rt)

	curr->mark = GC_NOMARK;
	rt->tail = curr;
	rt->has_marked = false;
}

M src/types.c => src/types.c +20 -62
@@ 21,7 21,7 @@ static lisp_value *eval_error(lisp_runtime *rt, lisp_scope *s, lisp_value *v)
{
	(void)s;
	(void)v;
	return (lisp_value*) lisp_error_new(rt, "cannot evaluate this object");
	return lisp_error_new(rt, "cannot evaluate this object");
}

static lisp_value *eval_same(lisp_runtime *rt, lisp_scope *s, lisp_value *v)


@@ 37,16 37,7 @@ static lisp_value *call_error(lisp_runtime *rt, lisp_scope *s, lisp_value *c,
	(void)s;
	(void)c;
	(void)v;
	return (lisp_value*) lisp_error_new(rt, "not callable!");
}

static lisp_value *call_same(lisp_runtime *rt, lisp_scope *s, lisp_value *c,
                             lisp_value *v)
{
	(void)rt;
	(void)s;
	(void)v;
	return c;
	return lisp_error_new(rt, "not callable!");
}

static bool has_next_index_lt_state(struct iterator *iter)


@@ 193,15 184,15 @@ static lisp_value *list_eval(lisp_runtime *rt, lisp_scope *scope, lisp_value *v)
	lisp_list *list = (lisp_list*) v;

	if (lisp_nil_p(v)) {
		return (lisp_value*) lisp_error_new(rt, "cannot call empty list");
		return lisp_error_new(rt, "Cannot call empty list");
	}

	if (list->right->type != type_list) {
		return (lisp_value*) lisp_error_new(rt, "bad function call syntax");
		return lisp_error_new(rt, "You may not call with an s-expression");
	}
	lisp_value *callable = lisp_eval(rt, scope, list->left);
	lisp_value *rv = lisp_call(rt, scope, callable, list->right);
	return rv;
	lisp_error_check(callable);
	return lisp_call(rt, scope, callable, list->right);
}

static void list_print_internal(FILE *f, lisp_list *list)


@@ 331,47 322,6 @@ static void symbol_free(void *v)
}

/*
 * error
 */

static void error_print(FILE *f, lisp_value *v);
static lisp_value *error_new(void);
static void error_free(void *v);

static lisp_type type_error_obj = {
	.type=&type_type_obj,
	.name="error",
	.print=error_print,
	.new=error_new,
	.eval=eval_same,
	.free=error_free,
	.call=call_same,
	.expand=iterator_empty,
};
lisp_type *type_error = &type_error_obj;

static void error_print(FILE *f, lisp_value *v)
{
	lisp_error *error = (lisp_error*) v;
	fprintf(f, "error: %s", error->message);
}

static lisp_value *error_new(void)
{
	lisp_error *error = malloc(sizeof(lisp_error));
	error->type = type_error;
	error->message = NULL;
	return (lisp_value*)error;
}

static void error_free(void *v)
{
	lisp_error *error = (lisp_error*) v;
	free(error->message);
	free(error);
}

/*
 * integer
 */



@@ 526,6 476,7 @@ static lisp_value *lambda_call(lisp_runtime *rt, lisp_scope *scope,
{
	lisp_lambda *lambda = (lisp_lambda*) c;
	lisp_list *argvalues = (lisp_list*)lisp_eval_list(rt, scope, arguments);
	lisp_error_check(argvalues);
	lisp_scope *inner = (lisp_scope*)lisp_new(rt, type_scope);
	inner->up = lambda->closure;



@@ 537,10 488,10 @@ static lisp_value *lambda_call(lisp_runtime *rt, lisp_scope *scope,
	}

	if (!lisp_nil_p((lisp_value*)it1)) {
		return (lisp_value*) lisp_error_new(rt, "not enough arguments");
		return lisp_error_new(rt, "not enough arguments to lambda call");
	}
	if (!lisp_nil_p((lisp_value*)it2)) {
		return (lisp_value*) lisp_error_new(rt, "too many arguments");
		return lisp_error_new(rt, "too many arguments to lambda call");
	}

	return lisp_eval(rt, inner, lambda->code);


@@ 597,11 548,18 @@ lisp_value *lisp_eval(lisp_runtime *rt, lisp_scope *scope, lisp_value *value)
lisp_value *lisp_call(lisp_runtime *rt, lisp_scope *scope,
                      lisp_value *callable, lisp_value *args)
{
	if (callable->type == type_error) {
		return callable;
	}
	lisp_value *rv;
	/* create new stack frame */
	rt->stack = lisp_list_new(rt, callable, (lisp_value *) rt->stack);
	rt->stack_depth++;

	/* make function call */
	rv = callable->type->call(rt, scope, callable, args);

	return callable->type->call(rt, scope, callable, args);
	/* get rid of stack frame */
	rt->stack = (lisp_list*) rt->stack->right;
	rt->stack_depth--;
	return rv;
}

lisp_value *lisp_new(lisp_runtime *rt, lisp_type *typ)

M src/util.c => src/util.c +64 -21
@@ 11,6 11,7 @@
#include <stdarg.h>
#include <string.h>
#include <stdlib.h>
#include <stdio.h>

#include "funlisp_internal.h"
#include "hashtable.h"


@@ 28,7 29,7 @@ lisp_value *lisp_scope_lookup(lisp_runtime *rt, lisp_scope *scope,
		if (scope->up) {
			return lisp_scope_lookup(rt, scope->up, symbol);
		} else {
			return (lisp_value*)lisp_error_new(rt, "symbol not found in scope");
			return lisp_error_new(rt, "symbol not found in scope");
		}
	} else {
		return v;


@@ 54,14 55,19 @@ void lisp_scope_add_builtin(lisp_runtime *rt, lisp_scope *scope, char *name,

lisp_value *lisp_eval_list(lisp_runtime *rt, lisp_scope *scope, lisp_value *l)
{
	lisp_value *left, *right;
	if (lisp_nil_p(l)) {
		return l;
	}
	lisp_list *list = (lisp_list*) l;
	lisp_list *result = (lisp_list*)lisp_new(rt, type_list);
	result->left = lisp_eval(rt, scope, list->left);
	result->right = lisp_eval_list(rt, scope, list->right);
	return (lisp_value*) result;

	left = lisp_eval(rt, scope, list->left);
	lisp_error_check(left);

	right = lisp_eval_list(rt, scope, list->right);
	lisp_error_check(right);

	return (lisp_value *) lisp_list_new(rt, left, right);
}

int lisp_list_length(lisp_list *list)


@@ 98,8 104,6 @@ static lisp_type *lisp_get_type(char c)
		return type_string;
	case 'o':
		return type_scope;
	case 'e':
		return type_error;
	case 'b':
		return type_builtin;
	case 't':


@@ 211,8 215,9 @@ lisp_value *lisp_run_main_if_exists(lisp_runtime *rt, lisp_scope *scope,
	lisp_value *main_func = lisp_scope_lookup(
		rt, scope, lisp_symbol_new(rt, "main"));

	if (main_func->type == type_error) {
		return NULL;
	if (main_func->type == NULL) {
		lisp_clear_error(rt);
		return lisp_nil_new(rt);
	}

	args = lisp_list_of_strings(rt, argv, argc, 0);


@@ 280,18 285,6 @@ char *lisp_symbol_get(lisp_symbol *sym)
	return sym->sym;
}

lisp_error *lisp_error_new(lisp_runtime *rt, char *message)
{
	lisp_error *err = (lisp_error*)lisp_new(rt, type_error);
	err->message = strdup(message);
	return err;
}

char *lisp_error_get(lisp_error *err)
{
	return err->message;
}

lisp_list *lisp_list_new(lisp_runtime *rt, lisp_value *left, lisp_value *right)
{
	lisp_list *l = (lisp_list *) lisp_new(rt, type_list);


@@ 321,3 314,53 @@ int lisp_integer_get(lisp_integer *integer)
{
	return integer->x;
}

void lisp_dump_stack(lisp_runtime *rt, lisp_list *stack, FILE *file)
{
	if (!stack)
		stack = rt->stack;

	fprintf(file, "Stack trace (most recent call first):\n");
	while (!lisp_nil_p((lisp_value *) stack)) {
		fprintf(file, "  ");
		lisp_print(file, stack->left);
		fprintf(file, "\n");

		stack = (lisp_list *) stack->right;
	}
}

lisp_value *lisp_error_new(lisp_runtime *rt, char *message)
{
	rt->error = message;
	rt->error_stack = rt->stack;
	return NULL;
}

char *lisp_get_error(lisp_runtime *rt)
{
	return rt->error;
}

void lisp_clear_error(lisp_runtime *rt)
{
	rt->error = NULL;
	rt->error_stack = NULL;
	rt->error_line = 0;
}

void lisp_print_error(lisp_runtime *rt, FILE *file)
{
	if (!rt->error) {
		fprintf(stderr, "BUG: lisp_print_error() expects error, found none\n");
		return;
	}

	if (rt->error_line)
		fprintf(file, "at line %d: ", rt->error_line);

	fprintf(file, "%s\n\n", rt->error);

	if (rt->error_stack)
		lisp_dump_stack(rt, rt->error_stack, file);
}

M tools/call_lisp.c => tools/call_lisp.c +1 -1
@@ 16,7 16,7 @@ int call_double_or_square(lisp_runtime *rt, lisp_scope *scope, int x)
	lisp_value *args, *res;
	lisp_value *function = lisp_scope_lookup_string(rt, scope,
		"double_or_square");
	assert(function->type != type_error);
	assert(function->type != NULL);

	args = (lisp_value*) lisp_list_new(rt,
		(lisp_value *) lisp_integer_new(rt, x),

M tools/hello_repl.c => tools/hello_repl.c +4 -1
@@ 52,7 52,10 @@ int main(int argc, char **argv)
		if (!value)
			continue; /* blank line */
		lisp_value *result = lisp_eval(rt, scope, value);
		if (!lisp_nil_p(result)) {
		if (!result) {
			lisp_print_error(rt, stderr);
			lisp_error_clear(rt);
		} else if (!lisp_nil_p(result)) {
			lisp_print(stdout, result);
			fprintf(stdout, "\n");
		}

M tools/repl.c => tools/repl.c +4 -1
@@ 28,7 28,10 @@ int main(int argc, char **argv)
		if (!value)
			continue; /* blank line */
		lisp_value *result = lisp_eval(rt, scope, value);
		if (!lisp_nil_p(result)) {
		if (!result) {
			lisp_print_error(rt, stderr);
			lisp_clear_error(rt);
		} else if (!lisp_nil_p(result)) {
			lisp_print(stdout, result);
			fprintf(stdout, "\n");
		}

M tools/runfile.c => tools/runfile.c +4 -2
@@ 36,10 36,12 @@ int main(int argc, char **argv)
	fclose(input);

	result = lisp_run_main_if_exists(rt, scope, argc - 2, argv + 2);
	if (result && lisp_is(result, type_error))
	if (!result) {
		lisp_print_error(rt, stderr);
		rv = 1;
	else
	} else {
		rv = 0;
	}
	lisp_runtime_free(rt); /* sweeps everything before exit */
	return rv;
}