From c2af9fe77525ab7b5c155753eeac4e372e31017c Mon Sep 17 00:00:00 2001
From: Daniel Kochmanski <daniel@turtleware.eu>
Date: Thu, 10 Aug 2017 20:23:30 +0200
Subject: [PATCH] cmp: refactor: expand-vector-push: get rid of one nesting
 level

---
 src/cmp/cmparray.lsp | 77 ++++++++++++++++++++++----------------------
 1 file changed, 38 insertions(+), 39 deletions(-)

diff --git a/src/cmp/cmparray.lsp b/src/cmp/cmparray.lsp
index 7cef72ec7..be6276d86 100644
--- a/src/cmp/cmparray.lsp
+++ b/src/cmp/cmparray.lsp
@@ -90,46 +90,45 @@
 ;;; VECTOR-PUSH and VECTOR-PUSH-EXTEND
 ;;;
 
-(defun expand-vector-push (whole env extend)
+(defun expand-vector-push (whole env extend &aux (args (rest whole)))
   (declare (si::c-local))
-  (let* ((args (rest whole)))
-    (with-clean-symbols (value vector index dimension)
-      (unless (or (eq (first args) 'value) ; No infinite recursion
-                  (not (policy-open-code-aref/aset)))
-        (setf whole
-              (if (or (< (length args) 2)
-                      (and (not extend)
-                           (> (length args) 2))
-                      (and extend
-                           (> (length args) 3)))
-                  (progn
-                    (cmpwarn "Wrong number of arguments passed to function ~S"
-                             (symbol-function
-                              (if extend
-                                    'vector-push-extend
-                                    'vector-push)))
-                    `(si::simple-program-error
-                      "Wrong number of arguments passed to function ~S"
-                      (symbol-function
-                       ',(if extend
-                             'vector-push-extend
-                             'vector-push))))
-                    `(let* ((value ,(car args))
-                            (vector ,(second args)))
-                       (declare (:read-only value vector)
-                                (optimize (safety 0)))
-                       (optional-type-assertion vector vector)
-                       (let ((index (fill-pointer vector))
-                             (dimension (array-total-size vector)))
-                         (declare (fixnum index dimension)
-                                  (:read-only index dimension))
-                         (cond ((< index dimension)
-                                (sys::fill-pointer-set vector (truly-the fixnum (+ 1 index)))
-                                (sys::aset vector index value)
-                                index)
-                               (t ,(if extend
-                                       `(vector-push-extend value vector ,@(cddr args))
-                                       nil))))))))))
+  (with-clean-symbols (value vector index dimension)
+    (unless (or (eq (first args) 'value) ; No infinite recursion
+                (not (policy-open-code-aref/aset)))
+      (setf whole
+            (if (or (< (length args) 2)
+                    (and (not extend)
+                         (> (length args) 2))
+                    (and extend
+                         (> (length args) 3)))
+                (progn
+                  (cmpwarn "Wrong number of arguments passed to function ~S"
+                           (symbol-function
+                            (if extend
+                                'vector-push-extend
+                                'vector-push)))
+                  `(si::simple-program-error
+                    "Wrong number of arguments passed to function ~S"
+                    (symbol-function
+                     ',(if extend
+                           'vector-push-extend
+                           'vector-push))))
+                `(let* ((value ,(car args))
+                        (vector ,(second args)))
+                   (declare (:read-only value vector)
+                            (optimize (safety 0)))
+                   (optional-type-assertion vector vector)
+                   (let ((index (fill-pointer vector))
+                         (dimension (array-total-size vector)))
+                     (declare (fixnum index dimension)
+                              (:read-only index dimension))
+                     (cond ((< index dimension)
+                            (sys::fill-pointer-set vector (truly-the fixnum (+ 1 index)))
+                            (sys::aset vector index value)
+                            index)
+                           (t ,(if extend
+                                   `(vector-push-extend value vector ,@(cddr args))
+                                   nil)))))))))
     whole)
 
 (define-compiler-macro vector-push (&whole whole &rest args &environment env)