add defn form

4 files changed, 47 insertions, 0 deletions

diff --git a/com.c b/com.c
index dbf07a4..19ea302 100644
--- a/com.c
+++ b/com.c
@@ -529,6 +529,40 @@ void fn_form(Compiler *C, AstVec l, Op _, int flags) {
 	compile_byte(C, compile_constant(C, VAL_OBJ(func)));
 }
 
+void defn_form(Compiler *C, AstVec l, Op _, int flags) {
+	// todo: reduce redundancy
+	CHECK(l.vals[1].ty == AST_LIST, "defns first arg must be list");
+	AstVec blist = l.vals[1].as.list;
+	CHECK(blist.len > 0, "defn needs at least a function name");
+	CHECK(blist.len <= 256, "maximum 255 args for function");
+	CHECK(flags & F_toplevel, "defn only allowed at toplevel");
+	uint8_t arity = blist.len - 1;
+
+	CHECK(blist.vals[0].ty == AST_IDENT, "func name must be ident");
+	char *fname = blist.vals[0].as.str;
+
+	ObjFunc *func = objfunc_new(C->S, arity);
+	Compiler subcompiler = compiler_new(C, &func->ch);
+	Compiler *SC = &subcompiler;
+	begin_scope(SC);
+	SC->stack_cur ++;
+	declare_local(SC, fname);
+	for (int i = 0; i < arity; i++) {
+		AstNode argname = blist.vals[i+1];
+		CHECK(argname.ty == AST_IDENT, "arg name must be identifier");
+		SC->stack_cur ++;
+		declare_local(SC, argname.as.str);
+	}
+	compile_body(SC, l, 2, F_tail);
+	end_scope(SC);
+	compile_opcode(SC, OP_RET);
+
+	compile_opcode(C, OP_LOADK);
+	compile_byte(C, compile_constant(C, VAL_OBJ(func)));
+	declare_local(C, fname);
+	compile_opcode(C, OP_NIL);
+}
+
 typedef struct {
 	char *name;
 	int min_params;
@@ -547,6 +581,7 @@ static BuiltinForm builtin_forms[] = {
 	{ "fn",    2,  true, fn_form, 0 },
 	{ "let",   2,  true, let_form, 0 },
 	{ "def",   2, false, def_form, 0 },
+	{ "defn",  2,  true, defn_form, 0 },
 #define ARITH_OP(str, op) \
 	{ str, 2, false, arith_form, op },
 	ARITH_OP("+", OP_ADD)
diff --git a/tests/defn.bth b/tests/defn.bth
new file mode 100644
index 0000000..81fcada
--- /dev/null
+++ b/tests/defn.bth
@@ -0,0 +1,2 @@
+(defn (f x) (* x x))
+(say (f 12))
diff --git a/tests/sumrec_local.bth b/tests/sumrec_local.bth
new file mode 100644
index 0000000..b40418b
--- /dev/null
+++ b/tests/sumrec_local.bth
@@ -0,0 +1,8 @@
+(defn (f' x acc)
+	(if (< x 1)
+		acc
+		(f' (- x 1) (+ acc x))))
+(set _global_f' f')
+(defn (f x) (_global_f' x 0))
+(say (f 10))
+(say (f 1000))
diff --git a/tests/sumrec_local.out b/tests/sumrec_local.out
new file mode 100644
index 0000000..2a5dbfe
--- /dev/null
+++ b/tests/sumrec_local.out
@@ -0,0 +1,2 @@
+55
+500500