Add detailed error reporting, remove panics
diff --git a/.build.yml b/.build.yml
index 8f6eb05..90d238c 100644
--- a/.build.yml
+++ b/.build.yml
@@ -22,7 +22,7 @@
cd bluejay
./bin/jmk
cd src/lisp
- make
+ make NO_READLINE=1
- build-latex: |
cd bluejay
./bin/jmk
diff --git a/src/lisp/Jmk b/src/lisp/Jmk
index 5b00b6d..ed2e788 100644
--- a/src/lisp/Jmk
+++ b/src/lisp/Jmk
@@ -13,10 +13,16 @@
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 @@
plat/linux.o \
istream.o \
gc.o \
- call_list.o
+ call_list.o \
+ error.o
LUA = vendor/luajit/src/host/minilua
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index 7e71c51..e591ed3 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -131,13 +131,16 @@
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 @@
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 @@
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 @@
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 @@
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 @@
{
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
| pop eax;
}
}
+
+ OKAY();
}
value_t eval(struct environment *env, value_t form)
@@ -409,8 +440,15 @@
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 @@
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 @@
| 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 @@
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 @@
| 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 @@
// 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 @@
{
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 @@
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 @@
{
if (nargs)
{
- err_at(val, "gc takes no arguments");
+ THROW(EARGS, "gc takes no arguments");
}
| run_gc;
@@ -569,7 +621,7 @@
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 @@
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 @@
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 @@
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 @@
// 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 @@
{
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 @@
{
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 @@
{
if (func == NULL)
{
- err_at(val, "Function %s undefined", name);
+ THROW(EINVALID, "Function %s undefined", name);
}
nargs_needed = func->args;
@@ -734,11 +788,10 @@
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 @@
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 @@
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 @@
pop_pool(pool);
- compile_expression(env, local, expanded_to, false, Dst);
+ TRY(compile_expression(env, local, expanded_to, false, Dst));
}
}
}
@@ -847,11 +900,10 @@
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 @@
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 @@
}
}
-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 @@
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 @@
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 @@
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 @@
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 @@
}
}
- return args;
+ *a = args;
+ OKAY();
}
void display_args(struct args *args)
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index 5ba6620..67c03e6 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -104,16 +104,16 @@
* `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 @@
* @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 @@
* @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 @@
* @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,
diff --git a/src/lisp/error.c b/src/lisp/error.c
new file mode 100644
index 0000000..266f797
--- /dev/null
+++ b/src/lisp/error.c
@@ -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);
+ }
+ }
+}
diff --git a/src/lisp/error.h b/src/lisp/error.h
new file mode 100644
index 0000000..d4c47e8
--- /dev/null
+++ b/src/lisp/error.h
@@ -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);
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index 85221ea..5ad02bc 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -89,6 +89,7 @@
value_t l_read_stdin()
{
+#ifndef NO_READLINE
char *string = read_input_line("lisp> ");
if (!string)
return nil;
@@ -96,12 +97,25 @@
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 @@
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 @@
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)
diff --git a/src/lisp/lib/std.h b/src/lisp/lib/std.h
index dae0ac3..eb129d5 100644
--- a/src/lisp/lib/std.h
+++ b/src/lisp/lib/std.h
@@ -8,5 +8,5 @@
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);
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index 6ed3fb9..64ab9ae 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -1,4 +1,5 @@
#include "lisp.h"
+#include "error.h"
#include "plat/plat.h"
#include <ctype.h>
@@ -15,28 +16,6 @@
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 @@
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 @@
*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 @@
*val |= STRING_TAG;
add_this_alloc(a, STRING_TAG);
- return true;
+
+ OKAY();
}
}
}
@@ -265,12 +250,15 @@
}
}
-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 @@
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 @@
}
*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 @@
// 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 @@
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 read_val;
- while (read1(is, &read_val))
+ while (IS_OKAY(read1(is, &read_val)))
{
int line;
char *file;
@@ -703,6 +682,7 @@
}
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;
}
}
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index c572c80..430e526 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -1,5 +1,6 @@
#pragma once
+#include "error.h"
#include "istream.h"
#include <stdbool.h>
#include <stdio.h>
@@ -153,22 +154,21 @@
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 @@
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);
diff --git a/src/lisp/main.c b/src/lisp/main.c
index b0c014e..07e6d4a 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -12,13 +12,13 @@
}
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 @@
fprintf(stderr, "No MAIN function defined! nothing to do\n");
}
+done:
free_all();
- del_env(env);
+ if (env)
+ del_env(env);
}