~ chicken-core (chicken-5) 1382439b5c952f46c2eb4cfa5c5a46484112c8c8

commit 1382439b5c952f46c2eb4cfa5c5a46484112c8c8
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Mon Dec 21 12:18:48 2015 +1300
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Mon Dec 21 21:26:30 2015 +0100

    Use pair as loop result handle in compiler-syntax for `map`
    
    This allows the expansion to blindly dereference the second slot of the
    value accumulated by the loop, avoiding the need for a conditional that
    detects the first iteration and updates the loop's result box and
    removing the continuation resulting from that conditional. Because the
    map-loop is then free of any CPS calls, it compiles to a label and goto.
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index eedbdfdf..09a0ccf3 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -109,28 +109,26 @@
     (if (and (memq 'map standard-bindings) ; s.a.
 	     (> (length+ x) 2))
 	(let ((vars (map (lambda _ (gensym)) lsts)))
-	  `(,%let ((,%result (,%quote ()))
-		   (,%node #f)
-		   (,%proc ,(cadr x))
-		   ,@(map list vars lsts))		   
-		  ,@(map (lambda (var)
-			   `(##core#check (##sys#check-list ,var (,%quote map))))
-			 vars)
-		  (,%let ,%loop ,(map list vars vars)
-			 (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))
-			       (,%let ((,%res
-					(,%cons
-					 (,%proc
-					  ,@(map (lambda (v) `(##sys#slot ,v 0)) vars))
-					 (,%quote ()))))
-				      (,%if ,%node
-					    (##sys#setslot ,%node 1 ,%res)
-					    (,%set! ,%result ,%res))
-				      (,%set! ,%node ,%res)
-				      (##core#app
-				       ,%loop
-				       ,@(map (lambda (v) `(##sys#slot ,v 1)) vars)))
-			       ,%result))))
+	  `(,%let ((,%node (,%cons (##core#undefined) (,%quote ()))))
+	     (,%let ((,%result ,%node)
+		     (,%proc ,(cadr x))
+		     ,@(map list vars lsts))
+		    ,@(map (lambda (var)
+			     `(##core#check (##sys#check-list ,var (,%quote map))))
+			   vars)
+	       (,%let ,%loop ,(map list vars vars)
+		 (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))
+		       (,%let ((,%res
+				(,%cons
+				 (,%proc
+				  ,@(map (lambda (v) `(##sys#slot ,v 0)) vars))
+				 (,%quote ()))))
+			      (##sys#setslot ,%node 1 ,%res)
+			      (,%set! ,%node ,%res)
+			      (##core#app
+			       ,%loop
+			       ,@(map (lambda (v) `(##sys#slot ,v 1)) vars)))
+		       (##sys#slot ,%result 1))))))
 	x)))
 
 (define-internal-compiler-syntax ((o #%o) x r c) ()