~swisschili/bluejay

6d02af472f6ce87ea50ff24aa77f88928dbf31bc — swissChili 3 months ago fbf525f lisp-error-handling
Add detailed error reporting, remove panics
M .build.yml => .build.yml +1 -1
@@ 22,7 22,7 @@ tasks:
      cd bluejay
      ./bin/jmk
      cd src/lisp
      make
      make NO_READLINE=1
  - build-latex: |
      cd bluejay
      ./bin/jmk

M src/lisp/Jmk => src/lisp/Jmk +8 -1
@@ 13,10 13,16 @@ preset(nasm)
archetype(c)
archetype(asm)

NO_READLINE ?= 0

CFLAGS += -Ivendor/luajit/dynasm -Werror -lreadline # -fsanitize=address
LDFLAGS += -lreadline
ASMFLAGS += -felf -Fdwarf

ifeq ($(NO_READLINE),1)
CFLAGS += -DNO_READLINE
endif

OBJECTS = main.o \
			lisp.o \
			compiler.o \


@@ 24,7 30,8 @@ OBJECTS = main.o \
			plat/linux.o \
			istream.o \
			gc.o \
			call_list.o
			call_list.o \
			error.o

LUA = vendor/luajit/src/host/minilua


M src/lisp/compiler.dasc => src/lisp/compiler.dasc +159 -98
@@ 131,13 131,16 @@ void add_load(struct environment *env, char *path)
	env->first_loaded = f;
}

struct dasm_State *compile_function(value_t args, enum namespace namespace,
                                    struct environment *env,
                                    struct local *local_out,
                                    struct local *local_parent,
                                    struct args **args_out, char *name,
                                    char *path)
