Fix bug with merge2 and ,@, add (let)
diff --git a/lib/lisp/std/std.lisp b/lib/lisp/std/std.lisp
index 4e2166e..766fe6f 100644
--- a/lib/lisp/std/std.lisp
+++ b/lib/lisp/std/std.lisp
@@ -59,7 +59,15 @@
`(progn ,@body)))
(defmacro flet (funcs & body)
- ;; (flet- funcs body)
- (print funcs))
+ (flet- funcs body))
+
+(defmacro let (bindings & body)
+ (flet ((let- (bindings body)
+ (if bindings
+ `(let1 ,(car bindings)
+ ,(recurse (cdr bindings)
+ body))
+ `(progn ,@body)))))
+ (funcall let- bindings body))
(load "list-functions.lisp")
diff --git a/src/lisp/Jmk2 b/src/lisp/Jmk2
index 2fc98d4..a54cd87 100644
--- a/src/lisp/Jmk2
+++ b/src/lisp/Jmk2
@@ -36,7 +36,7 @@
rule valgrind [pwd]/lisp {
log VALGRIND "lisp test-gc.lisp"
- shell "LISP_LIBRARY_PATH=$::lisp_libpath valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all ./lisp test-gc.lisp"
+ shell "LISP_LIBRARY_PATH=$::lisp_libpath valgrind --track-origins=yes --leak-check=full --show-leak-kinds=all ./lisp quicksort.lisp"
}
srcs main.c lisp.c compiler.c lib/std.c plat/linux.c istream.c gc.c \
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index 6549ecc..0a01079 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -488,6 +488,7 @@
}
else
{
+ // tail of the list
| push nil;
for (int i = n - 1; i >= 0; i--)
@@ -693,6 +694,7 @@
NEARVAL(binding);
if (length(binding) != 2)
{
+ printval(args, 0);
THROW(EARGS, "Binding list in let1 must contain exactly two entries");
}
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index 6299e03..8002319 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -603,12 +603,12 @@
void del_alloc(struct alloc *alloc)
{
- if (alloc->type_tag == CLOSURE_TAG)
- {
- fprintf(stderr, "del_alloc closure\n");
- struct closure_alloc *ca = alloc;
- free(ca->closure.args);
- }
+ /* if (alloc->type_tag == CLOSURE_TAG) */
+ /* { */
+ /* fprintf(stderr, "del_alloc closure\n"); */
+ /* struct closure_alloc *ca = alloc; */
+ /* free(ca->closure.args); */
+ /* } */
free_aligned(alloc);
}
@@ -723,17 +723,20 @@
}
}
-value_t *nilptr(value_t val)
+value_t *nilptr(value_t *val)
{
- if (!listp(val))
+ if (!val)
return NULL;
- if (nilp(val))
+ if (!listp(*val))
return NULL;
+ if (nilp(*val))
+ return val;
+
value_t *p;
- for (p = cdrref(val); !nilp(*p); p = cdrref(*p))
+ for (p = cdrref(*val); !nilp(*p); p = cdrref(*p))
{
}
@@ -748,7 +751,7 @@
if (listp(front) && !listp(back))
back = cons(back, nil);
- *nilptr(front) = back;
+ *nilptr(&front) = back;
return front;
}
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index ad7314a..c5cb398 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -83,6 +83,18 @@
value_t data[];
};
+struct class
+{
+ // A symbol representing the name of the class this is an instance
+ // of.
+ value_t type;
+
+ int num_members;
+ // C data
+ void *cdata;
+ value_t members[];
+};
+
/// Default pool (no pool)
#define NO_POOL 0
@@ -131,6 +143,12 @@
struct closure closure;
};
+struct class_alloc
+{
+ struct alloc alloc;
+ struct class class;
+};
+
/**
* Create a new allocation pool.
*/
@@ -181,7 +199,7 @@
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 *nilptr(value_t *val);
value_t *carref(value_t v);
value_t *cdrref(value_t v);
/// @returns the `index`-th `cdr`
diff --git a/src/lisp/lispbugs b/src/lisp/lispbugs
deleted file mode 100644
index 67ac030..0000000
--- a/src/lisp/lispbugs
+++ /dev/null
@@ -1,8 +0,0 @@
-BUG: "random" segfault in lisp (gc) calls.
-
-Theory: the values we're walking on the stack are garbage, i.e. coming
-from C.
-
-Looks like the GCSegments code got lost, I need to readd that and it
-should fix this. `eval' in `compiler.dasc' is getting it's local
-variables inspected by _do_gc.
\ No newline at end of file
diff --git a/src/lisp/main.c b/src/lisp/main.c
index 96a2f8e..6205bd1 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -2,25 +2,41 @@
#include "gc.h"
#include "lisp.h"
#include "plat/plat.h"
+#include "lib/std.h"
+#include <stdlib.h>
int main(int argc, char **argv)
{
gc_push_segment(NULL, 0);
- if (argc < 2)
- {
- puts("pass the program you want to run as the first argument please");
- return 1;
- }
-
- bool ok;
struct environment *env = NULL;
struct error compile_error;
- if (!IS_OKAY((compile_error = compile_file(argv[1], &env))))
+
+ if (argc < 2)
{
- ereport(compile_error);
- goto done;
+ env = malloc(sizeof(struct environment));
+ env->first = NULL;
+ env->first_loaded = NULL;
+
+ if (!IS_OKAY((compile_error = load_std(env))))
+ {
+ ereport(compile_error);
+ goto done;
+ }
+
+ if (!load_library(env, "repl"))
+ goto done;
}
+ else
+ {
+ if (!IS_OKAY((compile_error = compile_file(argv[1], &env))))
+ {
+ ereport(compile_error);
+ goto done;
+ }
+ }
+
+
struct function *lisp_main_f = find_function(env, "main");