[Sbcl-commits] master: A few random simplifications.

[Douglas K. <sn...@us...>]

The branch "master" has been updated in SBCL:
       via  28d12d522057f4d9b9cd0bd6957c7816047274af (commit)
      from  66bc347e314e889bed4dd2e1561f5713f377460a (commit)

- Log -----------------------------------------------------------------
commit 28d12d522057f4d9b9cd0bd6957c7816047274af
Author: Douglas Katzman <do...@go...>
Date:   Wed Jun 10 09:01:43 2015 -0400

    A few random simplifications.
    
    - Generally assume that parse-lambda-list has done it's job right;
      specifically, don't need a re-check for well-formed &AUX bindings.
    - Don't reinvent PARSE-KEY-ARG-SPEC for the Nth time.
    - Var-ifying &REST and &MORE lambda vars can use the same loop.
---
 src/code/defstruct.lisp          |    9 ++-----
 src/compiler/ir1tran-lambda.lisp |   44 +++++++++++++-------------------------
 src/compiler/macros.lisp         |    7 +-----
 src/pcl/boot.lisp                |    2 +-
 4 files changed, 20 insertions(+), 42 deletions(-)

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index c765e4a..c4960d3 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -1630,17 +1630,14 @@ or they must be declared locally notinline at each call site.~@:>")
             (arglist '&aux)
             (dolist (arg aux)
               (typecase arg
-                ((cons symbol (cons t null))
+                ((cons symbol cons)
                  (let ((var (first arg)))
                    (arglist arg)
                    (vars var)
                    (decls `(type ,(get-slot var) ,var))))
-                ((cons symbol null)
-                 (skipped-vars (first arg)))
-                (symbol
-                 (skipped-vars arg))
                 (t
-                 (error "Malformed &AUX binding specifier: ~s." arg)))))))
+                 ;; (&AUX X) and (&AUX (X)) both skip the slot
+                 (skipped-vars (if (consp arg) (first arg) arg))))))))
 
       (funcall creator defstruct (first boa)
                (arglist) (ftype-args) (decls)
diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index fcfe08b..b24ec76 100644
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -28,7 +28,7 @@
 (declaim (ftype (sfunction (t list &optional t) lambda-var) varify-lambda-arg))
 (defun varify-lambda-arg (name names-so-far &optional (context "lambda list"))
   (declare (inline member))
-  (unless (symbolp name)
+  (unless (symbolp name) ;; FIXME: probably unreachable. Change to AVER?
     (compiler-error "~S is not a symbol, and cannot be used as a variable." name))
   (when (member name names-so-far :test #'eq)
     (compiler-error "The variable ~S occurs more than once in the ~A."
@@ -125,23 +125,14 @@
                 (names-so-far name)
                 (parse-default spec info))))
 
-        (when (eq (ll-kwds-restp llks) '&rest)
-          (let ((var (varify-lambda-arg (car rest/more) (names-so-far))))
-            (setf (lambda-var-arg-info var) (make-arg-info :kind :rest))
-            (vars var)
-            (names-so-far (lambda-var-%source-name var))))
-
-        (when (eq (ll-kwds-restp llks) '&more)
-          (let ((var (varify-lambda-arg (car rest/more) (names-so-far))))
-            (setf (lambda-var-arg-info var)
-                  (make-arg-info :kind :more-context))
-            (vars var)
-            (names-so-far (lambda-var-%source-name var)))
-          (let ((var (varify-lambda-arg (cadr rest/more) (names-so-far))))
-            (setf (lambda-var-arg-info var)
-                  (make-arg-info :kind :more-count))
-            (vars var)
-            (names-so-far (lambda-var-%source-name var))))
+        (when rest/more
+          (mapc (lambda (name kind)
+                  (let ((var (varify-lambda-arg name (names-so-far))))
+                    (setf (lambda-var-arg-info var) (make-arg-info :kind kind))
+                    (vars var)
+                    (names-so-far name)))
+                rest/more (let ((morep (eq (ll-kwds-restp llks) '&more)))
+                            (if morep '(:more-context :more-count) '(:rest)))))
 
         (dolist (spec keys)
           (cond
@@ -179,17 +170,12 @@
                 (parse-default spec info))))))
 
         (dolist (spec aux)
-          (cond ((atom spec)
-                 (let ((var (varify-lambda-arg spec nil)))
-                   (aux-vars var)
-                   (aux-vals nil)
-                   (names-so-far spec)))
-                (t
-                 (let* ((name (first spec))
-                        (var (varify-lambda-arg name nil)))
-                   (aux-vars var)
-                   (aux-vals (second spec))
-                   (names-so-far name)))))
+          (multiple-value-bind (name val)
+              (if (atom spec) spec (values (car spec) (cadr spec)))
+            (let ((var (varify-lambda-arg name nil)))
+              (aux-vars var)
+              (aux-vals val)
+              (names-so-far name))))
 
         (values (vars) (ll-kwds-keyp llks) (ll-kwds-allowp llks)
                 (aux-vars) (aux-vals))))))
diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index 3b7e916..48fbf53 100644
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -269,12 +269,7 @@
            ;; parse-lambda-just, and more.
            (keys (mapcar (lambda (spec)
                            (multiple-value-bind (key var)
-                               (if (atom spec)
-                                   (values (keywordicate spec) spec)
-                                   (let ((head (car spec)))
-                                     (if (atom head)
-                                         (values (keywordicate head) head)
-                                         (values (car head) (cadr head)))))
+                               (parse-key-arg-spec spec)
                              (cons var key)))
                          keys))
            final-mandatory-arg)
diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 9dabc18..ec68d5e 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -1782,7 +1782,7 @@ bootstrapping.
 
 (defun ll-keyp-or-restp (bits)
   (logtest #.(lambda-list-keyword-mask '(&key &rest)) bits))
-                            
+
 (defun set-arg-info (gf &key new-method (lambda-list nil lambda-list-p)
                         argument-precedence-order)
   (let* ((arg-info (if (eq **boot-state** 'complete)

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL