Add optional, variadic arguments
diff --git a/.vscode/launch.json b/.vscode/launch.json
index 0597115..a8d2c36 100644
--- a/.vscode/launch.json
+++ b/.vscode/launch.json
@@ -9,7 +9,7 @@
"type": "cppdbg",
"request": "launch",
"program": "${workspaceFolder}/src/lisp/lisp",
- "args": ["test-closures.lisp"],
+ "args": ["test-args.lisp"],
"stopAtEntry": false,
"cwd": "${workspaceFolder}/src/lisp",
"environment": [
diff --git a/lib/lisp/std/std.lisp b/lib/lisp/std/std.lisp
index 096b885..388637b 100644
--- a/lib/lisp/std/std.lisp
+++ b/lib/lisp/std/std.lisp
@@ -1,5 +1,7 @@
;;;; std.lisp -- Lisp standard library
+;; Boring utilities
+
(defun caar (val)
(car (car val)))
@@ -15,12 +17,32 @@
(defun caddar (val)
(car (cdr (cdr (car val)))))
+;; /Boring utilitites
+
+
+
;; Instead of a function this is a macro for a slight performance increase
(defmacro not (val)
(nilp val))
;; TODO: make tail recursive (for this `flet` would be nice)
(defun length (list)
+ "Returns the length of `list`, or `nil` if it is not a list"
(if (nilp list)
0
(+ 1 (length (cdr list)))))
+
+(defmacro when (cond & body)
+ "Evaluate `body` when `cond` is truthy.
+When `cond` is truthy, evaluates `body` in order, finally evaluating to
+the final item."
+ (list 'if cond
+ (cons 'progn body)))
+
+(defmacro unless (cond & body)
+ "Evaluate `body` unless `cond` is truthy.
+When `cond` is nil, evaluates `body` in order, finally evaluating to the
+final item."
+ (list 'if cond
+ nil
+ (cons 'progn body)))
diff --git a/src/lisp/Jmk b/src/lisp/Jmk
index 628a33d..3f50e85 100644
--- a/src/lisp/Jmk
+++ b/src/lisp/Jmk
@@ -13,7 +13,7 @@
archetype(c)
archetype(asm)
-CFLAGS += -Ivendor/luajit/dynasm
+CFLAGS += -Ivendor/luajit/dynasm -Werror
ASMFLAGS += -felf -Fdwarf
OBJECTS = main.o \
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index 2807967..2a60640 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -126,7 +126,8 @@
struct dasm_State *compile_function(value_t args, enum namespace namespace,
struct environment *env, struct local *local_out,
- struct local *local_parent, int *nargs, char *name)
+ struct local *local_parent, struct args **args_out,
+ char *name)
{
dasm_State *d;
dasm_State **Dst = &d;
@@ -160,17 +161,13 @@
value_t arglist = car(args);
value_t body = cdr(args);
- local.num_args = length(arglist);
+ // This will add the arguments to local too.
+ struct args *ar = list_to_args(env, arglist, &local);
+ local.args = ar;
- value_t a = arglist;
- for (int i = 0; !nilp(a); a = cdr(a), i++)
+ if (!ar)
{
- if (!symbolp(car(a)))
- {
- err("defun argument must be a symbol");
- }
-
- add_variable(&local, V_ARGUMENT, (char *)(car(a) ^ SYMBOL_TAG), i);
+ err("Malformed args list");
}
for (value_t body_ = body; !nilp(body_); body_ = cdr(body_))
@@ -193,8 +190,8 @@
if (local_out)
*local_out = local;
- if (nargs)
- *nargs = length(arglist);
+ if (args_out)
+ *args_out = ar;
return d;
}
@@ -215,13 +212,13 @@
namespace = NS_MACRO;
struct local local;
- int nargs;
+ struct args *a;
char *name = (char *)(car(args) ^ SYMBOL_TAG);
- dasm_State *d = compile_function(cdr(args), namespace, env, &local, NULL, &nargs, name);
+ dasm_State *d = compile_function(cdr(args), namespace, env, &local, NULL, &a, name);
add_function(env, name, link_program(&d),
- nargs, namespace);
+ a, namespace);
dasm_free(&d);
del_local(&local);
@@ -483,7 +480,7 @@
}
struct function *f = find_function(env, (char *)(car(args) ^ SYMBOL_TAG));
- value_t closure = create_closure(f->code_ptr, f->nargs, 0);
+ value_t closure = create_closure(f->code_ptr, f->args, 0);
| mov eax, (closure);
}
@@ -563,12 +560,12 @@
struct function *func = find_function(env, name);
bool is_recursive = false;
- int nargs_needed = 0;
+ struct args *nargs_needed = NULL;
if (symstreq(fsym, local->current_function_name))
{
is_recursive = true;
- nargs_needed = local->num_args;
+ nargs_needed = local->args;
}
else
{
@@ -578,24 +575,38 @@
err("Function undefined");
}
- nargs_needed = func->nargs;
+ nargs_needed = func->args;
}
- if (nargs != nargs_needed)
+ if (!are_args_acceptable(nargs_needed, nargs))
{
fprintf(stderr, "Function call: %s at %s:%d, want %d args but given %d\n",
- name, cons_file(val), cons_line(val), nargs_needed, nargs);
+ name, cons_file(val), cons_line(val), nargs_needed->num_required, nargs);
err("wrong number of args");
}
if (is_recursive || func->namespace == NS_FUNCTION)
{
- for (int i = length(args) - 1; i >= 0; i--)
+ int nargs = length(args);
+
+ if (nargs <= nargs_needed->num_required)
+ {
+ // Push the variadic list (nil)
+ | push (nil);
+ }
+
+ for (int i = nargs_needed->num_optional - 1; i >= nargs - nargs_needed->num_required; i--)
+ {
+ // Push the default optional values
+ | push (nargs_needed->optional_arguments[i].value);
+ }
+
+ for (int i = nargs - 1; i >= 0; i--)
{
compile_expression(env, local, elt(args, i), Dst);
| push eax;
}
-
+
if (is_recursive)
{
| call ->function_start;
@@ -687,7 +698,8 @@
if (v)
{
- // We found this in a parent scope, add it as a V_FREE variable to skip the search.
+ // We found this in a parent scope, add it as a V_FREE variable
+ // to skip the search.
v = add_variable(local, V_FREE, name, local->num_closure_slots++);
}
}
@@ -697,12 +709,188 @@
extern value_t _call_list(void *addr, value_t list, value_t *edi);
-value_t call_list(struct function *func, value_t list)
+value_t call_list_args(void *code_ptr, struct args *args, value_t list, void *data)
{
- return _call_list(func->code_ptr, list, NULL);
+ list = deep_copy(list);
+ int nargs = length(list);
+
+ value_t *val = NULL;
+
+ for (value_t i = list; !nilp(i); i = cdr(i))
+ {
+ val = cdrref(i);
+ }
+
+ int total_required = args->num_required + args->num_optional;
+
+ if (nargs > total_required)
+ {
+ // Take the remainder of the list and put it as the last item in the
+ // list.
+ value_t trailing = cxdr(list, total_required);
+ value_t last_item = cons(trailing, nil);
+
+ *cxdrref(&list, total_required) = last_item;
+ }
+ else if (nargs < total_required)
+ {
+ for (int i = nargs - args->num_required; i < args->num_optional; i++)
+ {
+ // Append the i-th defualt argument
+ value_t appended = cons(args->optional_arguments[i].value, nil);
+ *val = appended;
+ val = cdrref(appended);
+ }
+ }
+
+ // We want to call this if we pass the correct # of arguments or less, just
+ // not if we have already passed varargs. Appends a nil argument.
+ if (nargs <= total_required)
+ {
+ // Enough real arguments but no variadic arguments. Pass a nil list.
+ *val = cons(nil, nil);
+ }
+
+ return _call_list(code_ptr, list, data);
+}
+
+value_t call_list(struct function *fun, value_t list)
+{
+ return call_list_args(fun->code_ptr, fun->args, list, NULL);
}
value_t call_list_closure(struct closure *c, value_t list)
{
- return _call_list(c->function, list, c->data);
+ return call_list_args(c->function, c->args, list, c->data);
+}
+
+struct args *new_args()
+{
+ struct args *a = malloc(sizeof(struct args));
+ a->num_optional = 0;
+ a->num_required = 0;
+ a->variadic = false;
+
+ return a;
+}
+
+struct args *add_optional_arg(struct args *args, value_t name,
+ value_t value)
+{
+ int i = args->num_optional++;
+ args = realloc(args, sizeof(struct args) +
+ sizeof(struct optional_argument) * args->num_optional);
+
+ args->optional_arguments[i] = (struct optional_argument)
+ {
+ .value = value ,
+ .name = name,
+ };
+
+ return args;
+}
+
+bool are_args_acceptable(struct args *args, int number)
+{
+ if (args->variadic)
+ {
+ return number >= args->num_required;
+ }
+ else
+ {
+ return number >= args->num_required &&
+ number <= args->num_required + args->num_optional;
+ }
+}
+
+struct args *list_to_args(struct environment *env, value_t list, struct local *local)
+{
+ struct args *args = new_args();
+
+ bool in_optional = false;
+
+ for (value_t i = list; !nilp(i); i = cdr(i))
+ {
+ value_t val = car(i);
+ if (symbolp(val))
+ {
+ if (!args->variadic && symstreq(val, "&"))
+ {
+ i = cdr(i);
+ value_t name = car(i);
+
+ if (!symbolp(name))
+ {
+ err("You must provide a symbol after & in an argument list to bind the\n"
+ "variadic arguments to.");
+ }
+
+ args->variadic = true;
+
+ add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG),
+ args->num_optional + args->num_required);
+
+ continue;
+ }
+
+ if (!in_optional)
+ {
+ add_variable(local, V_ARGUMENT, (char *)(val ^ SYMBOL_TAG), args->num_required++);
+ }
+ else
+ {
+ 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.");
+ }
+ else
+ {
+ err("Cannot define a non-optional argument after an optional one.");
+ }
+ }
+ }
+ else if (listp(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.");
+ }
+
+ value_t name = car(val);
+ value_t expr = car(cdr(val));
+
+ value_t function = cons(nil, cons(expr, nil));
+
+ dasm_State *d = compile_function(function, NS_ANONYMOUS, env, NULL, NULL, NULL, NULL);
+
+ // TODO: GC stack top!
+ value_t (*compiled)() = link_program(&d);
+
+ value_t value = compiled();
+ args = add_optional_arg(args, name, value);
+
+ add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG), args->num_required + args->num_optional - 1);
+ }
+ }
+
+ return args;
+}
+
+void display_args(struct args *args)
+{
+ printf("Args object taking %d require arguments and %d optionals:\n",
+ args->num_required, args->num_optional);
+
+ for (int i = 0; i < args->num_optional; i++)
+ {
+ printf(" %d\t%s\n", i, (char *)(args->optional_arguments[i].name ^ SYMBOL_TAG));
+ printval(args->optional_arguments[i].value, 2);
+ }
}
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index 62b43c0..e03d93a 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -15,10 +15,20 @@
NS_ANONYMOUS,
};
+
+struct args *new_args();
+struct args *add_optional_arg(struct args *args, value_t name,
+ value_t expression);
+
+/**
+ * @returns if `number` is an acceptable number of arguments for `args`.
+ */
+bool are_args_acceptable(struct args *args, int number);
+
struct function
{
char *name;
- int nargs; // number of arguments
+ struct args *args;
enum namespace namespace;
union
@@ -72,7 +82,8 @@
/// for a lambda.
char *current_function_name;
- int num_vars, num_args;
+ int num_vars;
+ struct args *args;
/// Most recently defined variable
struct variable *first;
int npc;
@@ -86,6 +97,19 @@
int num_closure_slots;
};
+/**
+ * Parse a list of arguments to an args object and add them as V_ARGUMENT
+ * variables to `local`. The list should be in the same format as is accepted by
+ * `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);
+
+/**
+ * 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, dasm_State **Dst);
@@ -99,14 +123,14 @@
* should since you need to free the stack slot allocation map).
* @param local_parent Parent local environment, only needed for closures. NULL
* if no parent.
- * @param nargs The number of arguments for this function will be returned here.
- * NULL if you don't care about it.
+ * @param args An object representing the arguments this function accepts will
+ * be returned here. Set this to NULL if you don't care.
* @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, int *nargs, char *name);
+ struct local *local_parent, struct args **ar, char *name);
void compile_variable(struct variable *v, dasm_State *Dst);
diff --git a/src/lisp/istream.c b/src/lisp/istream.c
index 957b2b5..8ac275a 100644
--- a/src/lisp/istream.c
+++ b/src/lisp/istream.c
@@ -130,6 +130,7 @@
int next;
bool has_next;
int line;
+ char *path;
};
int fistream_peek(struct istream *is)
@@ -192,7 +193,7 @@
struct fistream_private *p = is->data;
*line = p->line;
- *name = "<FILE *>";
+ *name = p->path;
}
struct istream *new_fistream(char *path, bool binary)
@@ -213,6 +214,7 @@
p->has_next = false;
p->file = fp;
p->line = 1;
+ p->path = path;
is->data = p;
is->get = fistream_get;
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index c7efca0..3681e47 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -52,34 +52,57 @@
return call_list_closure((struct closure *)(func ^ CLOSURE_TAG), args);
}
-void add_function(struct environment *env, char *name, void *func, int nargs, enum namespace ns)
+value_t l_nilp(value_t val)
+{
+ return nilp(val) ? t : nil;
+}
+
+void add_function(struct environment *env, char *name, void *func, struct args *args, enum namespace ns)
{
struct function *last, *new = malloc(sizeof(struct function));
last = env->first;
new->prev = last;
new->name = name;
- new->nargs = nargs;
+ new->args = args;
new->code_ptr = func;
new->namespace = ns;
env->first = new;
}
+void add_c_function(struct environment *env, char *name, void *func, int nargs)
+{
+ struct args *args = new_args();
+ args->num_required = nargs;
+
+ add_function(env, name, func, args, NS_FUNCTION);
+}
+
+value_t l_elt(value_t seq, value_t i)
+{
+ if (!listp(seq) || !integerp(i))
+ return nil;
+
+ return elt(seq, i >> 2);
+}
+
void load_std(struct environment *env)
{
- add_function(env, "+", l_plus, 2, NS_FUNCTION);
- add_function(env, "-", l_minus, 2, NS_FUNCTION);
- add_function(env, "*", l_times, 2, NS_FUNCTION);
- add_function(env, "/", l_divide, 2, NS_FUNCTION);
+ add_c_function(env, "+", l_plus, 2);
+ add_c_function(env, "-", l_minus, 2);
+ add_c_function(env, "*", l_times, 2);
+ add_c_function(env, "/", l_divide, 2);
- add_function(env, "car", car, 1, NS_FUNCTION);
- add_function(env, "cdr", cdr, 1, NS_FUNCTION);
- add_function(env, "cons", cons, 2, NS_FUNCTION);
+ add_c_function(env, "car", car, 1);
+ add_c_function(env, "cdr", cdr, 1);
+ add_c_function(env, "cons", cons, 2);
- add_function(env, "print", l_printval, 1, NS_FUNCTION);
+ add_c_function(env, "print", l_printval, 1);
+ add_c_function(env, "apply", l_apply, 2);
- add_function(env, "apply", l_apply, 2, NS_FUNCTION);
+ add_c_function(env, "nilp", l_nilp, 1);
+ add_c_function(env, "elt", l_elt, 2);
if (!load_library(env, "std"))
{
diff --git a/src/lisp/lib/std.h b/src/lisp/lib/std.h
index a117b5d..dae0ac3 100644
--- a/src/lisp/lib/std.h
+++ b/src/lisp/lib/std.h
@@ -6,6 +6,7 @@
value_t l_plus(value_t a, value_t b);
value_t l_printval(value_t val);
-void add_function(struct environment *env, char *name, void *func, int nargs, enum namespace ns);
+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);
bool load_library(struct environment *env, char *name);
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index c606e29..e151670 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -14,7 +14,7 @@
unsigned char max_pool = 0, current_pool = 0;
-void err(const char *msg)
+__attribute__((noreturn)) void err(const char *msg)
{
fprintf(stderr, "ERROR: %s\n", msg);
exit(1);
@@ -239,7 +239,7 @@
{
struct closure *c = (void *)(v ^ CLOSURE_TAG);
printf("closure %p taking %d argument(s) and capturing %d value(s)\n",
- c->function, c->num_args, c->num_captured);
+ c->function, c->args->num_required, c->num_captured);
}
else
{
@@ -598,13 +598,13 @@
return c->name;
}
-value_t create_closure(void *code, int nargs, int ncaptures)
+value_t create_closure(void *code, struct args *args, int ncaptures)
{
struct closure_alloc *ca = malloc_aligned(sizeof(struct closure_alloc) +
ncaptures * sizeof(value_t));
ca->closure.function = code;
- ca->closure.num_args = nargs;
+ ca->closure.args = args;
ca->closure.num_captured = ncaptures;
add_this_alloc(&ca->alloc, CLOSURE_TAG);
@@ -621,3 +621,68 @@
c->data[index] = value;
}
+
+value_t cxdr(value_t v, int index)
+{
+ if (!listp(v) || index >= length(v))
+ return nil;
+
+ for (int i = 0; i < index; i++)
+ {
+ v = cdr(v);
+ }
+
+ return v;
+}
+
+value_t *cxdrref(value_t *v, int index)
+{
+ if (!listp(*v) || index >= length(*v))
+ return NULL;
+
+ value_t *p = v;
+
+ for (int i = 0; i < index; i++)
+ {
+ p = cdrref(*p);
+ }
+
+ return p;
+}
+
+value_t deep_copy(value_t val)
+{
+ if (integerp(val) || val == nil || val == t)
+ {
+ return val;
+ }
+ else if (symbolp(val))
+ {
+ return symval((char *)(val ^ SYMBOL_TAG));
+ }
+ else if (stringp(val))
+ {
+ return strval((char *)(val ^ STRING_TAG));
+ }
+ else if (consp(val))
+ {
+ return cons(deep_copy(car(val)), deep_copy(cdr(val)));
+ }
+ else if (closurep(val))
+ {
+ struct closure *c = (void *)(val ^ CLOSURE_TAG);
+ value_t new = create_closure(c->function, c->args, c->num_captured);
+ struct closure *new_c = (void *)(new ^ CLOSURE_TAG);
+
+ for (int i = 0; i < c->num_captured; i++)
+ {
+ new_c->data[i] = deep_copy(c->data[i]);
+ }
+
+ return new;
+ }
+ else
+ {
+ err("Don't know how to deep copy this, sorry... please report this bug :)");
+ }
+}
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index 7c0e571..a8bea1c 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -39,10 +39,39 @@
char *name;
};
+/**
+ * Represents how many arguments a function takes.
+ */
+struct args
+{
+ /// The minimum valid number of arguments
+ int num_required;
+
+ /// The number of optional values
+ int num_optional;
+
+ /// Does this function accept variadic arguments? If `true`, any arguments
+ /// after the required and optional arguments will be `cons`-ed to a list
+ /// and passed as a final argument.
+ bool variadic;
+
+ /// The default values for the optional arguments, as expressions. These
+ /// should be evaluated at the call site. They are known not to reference
+ /// anything that could clash with scope at the call site.
+ struct optional_argument
+ {
+ /// The default value of this argument
+ value_t value;
+
+ /// The name of this argument as a symbol
+ value_t name;
+ } optional_arguments[];
+};
+
struct closure
{
/// How many arguments does this closure take
- int num_args;
+ struct args *args;
/// How many free variables does it capture (i.e. length of `data`)
int num_captured;
/// The function pointer itself
@@ -146,6 +175,12 @@
value_t cdr(value_t v);
value_t *carref(value_t v);
value_t *cdrref(value_t v);
+/// @returns the `index`-th `cdr`
+value_t cxdr(value_t v, int index);
+/// @returns a reference to the `index`-th `cdr`
+value_t *cxdrref(value_t *v, int index);
+
+value_t deep_copy(value_t val);
int cons_line(value_t val);
char *cons_file(value_t val);
@@ -167,7 +202,7 @@
bool symstreq(value_t sym, char *str);
-value_t create_closure(void *code, int nargs, int ncaptures);
+value_t create_closure(void *code, struct args *args, int ncaptures);
/**
* Set the `index`th capture variable of `closure`. This should really only be
diff --git a/src/lisp/test-args.lisp b/src/lisp/test-args.lisp
new file mode 100644
index 0000000..14364a8
--- /dev/null
+++ b/src/lisp/test-args.lisp
@@ -0,0 +1,7 @@
+(defun with-optional (required (optional 3))
+ (+ required optional))
+
+(defun main ()
+ (when t
+ (print (with-optional 2))
+ (print (with-optional 2 4))))