add array index setting syntax

11 files changed, 60 insertions, 16 deletions

diff --git a/com.c b/com.c
index ff13815..521adec 100644
--- a/com.c
+++ b/com.c
@@ -59,12 +59,15 @@ static int stack_effect_of(Op opcode) {
 	case OP_MOD:
 	case OP_ARRAPPEND:
 		return -1;
+	case OP_SETIDX:
+		return -2;
 
 	// these ones depend on their argument. handle them specifically
 	case OP_CALL:
 	case OP_TAILCALL:
 	case OP_ENDSCOPE:
 		return 0;
+
 	default:
 		ERROR("unknown stack effect of opcode %d",opcode); 
 	}
@@ -172,21 +175,31 @@ void single_form(Compiler *C, AstVec l, Op op) {
 static Local *locate_local(Compiler *C, char *name);
 
 void set_form(Compiler *C, AstVec l, Op _, int flags) {
-	AstNode ident = l.vals[1];
-	CHECK(ident.ty == AST_IDENT, "set's first argument must be identifier");
-	char *name = ident.as.str;
-
-	Local *loc = locate_local(C, name);
-	if (loc != NULL) {
-		compile_node(C, l.vals[2], 0);
-		compile_opcode(C, OP_SETLOCAL);
-		compile_byte(C, loc->slot);
-	} else {
-		// write global
-		ObjString *o = objstring_copy_cstr(C->S, name);
+	AstNode target = l.vals[1];
+	if (target.ty == AST_IDENT)  {
+		// set variable, local or global
+		char *name = target.as.str;
+
+		Local *loc = locate_local(C, name);
+		if (loc != NULL) {
+			compile_node(C, l.vals[2], 0);
+			compile_opcode(C, OP_SETLOCAL);
+			compile_byte(C, loc->slot);
+		} else {
+			// write global
+			ObjString *o = objstring_copy_cstr(C->S, name);
+			compile_node(C, l.vals[2], 0);
+			compile_opcode(C, OP_SETGLOBAL);
+			compile_byte(C, compile_constant(C, VAL_OBJ(o)));
+		}
+	} else if (target.ty == AST_LIST) {
+		AstVec pair = target.as.list;
+		CHECK(pair.len == 2, "can only set to (arr, ix) 2-pair");
+		// (value arr ix) <- TOS
 		compile_node(C, l.vals[2], 0);
-		compile_opcode(C, OP_SETGLOBAL);
-		compile_byte(C, compile_constant(C, VAL_OBJ(o)));
+		compile_node(C, pair.vals[0], 0);
+		compile_node(C, pair.vals[1], 0);
+		compile_opcode(C, OP_SETIDX);
 	}
 }
 
@@ -332,6 +345,8 @@ void def_form(Compiler *C, AstVec l, Op _, int flags) {
 	compile_node(C, l.vals[2], 0);
 	declare_local(C, l.vals[1].as.str);
 	// whatever is calling us will compile an OP_DROP next
+	// or, well. not if we're in tail position. but i can't see
+	// any circumstance where you'd want that anyway
 	compile_opcode(C, OP_NIL);
 }
 
diff --git a/tests/arr6.bth b/tests/arr6.bth
new file mode 100644
index 0000000..e814db4
--- /dev/null
+++ b/tests/arr6.bth
@@ -0,0 +1,4 @@
+(let (a [10 20 30])
+	(say a)
+	(set (a 1) 50)
+	(say a))
diff --git a/tests/arr6.out b/tests/arr6.out
new file mode 100644
index 0000000..e80d1c2
--- /dev/null
+++ b/tests/arr6.out
@@ -0,0 +1,2 @@
+[ 10 20 30 ]
+[ 10 50 30 ]
diff --git a/tests/arr7.bth b/tests/arr7.bth
new file mode 100644
index 0000000..7b9a784
--- /dev/null
+++ b/tests/arr7.bth
@@ -0,0 +1,4 @@
+(let (a [10 20 30])
+	(say a)
+	(set (a 3) 40)
+	(say a))
diff --git a/tests/arr7.out b/tests/arr7.out
new file mode 100644
index 0000000..7d6d4b2
--- /dev/null
+++ b/tests/arr7.out
@@ -0,0 +1,2 @@
+[ 10 20 30 ]
+[ 10 20 30 40 ]
diff --git a/tests/arr8.bth b/tests/arr8.bth
new file mode 100644
index 0000000..8f41f0c
--- /dev/null
+++ b/tests/arr8.bth
@@ -0,0 +1,3 @@
+(let (a [10 20 30])
+	(set (a 1) 50)
+	(let (x 100 y 200 z 300) (say y)))
diff --git a/tests/arr8.out b/tests/arr8.out
new file mode 100644
index 0000000..08839f6
--- /dev/null
+++ b/tests/arr8.out
@@ -0,0 +1 @@
+200
diff --git a/tests/sumrec.bth b/tests/sumrec.bth
index 8c8804a..0bbf2b6 100644
--- a/tests/sumrec.bth
+++ b/tests/sumrec.bth
@@ -4,4 +4,4 @@
 		(f' (- x 1) (+ acc x)))))
 (set f (fn (x) (f' x 0)))
 (say (f 10))
-(say (f 100))
+(say (f 1000))
diff --git a/tests/sumrec.out b/tests/sumrec.out
index e613215..2a5dbfe 100644
--- a/tests/sumrec.out
+++ b/tests/sumrec.out
@@ -1,2 +1,2 @@
 55
-5050
+500500
diff --git a/vm.c b/vm.c
index 4a65832..0857571 100644
--- a/vm.c
+++ b/vm.c
@@ -228,6 +228,18 @@ int runvm(State *S) {
 			break;
 		}
 
+		case OP_SETIDX: {
+			Val vix = POP();
+			Val varr = POP();
+			Val v = PEEK();
+			CHECK(IS_NUM(vix), "can only index numerically");
+			CHECK(IS_ARR(varr), "can only set index on array");
+			size_t ix = (size_t)AS_NUM(vix);
+			ObjArr *arr = AS_ARR(varr);
+			objarr_put(S, arr, ix, v);
+			break;
+		}
+	
 		case OP_ENDSCOPE: {
 			uint8_t nlocals = RBYTE();
 			Val retval = POP();
diff --git a/vm.h b/vm.h
index 1ca2c48..e878847 100644
--- a/vm.h
+++ b/vm.h
@@ -66,6 +66,7 @@ typedef enum {
 
 	OP_ARRNEW,
 	OP_ARRAPPEND,
+	OP_SETIDX,
 } Op;
 
 int runvm(State *S);