misc

15 files changed, 77 insertions, 55 deletions

diff --git a/com.c b/com.c
index 6d701d9..f610bd7 100644
--- a/com.c
+++ b/com.c
@@ -7,7 +7,6 @@
 #include "mem.h"
 #include "chunk.h"
 #include "util.h"
-#include "prs.h"
 #include "lib.h"
 #include "read.h"
 
@@ -23,9 +22,9 @@ Chunk chunk_new(State *S) {
 	return (Chunk){ 0 };
 }
 
-Compiler compiler_new(Compiler *outer, Chunk *ch) {
+Compiler compiler_new(State *S, Compiler *outer, Chunk *ch) {
 	return (Compiler){
-		.S = outer->S,
+		.S = S,
 		.ch = ch,
 		.stack_cur = 0,
 		.scope = NULL,
@@ -365,6 +364,7 @@ static void for_form(Compiler *C, ObjArr *a, Op _, int flags) {
 	cpl_op(C, OP_ADD);
 	cpl_op(C, OP_SETLOCAL);
 	cpl_op(C, islot);
+	cpl_op(C, OP_DROP);
 	cpl_op(C, OP_REDO);
 	size_t ph_A = placeholder(C);
 	size_t dest_B = BYTECODE(C).len;
@@ -478,7 +478,7 @@ static void fn_form(Compiler *C, ObjArr *a, Op _, int flags) {
 	uint8_t arity = arglist->len;
 
 	ObjFunc *func = objfunc_new(C->S, arity);
-	Compiler subcompiler = compiler_new(C, &func->ch);
+	Compiler subcompiler = compiler_new(C->S, C, &func->ch);
 
 	Compiler *SC = &subcompiler;
 	begin_scope(SC);
@@ -514,7 +514,7 @@ static void defn_form(Compiler *C, ObjArr *a, Op _, int flags) {
 	char *fname = AS_CSTRING(blist->d[0]);
 
 	ObjFunc *func = objfunc_new(C->S, arity);
-	Compiler subcompiler = compiler_new(C, &func->ch);
+	Compiler subcompiler = compiler_new(C->S, C, &func->ch);
 	Compiler *SC = &subcompiler;
 	begin_scope(SC);
 	SC->stack_cur ++;
diff --git a/com.h b/com.h
index c623d49..7ec4d21 100644
--- a/com.h
+++ b/com.h
@@ -26,7 +26,7 @@ struct _compiler {
 	int stack_cur;
 	Scope *scope;
 };
-Compiler compiler_new(Compiler *outer, Chunk *ch);
+Compiler compiler_new(State *S, Compiler *outer, Chunk *ch);
 
 #define BYTECODE(C) (C->ch->bc)
 
diff --git a/doc.txt b/doc.txt
index d65c981..0c84bcc 100644
--- a/doc.txt
+++ b/doc.txt
@@ -40,17 +40,20 @@
 	(clock): clock(3)
 	(say x): print representation of x, followed by newline
 	(write x): print representation of x, with no newline
+	(writebytes a): a is a list of nums in [0,255]
 	(arr): create new empty array
-	(append a x): appends to array a, returns a
-	(len a): get length of array a
+	(append! a x): appends to array a in place, returns a
+	(# a): get length of array a
 	(, ...): pend. concatenates arrays, promotes non-arrays to arrays
 				(, [1 2 3] 4) -> [1 2 3 4]
 				(, [1 2 3] [4 5]) -> [1 2 3 4 5]
 				(, 10 20) -> [10 20]  etc
+	(s, ...): spend. concatenates strings
 
 # cmdline args
 	bth [-Dl] [-Dt] filenames...
 		-Dl: print bytecode listing before execution
 		-Dt: trace each executed bytecode instruction
+		-Ds: dump read s-expressions
 		filename "-" can be provided to mean stdin.
 	
diff --git a/lib.c b/lib.c
index a1ca311..dddd377 100644
--- a/lib.c
+++ b/lib.c
@@ -1,9 +1,12 @@
 #include <time.h>
+#include <string.h>
+#include <stdio.h>
 
 #include "lib.h"
 #include "state.h"
 #include "val.h"
 #include "util.h"
+#include "mem.h"
 
 static Val fn_clock(State *S, int nargs, Val *args) {
 	return VAL_NUM((double)clock() / CLOCKS_PER_SEC);
@@ -11,15 +14,33 @@ static Val fn_clock(State *S, int nargs, Val *args) {
 
 static Val fn_write(State *S, int nargs, Val *args) {
 	CHECK(nargs>0, "need 1 arg to write");
-	print_val(args[0]);
+	for (int i = 0; i < nargs; i++) print_val(args[i]);
 	return VAL_NIL;
 }
 static Val fn_say(State *S, int nargs, Val *args) {
 	CHECK(nargs>0, "need 1 arg to say");
-	println_val(args[0]);
+	for (int i = 0; i < nargs; i++) println_val(args[i]);
 	return VAL_NIL;
 }
 
+static uint8_t num_to_u8(Val v) {
+	CHECK(IS_NUM(v), "can't convert non-num to u8");
+	return (uint8_t)AS_NUM(v);
+}
+static Val fn_writebytes(State *S, int nargs, Val *args) {
+	CHECK(nargs == 1, "need exactly 1 arg to writebytes");
+	CHECK(IS_ARR(args[0]), "need array arg to writebytes");
+	ObjArr *a = AS_ARR(args[0]);
+	uint8_t *buf = malloc(1 * a->len);
+	for (int i = 0; i < a->len; i++) {
+		buf[i] = num_to_u8(a->d[i]);
+	}
+	fwrite(buf, 1, a->len, stdout);
+	return VAL_NIL;
+}
+
+
+
 
 // lists
 static Val fn_arr(State *S, int nargs, Val *args) {
@@ -57,6 +78,24 @@ static Val fn_pend(State *S, int nargs, Val *args) {
 }
 
 
+// strings
+static Val fn_spend(State *S, int nargs, Val *args) {
+	size_t len = 0;
+	for (int i = 0; i < nargs; i++) {
+		CHECK(IS_STRING(args[i]), "can only spend strings");
+		len += AS_STRING(args[i])->len;
+	}
+	char *new = NEW_ARR(S, char, len+1);
+	char *cur = new;
+	for (int i = 0; i < nargs; i++) {
+		ObjString *s = AS_STRING(args[i]);
+		memcpy(cur, s->d, s->len); 
+		cur += s->len;
+	}
+	return VAL_OBJ(objstring_take(S, new, len));
+}
+
+
 typedef struct {
 	char *name;
 	CFunc func;
@@ -65,11 +104,13 @@ static BuiltinFunc builtin_funcs[] = {
 	{ "clock", fn_clock },
 	{ "say", fn_say },
 	{ "write", fn_write },
+	{ "writebytes", fn_writebytes },
 
 	{ "arr", fn_arr },
-	{ "append", fn_append },
-	{ "len", fn_len },
+	{ "append!", fn_append },
+	{ "#", fn_len },
 	{ ",", fn_pend },
+	{ "s,", fn_spend },
 	{ 0 },
 };
 
diff --git a/tests/arr1.bth b/tests/arr1.bth
index 1120549..06a830e 100644
--- a/tests/arr1.bth
+++ b/tests/arr1.bth
@@ -1,9 +1,9 @@
 (set! A (arr))
 (say A)
-(say (len A))
-(append A 10)
-(append A 20)
-(append A 30)
+(say (# A))
+(append! A 10)
+(append! A 20)
+(append! A 30)
 (say A)
-(say (len A))
+(say (# A))
 (say (A 1))
diff --git a/tests/arr2.bth b/tests/arr2.bth
index a405bde..6297c49 100644
--- a/tests/arr2.bth
+++ b/tests/arr2.bth
@@ -1 +1 @@
-(say (append [1 2 3 4] 99))
+(say (append! [1 2 3 4] 99))
diff --git a/tests/arr3.bth b/tests/arr3.bth
index c2bce88..787165e 100644
--- a/tests/arr3.bth
+++ b/tests/arr3.bth
@@ -1 +1 @@
-(say (append [1 2 (+ 1 2) (let (x 2) (* x x))] (+ 2 3)))
+(say (append! [1 2 (+ 1 2) (let (x 2) (* x x))] (+ 2 3)))
diff --git a/tests/arr4.bth b/tests/arr4.bth
index 2521e63..979a640 100644
--- a/tests/arr4.bth
+++ b/tests/arr4.bth
@@ -1,4 +1,4 @@
 (say
-	(let (A (append [1 2 3 (let (x 2) (* x x)) 5] 6))
-		(let (B (append A 7)) (append B 8))
-		(append (append A 9) 10)))
+	(let (A (append! [1 2 3 (let (x 2) (* x x)) 5] 6))
+		(let (B (append! A 7)) (append! B 8))
+		(append! (append! A 9) 10)))
diff --git a/tests/arr5.bth b/tests/arr5.bth
index 15c85e5..8da56a0 100644
--- a/tests/arr5.bth
+++ b/tests/arr5.bth
@@ -1,3 +1,3 @@
 (set! A [1 2 3])
-(let (B A) (append B 10))
+(let (B A) (append! B 10))
 (say A)
diff --git a/tests/for2.bth b/tests/for2.bth
index 66c490f..8f842f6 100644
--- a/tests/for2.bth
+++ b/tests/for2.bth
@@ -1,3 +1,3 @@
 (let (a [6 7 8 9])
-	(for (i (len a))
+	(for (i (# a))
 		(say (+ (a i) (* i 10)))))
diff --git a/tests/iota_imp.bth b/tests/iota_imp.bth
index cc62db9..eea67f8 100644
--- a/tests/iota_imp.bth
+++ b/tests/iota_imp.bth
@@ -1,4 +1,4 @@
 (let (a [])
 	(for (i 10)
-		(append a i))
+		(append! a i))
 	(say a))
diff --git a/tests/iota_rec.bth b/tests/iota_rec.bth
index 8e274a4..5ce196d 100644
--- a/tests/iota_rec.bth
+++ b/tests/iota_rec.bth
@@ -1,6 +1,6 @@
 (defn (iota' arr i max)
 	(if (< i max)
-		(iota' (append arr i) (+ i 1) max)
+		(iota' (append! arr i) (+ i 1) max)
 		arr))
 (set! _G_iota' iota')
 (defn (iota n) (_G_iota' [] 0 n))
diff --git a/tests/map.bth b/tests/map.bth
index 9f739bb..c3170bd 100644
--- a/tests/map.bth
+++ b/tests/map.bth
@@ -1,5 +1,5 @@
 (set! map' (fn (f ix in out)
-              (if (< ix (len in))
+              (if (< ix (# in))
                   (let (elem (in ix)
                         felem (f elem)
                         newix (+ 1 ix))
diff --git a/tests/whilelet.bth b/tests/whilelet.bth
index f4188ad..e717a6e 100644
--- a/tests/whilelet.bth
+++ b/tests/whilelet.bth
@@ -2,7 +2,7 @@
 	(let (i 0
 		  a [])
 		(while (< i 10)
-			(append a i)
+			(append! a i)
 			(set! i (+ i 1)))
 		(let (x 100
 			  y 200
diff --git a/vm.c b/vm.c
index 2131c5a..f3e59c2 100644
--- a/vm.c
+++ b/vm.c
@@ -28,8 +28,6 @@ int runvm(State *S) {
 	Thread *th = S->th;
 	Chunk *ch = th->ch;
 
-	int status = 1;
-
 	if (S->do_disasm) {
 		disasm_chunk(ch);
 		puts("---");
@@ -92,11 +90,7 @@ int runvm(State *S) {
 		case OP_GETGLOBAL: {
 			uint8_t cix = RBYTE();
 			Val varname = ch->consts.d[cix];
-			if (!IS_STRING(varname)) {
-				printf("global names must be string, not %s\n",
-					typename_str(varname));
-				goto done;
-			}
+			CHECK(IS_STRING(varname), "global names must be string");
 			Val v = ht_get(S, &S->globals, AS_STRING(varname));
 			PUSH(v);
 			if (IS_NIL(v)) {
@@ -107,11 +101,7 @@ int runvm(State *S) {
 		case OP_SETGLOBAL: {
 			uint8_t cix = RBYTE();
 			Val varname = ch->consts.d[cix];
-			if (!IS_STRING(varname)) {
-				printf("global names must be string, not %s\n",
-					typename_str(varname));
-				goto done;
-			}
+			CHECK(IS_STRING(varname), "global names must be string");
 			Val v = PEEK();
 
 			ht_put(S, &S->globals, AS_STRING(varname), v);
@@ -134,11 +124,7 @@ int runvm(State *S) {
 		case opcode: { \
 			Val b = POP(); \
 			Val a = POP(); \
-			if (!IS_NUM(a) || !IS_NUM(b)) { \
-				printf("can't do arithmetic on %s and %s\n", \
-					typename_str(a), typename_str(b)); \
-				goto done; \
-			} \
+		    CHECK(IS_NUM(a) && IS_NUM(b), "can only do arithmetic on num"); \
 			PUSH(RET_TYPE(AS_NUM(a) OP AS_NUM(b))); \
 			} \
 			break;
@@ -161,11 +147,7 @@ int runvm(State *S) {
 		case OP_MOD: {
 			Val b = POP();
 			Val a = POP();
-			if (!IS_NUM(a) || !IS_NUM(b)) {
-				printf("can't do arithmetic on %s and %s", 
-					typename_str(a), typename_str(b));
-				goto done;
-			}
+			CHECK(IS_NUM(a) && IS_NUM(b), "can only do arithmetic on num");
 			PUSH(VAL_NUM(fmod(AS_NUM(a), AS_NUM(b))));
 			break;
 		} 
@@ -257,9 +239,7 @@ int runvm(State *S) {
 			break;
 		}
 		case OP_HALT:
-			status = 0;
-			goto done;
-			break;
+			return 0;
 
 		case OP_ARRNEW: {
 			ObjArr *a = objarr_new(S);
@@ -288,8 +268,6 @@ int runvm(State *S) {
 
 
 	}
-	done:;
-	return status;
 }
 
 #undef RBYTE