add (each (x arr) ...) array-loop form

8 files changed, 163 insertions, 43 deletions

diff --git a/.gitignore b/.gitignore
index 58dd503..1b2d205 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,4 @@ prs.h
 bth
 vm
 gmon.out
+tty.*
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 },
diff --git a/dis.c b/dis.c
index 0ca77e7..2d7e9a2 100644
--- a/dis.c
+++ b/dis.c
@@ -108,6 +108,7 @@ static size_t disasm_instr_h(Chunk *ch, size_t ip, int depth) {
 	SIMPLE_INSTR(OP_HALT, "halt")
 	SIMPLE_INSTR(OP_ARRNEW, "arrnew")
 	SIMPLE_INSTR(OP_ARRAPPEND, "arrappend")
+	SIMPLE_INSTR(OP_ARRLEN, "arrlen")
 	#undef SIMPLE_INSTR
 
 	default:
diff --git a/tests/each.bth b/tests/each.bth
new file mode 100644
index 0000000..3dd3f9f
--- /dev/null
+++ b/tests/each.bth
@@ -0,0 +1,4 @@
+(let (a [2 3 4 5 6])
+	(each (x a)
+		(say (* x x))
+		(let (q 100 r 200 s 300) (say r))))
diff --git a/tests/each.out b/tests/each.out
new file mode 100644
index 0000000..f8ae193
--- /dev/null
+++ b/tests/each.out
@@ -0,0 +1,10 @@
+4
+200
+9
+200
+16
+200
+25
+200
+36
+200
diff --git a/todo b/todo
index 744be41..2f3364a 100644
--- a/todo
+++ b/todo
@@ -1,38 +1,49 @@
-closures, upvalues
-good repl
-arrays, hashes, other useful types
-	arrays:
-		get index
-		set index
-		get length
-		literals
-		append
-		concat
-		conformation of at least arithmetic over arrays
-	hashes:
-		get index
-		set index
-		get count
-		literals
-		merge?
-		delete?
-		should probably implement ht with keys other than strings
-	user-defined structs, somehow, maybe
-good loops
-	numeric for
-	array for each
-	functional variants of the above
-	variants of the above that record an array of all their results
-pattern matching
+[_] closures, upvalues
+
+[_] good repl
+
+[_] arrays, hashes, other useful types
+	[_] arrays:
+		[x] get index
+		[x] set index
+		[x] get length
+		[x] literals
+		[x] append
+		[_] concat
+		[_] conformation of at least arithmetic over arrays
+	[_] hashes:
+		[_] get index
+		[_] set index
+		[_] get count
+		[_] literals
+		[_] merge?
+		[_] delete?
+		[_] keys other than strings
+
+	[_] user-defined structs, somehow, maybe
+
+[_] good loops
+	[x] numeric for
+	[x] array for each
+		[_] really these both should be macros or something
+	[_] functional variants of the above
+	[_] variants of the above that record an array of all their results
+
+[_] pattern matching
 	probably doesn't need to be too complex
-garbage collector
-	go thru everything make sure references are kept around properly
-macros
-error handling
-	record line and col of everything
+
+[_] garbage collector
+	[_] go thru everything make sure references are kept around properly
+
+[_] macros
+
+[_] error handling
+	[_] record line and col of everything
 	not sure how to do error handling in language but at least
-		make the error messages good
-	more sophisticated testing of errors
+		[_] make the error messages good
+		[_] tracebacks etc
+	[_] more sophisticated testing of errors
 		instead of just literally matching error message
-tidy and clean the code
-	properly do bounds checking everywhere etc
+
+[_] tidy and clean the code
+	[_] properly do bounds checking everywhere etc
diff --git a/vm.c b/vm.c
index 0857571..2131c5a 100644
--- a/vm.c
+++ b/vm.c
@@ -274,6 +274,13 @@ int runvm(State *S) {
 			objarr_append(S, arr, v);
 			break;
 		}
+		case OP_ARRLEN: {
+			Val v = POP();
+			CHECK(IS_ARR(v), "can only get length of array");
+			ObjArr *arr = AS_ARR(v);
+			PUSH(VAL_NUM(arr->len));
+			break;
+		}
 		default:
 			ERROR("unknown opcode");
 
diff --git a/vm.h b/vm.h
index e878847..9b175a7 100644
--- a/vm.h
+++ b/vm.h
@@ -66,6 +66,7 @@ typedef enum {
 
 	OP_ARRNEW,
 	OP_ARRAPPEND,
+	OP_ARRLEN,
 	OP_SETIDX,
 } Op;