From b61152027411f520247d95b9ff012d7012ebdf75 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Tue, 19 Jun 2018 18:06:18 -0400
Subject: [PATCH] Optimize calls to (list)

---
 include/cyclone/types.h       | 12 +++++------
 scheme/cyclone/transforms.sld | 39 +++++++++++++++++++++--------------
 2 files changed, 30 insertions(+), 21 deletions(-)

diff --git a/include/cyclone/types.h b/include/cyclone/types.h
index 295fe481..28bd2903 100644
--- a/include/cyclone/types.h
+++ b/include/cyclone/types.h
@@ -1069,18 +1069,18 @@ typedef pair_type *pair;
 
 #define make_list_2(l, a1, a2) \
   make_pair(l##__2, a2, NULL); \
-  make_pair(l, a1, l##__2);
+  make_pair(l, a1, &l##__2);
 
 #define make_list_3(l, a1, a2, a3) \
   make_pair(l##__3, a3, NULL); \
-  make_pair(l##__2, a2, l##__3); \
-  make_pair(l, a1, l##__2);
+  make_pair(l##__2, a2, &l##__3); \
+  make_pair(l, a1, &l##__2);
 
 #define make_list_4(l, a1, a2, a3, a4) \
   make_pair(l##__4, a4, NULL); \
-  make_pair(l##__3, a3, l##__4); \
-  make_pair(l##__2, a2, l##__3); \
-  make_pair(l, a1, l##__2);
+  make_pair(l##__3, a3, &l##__4); \
+  make_pair(l##__2, a2, &l##__3); \
+  make_pair(l, a1, &l##__2);
 
 /**
  * Create a pair with a single value. 
diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld
index 1153a351..6aafdc96 100644
--- a/scheme/cyclone/transforms.sld
+++ b/scheme/cyclone/transforms.sld
@@ -913,21 +913,30 @@
                    (append a-lookup defines-a-lookup renamed))
                 (map (lambda (p) (cdr p)) defines-a-lookup)))))
       ((app? ast)
-       (cond
-        ;; Special case, convert these to primitives if possible
-        ((and (eq? (car ast) 'member)
-              (not (assoc (car ast) renamed))
-              (= (length ast) 3))
-         (cons 'Cyc-fast-member
-               (map (lambda (a) (convert a renamed)) (cdr ast))))
-        ((and (eq? (car ast) 'assoc)
-              (not (assoc (car ast) renamed))
-              (= (length ast) 3))
-         (cons 'Cyc-fast-assoc
-               (map (lambda (a) (convert a renamed)) (cdr ast))))
-        ;; Regular case, alpha convert everything
-        (else
-         (map (lambda (a) (convert a renamed)) ast))))
+       (let ((regular-case 
+               (lambda ()
+                 ;; Regular case, alpha convert everything
+                 (map (lambda (a) (convert a renamed)) ast))))
+         (cond
+          ;; If identifier is renamed it is not a special case
+          ((assoc (car ast) renamed)
+           (regular-case))
+          ;; Special case, convert these to primitives if possible
+          ((and (eq? (car ast) 'member) (= (length ast) 3))
+           (cons 'Cyc-fast-member (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ((and (eq? (car ast) 'assoc) (= (length ast) 3))
+           (cons 'Cyc-fast-assoc (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ((and (eq? (car ast) 'list) (= (length ast) 2))
+           (cons 'Cyc-fast-list-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ((and (eq? (car ast) 'list) (= (length ast) 3))
+           (cons 'Cyc-fast-list-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ((and (eq? (car ast) 'list) (= (length ast) 4))
+           (cons 'Cyc-fast-list-3 (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ((and (eq? (car ast) 'list) (= (length ast) 5))
+           (cons 'Cyc-fast-list-4 (map (lambda (a) (convert a renamed)) (cdr ast))))
+          ;; Regular case, alpha convert everything
+          (else
+           (regular-case)))))
       (else
         (error "unhandled expression: " ast))))