~swisschili/bluejay

a7568dc427ab04f649fecea3e9425f1c18e586d0 — swissChili 3 months ago 36f2c69
Add unquote-splice (,@)
M src/lisp/compiler.dasc => src/lisp/compiler.dasc +35 -10
@@ 139,6 139,8 @@ struct error compile_function(value_t args, enum namespace namespace,
							  char *path,
							  dasm_State **state)
{
	UNUSED(namespace);

	E_INIT();

	dasm_State *d;


@@ 455,23 457,46 @@ struct error compile_backquote(struct environment *env, struct local *local,

			TRY(compile_expression(env, local, car(args), false, Dst));
		}
		else if (symstreq(fsym, "unquote-splice"))
		{

		}
		else
		{
			| push nil;

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

				// Remove unnecessary pop
				| push eax;
				if (listp(v) && symstreq(car(v), "unquote-splice"))
				{
					NEARVAL(v);

					if (length(v) != 2)
					{
						THROW(EARGS, "unquote-splice (or ,@) takes exactly 1 argument");
					}

					value_t expr = car(cdr(v));

					if (!listp(expr))
					{
						THROW(EINVALID, "unquote-splice (or ,@) argument must be a list");
					}

					TRY(compile_expression(env, local, expr, false, Dst));
					| push eax;
					| call_extern merge2;
					| add esp, 8;
					| push eax;
				}
				else
				{
					TRY(compile_backquote(env, local, v, Dst));
					| push eax;
					| call_extern cons;
					| add esp, 8;

					// Remove unnecessary pop
					| push eax;
				}
			}
			| pop eax;
		}

M src/lisp/error.h => src/lisp/error.h +2 -0
@@ 98,3 98,5 @@ char *ehsprintf(const char *msg, ...);
void ereport(struct error err);

void edebug(struct error err, char *file, int line, const char *func, const char *why);

#define UNUSED(val) (void)(val)

M src/lisp/lisp.c => src/lisp/lisp.c +30 -0
@@ 696,3 696,33 @@ value_t deep_copy(value_t val)
		return nil;
	}
}

value_t *nilptr(value_t val)
{
	if (!listp(val))
		return NULL;

	if (nilp(val))
		return NULL;

	value_t *p;

	for (p = cdrref(val); !nilp(*p); p = cdrref(*p))
	{
	}

	return p;
}

value_t merge2(value_t front, value_t back)
{
	if (!listp(front) || !listp(back))
		return nil;

	if (nilp(front))
		return back;
	else
		*nilptr(front) = back;

	return front;
}

M src/lisp/lisp.h => src/lisp/lisp.h +4 -0
@@ 170,12 170,16 @@ value_t intval(int i);
value_t strval(char *str);
value_t symval(char *str);
value_t cons(value_t car, value_t cdr);
value_t merge2(value_t front, value_t back);
struct error read1(struct istream *is, value_t *val) WARN_UNUSED;
value_t read(struct istream *is);
value_t readn(struct istream *is);

value_t car(value_t v);
value_t cdr(value_t v);
/// Return a pointer to the "nil" tail of the list, or NULL if you do
/// something stupid.
value_t *nilptr(value_t val);
value_t *carref(value_t v);
value_t *cdrref(value_t v);
/// @returns the `index`-th `cdr`

M src/lisp/plat/linux.c => src/lisp/plat/linux.c +4 -0
@@ 1,4 1,5 @@
#include "plat.h"
#include "../error.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>


@@ 50,6 51,7 @@ char *read_input_line(char *prompt)
#ifndef NO_READLINE
	return readline(prompt);
#else
	UNUSED(prompt);
	return "";
#endif
}


@@ 58,5 60,7 @@ void add_line_to_history(char *line)
{
#ifndef NO_READLINE
	add_history(line);
#else
	UNUSED(line);
#endif
}

A src/lisp/test-errors.lisp => src/lisp/test-errors.lisp +1 -0
@@ 0,0 1,1 @@
'(

A src/lisp/test-unquote.lisp => src/lisp/test-unquote.lisp +5 -0
@@ 0,0 1,5 @@
(defun numbers ()
  (list 1 2 3 4 5))

(defun main ()
  (print `(numbers are ,@(numbers) yeah)))