Changeset 15004 for trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp

Timestamp:

05/15/17 20:37:26 (6 years ago)

Author:

Mark Evenson

Message:

Fix DESTRUCTURING-BIND with &rest arguments

(Olof-Joachim Frahm)

Fixes <​http://abcl.org/trac/ticket/417> aka
<​https://github.com/armedbear/abcl/issues/8>.

Merges <​https://github.com/armedbear/abcl/pull/42>.

File:

• trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp (modified) (4 diffs)

trunk/abcl/src/org/armedbear/lisp/destructuring-bind.lisp

@@ -142 +142 @@
     (when (eq keyword (car remaining))
       (return t))))
+
+(defun dot-length (cons)
+  (do ((rest cons (cdr rest))
+       (length 0 (1+ length)))
+      ((or (null rest) (atom rest)) length)))
 
 (defun parse-defmacro-lambda-list
@@ -194 +199 @@
                             env-arg-used t))
          (t
-          (defmacro-error "&ENVIRONMENT" error-kind name))))
+          (defmacro-error "&ENVIRONMENT" name))))
         ((or (eq var '&rest) (eq var '&body))
          (cond ((and (cdr rest-of-args) (symbolp (cadr rest-of-args)))
@@ -210 +215 @@
        destructuring-lambda-list sub name error-kind error-fun)))
          (t
-          (defmacro-error (symbol-name var) error-kind name))))
+          (defmacro-error (symbol-name var) name))))
         ((eq var '&optional)
          (setq now-processing :optionals))
@@ -280 +285 @@
         (t
          (error "non-symbol in lambda-list: ~S" var)))))
-    ;; Generate code to check the number of arguments, unless dotted
-    ;; in which case length will not work.
-    (unless restp
-      (push `(unless (<= ,minimum
-                         (length ,path-0)
-                         ,@(unless restp
-                             (list maximum)))
-               ,(if (eq error-fun 'error)
-                    `(arg-count-error ',error-kind ',name ,path-0
-                                      ',lambda-list ,minimum
-                                      ,(unless restp maximum))
-                    `(,error-fun 'arg-count-error
-                      :kind ',error-kind
-                      ,@(when name `(:name ',name))
-                      :argument ,path-0
-                      :lambda-list ',lambda-list
-                      :minimum ,minimum
-                      ,@(unless restp `(:maximum ,maximum)))))
-            *arg-tests*))
+    ;; Generate code to check the number of arguments.
+    (push `(unless (<= ,minimum
+                       (dot-length ,path-0)
+                       ,@(unless restp
+                           (list maximum)))
+             ,(if (eq error-fun 'error)
+                  `(arg-count-error ',error-kind ',name ,path-0
+                                    ',lambda-list ,minimum
+                                    ,(unless restp maximum))
+                  `(,error-fun 'arg-count-error
+                    :kind ',error-kind
+                    ,@(when name `(:name ',name))
+                    :argument ,path-0
+                    :lambda-list ',lambda-list
+                    :minimum ,minimum
+                    ,@(unless restp `(:maximum ,maximum)))))
+          *arg-tests*)
     (if keys
         (let ((problem (gensym "KEY-PROBLEM-"))