Add (read), improve error reporting
diff --git a/.gitignore b/.gitignore
index fea5e90..ee4a8e6 100644
--- a/.gitignore
+++ b/.gitignore
@@ -18,4 +18,5 @@
doc/_build
!doc/Makefile
mnt/*
-doc/_dox*
\ No newline at end of file
+doc/_dox*
+.ccls*
diff --git a/.vscode/launch.json b/.vscode/launch.json
index a8d2c36..2c23b66 100644
--- a/.vscode/launch.json
+++ b/.vscode/launch.json
@@ -38,6 +38,32 @@
"remote": true,
"cwd": "${workspaceRoot}",
"valuesFormatting": "parseText",
- }
+ },
+ {
+ "name": "Debug lisp repl",
+ "type": "cppdbg",
+ "request": "launch",
+ "program": "${workspaceFolder}/src/lisp/lisp",
+ "args": ["${workspaceFolder}/lib/lisp/repl/repl.lisp"],
+ "stopAtEntry": false,
+ "cwd": "${workspaceFolder}/src/lisp",
+ "environment": [
+ {
+ "name": "LISP_LIBRARY_PATH",
+ "value": "${workspaceFolder}/lib/lisp"
+ }
+ ],
+ "externalConsole": false,
+ "MIMode": "gdb",
+ "setupCommands": [
+ {
+ "description": "Enable pretty-printing for gdb",
+ "text": "-enable-pretty-printing",
+ "ignoreFailures": true
+ }
+ ],
+ "preLaunchTask": "buildLisp"
+ },
+
]
}
\ No newline at end of file
diff --git a/lib/lisp/repl/repl.lisp b/lib/lisp/repl/repl.lisp
new file mode 100644
index 0000000..97206dd
--- /dev/null
+++ b/lib/lisp/repl/repl.lisp
@@ -0,0 +1,9 @@
+(defun repl ()
+ (let1 (val (read))
+ (when val
+ (print (eval val))
+ (repl))))
+
+(defun main ()
+ (print "Welcome to the Bluejay REPL!")
+ (repl))
diff --git a/lib/lisp/std/list-functions.lisp b/lib/lisp/std/list-functions.lisp
new file mode 100644
index 0000000..a777401
--- /dev/null
+++ b/lib/lisp/std/list-functions.lisp
@@ -0,0 +1,5 @@
+(defun mapcar (fun list)
+ (if list
+ (cons (funcall fun (car list))
+ (mapcar fun (cdr list)))
+ nil))
diff --git a/lib/lisp/std/std.lisp b/lib/lisp/std/std.lisp
index 388637b..d995f0e 100644
--- a/lib/lisp/std/std.lisp
+++ b/lib/lisp/std/std.lisp
@@ -23,7 +23,7 @@
;; Instead of a function this is a macro for a slight performance increase
(defmacro not (val)
- (nilp val))
+ (list 'nilp val))
;; TODO: make tail recursive (for this `flet` would be nice)
(defun length (list)
@@ -46,3 +46,10 @@
(list 'if cond
nil
(cons 'progn body)))
+
+(defun read ((stream nil))
+ (if (not stream)
+ (read-stdin)))
+
+(print "Loading list functions")
+(print (load "list-functions.lisp"))
diff --git a/src/lisp/Jmk b/src/lisp/Jmk
index 3f50e85..8647e85 100644
--- a/src/lisp/Jmk
+++ b/src/lisp/Jmk
@@ -13,7 +13,8 @@
archetype(c)
archetype(asm)
-CFLAGS += -Ivendor/luajit/dynasm -Werror
+CFLAGS += -Ivendor/luajit/dynasm -Werror -lreadline
+LDFLAGS += -lreadline
ASMFLAGS += -felf -Fdwarf
OBJECTS = main.o \
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index 2a60640..668d59a 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -1,13 +1,16 @@
/* -*- mode:c -*- */
#include "compiler.h"
-#include "lib/std.h"
-#include "plat/plat.h"
#include "gc.h"
+#include "lib/std.h"
+#include "lisp.h"
+#include "plat/plat.h"
#include <dasm_proto.h>
#include <dasm_x86.h>
+#include <libgen.h>
+#include <stdio.h>
#include <stdlib.h>
#include <string.h>
@@ -16,8 +19,7 @@
|.arch x86;
|.macro setup, nvars;
-|->function_start:
-| push ebp;
+|->function_start : | push ebp;
| mov ebp, esp;
| sub esp, (value_size * nvars);
|.endmacro;
@@ -70,7 +72,8 @@
int old_size = local->num_stack_slots;
local->num_stack_slots += 4;
- local->stack_slots = realloc(local->stack_slots, local->num_stack_slots * sizeof(bool));
+ local->stack_slots =
+ realloc(local->stack_slots, local->num_stack_slots * sizeof(bool));
// unreadable: set the remaining slots to unused
memset(local->stack_slots + old_size, 0, local->num_stack_slots - old_size);
local->stack_slots[old_size] = true;
@@ -109,6 +112,8 @@
free(l->resolved_path);
free(l);
}
+
+ free(env);
}
void add_load(struct environment *env, char *path)
@@ -125,9 +130,11 @@
}
struct dasm_State *compile_function(value_t args, enum namespace namespace,
- struct environment *env, struct local *local_out,
- struct local *local_parent, struct args **args_out,
- char *name)
+ struct environment *env,
+ struct local *local_out,
+ struct local *local_parent,
+ struct args **args_out, char *name,
+ char *path)
{
dasm_State *d;
dasm_State **Dst = &d;
@@ -155,6 +162,7 @@
local.num_closure_slots = 0;
local.parent = local_parent;
local.current_function_name = name;
+ local.current_file_path = path;
dasm_growpc(&d, local.npc);
@@ -175,7 +183,7 @@
walk_and_alloc(&local, car(body_));
}
- | setup (local.num_stack_entries);
+ | setup(local.num_stack_entries);
memset(local.stack_slots, 0, local.num_stack_slots * sizeof(bool));
local.num_stack_entries = 0;
@@ -196,7 +204,7 @@
return d;
}
-void compile_tl(value_t val, struct environment *env)
+void compile_tl(value_t val, struct environment *env, char *fname)
{
if (!listp(val))
err("Top level must be a list");
@@ -209,16 +217,16 @@
enum namespace namespace = NS_FUNCTION;
if (symstreq(form, "defmacro"))
- namespace = NS_MACRO;
+ namespace = NS_MACRO;
struct local local;
struct args *a;
char *name = (char *)(car(args) ^ SYMBOL_TAG);
- dasm_State *d = compile_function(cdr(args), namespace, env, &local, NULL, &a, name);
+ dasm_State *d = compile_function(cdr(args), namespace, env, &local,
+ NULL, &a, name, fname);
- add_function(env, name, link_program(&d),
- a, namespace);
+ add_function(env, name, link_program(&d), a, namespace);
dasm_free(&d);
del_local(&local);
@@ -227,7 +235,7 @@
{
for (value_t val = args; !nilp(val); val = cdr(val))
{
- compile_tl(car(val), env);
+ compile_tl(car(val), env, fname);
}
}
}
@@ -284,7 +292,7 @@
while (read1(is, &val))
{
- compile_tl(val, env);
+ compile_tl(val, env, path);
}
del_fistream(is);
@@ -293,17 +301,34 @@
return true;
}
-struct environment compile_file(char *filename, bool *ok)
+value_t load_relative(struct environment *env, char *to, value_t name)
+{
+ if (!stringp(name))
+ return nil;
+
+ char *new_path = (char *)(name ^ STRING_TAG);
+ char *relative_to = strdup(to);
+ char full_path[512];
+
+ snprintf(full_path, 512, "%s/%s", dirname(relative_to), new_path);
+
+ if (load(env, full_path))
+ return t;
+ else
+ return nil;
+}
+
+struct environment *compile_file(char *filename, bool *ok)
{
value_t val;
- struct environment env;
- env.first = NULL;
- env.first_loaded = NULL;
+ struct environment *env = malloc(sizeof(struct environment));
+ env->first = NULL;
+ env->first_loaded = NULL;
- add_load(&env, filename);
- load_std(&env);
+ add_load(env, filename);
+ load_std(env);
- bool ok_ = load(&env, filename);
+ bool ok_ = load(env, filename);
if (ok)
*ok = ok_;
@@ -331,37 +356,54 @@
}
else
{
- value_t fsym = car(val),
- args = cdr(val);
+ value_t fsym = car(val), args = cdr(val);
int nargs = length(args);
// TODO
}
}
+value_t eval(struct environment *env, value_t form)
+{
+ // Eval!
+ value_t function = cons(nil, cons(form, nil));
+
+ struct local local;
+ struct args *args;
+
+ dasm_State *d = compile_function(function, NS_ANONYMOUS, env, &local, NULL,
+ &args, NULL, "/");
+
+ del_local(&local);
+
+ value_t (*f)() = link_program(&d);
+ return f();
+}
+
void compile_variable(struct variable *v, dasm_State *Dst)
{
switch (v->type)
{
case V_ARGUMENT:
- | mov eax, dword [ebp + (value_size * (v->number + 2))];
+ | mov eax, dword[ebp + (value_size * (v->number + 2))];
break;
case V_BOUND:
- | mov eax, dword [ebp - ((v->number + 1) * value_size)];
+ | mov eax, dword[ebp - ((v->number + 1) * value_size)];
break;
case V_FREE:
// edi is the closure context pointer
- | mov eax, dword [edi + (v->number * value_size)];
+ | mov eax, dword[edi + (v->number * value_size)];
break;
default:
- err("Sorry, can only access V_ARGUMENT, V_FREE and V_BOUND variables for now :(");
+ err("Sorry, can only access V_ARGUMENT, V_FREE and V_BOUND variables "
+ "for now :(");
}
}
void compile_expression(struct environment *env, struct local *local,
value_t val, dasm_State **Dst)
{
- if (symstreq(val, "nil"))
+ if (symstreq(val, "nil") || nilp(val))
{
| mov eax, (nil);
}
@@ -381,7 +423,8 @@
if (!symbolp(fsym))
{
- err("function name must be a symbol");
+ printval(val, 2);
+ err_at(val, "function name must be a symbol");
}
if (symstreq(fsym, "if"))
@@ -395,14 +438,14 @@
// result is in eax
| cmp eax, (nil);
- | je =>false_label;
+ | je = > false_label;
compile_expression(env, local, elt(args, 1), Dst);
- | jmp =>after_label;
- |=>false_label:;
+ | jmp = > after_label;
+ |= > false_label:;
if (nargs == 3)
- compile_expression(env, local, elt(args, 2), Dst);
- |=>after_label:
+ compile_expression(env, local, elt(args, 2), Dst);
+ |= > after_label:
}
else if (symstreq(fsym, "progn"))
{
@@ -434,7 +477,7 @@
add_variable(local, V_BOUND, (char *)(name ^ SYMBOL_TAG), i);
- | mov dword [ebp - ((i + 1) * value_size)], eax;
+ | mov dword[ebp - ((i + 1) * value_size)], eax;
for (; !nilp(rest); rest = cdr(rest))
{
@@ -447,7 +490,7 @@
{
if (nargs)
{
- err("gc takes no arguments");
+ err_at(val, "gc takes no arguments");
}
| run_gc;
@@ -476,17 +519,19 @@
if (!symbolp(car(args)))
{
- err("argument to function should be a symbol resolvable at compile time");
+ err("argument to function should be a symbol resolvable at "
+ "compile time");
}
- struct function *f = find_function(env, (char *)(car(args) ^ SYMBOL_TAG));
+ struct function *f =
+ find_function(env, (char *)(car(args) ^ SYMBOL_TAG));
value_t closure = create_closure(f->code_ptr, f->args, 0);
| mov eax, (closure);
}
else if (symstreq(fsym, "list"))
{
- | push (nil);
+ | push(nil);
for (int i = nargs - 1; i >= 0; i--)
{
@@ -510,16 +555,18 @@
// Compile the function with this as the parent scope
struct local new_local;
int nargs_out;
- dasm_State *d = compile_function(args, NS_ANONYMOUS, env, &new_local, local, &nargs_out, "recurse");
+ dasm_State *d = compile_function(
+ args, NS_ANONYMOUS, env, &new_local, local, &nargs_out,
+ "recurse", local->current_file_path);
// Link the function
void *func_ptr = link_program(&d);
// Create a closure object with the correct number of captures at
// runtime
- | push (new_local.num_closure_slots);
- | push (nargs_out);
- | push (func_ptr);
+ | push(new_local.num_closure_slots);
+ | push(nargs_out);
+ | push(func_ptr);
| mov ebx, (create_closure);
| call ebx;
| add esp, 12;
@@ -539,7 +586,7 @@
| push eax;
// The capture offset
- | push (var->number);
+ | push(var->number);
| mov ebx, (set_closure_capture_variable);
| call ebx;
// Skip the value and index
@@ -554,15 +601,43 @@
dasm_free(&d);
del_local(&new_local);
}
+ else if (symstreq(fsym, "eval"))
+ {
+ if (nargs != 1)
+ {
+ err("eval takes exactly 1 argument");
+ }
+
+ compile_expression(env, local, car(args), Dst);
+ | push eax;
+ | push(env);
+ | mov ebx, (eval);
+ | call ebx;
+ }
+ else if (symstreq(fsym, "load"))
+ {
+ if (nargs != 1)
+ {
+ err_at(val, "load takes exactly 1 argument, %d given", nargs);
+ }
+
+ compile_expression(env, local, car(args), Dst);
+ | push eax;
+ | push(local->current_file_path);
+ | push(env);
+ | mov ebx, (load_relative);
+ | call ebx;
+ }
else
{
char *name = (char *)(fsym ^ SYMBOL_TAG);
struct function *func = find_function(env, name);
-
+
bool is_recursive = false;
struct args *nargs_needed = NULL;
- if (symstreq(fsym, local->current_function_name))
+ if (local->current_function_name &&
+ symstreq(fsym, local->current_function_name))
{
is_recursive = true;
nargs_needed = local->args;
@@ -571,8 +646,7 @@
{
if (func == NULL)
{
- fprintf(stderr, "Function call: %s at %s:%d\n", name, cons_file(val), cons_line(val));
- err("Function undefined");
+ err_at(val, "Function %s undefined", name);
}
nargs_needed = func->args;
@@ -580,9 +654,11 @@
if (!are_args_acceptable(nargs_needed, nargs))
{
- fprintf(stderr, "Function call: %s at %s:%d, want %d args but given %d\n",
- name, cons_file(val), cons_line(val), nargs_needed->num_required, nargs);
- err("wrong number of args");
+ err_at(val,
+ "wrong number of args in function call: %s at %s:%d, "
+ "want %d args but given %d\n",
+ name, cons_file(val), cons_line(val),
+ nargs_needed->num_required, nargs);
}
if (is_recursive || func->namespace == NS_FUNCTION)
@@ -592,13 +668,14 @@
if (nargs <= nargs_needed->num_required)
{
// Push the variadic list (nil)
- | push (nil);
+ | push(nil);
}
- for (int i = nargs_needed->num_optional - 1; i >= nargs - nargs_needed->num_required; i--)
+ for (int i = nargs_needed->num_optional - 1;
+ i >= nargs - nargs_needed->num_required; i--)
{
// Push the default optional values
- | push (nargs_needed->optional_arguments[i].value);
+ | push(nargs_needed->optional_arguments[i].value);
}
for (int i = nargs - 1; i >= 0; i--)
@@ -609,7 +686,7 @@
if (is_recursive)
{
- | call ->function_start;
+ | call->function_start;
}
else
{
@@ -621,7 +698,8 @@
}
else if (func->namespace == NS_MACRO)
{
- // Make sure that the stuff allocated by the macro isn't in a pool
+ // 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);
@@ -634,31 +712,28 @@
}
else if (symbolp(val))
{
- struct variable *v = find_variable(local, (char *)(val ^ SYMBOL_TAG));
-
- if (!v)
+ if (symstreq(val, "+current-file+"))
{
- fprintf(stderr, "var: %s\n", (char *)(val ^ SYMBOL_TAG));
- err("Variable unbound");
+ value_t file_name_val = strval(local->current_file_path);
+
+ | mov eax, (file_name_val);
}
+ else
+ {
+ struct variable *v =
+ find_variable(local, (char *)(val ^ SYMBOL_TAG));
- compile_variable(v, Dst);
+ if (!v)
+ {
+ fprintf(stderr, "var: %s\n", (char *)(val ^ SYMBOL_TAG));
+ err("Variable unbound");
+ }
+
+ compile_variable(v, Dst);
+ }
}
}
-void compile_expr_to_func(struct environment *env, char *name, value_t val,
- dasm_State **Dst)
-{
- | setup 0;
-
- struct local local;
- compile_expression(env, &local, val, Dst);
-
- | cleanup;
-
- add_function(env, name, link_program(Dst), 0, NS_FUNCTION);
-}
-
struct variable *add_variable(struct local *local, enum var_type type,
char *name, int number)
{
@@ -688,7 +763,8 @@
struct variable *v = local->first;
for (; v && strcmp(v->name, name) != 0; v = v->prev)
- {}
+ {
+ }
if (!v)
{
@@ -700,7 +776,8 @@
{
// We found this in a parent scope, add it as a V_FREE variable
// to skip the search.
- v = add_variable(local, V_FREE, name, local->num_closure_slots++);
+ v = add_variable(local, V_FREE, name,
+ local->num_closure_slots++);
}
}
}
@@ -709,7 +786,8 @@
extern value_t _call_list(void *addr, value_t list, value_t *edi);
-value_t call_list_args(void *code_ptr, struct args *args, value_t list, void *data)
+value_t call_list_args(void *code_ptr, struct args *args, value_t list,
+ void *data)
{
list = deep_copy(list);
int nargs = length(list);
@@ -774,17 +852,16 @@
return a;
}
-struct args *add_optional_arg(struct args *args, value_t name,
- value_t value)
+struct args *add_optional_arg(struct args *args, value_t name, value_t value)
{
int i = args->num_optional++;
- args = realloc(args, sizeof(struct args) +
- sizeof(struct optional_argument) * args->num_optional);
+ args =
+ realloc(args, sizeof(struct args) + sizeof(struct optional_argument) *
+ args->num_optional);
- args->optional_arguments[i] = (struct optional_argument)
- {
- .value = value ,
- .name = name,
+ args->optional_arguments[i] = (struct optional_argument){
+ .value = value,
+ .name = name,
};
return args;
@@ -799,11 +876,12 @@
else
{
return number >= args->num_required &&
- number <= args->num_required + args->num_optional;
+ number <= args->num_required + args->num_optional;
}
}
-struct args *list_to_args(struct environment *env, value_t list, struct local *local)
+struct args *list_to_args(struct environment *env, value_t list,
+ struct local *local)
{
struct args *args = new_args();
@@ -821,34 +899,39 @@
if (!symbolp(name))
{
- err("You must provide a symbol after & in an argument list to bind the\n"
- "variadic arguments to.");
+ err("You must provide a symbol after & in an argument list "
+ "to bind the\n"
+ "variadic arguments to.");
}
args->variadic = true;
add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG),
- args->num_optional + args->num_required);
+ args->num_optional + args->num_required);
continue;
}
if (!in_optional)
{
- add_variable(local, V_ARGUMENT, (char *)(val ^ SYMBOL_TAG), args->num_required++);
+ add_variable(local, V_ARGUMENT, (char *)(val ^ SYMBOL_TAG),
+ args->num_required++);
}
else
{
char *name = (char *)(val ^ SYMBOL_TAG);
if (name[0] == '&')
{
- err("Non-optional argument following optional arguments starts with a &\n"
- "did you mean to declare a variadic argument? If so leave a space\n"
- "between the & and name.");
+ err("Non-optional argument following optional arguments "
+ "starts with a &\n"
+ "did you mean to declare a variadic argument? If so "
+ "leave a space\n"
+ "between the & and name.");
}
else
{
- err("Cannot define a non-optional argument after an optional one.");
+ err("Cannot define a non-optional argument after an "
+ "optional one.");
}
}
}
@@ -859,8 +942,9 @@
if (len != 2)
{
- err("A list defining an optional value must be structured like (name expr)\n"
- "with exactly two arguments.");
+ err("A list defining an optional value must be structured like "
+ "(name expr)\n"
+ "with exactly two arguments.");
}
value_t name = car(val);
@@ -868,7 +952,9 @@
value_t function = cons(nil, cons(expr, nil));
- dasm_State *d = compile_function(function, NS_ANONYMOUS, env, NULL, NULL, NULL, NULL);
+ dasm_State *d =
+ compile_function(function, NS_ANONYMOUS, env, NULL, NULL, NULL,
+ NULL, local->current_file_path);
// TODO: GC stack top!
value_t (*compiled)() = link_program(&d);
@@ -876,7 +962,8 @@
value_t value = compiled();
args = add_optional_arg(args, name, value);
- add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG), args->num_required + args->num_optional - 1);
+ add_variable(local, V_ARGUMENT, (char *)(name ^ SYMBOL_TAG),
+ args->num_required + args->num_optional - 1);
}
}
@@ -886,11 +973,12 @@
void display_args(struct args *args)
{
printf("Args object taking %d require arguments and %d optionals:\n",
- args->num_required, args->num_optional);
+ args->num_required, args->num_optional);
for (int i = 0; i < args->num_optional; i++)
{
- printf(" %d\t%s\n", i, (char *)(args->optional_arguments[i].name ^ SYMBOL_TAG));
+ printf(" %d\t%s\n", i,
+ (char *)(args->optional_arguments[i].name ^ SYMBOL_TAG));
printval(args->optional_arguments[i].value, 2);
}
}
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index e03d93a..6031fde 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -15,7 +15,6 @@
NS_ANONYMOUS,
};
-
struct args *new_args();
struct args *add_optional_arg(struct args *args, value_t name,
value_t expression);
@@ -31,8 +30,7 @@
struct args *args;
enum namespace namespace;
- union
- {
+ union {
value_t (*def0)();
value_t (*def1)(value_t);
value_t (*def2)(value_t, value_t);
@@ -82,6 +80,9 @@
/// for a lambda.
char *current_function_name;
+ /// Path to the current file
+ char *current_file_path;
+
int num_vars;
struct args *args;
/// Most recently defined variable
@@ -103,7 +104,8 @@
* `defun`, `defmacro`, `lambda`, etc.
* @returns NULL if the list is malformed.
*/
-struct args *list_to_args(struct environment *env, value_t list, struct local *local);
+struct args *list_to_args(struct environment *env, value_t list,
+ struct local *local);
/**
* Print out `args` to stdout. Useful for debugging.
@@ -129,8 +131,10 @@
* `add_function` or something similar.
*/
struct dasm_State *compile_function(value_t args, enum namespace namespace,
- struct environment *env, struct local *local_out,
- struct local *local_parent, struct args **ar, char *name);
+ struct environment *env,
+ struct local *local_out,
+ struct local *local_parent,
+ struct args **ar, char *name, char *path);
void compile_variable(struct variable *v, dasm_State *Dst);
@@ -140,9 +144,6 @@
void compile_backquote(struct environment *env, struct local *local,
value_t val, dasm_State **Dst);
-void compile_expr_to_func(struct environment *env, char *name, value_t val,
- dasm_State **Dst);
-
int nextpc(struct local *local, dasm_State **Dst);
// Local utilities
@@ -165,8 +166,13 @@
* Walk `body` and reserve space in `local` for any variable declarations.
*/
void walk_and_alloc(struct local *local, value_t body);
-// Compile top-level declaration
-void compile_tl(value_t val, struct environment *env);
+
+/**
+ * Compile a top level definition
+ * @param fname The path to the current file.
+ * @param val The expression to compile.
+ */
+void compile_tl(value_t val, struct environment *env, char *fname);
/**
* Compile a file in a new environment.
@@ -176,7 +182,7 @@
* @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 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,
diff --git a/src/lisp/gen_compile_commands.sh b/src/lisp/gen_compile_commands.sh
new file mode 100755
index 0000000..3360e00
--- /dev/null
+++ b/src/lisp/gen_compile_commands.sh
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+make clean
+bear make
+
+sed -i 's/compiler.c/compiler.dasc/g' compile_commands.json
diff --git a/src/lisp/lib/std.c b/src/lisp/lib/std.c
index 3681e47..d4c4c25 100644
--- a/src/lisp/lib/std.c
+++ b/src/lisp/lib/std.c
@@ -87,6 +87,23 @@
return elt(seq, i >> 2);
}
+value_t l_read_stdin()
+{
+ char *string = read_input_line("lisp> ");
+ if (!string)
+ return nil;
+
+ struct istream *is = new_stristream_nt(string);
+
+ value_t val = nil;
+ read1(is, &val);
+
+ del_stristream(is);
+ free(string);
+
+ return val;
+}
+
void load_std(struct environment *env)
{
add_c_function(env, "+", l_plus, 2);
@@ -99,6 +116,7 @@
add_c_function(env, "cons", cons, 2);
add_c_function(env, "print", l_printval, 1);
+ add_c_function(env, "read-stdin", l_read_stdin, 0);
add_c_function(env, "apply", l_apply, 2);
add_c_function(env, "nilp", l_nilp, 1);
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index e151670..e87b9d1 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -6,6 +6,7 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <stdarg.h>
struct alloc *first_a = NULL, *last_a = NULL;
@@ -20,6 +21,22 @@
exit(1);
}
+__attribute__((noreturn)) void err_at(value_t form, const char *msg, ...)
+{
+ int line = cons_line(form);
+ char *file = cons_file(form);
+
+ fprintf(stderr, "\033[31merror at\033[0m %s:%d\n", file, line);
+
+ va_list list;
+ va_start(list, msg);
+ vfprintf(stderr, msg, list);
+ va_end(list);
+ fprintf(stderr, "\n");
+
+ exit(1);
+}
+
value_t intval(int i)
{
i <<= 2;
@@ -186,6 +203,7 @@
}
else
{
+ s[i] = '\0';
is->get(is);
*val = (value_t)s;
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index a8bea1c..c572c80 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -3,6 +3,7 @@
#include "istream.h"
#include <stdbool.h>
#include <stdio.h>
+#include <stdarg.h>
#define INT_MASK 0b11
#define INT_TAG 0b00
@@ -16,7 +17,7 @@
#define HEAP_MASK 0b111
#define CONS_TAG 0b001
-#define VECTOR_TAG 0b010
+#define CLASS_TAG 0b010
#define STRING_TAG 0b011
#define SYMBOL_TAG 0b101
#define CLOSURE_TAG 0b110
@@ -199,6 +200,7 @@
void printval(value_t v, int depth);
void err(const char *msg);
+void err_at(value_t form, const char *msg, ...);
bool symstreq(value_t sym, char *str);
diff --git a/src/lisp/main.c b/src/lisp/main.c
index 1ece9ae..f9ad122 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -12,7 +12,7 @@
}
bool ok;
- struct environment env = compile_file(argv[1], &ok);
+ struct environment *env = compile_file(argv[1], &ok);
if (!ok)
{
@@ -20,11 +20,11 @@
return 1;
}
- value_t (*lisp_main)() = find_function(&env, "main")->def0;
+ value_t (*lisp_main)() = find_function(env, "main")->def0;
gc_set_base_here();
lisp_main();
free_all();
- del_env(&env);
+ del_env(env);
}
diff --git a/src/lisp/plat/linux.c b/src/lisp/plat/linux.c
index b71f342..b24b3f7 100644
--- a/src/lisp/plat/linux.c
+++ b/src/lisp/plat/linux.c
@@ -3,6 +3,8 @@
#include <string.h>
#include <sys/mman.h>
#include <unistd.h>
+#include <readline/readline.h>
+#include <readline/history.h>
void *malloc_aligned(size_t size)
{
@@ -39,3 +41,13 @@
{
return access(path, F_OK) == 0;
}
+
+char *read_input_line(char *prompt)
+{
+ return readline(prompt);
+}
+
+void add_line_to_history(char *line)
+{
+ add_history(line);
+}
diff --git a/src/lisp/plat/plat.h b/src/lisp/plat/plat.h
index 1c4216a..bcd5b1a 100644
--- a/src/lisp/plat/plat.h
+++ b/src/lisp/plat/plat.h
@@ -18,4 +18,7 @@
extern ssize_t readlink(const char *pathname, char *buf, size_t buf_size);
bool file_exists(const char *path);
+char *read_input_line(char *prompt);
+void add_line_to_history(char *line);
+
#define THREAD_LOCAL