shithub: femtolisp

Info  •  Files  •  Log  •  Branches

for-each: stop on shortest list end, do not throw errors

--- a/flisp.c

+++ b/flisp.c

@@ -2107,25 +2107,20 @@

 		grow_stack();

 	FL(sp) += nargs;

-	for(uint32_t n = 0;; n++){

+	for(;;){

 		FL(stack)[FL(sp)-nargs] = FL(stack)[argSP];

 		uint32_t i, c;

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

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

-				FL(stack)[FL(sp)-nargs+i] = car_(FL(stack)[argSP+i]);

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

-				c++;

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

+				POPN(nargs);

+				return FL(t);

 			}

-			if(c != i+1 && c != 1)

-				lerrorf(FL(ArgError), "list %d is of different length", i-1);

+			FL(stack)[FL(sp)-nargs+i] = car_(FL(stack)[argSP+i]);

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

 		}

-		if(c == 1)

-			break;

 		_applyn(nargs-1);

 	}

-	POPN(nargs);

-	return FL(t);

 }

 BUILTIN("sleep", fl_sleep)

--- a/test/unittest.lsp

+++ b/test/unittest.lsp

@@ -395,12 +395,15 @@

 ;; 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 z) (set! q (cons (+ x y z) q))) '(1 2 3) '(4 5 6) '(7 8 9))

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

-(assert-fail (eval '(for-each (λ (x y) (+ x y)) '(1) '(2 3))))

-(assert-fail (eval '(for-each (λ (x y) (+ x y)) '(1 2) '(3))))

-(assert-fail (eval '(for-each (λ (x y z) (+ x y z)) '(1 2) '(3) '(4 5))))

+(define q 0)

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

+(assert (equal? q 4))

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

+(assert (equal? q 8))

+(for-each (λ (x y z) (set! q (+ x y z q))) '(1 2) '(3) '(4 5))

+(assert (equal? q 16))

 ;; make many initialized tables large enough not to be stored in-line

 (for 1 100 (λ (i)