From f3c83e42a485e5a88b4ed68509c51a2866d45224 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Fri, 9 Aug 2019 16:00:46 -0400
Subject: [PATCH] Optimized versions of (map) and (for-each)

These versions are optimized for when the function is being called with two list arguments.
---
 scheme/base.sld               | 11 +++++++++++
 scheme/cyclone/transforms.sld |  4 ++++
 2 files changed, 15 insertions(+)

diff --git a/scheme/base.sld b/scheme/base.sld
index 2c9dae2f..80789c5e 100644
--- a/scheme/base.sld
+++ b/scheme/base.sld
@@ -85,7 +85,9 @@
     list-copy
     map
     Cyc-map-loop-1
+    Cyc-map-loop-2
     Cyc-for-each-loop-1
+    Cyc-for-each-loop-2
     for-each
     list-tail
     list-ref
@@ -807,11 +809,20 @@
       (if (null? lst)
         '()
        (cons (f (car lst)) (Cyc-map-loop-1 f (cdr lst)))))
+    (define (Cyc-map-loop-2 f lst1 lst2)
+      (if (or (null? lst1) (null? lst2))
+        '()
+       (cons (f (car lst1) (car lst2)) (Cyc-map-loop-2 f (cdr lst1) (cdr lst2)))))
     (define (Cyc-for-each-loop-1 f lst)
       (if (null? lst)
         '()
        (begin (f (car lst)) 
               (Cyc-for-each-loop-1 f (cdr lst)))))
+    (define (Cyc-for-each-loop-2 f lst1 lst2)
+      (if (or (null? lst1) (null? lst2))
+        '()
+       (begin (f (car lst1) (car lst2)) 
+              (Cyc-for-each-loop-2 f (cdr lst1) (cdr lst2)))))
 
     (define (for-each f lis1 . lists)
       (if (not (null? lis1))
diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld
index dc2e08e0..bf243fd0 100644
--- a/scheme/cyclone/transforms.sld
+++ b/scheme/cyclone/transforms.sld
@@ -1115,8 +1115,12 @@ if (acc) {
            (cons 'Cyc-fast-list-4 (map (lambda (a) (convert a renamed)) (cdr ast))))
           ((and (eq? (car ast) 'for-each) (= (length ast) 3))
            (cons 'Cyc-for-each-loop-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ((and (eq? (car ast) 'for-each) (= (length ast) 4))
+           (cons 'Cyc-for-each-loop-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
           ((and (eq? (car ast) 'map) (= (length ast) 3))
            (cons 'Cyc-map-loop-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ((and (eq? (car ast) 'map) (= (length ast) 4))
+           (cons 'Cyc-map-loop-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
           ;; Regular case, alpha convert everything
           (else
            (regular-case)))))