>From 328b2119511c626cd7b6f446cef175fd2321b66e Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Mon, 21 Dec 2015 12:18:48 +1300
Subject: [PATCH] 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.
---
 compiler-syntax.scm | 42 ++++++++++++++++++++----------------------
 1 file changed, 20 insertions(+), 22 deletions(-)

diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 520c775..6c7e81e 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -118,28 +118,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 ((chicken.data-structures#o) x r c) ()
-- 
2.6.2