From 8293fb6eb441f29da5b830f5eb8986f0c07aa2e2 Mon Sep 17 00:00:00 2001
From: Daniel Kochmanski <daniel@turtleware.eu>
Date: Thu, 10 Aug 2017 20:44:35 +0200
Subject: [PATCH] expand-vector-push: reduce complexity (one nesting level
 less)

catch the infinite recursion and do return-form instead of setting
`whole'.
---
 src/cmp/cmparray.lsp | 73 ++++++++++++++++++++++----------------------
 1 file changed, 36 insertions(+), 37 deletions(-)

diff --git a/src/cmp/cmparray.lsp b/src/cmp/cmparray.lsp
index be6276d86..b0e602959 100644
--- a/src/cmp/cmparray.lsp
+++ b/src/cmp/cmparray.lsp
@@ -93,43 +93,42 @@
 (defun expand-vector-push (whole env extend &aux (args (rest whole)))
   (declare (si::c-local))
   (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)
+    (when (or (eq (first args) 'value) ; No infinite recursion
+              (not (policy-open-code-aref/aset)))
+      (return-from expand-vector-push 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))))))))
 
 (define-compiler-macro vector-push (&whole whole &rest args &environment env)
   (expand-vector-push whole env nil))