shithub: femtolisp

Download patch

ref: 7f5c363205f4a6fd78a7a78fcb1bb00fbf0128d1
parent: 83ec06d0005f053b5dce99bf2d8c24923f335e2b
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Fri Dec 6 09:07:47 EST 2024 

map: allow a shorter list in any position

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


--- a/flisp.c
+++ b/flisp.c
@@ -2027,74 +2027,34 @@
 {
 	if(__unlikely(nargs < 2))
 		lerrorf(FL(ArgError), "too few arguments");
-	if(!iscons(args[1]))
-		return FL(Nil);
-	value_t v;
-	intptr_t first, last, argSP = args-FL(stack);
+	intptr_t argSP = args-FL(stack);
 	assert(argSP >= 0 && argSP < FL(nstack));
-	if(nargs == 2){
-		if(FL(sp)+4 > FL(nstack))
-			grow_stack();
+	while(FL(sp)+2+nargs > FL(nstack))
+		grow_stack();
+	uint32_t k = FL(sp);
+	PUSH(FL(Nil));
+	PUSH(FL(Nil));
+	for(;;){
 		PUSH(FL(stack)[argSP]);
-		PUSH(car_(FL(stack)[argSP+1]));
-		v = _applyn(1);
-		POPN(2);
-		PUSH(v);
-		v = mk_cons();
-		car_(v) = POP(); cdr_(v) = FL(Nil);
-		PUSH(v);
-		PUSH(v);
-		first = FL(sp)-2;
-		last = FL(sp)-1;
-		FL(stack)[argSP+1] = cdr_(FL(stack)[argSP+1]);
-		while(iscons(FL(stack)[argSP+1])){
-			PUSH(FL(stack)[argSP]);
-			PUSH(car_(FL(stack)[argSP+1]));
-			v = _applyn(1);
-			POPN(2);
-			PUSH(v);
-			v = mk_cons();
-			car_(v) = POP(); cdr_(v) = FL(Nil);
-			cdr_(FL(stack)[last]) = v;
-			FL(stack)[last] = v;
-			FL(stack)[argSP+1] = cdr_(FL(stack)[argSP+1]);
-		}
-		POPN(2);
-	}else{
-		size_t i;
-		while(FL(sp)+nargs+1 > FL(nstack))
-			grow_stack();
-		PUSH(FL(stack)[argSP]);
-		for(i = 1; i < nargs; i++){
+		for(uint32_t i = 1; i < nargs; i++){
+			if(!iscons(FL(stack)[argSP+i])){
+				POPN(1+i);
+				return FL(stack)[k+1];
+			}
 			PUSH(car(FL(stack)[argSP+i]));
 			FL(stack)[argSP+i] = cdr_(FL(stack)[argSP+i]);
 		}
-		v = _applyn(nargs-1);
+		value_t v = _applyn(nargs-1);
 		POPN(nargs);
 		PUSH(v);
-		v = mk_cons();
-		car_(v) = POP(); cdr_(v) = FL(Nil);
-		PUSH(v);
-		PUSH(v);
-		first = FL(sp)-2;
-		last = FL(sp)-1;
-		while(iscons(FL(stack)[argSP+1])){
-			PUSH(FL(stack)[argSP]);
-			for(i = 1; i < nargs; i++){
-				PUSH(car(FL(stack)[argSP+i]));
-				FL(stack)[argSP+i] = cdr_(FL(stack)[argSP+i]);
-			}
-			v = _applyn(nargs-1);
-			POPN(nargs);
-			PUSH(v);
-			v = mk_cons();
-			car_(v) = POP(); cdr_(v) = FL(Nil);
-			cdr_(FL(stack)[last]) = v;
-			FL(stack)[last] = v;
-		}
-		POPN(2);
+		value_t c = mk_cons();
+		car_(c) = POP(); cdr_(c) = FL(Nil);
+		if(FL(stack)[k+1] == FL(Nil))
+			FL(stack)[k+1] = c;
+		else
+			cdr_(FL(stack)[k]) = c;
+		FL(stack)[k] = c;
 	}
-	return FL(stack)[first];
 }
 
 BUILTIN("for-each", for_each)
--- a/test/unittest.lsp
+++ b/test/unittest.lsp
@@ -405,6 +405,12 @@
 (for-each (λ (x y z) (set! q (+ x y z q))) '(1 2) '(3) '(4 5))
 (assert (equal? q 16))
 
+;; map with multiple lists
+(assert (equal? (map (λ (x y z) (+ x y z)) '(1 2 3) '(4 5 6) '(7 8 9)) '(12 15 18)))
+(assert (equal? (map (λ (x y) (+ x y)) '(1) '(3 9)) '(4)))
+(assert (equal? (map (λ (x y) (+ x y)) '(1 2) '(3)) '(4)))
+(assert (equal? (map (λ (x y z) (+ x y z)) '(1 2) '(3) '(4 5)) '(8)))
+
 ;; make many initialized tables large enough not to be stored in-line
 (for 1 100 (λ (i)
   (table eq?      2      eqv?     2