struct error compile_function(value_t args, enum namespace namespace,
							  struct environment *env,
							  struct local *local_out,
							  struct local *local_parent,
							  struct args **args_out, char *name,
							  char *path,
							  dasm_State **state)
{
	E_INIT();

	dasm_State *d;
	dasm_State **Dst = &d;



@@ 172,12 175,14 @@ struct dasm_State *compile_function(value_t args, enum namespace namespace,
	value_t body = cdr(args);

	// This will add the arguments to local too.
	struct args *ar = list_to_args(env, arglist, &local);
	struct args *ar;
	TRY(list_to_args(env, arglist, &local, &ar));
	local.args = ar;

	if (!ar)
	{
		err("Malformed args list");
		NEARVAL(arglist);
		THROW(EMALFORMED, "Malformed argument list");
	}

	for (value_t body_ = body; !nilp(body_); body_ = cdr(body_))


@@ 193,7 198,7 @@ struct dasm_State *compile_function(value_t args, enum namespace namespace,
	for (; !nilp(body); body = cdr(body))
	{
		bool tail = nilp(cdr(body));
		compile_expression(env, &local, car(body), tail, Dst);
		TRY(compile_expression(env, &local, car(body), tail, Dst));
	}

	| cleanup;


@@ 204,13 209,21 @@ struct dasm_State *compile_function(value_t args, enum namespace namespace,
	if (args_out)
		*args_out = ar;

	return d;
	*state = d;

	OKAY();
}

void compile_tl(value_t val, struct environment *env, char *fname)
struct error compile_tl(value_t val, struct environment *env, char *fname)
{
	E_INIT();

	NEARVAL(val);

	if (!listp(val))
		err("Top level must be a list");
	{
		THROW(EEXPECTED, "Top level form must be a list");
	}

	value_t form = car(val);
	value_t args = cdr(val);


@@ 226,8 239,9 @@ void compile_tl(value_t val, struct environment *env, char *fname)
		struct args *a;
		char *name = (char *)(car(args) ^ SYMBOL_TAG);

		dasm_State *d = compile_function(cdr(args), namespace, env, &local,
		                                 NULL, &a, name, fname);
		dasm_State *d;
		TRY(compile_function(cdr(args), namespace, env, &local,
							 NULL, &a, name, fname, &d));

		add_function(env, name, link_program(&d), a, namespace);



@@ 238,18 252,21 @@ void compile_tl(value_t val, struct environment *env, char *fname)
	{
		for (value_t val = args; !nilp(val); val = cdr(val))
		{
			compile_tl(car(val), env, fname);
			TRY(compile_tl(car(val), env, fname));
		}
	}
	else if (symstreq(form, "load"))
	{
		if (length(args) != 1)
		{
			err_at(val, "load expects exactly 1 argument, %d given",
				   length(args));
			NEARVAL(args);
			THROW(EARGS, "load expects exactly 1 argument, %d given",
				  length(args));
		}
		load_relative(env, fname, car(args));
	}

	OKAY();
}

void walk_and_alloc(struct local *local, value_t body)


@@ 303,9 320,10 @@ bool load(struct environment *env, char *path)

	value_t val;

	while (read1(is, &val))
	while (IS_OKAY(read1(is, &val)))
	{
		compile_tl(val, env, path);
		if (!IS_OKAY(compile_tl(val, env, path)))
			break;
	}

	del_fistream(is);


@@ 331,22 349,29 @@ value_t load_relative(struct environment *env, char *to, value_t name)
		return nil;
}

struct environment *compile_file(char *filename, bool *ok)
struct error compile_file(char *filename, struct environment **e)
{
	E_INIT();

	value_t val;
	struct environment *env = malloc(sizeof(struct environment));
	env->first = NULL;
	env->first_loaded = NULL;

	add_load(env, filename);
	load_std(env);
	TRY(load_std(env));

	bool ok_ = load(env, filename);

	if (ok)
		*ok = ok_;
	if (!ok_)
	{
		free(env);
		THROWSAFE(ENOTFOUND);
	}

	return env;
	*e = env;

	OKAY();
}

int nextpc(struct local *local, dasm_State **Dst)


@@ 360,9 385,11 @@ int nextpc(struct local *local, dasm_State **Dst)
	return n;
}

void compile_backquote(struct environment *env, struct local *local,
                       value_t val, dasm_State **Dst)
struct error compile_backquote(struct environment *env, struct local *local,
							   value_t val, dasm_State **Dst)
{
	E_INIT();

	if (!listp(val))
	{
		| mov eax, (val);


@@ 373,14 400,16 @@ void compile_backquote(struct environment *env, struct local *local,
		int nargs = length(args),
			n = length(val);

		NEARVAL(val);

		if (symstreq(fsym, "unquote"))
		{
			if (nargs != 1)
			{
				err_at(val, "unquote (or ,) takes exactly 1 argument");
				THROW(EARGS, "unquote (or ,) takes exactly 1 argument");
			}

			compile_expression(env, local, car(args), false, Dst);
			TRY(compile_expression(env, local, car(args), false, Dst));
		}
		else
		{


@@ 388,7 417,7 @@ void compile_backquote(struct environment *env, struct local *local,

			for (int i = n - 1; i >= 0; i--)
			{
				compile_backquote(env, local, elt(val, i), Dst);
				TRY(compile_backquote(env, local, elt(val, i), Dst));
				| push eax;
				| call_extern cons;
				| add esp, 8;


@@ 399,6 428,8 @@ void compile_backquote(struct environment *env, struct local *local,
			| pop eax;
		}
	}

	OKAY();
}

value_t eval(struct environment *env, value_t form)


@@ 409,8 440,15 @@ value_t eval(struct environment *env, value_t form)
	struct local local;
	struct args *args;

	dasm_State *d = compile_function(function, NS_ANONYMOUS, env, &local, NULL,
	                                 &args, NULL, "/");
	dasm_State *d;
	struct error err;

	if (!IS_OKAY((err = compile_function(function, NS_ANONYMOUS, env, &local, NULL,
										 &args, NULL, "/", &d))))
	{
		ereport(err);
		return nil;
	}

	del_local(&local);



@@ 418,8 456,9 @@ value_t eval(struct environment *env, value_t form)
	return f();
}

void compile_variable(struct variable *v, dasm_State *Dst)
struct error compile_variable(struct variable *v, dasm_State *Dst)
{
	E_INIT();
	switch (v->type)
	{
	case V_ARGUMENT:


@@ 433,14 472,18 @@ void compile_variable(struct variable *v, dasm_State *Dst)
		| mov eax, dword[edi + (v->number * value_size)];
		break;
	default:
		err("Sorry, can only access V_ARGUMENT, V_FREE and V_BOUND variables "
		    "for now :(");
		THROW(EUNIMPL, "Sorry, can only access V_ARGUMENT, V_BOUND, and V_FREE vars");
	}
	OKAY();
}

void compile_expression(struct environment *env, struct local *local,
                        value_t val, bool tail, dasm_State **Dst)
struct error compile_expression(struct environment *env, struct local *local,
								value_t val, bool tail, dasm_State **Dst)
{
	E_INIT();

	NEARVAL(val);

	if (symstreq(val, "nil") || nilp(val))
	{
		| mov eax, (nil);


@@ 461,16 504,17 @@ void compile_expression(struct environment *env, struct local *local,

		if (!symbolp(fsym))
		{
			printval(val, 2);
			err_at(val, "function name must be a symbol");
			THROW(EEXPECTED, "Function name must be a symbol");
		}

		if (symstreq(fsym, "if"))
		{
			if (nargs < 2 || nargs > 3)
				err("Must give at least 2 arguments to if");
			{
				THROW(EARGS, "Must give at least 2 arguments to if");
			}

			compile_expression(env, local, car(args), false, Dst);
			TRY(compile_expression(env, local, car(args), false, Dst));
			int false_label = nextpc(local, Dst),
			    after_label = nextpc(local, Dst);



@@ 478,11 522,11 @@ void compile_expression(struct environment *env, struct local *local,
			| cmp eax, (nil);
			| je =>false_label;

			compile_expression(env, local, elt(args, 1), tail, Dst);
			TRY(compile_expression(env, local, elt(args, 1), tail, Dst));
			| jmp =>after_label;
			|=>false_label:;
			if (nargs == 3)
				compile_expression(env, local, elt(args, 2), tail, Dst);
				TRY(compile_expression(env, local, elt(args, 2), tail, Dst));
			|=>after_label:;
		}
		else if (symstreq(fsym, "and") || symstreq(fsym, "or"))


@@ 492,14 536,16 @@ void compile_expression(struct environment *env, struct local *local,
			// Boolean and and or, short circuit like &&/||
			if (nargs < 1)
			{
				err_at(val, "and & or require at least 1 argument.");
				THROW(EARGS, "and & or require at least 1 argument.");
			}

			int after = nextpc(local, Dst);

			for (; !nilp(args); args = cdr(args))
			{
				compile_expression(env, local, car(args), false, Dst);
				NEARVAL(args);

				TRY(compile_expression(env, local, car(args), false, Dst));
				if (!nilp(cdr(args)))
				{
					| cmp eax, nil;


@@ 520,28 566,33 @@ void compile_expression(struct environment *env, struct local *local,
		{
			for (value_t val = args; !nilp(val); val = cdr(val))
			{
				NEARVAL(args);

				bool t = tail && nilp(cdr(val));
				compile_expression(env, local, car(val), t, Dst);
				TRY(compile_expression(env, local, car(val), t, Dst));
			}
		}
		else if (symstreq(fsym, "let1"))
		{
			if (nargs < 2)
			{
				err("Must give at least 2 arguments to let1");
				THROW(EARGS, "Must give at least 2 arguments to let1");
			}
			value_t binding = car(args);
			value_t rest = cdr(args);

			NEARVAL(binding);
			if (length(binding) != 2)
			{
				err("Binding list in let1 must contain exactly two entries");
				THROW(EARGS, "Binding list in let1 must contain exactly two entries");
			}

			NEARVAL(rest);

			value_t name = car(binding);
			value_t value = car(cdr(binding));

			compile_expression(env, local, value, false, Dst);
			TRY(compile_expression(env, local, value, false, Dst));

			int i = local_alloc(local);



@@ 552,7 603,8 @@ void compile_expression(struct environment *env, struct local *local,
			for (; !nilp(rest); rest = cdr(rest))
			{
				bool t = tail && nilp(cdr(rest));
				compile_expression(env, local, car(rest), t, Dst);
				NEARVAL(rest);
				TRY(compile_expression(env, local, car(rest), t, Dst));
			}

			local_free(local, i);


@@ 561,7 613,7 @@ void compile_expression(struct environment *env, struct local *local,
		{
			if (nargs)
			{
				err_at(val, "gc takes no arguments");
				THROW(EARGS, "gc takes no arguments");
			}

			| run_gc;


@@ 569,7 621,7 @@ void compile_expression(struct environment *env, struct local *local,
		else if (symstreq(fsym, "quote"))
		{
			if (nargs != 1)
				err("quote should take exactly 1 argument");
				THROW(EARGS, "quote should take exactly 1 argument");

			// Simple!
			| mov eax, (car(args));


@@ 577,20 629,21 @@ void compile_expression(struct environment *env, struct local *local,
		else if (symstreq(fsym, "backquote"))
		{
			if (nargs != 1)
				err("backquote should take exactly 1 argument");
				THROW(EARGS, "backquote should take exactly 1 argument");

			compile_backquote(env, local, car(args), Dst);
			TRY(compile_backquote(env, local, car(args), Dst));
		}
		else if (symstreq(fsym, "function"))
		{
			if (nargs != 1)
			{
				err("function should take exactly 1 argument");
				THROW(EARGS, "function should take exactly 1 argument");
			}

			NEARVAL(args);
			if (!symbolp(car(args)))
			{
				err("argument to function should be a symbol resolvable at "
				THROW(EINVALID, "argument to function should be a symbol resolvable at "
				    "compile time");
			}



@@ 609,7 662,7 @@ void compile_expression(struct environment *env, struct local *local,

				if (!f)
				{
					err_at(val, "Function `%s' does not exist", (char *)(car(args) ^ SYMBOL_TAG));
					THROW(EINVALID, "Function `%s' does not exist", (char *)(car(args) ^ SYMBOL_TAG));
				}
				value_t closure = create_closure(f->code_ptr, f->args, 0);
				| mov eax, (closure);


@@ 621,23 674,24 @@ void compile_expression(struct environment *env, struct local *local,

			for (int i = nargs - 1; i >= 0; i--)
			{
				compile_expression(env, local, elt(args, i), false, Dst);
				TRY(compile_expression(env, local, elt(args, i), false, Dst));

				| push eax;
				| call_extern cons;
				| add esp, (2 * value_size);
				| push eax;
			}
				| pop eax;
			| pop eax;
		}
		else if (symstreq(fsym, "lambda"))
		{
			// Compile the function with this as the parent scope
			struct local new_local;
			int nargs_out;
			dasm_State *d = compile_function(
			    args, NS_ANONYMOUS, env, &new_local, local, &nargs_out,
			    "recurse", local->current_file_path);
			dasm_State *d;
			TRY(compile_function(
					args, NS_ANONYMOUS, env, &new_local, local, &nargs_out,
					"recurse", local->current_file_path, &d));

			// Link the function
			void *func_ptr = link_program(&d);


@@ 661,7 715,7 @@ void compile_expression(struct environment *env, struct local *local,
					// Closure in eax
					| push eax;
					// Variable now in eax
					compile_variable(find_variable(local, var->name), Dst);
					TRY(compile_variable(find_variable(local, var->name), Dst));
					| push eax;

					// The capture offset


@@ 683,10 737,10 @@ void compile_expression(struct environment *env, struct local *local,
		{
			if (nargs != 1)
			{
				err("eval takes exactly 1 argument");
				THROW(EARGS, "eval takes exactly 1 argument");
			}

			compile_expression(env, local, car(args), false, Dst);
			TRY(compile_expression(env, local, car(args), false, Dst));
			| push eax;
			| push (env);
			| call_extern eval;


@@ 695,10 749,10 @@ void compile_expression(struct environment *env, struct local *local,
		{
			if (nargs != 1)
			{
				err_at(val, "load takes exactly 1 argument, %d given", nargs);
				THROW(EARGS, "load takes exactly 1 argument, %d given", nargs);
			}

			compile_expression(env, local, car(args), false, Dst);
			TRY(compile_expression(env, local, car(args), false, Dst));
			| push eax;
			| push (local->current_file_path);
			| push (env);


@@ 726,7 780,7 @@ void compile_expression(struct environment *env, struct local *local,
			{
				if (func == NULL)
				{
					err_at(val, "Function %s undefined", name);
					THROW(EINVALID, "Function %s undefined", name);
				}

				nargs_needed = func->args;


@@ 734,11 788,10 @@ void compile_expression(struct environment *env, struct local *local,

			if (!are_args_acceptable(nargs_needed, nargs))
			{
				err_at(val,
				       "wrong number of args in function call: %s at %s:%d, "
				       "want %d args but given %d\n",
				       name, cons_file(val), cons_line(val),
				       nargs_needed->num_required, nargs);
				THROW(EARGS,
					  "wrong number of args in function call: %s, "
					  "want %d args but given %d\n",
					  name, nargs_needed->num_required, nargs);
			}

			int total_taken = nargs_needed->num_optional +


@@ 764,7 817,7 @@ void compile_expression(struct environment *env, struct local *local,

					for (int i = nargs - 1; i >= total_taken; i--)
					{
						compile_expression(env, local, elt(args, i), false, Dst);
						TRY(compile_expression(env, local, elt(args, i), false, Dst));
						| push eax;
						| call_extern cons;
						| add esp, 8;


@@ 783,7 836,7 @@ void compile_expression(struct environment *env, struct local *local,

				for (int i = min - 1; i >= 0; i--)
				{
					compile_expression(env, local, elt(args, i), false, Dst);
					TRY(compile_expression(env, local, elt(args, i), false, Dst));
					| push eax;
				}



@@ 828,7 881,7 @@ void compile_expression(struct environment *env, struct local *local,

				pop_pool(pool);

				compile_expression(env, local, expanded_to, false, Dst);
				TRY(compile_expression(env, local, expanded_to, false, Dst));
			}
		}
	}


@@ 847,11 900,10 @@ void compile_expression(struct environment *env, struct local *local,

			if (!v)
			{
				fprintf(stderr, "var: %s\n", (char *)(val ^ SYMBOL_TAG));
				err("Variable unbound");
				THROW(EINVALID, "Variable `%s' unbound", (char *)(val ^ SYMBOL_TAG));
			}

			compile_variable(v, Dst);
			TRY(compile_variable(v, Dst));
		}
	}
	else if (closurep(val))


@@ 861,8 913,10 @@ void compile_expression(struct environment *env, struct local *local,
	else
	{
		printval(val, 1);
		err_at(val, "Don't know how to compile this, sorry.");
		THROW(EUNIMPL, "Don't know how to compile this, sorry.");
	}

	OKAY();
}

struct variable *add_variable(struct local *local, enum var_type type,


@@ 1012,9 1066,11 @@ bool are_args_acceptable(struct args *args, int number)
	}
}

struct args *list_to_args(struct environment *env, value_t list,
                          struct local *local)
struct error list_to_args(struct environment *env, value_t list,
                          struct local *local, struct args **a)
{
	E_INIT();

	struct args *args = new_args();

	bool in_optional = false;


@@ 1022,6 1078,8 @@ struct args *list_to_args(struct environment *env, value_t list,
	for (value_t i = list; !nilp(i); i = cdr(i))
	{
		value_t val = car(i);
		NEARVAL(i);

		if (symbolp(val))
		{
			if (!args->variadic && symstreq(val, "&"))


@@ 1031,9 1089,9 @@ struct args *list_to_args(struct environment *env, value_t list,

				if (!symbolp(name))
				{
					err("You must provide a symbol after & in an argument list "
					    "to bind the\n"
					    "variadic arguments to.");
					THROW(EEXPECTED, "You must provide a symbol after & in an argument list "
						  "to bind the\n"
						  "variadic arguments to.");
				}

				args->variadic = true;


@@ 1054,29 1112,31 @@ struct args *list_to_args(struct environment *env, value_t list,
				char *name = (char *)(val ^ SYMBOL_TAG);
				if (name[0] == '&')
				{
					err("Non-optional argument following optional arguments "
					    "starts with a &\n"
					    "did you mean to declare a variadic argument? If so "
					    "leave a space\n"
					    "between the & and name.");
					THROW(EINVALID, "Non-optional argument following optional arguments "
						  "starts with a &\n"
						  "did you mean to declare a variadic argument? If so "
						  "leave a space\n"
						  "between the & and name.");
				}
				else
				{
					err("Cannot define a non-optional argument after an "
					    "optional one.");
					THROW(EINVALID, "Cannot define a non-optional argument after an "
						  "optional one.");
				}
			}
		}
		else if (listp(val))
		{
			NEARVAL(val);

			in_optional = true;
			int len = length(val);

			if (len != 2)
			{
				err("A list defining an optional value must be structured like "
				    "(name expr)\n"
				    "with exactly two arguments.");
				THROW(EINVALID, "A list defining an optional value must be structured like "
					  "(name expr)\n"
					  "with exactly two arguments.");
			}

			value_t name = car(val);


@@ 1084,9 1144,9 @@ struct args *list_to_args(struct environment *env, value_t list,

			value_t function = cons(nil, cons(expr, nil));

			dasm_State *d =
			    compile_function(function, NS_ANONYMOUS, env, NULL, NULL, NULL,
			                     NULL, local->current_file_path);
			dasm_State *d;
			TRY(compile_function(function, NS_ANONYMOUS, env, NULL, NULL, NULL,
			                     NULL, local->current_file_path, &d));

			// TODO: GC stack top!
			value_t (*compiled)() = link_program(&d);


@@ 1099,7 1159,8 @@ struct args *list_to_args(struct environment *env, value_t list,
		}
	}

	return args;
	*a = args;
	OKAY();
}

void display_args(struct args *args)

M src/lisp/compiler.h => src/lisp/compiler.h +15 -14
@@ 104,16 104,16 @@ struct local
 * `defun`, `defmacro`, `lambda`, etc.
 * @returns NULL if the list is malformed.
 */
struct args *list_to_args(struct environment *env, value_t list,
                          struct local *local);
struct error list_to_args(struct environment *env, value_t list,
                          struct local *local, struct args **args);

/**
 * Print out `args` to stdout. Useful for debugging.
 */
void display_args(struct args *args);

void compile_expression(struct environment *env, struct local *local,
                        value_t val, bool tail, dasm_State **Dst);
struct error compile_expression(struct environment *env, struct local *local,
								value_t val, bool tail, dasm_State **Dst) WARN_UNUSED;

/**
 * Compile a function


@@ 130,19 130,20 @@ void compile_expression(struct environment *env, struct local *local,
 * @returns The compiled function state. You should probably give this to
 * `add_function` or something similar.
 */
struct dasm_State *compile_function(value_t args, enum namespace namespace,
                                    struct environment *env,
                                    struct local *local_out,
                                    struct local *local_parent,
                                    struct args **ar, char *name, char *path);
struct error compile_function(value_t args, enum namespace namespace,
							  struct environment *env,
							  struct local *local_out,
							  struct local *local_parent,
							  struct args **ar, char *name, char *path,
							  dasm_State **s) WARN_UNUSED;

void compile_variable(struct variable *v, dasm_State *Dst);
struct error compile_variable(struct variable *v, dasm_State *Dst) WARN_UNUSED;

/**
 * Compile a backquoted expression
 */
void compile_backquote(struct environment *env, struct local *local,
                       value_t val, dasm_State **Dst);
struct error compile_backquote(struct environment *env, struct local *local,
							   value_t val, dasm_State **Dst) WARN_UNUSED;

int nextpc(struct local *local, dasm_State **Dst);



@@ 172,7 173,7 @@ void walk_and_alloc(struct local *local, value_t body);
 * @param fname The path to the current file.
 * @param val The expression to compile.
 */
void compile_tl(value_t val, struct environment *env, char *fname);
struct error compile_tl(value_t val, struct environment *env, char *fname) WARN_UNUSED;

/**
 * Compile a file in a new environment.


@@ 182,7 183,7 @@ void compile_tl(value_t val, struct environment *env, char *fname);
 * @returns The environment for the compiled file, or an empty environment if
 * `ok` was set to `false` (i.e. the file could not be compiled).
 */
struct environment *compile_file(char *filename, bool *ok);
struct error compile_file(char *filename, struct environment **env) WARN_UNUSED;

struct function *find_function(struct environment *env, char *name);
struct variable *add_variable(struct local *local, enum var_type type,

A src/lisp/error.c => src/lisp/error.c +44 -0
@@ 0,0 1,44 @@
#include "error.h"
#include <string.h>
#include <stdlib.h>
#include <stdarg.h>
#include <stdio.h>

char *ehsprintf(const char *msg, ...)
{
	char *buf = malloc(1024);
	va_list list;
	va_start(list, msg);
	vsnprintf(buf, 1023, msg, list);
	va_end(list);

	return buf;
}

void ereport(struct error err)
{
	if (err.loc.file && err.loc.line)
		fprintf(stderr, "\033[31merror at\033[0m %s:%d\n", err.loc.file, err.loc.line);
	else
		fprintf(stderr, "\033[31merror\033[0m\n");
	
	if (err.message)
		fprintf(stderr, "%s\n", err.message);
	else
	{
		switch (err.code)
		{
		case EEXPECTED:
			fprintf(stderr, "Expected something but it was not found.\n");
			break;
		case EINVALID:
			fprintf(stderr, "Invalid input.\n");
			break;
		case ENOTFOUND:
			fprintf(stderr, "External resource not found.\n");
			break;
		default:
			fprintf(stderr, "Unknown error %d\n", err.code);
		}
	}
}

A src/lisp/error.h => src/lisp/error.h +98 -0
@@ 0,0 1,98 @@
#pragma once

#include <stdbool.h>

// Error handling code

struct eloc
{
	int line;
	char *file;
};

enum error_code
{
	EOK = 0,
	/// Expected something but didn't get it. if this is in a
	/// safe_state we should probably just re-try.
	EEXPECTED,
	/// An invalid token was present in the input
	EINVALID,
	/// A structure was malformed
	EMALFORMED,
	/// The arguments provided were invalid
	EARGS,
	/// An external resource (say, a file) was not found
	ENOTFOUND,
	/// This is unimplemented
	EUNIMPL,
};

struct error
{
	enum error_code code;
	// Is any state safe? I.e. can we continue or must we panic?
	bool safe_state;
	struct eloc loc;
	char *message;
};

#define E_INIT()                                                               \
	struct error __error;                                                      \
	__error.code = EOK;                                                        \
	__error.loc.line = 0;                                                      \
	__error.safe_state = false;                                                \
	__error.message = NULL;                                                    \
	__error.loc.file = NULL;
#define NEARVAL(val)                                                           \
	__error.loc.line = cons_line(val);                                         \
	__error.loc.file = cons_file(val)
#define NEARIS(is) (is)->getpos((is), &__error.loc.line, &__error.loc.file)
#define _TRY(expr, m, c)                                                       \
	{                                                                          \
		struct error __sub = (expr);                                           \
		if (__sub.code)                                                        \
		{                                                                      \
			if (!__sub.loc.file || !__sub.loc.line)                            \
				__sub.loc.file = __error.loc.file,                             \
				__sub.loc.line = __error.loc.line;                             \
			if (c)                                                             \
				__sub.code = c;                                                \
			if (m)                                                             \
				__sub.message = m;                                             \
			return __sub;                                                      \
		}                                                                      \
	}
#define TRY(expr) _TRY(expr, NULL, 0)
#define TRY_ELSE(expr, c, ...) _TRY(expr, ehsprintf(__VA_ARGS__), c)
#define OKAY() return __error
#define THROW(_c, ...)                                                         \
	{                                                                          \
		__error.code = (_c);                                                   \
		__error.message = ehsprintf(__VA_ARGS__);                              \
		return __error;                                                        \
	}
#define THROWSAFE(_c)                                                          \
	{                                                                          \
		__error.code = (_c);                                                   \
		__error.safe_state = true;                                             \
		return __error;                                                        \
	}

#define IS_OKAY(e) ((e).code == EOK)
#define OKAY_IF(val)                                                           \
	{                                                                          \
		struct error __sub = (val);                                            \
		if (IS_OKAY(__sub))                                                    \
			OKAY();                                                            \
		if (!__sub.safe_state)                                                 \
			TRY(__sub)                                                         \
	}

#define WARN_UNUSED __attribute__((warn_unused_result))

// error heap string print formatted
// returns a heap-allocated string.
char *ehsprintf(const char *msg, ...);

void ereport(struct error err);

M src/lisp/lib/std.c => src/lisp/lib/std.c +21 -3
@@ 89,6 89,7 @@ value_t l_elt(value_t seq, value_t i)

value_t l_read_stdin()
{
#ifndef NO_READLINE
	char *string = read_input_line("lisp> ");
	if (!string)
		return nil;


@@ 96,12 97,25 @@ value_t l_read_stdin()
	struct istream *is = new_stristream_nt(string);

	value_t val = nil;
	read1(is, &val);
	struct error err;
	
	if (!IS_OKAY((err = read1(is, &val))))
	{
		ereport(err);

		del_stristream(is);
		free(string);
		// tail recursion, yay!
		return l_read_stdin();
	}

	del_stristream(is);
	free(string);

	return val;
#else
	return nil;
#endif
}

value_t l_num_eq(value_t a, value_t b)


@@ 114,8 128,10 @@ value_t l_num_eq(value_t a, value_t b)
	return (a >> 3) == (b >> 3) ? t : nil;
}

void load_std(struct environment *env)
struct error load_std(struct environment *env)
{
	E_INIT();

	add_c_function(env, "+", l_plus, 2);
	add_c_function(env, "-", l_minus, 2);
	add_c_function(env, "*", l_times, 2);


@@ 135,8 151,10 @@ void load_std(struct environment *env)

	if (!load_library(env, "std"))
	{
		err("Could not load library `std`, make sure your $LISP_LIBRARY_PATH is correct.");
		THROW(ENOTFOUND, "Could not load library `std`, make sure your $LISP_LIBRARY_PATH is correct.");
	}

	OKAY();
}

bool load_library(struct environment *env, char *name)

M src/lisp/lib/std.h => src/lisp/lib/std.h +1 -1
@@ 8,5 8,5 @@ value_t l_printval(value_t val);

void add_function(struct environment *env, char *name, void *func, struct args *args, enum namespace ns);
void add_c_function(struct environment *env, char *name, void *func, int nargs);
void load_std(struct environment *env);
struct error load_std(struct environment *env) WARN_UNUSED;
bool load_library(struct environment *env, char *name);

M src/lisp/lisp.c => src/lisp/lisp.c +47 -67
@@ 1,4 1,5 @@
#include "lisp.h"
#include "error.h"
#include "plat/plat.h"

#include <ctype.h>


@@ 15,28 16,6 @@ value_t t = 1 << 3;

unsigned char max_pool = 0, current_pool = 0;

__attribute__((noreturn)) void err(const char *msg)
{
	fprintf(stderr, "ERROR: %s\n", msg);
	exit(1);
}

__attribute__((noreturn)) void err_at(value_t form, const char *msg, ...)
{
	int line = cons_line(form);
	char *file = cons_file(form);

	fprintf(stderr, "\033[31merror at\033[0m %s:%d\n", file, line);

	va_list list;
	va_start(list, msg);
	vfprintf(stderr, msg, list);
	va_end(list);
	fprintf(stderr, "\n");

	exit(1);
}

value_t intval(int i)
{
	i <<= 2;


@@ 116,12 95,14 @@ bool issym(char c)
	return isalpha(c) || isallowedchar(c) || isdigit(c);
}

bool readsym(struct istream *is, value_t *val)
struct error readsym(struct istream *is, value_t *val)
{
	E_INIT();

	skipws(is);

	if (!issymstart(is->peek(is)))
		return false;
		THROWSAFE(EEXPECTED);

	int size = 8;
	struct alloc *a = malloc_aligned(size + sizeof(struct alloc));


@@ 150,17 131,20 @@ bool readsym(struct istream *is, value_t *val)
			*val |= SYMBOL_TAG;

			add_this_alloc(a, SYMBOL_TAG);
			return true;

			OKAY();
		}
	}
}

bool readstr(struct istream *is, value_t *val)
struct error readstr(struct istream *is, value_t *val)
{
	E_INIT();

	skipws(is);

	if (is->peek(is) != '"')
		return false;
		THROWSAFE(EEXPECTED);

	bool escape = false;
	int size = 8;


@@ 209,7 193,8 @@ bool readstr(struct istream *is, value_t *val)
			*val |= STRING_TAG;

			add_this_alloc(a, STRING_TAG);
			return true;

			OKAY();
		}
	}
}


@@ 265,12 250,15 @@ void printval(value_t v, int depth)
	}
}

bool readlist(struct istream *is, value_t *val)
struct error readlist(struct istream *is, value_t *val)
{
	E_INIT();
	NEARIS(is);

	skipws(is);

	if (is->peek(is) != '(')
		return false;
		THROWSAFE(EEXPECTED);

	is->get(is);



@@ 280,23 268,24 @@ bool readlist(struct istream *is, value_t *val)

	if (is->peek(is) != ')')
	{
		is->showpos(is, stderr);
		err("Unterminated list");
		return false;
		NEARIS(is);
		THROW(EEXPECTED, "Unterminated list");
	}
	is->get(is);

	return true;
	OKAY();
}

bool readint(struct istream *is, value_t *val)
struct error readint(struct istream *is, value_t *val)
{
	E_INIT();

	skipws(is);

	int number = 0;

	if (!isdigit(is->peek(is)))
		return false;
		THROWSAFE(EEXPECTED);

	while (isdigit(is->peek(is)))
	{


@@ 305,11 294,13 @@ bool readint(struct istream *is, value_t *val)
	}

	*val = intval(number);
	return true;
	OKAY();
}

bool readquote(struct istream *is, value_t *val)
struct error readquote(struct istream *is, value_t *val)
{
	E_INIT();

	skipws(is);

	char c = is->peek(is);


@@ 332,15 323,9 @@ bool readquote(struct istream *is, value_t *val)
		// Read the next form and wrap it in the appropriate function

		value_t wrapped;
		bool has_next = read1(is, &wrapped);
		NEARIS(is);

		if (!has_next)
		{
			fprintf(stderr, "Expected a form after reader macro char %c\n", c);
			is->showpos(is, stderr);
			err("Invalid reader macro");
			return false;
		}
		TRY_ELSE(read1(is, &wrapped), EEXPECTED, "Expected a form after reader macro char %c", c);

		value_t symbol = nil;



@@ 362,39 347,33 @@ bool readquote(struct istream *is, value_t *val)
			symbol = symval("function");
			break;
		default:
			is->showpos(is, stderr);
			err("Something went wrong parsing a reader macro");
			NEARIS(is);
			THROW(EINVALID, "Invalid reader macro char %c", c);
		}

		*val = cons(symbol, cons(wrapped, nil));

		return true;
		OKAY();
	}
	else
	{
		return false;
		THROWSAFE(EEXPECTED);
	}
}

bool read1(struct istream *is, value_t *val)
struct error read1(struct istream *is, value_t *val)
{
	// This could all be one big short-circuiting || but that is ugly.
	if (readquote(is, val))
		return true;
	E_INIT();

	if (readsym(is, val))
		return true;
	NEARIS(is);

	if (readstr(is, val))
		return true;
	OKAY_IF(readquote(is, val));
	OKAY_IF(readsym(is, val));
	OKAY_IF(readstr(is, val));
	OKAY_IF(readint(is, val));
	OKAY_IF(readlist(is, val));

	if (readint(is, val))
		return true;

	if (readlist(is, val))
		return true;

	return false;
	THROWSAFE(EEXPECTED);
}

void set_cons_info(value_t cons, int line, char *name)


@@ 415,7 394,7 @@ value_t readn(struct istream *is)

	value_t read_val;

	while (read1(is, &read_val))
	while (IS_OKAY(read1(is, &read_val)))
	{
		int line;
		char *file;


@@ 703,6 682,7 @@ value_t deep_copy(value_t val)
	}
	else
	{
		err("Don't know how to deep copy this, sorry... please report this bug :)");
		fprintf(stderr, "Don't know how to deep copy this, sorry... please report this bug :)");
		return nil;
	}
}

M src/lisp/lisp.h => src/lisp/lisp.h +7 -10
@@ 1,5 1,6 @@
#pragma once

#include "error.h"
#include "istream.h"
#include <stdbool.h>
#include <stdio.h>


@@ 153,22 154,21 @@ bool pool_alive(unsigned char pool);

bool startswith(struct istream *s, char *pattern);

bool readsym(struct istream *is, value_t *val);
bool readstr(struct istream *is, value_t *val);
bool readlist(struct istream *is, value_t *val);
bool readint(struct istream *is, value_t *val);
struct error readsym(struct istream *is, value_t *val) WARN_UNUSED;
struct error readstr(struct istream *is, value_t *val) WARN_UNUSED;
struct error readlist(struct istream *is, value_t *val) WARN_UNUSED;
struct error readint(struct istream *is, value_t *val) WARN_UNUSED;

/**
 * Read a quoted form, including `'` (quote) `\`` (backquote) and `,` (unquote)
 * @returns true if read successfully, and sets `val`.
 */
bool readquote(struct istream *is, value_t *val);
struct error readquote(struct istream *is, value_t *val) WARN_UNUSED;

value_t intval(int i);
value_t strval(char *str);
value_t symval(char *str);
value_t cons(value_t car, value_t cdr);
bool read1(struct istream *is, value_t *val);
struct error read1(struct istream *is, value_t *val) WARN_UNUSED;
value_t read(struct istream *is);
value_t readn(struct istream *is);



@@ 199,9 199,6 @@ value_t elt(value_t v, int index);

void printval(value_t v, int depth);

void err(const char *msg);
void err_at(value_t form, const char *msg, ...);

bool symstreq(value_t sym, char *str);

value_t create_closure(void *code, struct args *args, int ncaptures);

M src/lisp/main.c => src/lisp/main.c +9 -7
@@ 12,13 12,13 @@ int main(int argc, char **argv)
	}

	bool ok;
	struct environment *env = compile_file(argv[1], &ok);

	if (!ok)
	struct environment *env = NULL;
	struct error compile_error;
	if (!IS_OKAY((compile_error = compile_file(argv[1], &env))))
	{
		fprintf(stderr, "Could not open %s\n", argv[1]);
		return 1;
	}
		ereport(compile_error);
		goto done;
	}		

	value_t (*lisp_main)() = find_function(env, "main")->def0;



@@ 32,6 32,8 @@ int main(int argc, char **argv)
		fprintf(stderr, "No MAIN function defined! nothing to do\n");
	}

done:
	free_all();
	del_env(env);
	if (env)
		del_env(env);
}