shithub: femtolisp

Info  •  Files  •  Log  •  Branches

for-each: work with vectors, arrays and hash tables

Fixes: https://todo.sr.ht/~ft/femtolisp/14

--- a/flisp.c

+++ b/flisp.c

@@ -2034,7 +2034,7 @@

 	uint32_t k = FL(sp);

 	PUSH(FL(Nil));

 	PUSH(FL(Nil));

-	for(;;){

+	for(bool first = true;;){

 		PUSH(FL(stack)[argSP]);

 		for(uint32_t i = 1; i < nargs; i++){

 			if(!iscons(FL(stack)[argSP+i])){

@@ -2049,34 +2049,72 @@

 		PUSH(v);

 		value_t c = mk_cons();

 		car_(c) = POP(); cdr_(c) = FL(Nil);

-		if(FL(stack)[k+1] == FL(Nil))

+		if(first)

 			FL(stack)[k+1] = c;

 		else

 			cdr_(FL(stack)[k]) = c;

 		FL(stack)[k] = c;

+		first = false;

 	}

 }

 BUILTIN("for-each", for_each)

 {

-	if(nargs < 2)

-		argcount(nargs, 2);

+	if(__unlikely(nargs < 2))

+		lerrorf(FL(ArgError), "too few arguments");

 	intptr_t argSP = args-FL(stack);

 	assert(argSP >= 0 && argSP < FL(nstack));

-	if(FL(sp)+nargs > FL(nstack))

+	if(FL(sp)+2*nargs > FL(nstack))

 		grow_stack();

-	for(;;){

+	for(size_t n = 0;; n++){

 		PUSH(FL(stack)[argSP]);

-		for(uint32_t i = 1; i < nargs; i++){

-			if(!iscons(FL(stack)[argSP+i])){

-				POPN(i);

-				return FL(t);

+		uint32_t pargs = 0;

+		for(uint32_t i = 1; i < nargs; i++, pargs++){

+			value_t v = FL(stack)[argSP+i];

+			if(iscons(v)){

+				PUSH(car_(v));

+				FL(stack)[argSP+i] = cdr_(v);

+				continue;

 			}

-			PUSH(car_(FL(stack)[argSP+i]));

-			FL(stack)[argSP+i] = cdr_(FL(stack)[argSP+i]);

+			if(isvector(v)){

+				size_t sz = vector_size(v);

+				if(n < sz){

+					PUSH(vector_elt(v, n));

+					continue;

+				}

+			}

+			if(isarray(v)){

+				size_t sz = cvalue_arraylen(v);

+				if(n < sz){

+					value_t a[2];

+					a[0] = v;

+					a[1] = fixnum(n);

+					PUSH(cvalue_array_aref(a));

+					continue;

+				}

+			}

+			if(ishashtable(v)){

+				htable_t *h = totable(v);

+				if(n == 0)

+					h->i = 0;

+				void **table = h->table;

+				for(; h->i < h->size; h->i += 2){

+					if(table[h->i+1] != HT_NOTFOUND)

+						break;

+				}

+				if(h->i < h->size){

+					PUSH((value_t)table[h->i]);

+					pargs++;

+					PUSH((value_t)table[h->i+1]);

+					h->i += 2;

+					continue;

+				}

+			}

+			POPN(pargs+1);

+			return FL(t);

 		}

-		_applyn(nargs-1);

-		POPN(nargs);

+		_applyn(pargs);

+		POPN(pargs+1);

 	}

 }

--- a/htable.h

+++ b/htable.h

@@ -6,6 +6,10 @@

 	size_t size;

 	void **table;

 	void *_space[HT_N_INLINE];

+

+	// this is to skip over non-items in for-each

+	// FIXME(sigrid): in a multithreaded environment this isn't enough

+	size_t i;

 }htable_t;

 // define this to be an invalid key/value

--- a/table.c

+++ b/table.c

@@ -66,7 +66,7 @@

 	print_traverse_htable,

 };

-static int

+bool

 ishashtable(value_t v)

 {

 	return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == FL(tabletype);

@@ -78,7 +78,7 @@

 	return ishashtable(args[0]) ? FL(t) : FL(f);

 }

-static htable_t *

+htable_t *

 totable(value_t v)

 {

 	if(!ishashtable(v))

--- a/table.h

+++ b/table.h

@@ -1,1 +1,3 @@

+bool ishashtable(value_t v);

+htable_t *totable(value_t v);

 void table_init(void);

--- a/test/unittest.lsp

+++ b/test/unittest.lsp

@@ -395,7 +395,7 @@

 ;; for-each with multiple lists

 (define q '())

-(for-each (λ (x y z) (set! q (cons (+ x y z) q))) '(1 2 3) '(4 5 6) '(7 8 9))

+(for-each (λ (x y k v) (set! q (cons (+ x y k v) q))) #(1 2 3) #vu8(4 5 6) (table 0 7 1 7 2 7))

 (assert (equal? q '(18 15 12)))

 (define q 0)

 (for-each (λ (x y) (set! q (+ x y q))) '(1) '(3 9))