Add flet1, flet, update reference
diff --git a/doc/lisp_reference/lisp_reference.tex b/doc/lisp_reference/lisp_reference.tex
index e53bd14..11b2207 100644
--- a/doc/lisp_reference/lisp_reference.tex
+++ b/doc/lisp_reference/lisp_reference.tex
@@ -113,7 +113,10 @@
\definition{
(\optlist{
\func{nilp} \text{ or } \func{not} \\
- \func{integerp}
+ \func{closurep} \text{ or } \func{functionp} \\
+ \func{integerp} \\
+ \func{consp} \\
+ \func{symbolp}
} \param{value})\index{nilp}\index{not}
}{
\ret{\T} if \param{value} is of the specified type, \ret{\nil}
@@ -133,12 +136,25 @@
}
\definition{
- (\mac{let1} (\param{variable} \param{form}) \param{body}\more)\index{let1}
+ (\mac{let1} (\param{variable} \param{form}) \param{body}\more)\index{let1} \\
+ (\mac{let} ((\param{variable} \param{form})\more) \param{body}\more)\index{let}
}{
First evaluate \param{form}, binding it to \param{variable}. Then
evaluate \param{body}, finally evaluating to \ret{the final entry in
\param{body}} or \ret{\nil} if \param{body} is
empty. \param{variable} is no longer in scope after this form ends.
+ \mac{let} is similar to \mac{let*} in other lisps, later variables
+ can reference previous ones.
+}
+
+\definition{
+ (\mac{flet1} (\param{name} (\param{args}\more) \param{body}\more)) \\
+ (\mac{flet} ((\param{name} (\param{args}\more)\more) \param{body}\more))
+ \index{flet}\index{flet1}
+}{
+ Like \mac{let} and \mac{let1} but creates a lambda. Unlike other
+ lisps the defined function remains in the variable namespace as a
+ \type{function-object}.
}
\definition{
diff --git a/lib/lisp/std/std.lisp b/lib/lisp/std/std.lisp
index db0cd12..2b522fc 100644
--- a/lib/lisp/std/std.lisp
+++ b/lib/lisp/std/std.lisp
@@ -46,8 +46,20 @@
(defun funcall (fun & list)
(apply fun list))
-;; (defmacro flet1 (func & body)
-;; `(let1 (,(car func) ,(cons 'lambda (cdr func)))
-;; ,@load))
+(defmacro flet1 (func & body)
+ `(let1 (,(car func)
+ (lambda ,@(cdr func)))
+ ,@body))
+
+(defun flet- (funcs body)
+ (if funcs
+ `(flet1 ,(car funcs)
+ ,(flet- (cdr funcs)
+ body))
+ `(progn ,@body)))
+
+(defmacro flet (funcs & body)
+ ;; (flet- funcs body)
+ (print funcs))
(list "body-functions.lisp")
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index bae4a39..5cd6897 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -189,7 +189,7 @@
for (value_t body_ = body; !nilp(body_); body_ = cdr(body_))
{
- TRY(walk_and_alloc(env, &local, carref(body_)));
+ TRY(walk_and_alloc(env, &local, carref(body_), false));
}
| setup (local.num_stack_entries);
@@ -271,31 +271,34 @@
OKAY();
}
-struct error walk_and_alloc(struct environment *env, struct local *local, value_t *bp)
+struct error walk_and_alloc(struct environment *env, struct local *local, value_t *bp, bool quoted)
{
+ // Note: this kind of sucks. Some of the quote-handling code is
+ // duplicated here and compile_expression. TODO: refactor
+ // eventually.
+
E_INIT();
value_t body = *bp;
- // TODO: handle macros
if (!listp(body))
OKAY();
value_t args = cdr(body);
- if (symstreq(car(body), "let1"))
+ if (!quoted && symstreq(car(body), "let1"))
{
int slot = local_alloc(local);
value_t expr = cdr(args);
for (; !nilp(expr); expr = cdr(expr))
{
- walk_and_alloc(env, local, carref(expr));
+ walk_and_alloc(env, local, carref(expr), false);
}
local_free(local, slot);
}
- else if (symstreq(car(body), "lambda"))
+ else if (!quoted && symstreq(car(body), "lambda"))
{
// We don't want to walk the lambda because it's another function. When
// the lambda is compiled it will be walked.
@@ -303,31 +306,46 @@
}
else
{
- // Is this a macro?
-
- struct function *mac = NULL;
-
- if (symbolp(car(body)))
- mac = find_function(env, (char *)(car(body) ^ SYMBOL_TAG));
- else
- walk_and_alloc(env, local, carref(body));
-
- if (mac && mac->namespace == NS_MACRO)
+ if (quoted)
{
- unsigned char pool = push_pool(0);
- value_t form = call_list(mac, args);
- pop_pool(pool);
-
- add_to_pool(form);
- *bp = form;
-
- walk_and_alloc(env, local, bp);
+ if (symstreq(car(body), "unquote") || symstreq(car(body), "unquote-splice"))
+ {
+ for (value_t b = cdr(body); !nilp(b); b = cdr(b))
+ {
+ walk_and_alloc(env, local, carref(b), false);
+ }
+ }
}
else
{
- for (; !nilp(args); args = cdr(args))
+ // Is this a macro?
+
+ struct function *mac = NULL;
+
+ if (symbolp(car(body)))
+ mac = find_function(env, (char *)(car(body) ^ SYMBOL_TAG));
+ else if (consp(car(body))) // consp, not just listp, since we don't care about nil.
+ walk_and_alloc(env, local, carref(body), false);
+
+ if (mac && mac->namespace == NS_MACRO)
{
- walk_and_alloc(env, local, carref(args));
+ unsigned char pool = push_pool(0);
+ value_t form = call_list(mac, args);
+ pop_pool(pool);
+
+ add_to_pool(form);
+ *bp = form;
+
+ walk_and_alloc(env, local, bp, false);
+ }
+ else
+ {
+ bool should_quote = symstreq(car(body), "quote") || symstreq(car(body), "backquote");
+
+ for (; !nilp(args); args = cdr(args))
+ {
+ walk_and_alloc(env, local, carref(args), should_quote);
+ }
}
}
}
@@ -351,12 +369,13 @@
value_t val;
- struct error read_error;
+ struct error compile_error, read_error;
while (IS_OKAY((read_error = read1(is, &val))))
{
- if (!IS_OKAY(compile_tl(val, env, path)))
+ if (!IS_OKAY((compile_error = compile_tl(val, env, path))))
{
+ ereport(compile_error);
goto failure;
}
}
@@ -476,11 +495,6 @@
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;
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index 75abe33..340d955 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -166,7 +166,7 @@
/**
* Walk `body` and reserve space in `local` for any variable declarations.
*/
-struct error walk_and_alloc(struct environment *env, struct local *local, value_t *body);
+struct error walk_and_alloc(struct environment *env, struct local *local, value_t *body, bool quoted);
/**
* Compile a top level definition
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index 0a203b5..935df1f 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -128,6 +128,16 @@
return (a >> 3) == (b >> 3) ? t : nil;
}
+#define LISP_PREDICATE(name) value_t l_##name(value_t v) { return name(v) ? t : nil; }
+
+LISP_PREDICATE(listp)
+LISP_PREDICATE(integerp)
+LISP_PREDICATE(symbolp)
+LISP_PREDICATE(closurep)
+LISP_PREDICATE(consp)
+
+#undef LISP_PREDICATE
+
struct error load_std(struct environment *env)
{
E_INIT();
@@ -147,6 +157,13 @@
add_c_function(env, "apply", l_apply, 2);
add_c_function(env, "nilp", l_nilp, 1);
+ add_c_function(env, "listp", l_listp, 1);
+ add_c_function(env, "integerp", l_integerp, 1);
+ add_c_function(env, "symbolp", l_symbolp, 1);
+ add_c_function(env, "closurep", l_closurep, 1);
+ add_c_function(env, "functionp", l_closurep, 1);
+ add_c_function(env, "consp", l_consp, 1);
+
add_c_function(env, "elt", l_elt, 2);
if (!load_library(env, "std"))
@@ -171,6 +188,7 @@
if (file_exists(path))
{
+ fprintf(stderr, "path: %s\n", path);
return load(env, path);
}
@@ -178,6 +196,7 @@
if (file_exists(path))
{
+ fprintf(stderr, "path: %s\n", path);
return load(env, path);
}
}
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index f1a02ed..9aac65d 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -716,13 +716,13 @@
value_t merge2(value_t front, value_t back)
{
- if (!listp(front) || !listp(back))
- return nil;
+ if (!listp(front) && listp(back))
+ return cons(front, back);
- if (nilp(front))
- return back;
- else
- *nilptr(front) = back;
+ if (listp(front) && !listp(back))
+ back = cons(back, nil);
+
+ *nilptr(front) = back;
return front;
}
diff --git a/src/lisp/test-flet.lisp b/src/lisp/test-flet.lisp
new file mode 100644
index 0000000..c8c64f2
--- /dev/null
+++ b/src/lisp/test-flet.lisp
@@ -0,0 +1,5 @@
+(defun main ()
+ (flet
+ '((a () 123)
+ (b () 456))
+ (print (funcall b))))