Add reduce
Broken
diff --git a/.vscode/launch.json b/.vscode/launch.json
index 2c23b66..89da0f7 100644
--- a/.vscode/launch.json
+++ b/.vscode/launch.json
@@ -9,7 +9,7 @@
"type": "cppdbg",
"request": "launch",
"program": "${workspaceFolder}/src/lisp/lisp",
- "args": ["test-args.lisp"],
+ "args": ["test-closures.lisp"],
"stopAtEntry": false,
"cwd": "${workspaceFolder}/src/lisp",
"environment": [
diff --git a/lib/lisp/std/list-functions.lisp b/lib/lisp/std/list-functions.lisp
index a777401..7bb22a7 100644
--- a/lib/lisp/std/list-functions.lisp
+++ b/lib/lisp/std/list-functions.lisp
@@ -1,5 +1,35 @@
(defun mapcar (fun list)
+ "Maps over the cars of `list` by running `fun` on each one.
+List must be a cons-list, other sequences are not supported."
(if list
(cons (funcall fun (car list))
(mapcar fun (cdr list)))
nil))
+
+(defun remove-if (predicate list)
+ "Returns a copy of `list` with elements satisfying `predicate`
+removed."
+ (if (not list)
+ nil
+ (if (funcall predicate (car list))
+ (remove-if predicate (cdr list))
+ (cons (car list)
+ (remove-if predicate (cdr list))))))
+
+(defun remove-if-not (predicate list)
+ "Returns a copy of `list` with elements not satisfying `predicate`
+removed."
+ (remove-if (lambda (val)
+ (not (funcall predicate val)))
+ list))
+
+(defun reduce (fun list (initial-value nil))
+ "Combines elements of `list` into one element using `fun`. `fun` must
+accept two arguments and return the result of combining those
+arguments. The first argument will be the result so far and the second
+will be the n-th item of the list. For the first item of the list, the
+result so far will be `initial-value`, or `nil` by default."
+ (if (not list)
+ initial-value
+ (reduce fun (cdr list)
+ (funcall fun initial-value (car list)))))
diff --git a/lib/lisp/std/std.lisp b/lib/lisp/std/std.lisp
index d995f0e..56e8294 100644
--- a/lib/lisp/std/std.lisp
+++ b/lib/lisp/std/std.lisp
@@ -21,9 +21,8 @@
-;; Instead of a function this is a macro for a slight performance increase
-(defmacro not (val)
- (list 'nilp val))
+(defun not (val)
+ (nilp val))
;; TODO: make tail recursive (for this `flet` would be nice)
(defun length (list)
@@ -51,5 +50,9 @@
(if (not stream)
(read-stdin)))
-(print "Loading list functions")
-(print (load "list-functions.lisp"))
+(defun funcall (fun & list)
+ (print fun)
+ (print list)
+ (apply fun list))
+
+(load "list-functions.lisp")
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index 668d59a..3cb80d8 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -19,7 +19,8 @@
|.arch x86;
|.macro setup, nvars;
-|->function_start : | push ebp;
+|->function_start:;
+| push ebp;
| mov ebp, esp;
| sub esp, (value_size * nvars);
|.endmacro;
@@ -30,7 +31,9 @@
| ret;
|.endmacro;
-|.macro local_var, index;
+|.macro call_extern, address;
+| mov ebx, address;
+| call ebx;
|.endmacro;
dasm_State *d;
@@ -139,7 +142,7 @@
dasm_State *d;
dasm_State **Dst = &d;
- |.section code;
+ |.section code, imports;
dasm_init(&d, DASM_MAXSECTION);
|.globals lbl_;
@@ -183,7 +186,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;
@@ -238,6 +241,15 @@
compile_tl(car(val), env, fname);
}
}
+ else if (symstreq(form, "load"))
+ {
+ if (length(args) != 1)
+ {
+ err_at(val, "load expects exactly 1 argument, %d given",
+ length(args));
+ }
+ load_relative(env, fname, car(args));
+ }
}
void walk_and_alloc(struct local *local, value_t body)
@@ -306,6 +318,8 @@
if (!stringp(name))
return nil;
+ fprintf(stderr, "Called load_relative\n");
+
char *new_path = (char *)(name ^ STRING_TAG);
char *relative_to = strdup(to);
char full_path[512];
@@ -438,14 +452,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:
+ |=>after_label:;
}
else if (symstreq(fsym, "progn"))
{
@@ -531,7 +545,7 @@
}
else if (symstreq(fsym, "list"))
{
- | push(nil);
+ | push (nil);
for (int i = nargs - 1; i >= 0; i--)
{
@@ -564,9 +578,9 @@
// 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;
@@ -586,7 +600,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
@@ -610,7 +624,7 @@
compile_expression(env, local, car(args), Dst);
| push eax;
- | push(env);
+ | push (env);
| mov ebx, (eval);
| call ebx;
}
@@ -623,8 +637,8 @@
compile_expression(env, local, car(args), Dst);
| push eax;
- | push(local->current_file_path);
- | push(env);
+ | push (local->current_file_path);
+ | push (env);
| mov ebx, (load_relative);
| call ebx;
}
@@ -664,21 +678,42 @@
if (is_recursive || func->namespace == NS_FUNCTION)
{
int nargs = length(args);
+ int total_taken = nargs_needed->num_optional +
+ nargs_needed->num_required;
- if (nargs <= nargs_needed->num_required)
+ int line = cons_line(val);
+ char *file = cons_file(val);
+
+ if (nargs_needed->variadic)
{
- // Push the variadic list (nil)
- | push(nil);
+ | push (nil);
+ }
+
+ if (nargs > total_taken && nargs_needed->variadic)
+ {
+ // We are passing varargs, which means we need to make a list
+
+ for (int i = nargs - 1; i >= total_taken; i--)
+ {
+ compile_expression(env, local, elt(args, i), Dst);
+ | push eax;
+ | mov ebx, (cons);
+ | call ebx;
+ | add esp, 8;
+ | push eax;
+ }
}
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--)
+ int min = MIN(nargs, total_taken);
+
+ for (int i = min - 1; i >= 0; i--)
{
compile_expression(env, local, elt(args, i), Dst);
| push eax;
@@ -686,12 +721,12 @@
if (is_recursive)
{
- | call->function_start;
+ | call ->function_start;
}
else
{
- | mov ebx, (func->code_addr);
- | call ebx;
+ // | mov ebx, (func->code_addr);
+ | call_extern func->code_addr;
}
| add esp, (nargs * value_size);
// result in eax
@@ -790,9 +825,13 @@
void *data)
{
list = deep_copy(list);
+
int nargs = length(list);
- value_t *val = NULL;
+ printf("IN call_list_args\n");
+ printval(list, 2);
+
+ value_t *val = &list;
for (value_t i = list; !nilp(i); i = cdr(i))
{
diff --git a/src/lisp/compiler.h b/src/lisp/compiler.h
index 6031fde..6a944e6 100644
--- a/src/lisp/compiler.h
+++ b/src/lisp/compiler.h
@@ -35,7 +35,7 @@
value_t (*def1)(value_t);
value_t (*def2)(value_t, value_t);
value_t (*def3)(value_t, value_t, value_t);
- void *code_ptr;
+ void *code_ptr;
uintptr_t code_addr;
};
@@ -209,6 +209,14 @@
bool load(struct environment *env, char *path);
/**
+ * Load a file relative to another file.
+ * @param to The file to load relative to.
+ * @param name The name or relative path of the file to load.
+ * @param env The environment to load in.
+ */
+value_t load_relative(struct environment *env, char *to, value_t name);
+
+/**
* 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.
diff --git a/src/lisp/test-args.lisp b/src/lisp/test-args.lisp
index 14364a8..75f6107 100644
--- a/src/lisp/test-args.lisp
+++ b/src/lisp/test-args.lisp
@@ -1,7 +1,11 @@
+; (load "../../lib/lisp/std/std.lisp")
+
(defun with-optional (required (optional 3))
(+ required optional))
+(defun takes-varargs (& rest)
+ (print rest))
+
(defun main ()
- (when t
- (print (with-optional 2))
- (print (with-optional 2 4))))
+ (print "hi")
+ (takes-varargs 1 2 3 4))
diff --git a/src/lisp/test-closures.lisp b/src/lisp/test-closures.lisp
index 573024d..39bb134 100644
--- a/src/lisp/test-closures.lisp
+++ b/src/lisp/test-closures.lisp
@@ -1,12 +1,5 @@
-(defun mapcar (func list)
- (if list
- (cons (apply func (list (car list)))
- (mapcar func (cdr list)))
- nil))
-
-(defun double (n)
- (+ n n))
-
(defun main ()
- (print (mapcar #'double
- (list 1 2 3 4 5))))
+ (print (reduce (lambda (a b)
+ (+ a b))
+ (list 1 2 3 4 5)
+ 0)))