Library

We will now create a small library of useful functions for our LISP system. Rather than creating new builtins for each one, let's take advantage of the fact that much of the LISP standard library can be implemented in LISP itself in terms of lower-level fuctions.

First we need a function to read the library definitions from disk.

char *slurp(const char *path)
{
	FILE *file;
	char *buf;
	long len;

	file = fopen(path, "r");
	if (!file)
		return NULL;
	fseek(file, 0, SEEK_END);
	len = ftell(file);
	fseek(file, 0, SEEK_SET);

	buf = malloc(len + 1);
	if (!buf)
		return NULL;

	fread(buf, 1, len, file);
	buf[len] = 0;
	fclose(file);

	return buf;
}

And a routine, similar to our REPL in main, to process the definitions. Because we read the whole file in one go, there is no problem with splitting definitions over several lines.

void load_file(Atom env, const char *path)
{
	char *text;

	printf("Reading %s...\n", path);
	text = slurp(path);
	if (text) {
		const char *p = text;
		Atom expr;
		while (read_expr(p, &p, &expr) == Error_OK) {
			Atom result;
			Error err = eval_expr(expr, env, &result);
			if (err) {
				printf("Error in expression:\n\t");
				print_expr(expr);
				putchar('\n');
			} else {
				print_expr(result);
				putchar('\n');
			}
		}
		free(text);
	}
}

Finally read in the library after setting up the builtins.

int main(int argc, char **argv)
{
	.
 	.
	.

	/* Set up the initial environment */
	.
	.
	.

	load_file(env, "library.lisp");

	/* Main loop */
	.
	.
	.
}

Testing

Create library.lisp with the following definition:

(define (abs x) (if (< x 0) (- x) x))

And run the interpreter:

Reading library.lisp...
ABS
> (abs -2)
2

fold

foldl and foldr allow us to easily construct functions which combine elements of a list.

(define (foldl proc init list)
  (if list
      (foldl proc
             (proc init (car list))
             (cdr list))
      init))

(define (foldr proc init list)
  (if list
      (proc (car list)
            (foldr proc init (cdr list)))
      init))

See the internet for more details.

(define (list . items)
  (foldr cons nil items))

(define (reverse list)
  (foldl (lambda (a x) (cons x a)) nil list))

list constructs a new list containing its arguments. reverse creates a copy of a list with the items in reverse order.

The recursive definition of LIST requires O(n) stack space - a serious implementation would most likely use a more efficient version.

Testing

> (list (+ 3 5) 'foo)
(8 FOO)
> (reverse '(1 2 3))
(3 2 1)

See how much easier this was than implementing the functions as builtins.

More builtins

Some primitive functions require access to the internals of the system.

apply

The apply function:

(APPLY fn arg-list)

int builtin_apply(Atom args, Atom *result)
{
	Atom fn;

	if (nilp(args) || nilp(cdr(args)) || !nilp(cdr(cdr(args))))
		return Error_Args;

	fn = car(args);
	args = car(cdr(args));

	if (!listp(args))
		return Error_Syntax;

	return apply(fn, args, result);
}

eq?

eq? tests whether two atoms refer to the same object.

int builtin_eq(Atom args, Atom *result)
{
	Atom a, b;
	int eq;

	if (nilp(args) || nilp(cdr(args)) || !nilp(cdr(cdr(args))))
		return Error_Args;

	a = car(args);
	b = car(cdr(args));

	if (a.type == b.type) {
		switch (a.type) {
		case AtomType_Nil:
			eq = 1;
			break;
		case AtomType_Pair:
		case AtomType_Closure:
		case AtomType_Macro:
			eq = (a.value.pair == b.value.pair);
			break;
		case AtomType_Symbol:
			eq = (a.value.symbol == b.value.symbol);
			break;
		case AtomType_Integer:
			eq = (a.value.integer == b.value.integer);
			break;
		case AtomType_Builtin:
			eq = (a.value.builtin == b.value.builtin);
			break;
		}
	} else {
		eq = 0;
	}

	*result = eq ? make_sym("T") : nil;
	return Error_OK;
}

pair?

Tests whether an atom is a pair.

int builtin_pairp(Atom args, Atom *result)
{
	if (nilp(args) || !nilp(cdr(args)))
		return Error_Args;

	*result = (car(args).type == AtomType_Pair) ? make_sym("T") : nil;
	return Error_OK;
}

Don't forget to add bindings for these to the initial environment.

env_set(env, make_sym("APPLY"), make_builtin(builtin_apply));
env_set(env, make_sym("EQ?"), make_builtin(builtin_eq));
env_set(env, make_sym("PAIR?"), make_builtin(builtin_pairp));

map

We can use foldr and apply to implement another important function map, which constructs a list containing the results of calling an n-ary function with the values contained in n lists in turn.

(define (unary-map proc list)
  (foldr (lambda (x rest) (cons (proc x) rest))
         nil
         list))

(define (map proc . arg-lists)
  (if (car arg-lists)
      (cons (apply proc (unary-map car arg-lists))
            (apply map (cons proc
                             (unary-map cdr arg-lists))))
      nil))

Once again please note that there are alternative implementations.

It works like this:

> (map + '(1 2 3) '(4 5 6))
(5 7 9)

The result is a list containing the results of evaluating (+ 1 4), (+ 2 5), and (+ 3 6).