From bf310ef23a680378d9353249f6f4e8aaba5c69cb Mon Sep 17 00:00:00 2001
From: Daniel Kochmanski <daniel@turtleware.eu>
Date: Thu, 10 Aug 2017 20:55:11 +0200
Subject: [PATCH] expand-vector-push: further reduce complexity

use return-from for catching forms of illegal number of arguments.
---
 src/cmp/cmparray.lsp | 57 +++++++++++++++++++-------------------------
 1 file changed, 24 insertions(+), 33 deletions(-)

diff --git a/src/cmp/cmparray.lsp b/src/cmp/cmparray.lsp
index b0e602959..5c5770311 100644
--- a/src/cmp/cmparray.lsp
+++ b/src/cmp/cmparray.lsp
@@ -95,40 +95,31 @@
   (with-clean-symbols (value vector index dimension)
     (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)))
+      (return-from expand-vector-push
+        whole))
+    (let ((len (length args)))
+      (when (or (< len 2)
+                (> len (if extend 3 2)))
+        (cmpwarn "Wrong number of arguments passed to function ~A in form: ~A" (first whole) whole)
+        (return-from expand-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))))))))
+            "Wrong number of arguments passed to function ~A in form: ~A" ',(first whole) ',whole))))
+    `(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))