Add load(), load_library(), lisp std
diff --git a/src/lisp/Jmk b/src/lisp/Jmk
index 7c1fe8e..628a33d 100644
--- a/src/lisp/Jmk
+++ b/src/lisp/Jmk
@@ -38,14 +38,15 @@
type(executable)
F ?= test.lisp
+lisp_libpath = $(ROOT)/lib/lisp
run: lisp
status_log(LISP, $(F))
- @./lisp $(F)
+ @LISP_LIBRARY_PATH="$(lisp_libpath)" ./lisp $(F)
leak-check: lisp
status_log(VALGRIND, lisp $(F))
- @valgrind --leak-check=full ./lisp $(F)
+ @LISP_LIBRARY_PATH="$(lisp_libpath)" valgrind --leak-check=full ./lisp $(F)
format:
status_log(FORMAT, *)
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index c2c0639..2807967 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -44,14 +44,10 @@
struct function *find_function(struct environment *env, char *name)
{
- struct function *f = env->first;
+ struct function *f;
- while (strcmp(f->name, name) != 0)
+ for (f = env->first; f && strcmp(f->name, name); f = f->prev)
{
- if (f->prev)
- f = f->prev;
- else
- return NULL;
}
return f;
@@ -106,6 +102,26 @@
// We're not gonna bother munmap()ing the function
free(f);
}
+
+ for (struct loaded_file *next, *l = env->first_loaded; l; l = next)
+ {
+ next = l->previous;
+ free(l->resolved_path);
+ free(l);
+ }
+}
+
+void add_load(struct environment *env, char *path)
+{
+ static char buffer[512];
+ long size = readlink(path, buffer, 512);
+ buffer[size] = '\0';
+ char *resolved = strdup(buffer);
+
+ struct loaded_file *f = malloc(sizeof(struct loaded_file));
+ f->resolved_path = resolved;
+ f->previous = env->first_loaded;
+ env->first_loaded = f;
}
struct dasm_State *compile_function(value_t args, enum namespace namespace,
@@ -201,14 +217,22 @@
struct local local;
int nargs;
char *name = (char *)(car(args) ^ SYMBOL_TAG);
+
dasm_State *d = compile_function(cdr(args), namespace, env, &local, NULL, &nargs, name);
- add_function(env, name, link(&d),
+ add_function(env, name, link_program(&d),
nargs, namespace);
dasm_free(&d);
del_local(&local);
}
+ else if (symstreq(form, "progn"))
+ {
+ for (value_t val = args; !nilp(val); val = cdr(val))
+ {
+ compile_tl(car(val), env);
+ }
+ }
}
void walk_and_alloc(struct local *local, value_t body)
@@ -245,23 +269,48 @@
}
}
-struct environment compile_all(struct istream *is)
+bool load(struct environment *env, char *path)
{
+ if (!file_exists(path))
+ return false;
+
+ add_load(env, path);
+
unsigned char pool = make_pool();
unsigned char pop = push_pool(pool);
+ struct istream *is = new_fistream(path, false);
+ if (!is)
+ return false;
+
value_t val;
- struct environment env;
- env.first = NULL;
- load_std(&env);
while (read1(is, &val))
{
- compile_tl(val, &env);
+ compile_tl(val, env);
}
+ del_fistream(is);
pop_pool(pop);
+ return true;
+}
+
+struct environment compile_file(char *filename, bool *ok)
+{
+ value_t val;
+ struct environment env;
+ env.first = NULL;
+ env.first_loaded = NULL;
+
+ add_load(&env, filename);
+ load_std(&env);
+
+ bool ok_ = load(&env, filename);
+
+ if (ok)
+ *ok = ok_;
+
return env;
}
@@ -358,6 +407,13 @@
compile_expression(env, local, elt(args, 2), Dst);
|=>after_label:
}
+ else if (symstreq(fsym, "progn"))
+ {
+ for (value_t val = args; !nilp(val); val = cdr(val))
+ {
+ compile_expression(env, local, car(val), Dst);
+ }
+ }
else if (symstreq(fsym, "let1"))
{
if (nargs < 2)
@@ -460,7 +516,7 @@
dasm_State *d = compile_function(args, NS_ANONYMOUS, env, &new_local, local, &nargs_out, "recurse");
// Link the function
- void *func_ptr = link(&d);
+ void *func_ptr = link_program(&d);
// Create a closure object with the correct number of captures at
// runtime
@@ -554,8 +610,13 @@
}
else if (func->namespace == NS_MACRO)
{
+ // Make sure that the stuff allocated by the macro isn't in a pool
+ unsigned char pool = push_pool(0);
+
value_t expanded_to = call_list(func, args);
+ pop_pool(pool);
+
compile_expression(env, local, expanded_to, Dst);
}
}
@@ -584,7 +645,7 @@
| cleanup;
- add_function(env, name, link(Dst), 0, NS_FUNCTION);
+ add_function(env, name, link_program(Dst), 0, NS_FUNCTION);
}
struct variable *add_variable(struct local *local, enum var_type type,
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index d70cac6..62b43c0 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -34,9 +34,16 @@
struct function *prev;
};
+struct loaded_file
+{
+ char *resolved_path;
+ struct loaded_file *previous;
+};
+
struct environment
{
struct function *first;
+ struct loaded_file *first_loaded;
};
enum var_type
@@ -136,7 +143,17 @@
void walk_and_alloc(struct local *local, value_t body);
// Compile top-level declaration
void compile_tl(value_t val, struct environment *env);
-struct environment compile_all(struct istream *is);
+
+/**
+ * Compile a file in a new environment.
+ * @param filename The path to the file.
+ * @param ok Set to `true` if loading succeeds, `false` otherwise. If `ok` is
+ * NULL it is ignored.
+ * @returns The environment for the compiled file, or an empty environment if
+ * `ok` was set to `false` (i.e. the file could not be compiled).
+ */
+struct environment compile_file(char *filename, bool *ok);
+
struct function *find_function(struct environment *env, char *name);
struct variable *add_variable(struct local *local, enum var_type type,
char *name, int number);
@@ -154,3 +171,16 @@
*/
value_t call_list(struct function *func, value_t list);
value_t call_list_closure(struct closure *c, value_t list);
+
+/**
+ * Load a lisp file into the current environment.
+ * @returns `true` if succesful, `false` otherwise.
+ */
+bool load(struct environment *env, char *path);
+
+/**
+ * Mark a file `path` as loaded in the environment. `path` will be expanded with
+ * `readlink`. You can pass a temporary string here, memory will be allocated by
+ * this function as needed.
+ */
+void add_load(struct environment *env, char *path);
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index 028dd3d..c7efca0 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -1,5 +1,7 @@
#include "std.h"
+#include "../plat/plat.h"
#include <stdlib.h>
+#include <string.h>
value_t l_plus(value_t a, value_t b)
{
@@ -78,4 +80,37 @@
add_function(env, "print", l_printval, 1, NS_FUNCTION);
add_function(env, "apply", l_apply, 2, NS_FUNCTION);
+
+ if (!load_library(env, "std"))
+ {
+ err("Could not load library `std`, make sure your $LISP_LIBRARY_PATH is correct.");
+ }
+}
+
+bool load_library(struct environment *env, char *name)
+{
+ char *lib_paths = getenv("LISP_LIBRARY_PATH");
+
+ if (!lib_paths)
+ lib_paths = "/lib/lisp";
+
+ for (char *p = strtok(lib_paths, ":"); p; p = strtok(NULL, ":"))
+ {
+ static char path[512];
+ snprintf(path, 512, "%s/%s.lisp", p, name);
+
+ if (file_exists(path))
+ {
+ return load(env, path);
+ }
+
+ snprintf(path, 512, "%s/%s/%s.lisp", p, name, name);
+
+ if (file_exists(path))
+ {
+ return load(env, path);
+ }
+ }
+
+ return false;
}
diff --git a/src/lisp/lib/std.h b/src/lisp/lib/std.h
index 9070de8..a117b5d 100644
--- a/src/lisp/lib/std.h
+++ b/src/lisp/lib/std.h
@@ -8,3 +8,4 @@
void add_function(struct environment *env, char *name, void *func, int nargs, enum namespace ns);
void load_std(struct environment *env);
+bool load_library(struct environment *env, char *name);
diff --git a/src/lisp/main.c b/src/lisp/main.c
index 94bdeaf..1ece9ae 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -1,6 +1,7 @@
#include "compiler.h"
#include "lisp.h"
#include "gc.h"
+#include "plat/plat.h"
int main(int argc, char **argv)
{
@@ -10,15 +11,15 @@
return 1;
}
- struct istream *is = new_fistream(argv[1], false);
+ bool ok;
+ struct environment env = compile_file(argv[1], &ok);
- if (is == NULL)
+ if (!ok)
{
fprintf(stderr, "Could not open %s\n", argv[1]);
return 1;
}
- struct environment env = compile_all(is);
value_t (*lisp_main)() = find_function(&env, "main")->def0;
gc_set_base_here();
@@ -26,5 +27,4 @@
free_all();
del_env(&env);
- del_fistream(is);
}
diff --git a/src/lisp/plat/linux.c b/src/lisp/plat/linux.c
index 4a223a6..b71f342 100644
--- a/src/lisp/plat/linux.c
+++ b/src/lisp/plat/linux.c
@@ -2,6 +2,7 @@
#include <stdlib.h>
#include <string.h>
#include <sys/mman.h>
+#include <unistd.h>
void *malloc_aligned(size_t size)
{
@@ -20,7 +21,7 @@
free(addr);
}
-void *link(dasm_State **Dst)
+void *link_program(dasm_State **Dst)
{
size_t size;
void *buf;
@@ -33,3 +34,8 @@
mprotect(buf, size, PROT_READ | PROT_EXEC);
return buf;
}
+
+bool file_exists(const char *path)
+{
+ return access(path, F_OK) == 0;
+}
diff --git a/src/lisp/plat/plat.h b/src/lisp/plat/plat.h
index 3640005..1c4216a 100644
--- a/src/lisp/plat/plat.h
+++ b/src/lisp/plat/plat.h
@@ -3,6 +3,8 @@
#include <dasm_proto.h>
#include <stddef.h>
#include <stdint.h>
+#include <stdbool.h>
+#include <sys/types.h>
/* Platform specific definitions */
@@ -11,6 +13,9 @@
void *realloc_aligned(void *addr, size_t size);
void free_aligned(void *addr);
-void *link(dasm_State **Dst);
+void *link_program(dasm_State **Dst);
+
+extern ssize_t readlink(const char *pathname, char *buf, size_t buf_size);
+bool file_exists(const char *path);
#define THREAD_LOCAL