From 033a9cbb66d65a0918e2c095d12937afb82fd4b2 Mon Sep 17 00:00:00 2001
From: ubq323 <ubq323@ubq323.website>
Date: Tue, 2 Jul 2024 17:17:01 +0100
Subject: add (each (x arr) ...) array-loop form

---
 com.c | 101 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------
 1 file changed, 93 insertions(+), 8 deletions(-)

(limited to 'com.c')

diff --git a/com.c b/com.c
index 2c44883..cd097df 100644
--- a/com.c
+++ b/com.c
@@ -47,6 +47,7 @@ static int stack_effect_of(Op opcode) {
 	case OP_SETLOCAL:
 	case OP_RET:
 	case OP_HALT:
+	case OP_ARRLEN:
 		return 0;
 	case OP_DROP:
 	case OP_0BRANCH:
@@ -298,15 +299,18 @@ static void end_scope(Compiler *C) {
 
 	free(sc);
 }
-static void declare_local(Compiler *C, char *name) {
+// returns slot of declared local
+static uint8_t declare_local(Compiler *C, char *name) {
 	Scope *sc = C->scope;
 	CHECK(sc != NULL, "can't declare local outside of scope");
 	Local *l = &sc->locals[sc->nlocals++];
 	l->name = name;
 	// -1 because local is expected to be already on the stack
 	// ie sitting just below where stack_cur points
-	l->slot = C->stack_cur - 1;
+	uint8_t slot = C->stack_cur - 1;
+	l->slot = slot;
 	// printf("declaring local %s at %d, stack_cur is %d\n",l->name, l->slot, C->stack_cur);
+	return slot;
 }
 static Local *locate_local(Compiler *C, char *name) {
 	for (Scope *sc = C->scope; sc != NULL; sc = sc->outer) {
@@ -353,14 +357,10 @@ void for_form(Compiler *C, AstVec l, Op _, int flags) {
 
 	compile_opcode(C, OP_LOADK);
 	compile_byte(C, compile_constant(C, VAL_NUM(0)));
-	declare_local(C, ivar);
-	Local *loc = locate_local(C, ivar);
-	int islot = loc->slot;
+	uint8_t islot = declare_local(C, ivar);
 
 	compile_node(C, blist.vals[1], 0);
-	declare_local(C, "__max__");
-	loc = locate_local(C, "__max__");
-	int mslot = loc->slot;
+	uint8_t mslot = declare_local(C, "__max__");
 
 	// A
 	// getlocal ivar
@@ -401,6 +401,90 @@ void for_form(Compiler *C, AstVec l, Op _, int flags) {
 	end_scope(C);
 }
 
+void each_form(Compiler *C, AstVec l, Op _, int flags) {
+	// (each (x a) ...)
+	// returns nil, for now
+	CHECK(l.vals[1].ty == AST_LIST, "each needs binding list");
+	AstVec blist = l.vals[1].as.list;
+	CHECK(blist.len == 2, "each binding list must have length 2");
+	CHECK(blist.vals[0].ty == AST_IDENT, "can only bind to ident");
+	char *ivar = blist.vals[0].as.str;
+
+	begin_scope(C);
+
+	compile_opcode(C, OP_LOADK);
+	compile_byte(C, compile_constant(C, VAL_NUM(0)));
+	uint8_t islot = declare_local(C, "__idx__");
+
+	compile_node(C, blist.vals[1], 0);
+	uint8_t aslot = declare_local(C, "__arr__");
+
+	compile_opcode(C, OP_GETLOCAL);
+	compile_byte(C, aslot);
+	compile_opcode(C, OP_ARRLEN);
+	uint8_t mslot = declare_local(C, "__max__");
+
+	compile_opcode(C, OP_NIL);
+	uint8_t vslot = declare_local(C, ivar);
+
+
+	// A
+	// getlocal idx
+	// getlocal max
+	// cmp
+	// 0branch -> B
+	// getlocal arr
+	// getlocal idx
+	// call 2
+	// setlocal ivar
+	// body ...
+	// incr idx
+	// redo -> A
+	// B:
+	// nil
+
+	size_t dest_A = BYTECODE(C).len;
+	compile_opcode(C, OP_GETLOCAL);
+	compile_byte(C, islot);
+	compile_opcode(C, OP_GETLOCAL);
+	compile_byte(C, mslot);
+	compile_opcode(C, OP_CMP);
+	compile_opcode(C, OP_0BRANCH);
+	size_t ph_B = placeholder(C);
+
+	compile_opcode(C, OP_GETLOCAL);
+	compile_byte(C, aslot);
+	compile_opcode(C, OP_GETLOCAL);
+	compile_byte(C, islot);
+	compile_call_instr(C, 2);
+	compile_opcode(C, OP_SETLOCAL);
+	compile_byte(C, vslot);
+	compile_opcode(C, OP_DROP);
+
+	compile_body(C, l, 2, flags & ~F_tail);
+	compile_opcode(C, OP_DROP);
+
+	compile_opcode(C, OP_GETLOCAL);
+	compile_byte(C, islot);
+	compile_opcode(C, OP_LOADK);
+	compile_byte(C, compile_constant(C, VAL_NUM(1)));
+	compile_opcode(C, OP_ADD);
+	compile_opcode(C, OP_SETLOCAL);
+	compile_byte(C, islot);
+	compile_opcode(C, OP_DROP);
+
+	compile_opcode(C, OP_REDO);
+	size_t ph_A = placeholder(C);
+
+	size_t dest_B = BYTECODE(C).len;
+	compile_opcode(C, OP_NIL);
+
+	patch(C, ph_A, ph_A - dest_A + 2);
+	patch(C, ph_B, dest_B - ph_B - 2);
+
+	end_scope(C);
+}
+
 
 void def_form(Compiler *C, AstVec l, Op _, int flags) {
 	CHECK(l.vals[1].ty == AST_IDENT, "def's first argument must be ident");
@@ -459,6 +543,7 @@ static BuiltinForm builtin_forms[] = {
 	{ "if",    3, false, if_form, 0 },
 	{ "while", 2,  true, while_form, 0 },
 	{ "for",   2,  true, for_form, 0 },
+	{ "each",  2,  true, each_form, 0 },
 	{ "fn",    2,  true, fn_form, 0 },
 	{ "let",   2,  true, let_form, 0 },
 	{ "def",   2, false, def_form, 0 },
-- 
cgit v1.2.3