Changeset 11844


Ignore:
Timestamp:
05/08/09 21:11:15 (13 years ago)
Author:
vvoutilainen
Message:

More list/list* cleanup, also don't use default nil values for my
recently added &optionals, that's not necessary.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11842 r11844  
    10021002;; functions with a wrong number of arguments or malformed keyword argument
    10031003;; lists, and using unrecognized declaration specifiers." (3.2.5)
    1004 (defun check-number-of-args (form n &optional (minimum nil))
     1004(defun check-number-of-args (form n &optional minimum)
    10051005  (declare (type fixnum n))
    10061006  (let* ((op (car form))
     
    65066506    (emit-move-from-stack target representation)))
    65076507
     6508(defun cons-for-list/list* (args target representation &optional list-star-p)
     6509  (let ((cons-heads (if list-star-p
     6510      (butlast args 1)
     6511          args)))
     6512    (dolist (cons-head cons-heads)
     6513      (emit 'new +lisp-cons-class+)
     6514      (emit 'dup)
     6515      (compile-form cons-head 'stack nil))
     6516    (when list-star-p
     6517      (compile-form (first (last args)) 'stack nil))
     6518    (unless list-star-p
     6519      (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 1))
     6520      (setf cons-heads (nbutlast cons-heads 1)))
     6521    (dolist (cons-head cons-heads)
     6522      (declare (ignore cons-head))
     6523      (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2)))
     6524    (when list-star-p
     6525      (apply #'maybe-emit-clear-values args)
     6526      (emit-move-from-stack target representation))))
     6527
    65086528(defun p2-list (form target representation)
    65096529  (let* ((args (cdr form))
    65106530         (len (length args)))
    6511     (cond ((> len 9) ; list1() through list9() are defined in Lisp.java.
     6531    (cond ((> len 4) ; list1() through list9() are defined in Lisp.java.
    65126532           (compile-function-call form target representation))
    65136533          (t
    65146534           (cond ((zerop len)
    65156535                  (emit-push-nil))
    6516                  ((= len 1)
    6517                   (emit 'new +lisp-cons-class+)
    6518                   (emit 'dup)
    6519                   (compile-form (first args) 'stack nil)
    6520                   (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 1)))
    6521                  ((and (>= *speed* *space*)
    6522                        (< len 4))
    6523                   (emit 'new +lisp-cons-class+)
    6524                   (emit 'dup)
    6525                   (compile-form (first args) 'stack nil)
    6526                   (emit 'new +lisp-cons-class+)
    6527                   (emit 'dup)
    6528                   (compile-form (second args) 'stack nil)
    6529                   (when (= len 3)
    6530                     (emit 'new +lisp-cons-class+)
    6531                     (emit 'dup)
    6532                     (compile-form (third args) 'stack nil))
    6533                   (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 1))
    6534                   (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))
    6535                   (when (= len 3)
    6536                     (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))))
    6537                  (t
    6538                   (dolist (arg args)
    6539                     (compile-form arg 'stack nil))
    6540                   (let ((s (copy-seq "list ")))
    6541                     (setf (schar s 4) (code-char (+ (char-code #\0) len)))
    6542                     (emit-invokestatic +lisp-class+ s
    6543                                        (make-list len :initial-element +lisp-object+)
    6544                                        +lisp-cons+))))
     6536                 ((>= 4 len 1)
     6537      (cons-for-list/list* args target representation)))
    65456538           (unless (every 'single-valued-p args)
    65466539             (emit-clear-values))
    65476540           (emit-move-from-stack target)))))
    65486541
    6549 (defun cons-for-list* (args target representation)
    6550   (let ((cons-heads (butlast args 1)))
    6551     (dolist (cons-head cons-heads)
    6552       (emit 'new +lisp-cons-class+)
    6553       (emit 'dup)
    6554       (compile-form cons-head 'stack nil))
    6555     (compile-form (first (last args)) 'stack nil)
    6556     (dolist (cons-head cons-heads)
    6557       (declare (ignore cons-head))
    6558       (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2)))
    6559     (apply #'maybe-emit-clear-values args)
    6560     (emit-move-from-stack target representation)))
    6561  
    65626542(defun p2-list* (form target representation)
    65636543  (let* ((args (cdr form))
    65646544         (length (length args)))
    6565      (cond ((= length 1)
    6566      (compile-forms-and-maybe-emit-clear-values (first args) 'stack nil)
    6567             (emit-move-from-stack target representation))
    6568      ((>= 4 length 2)
    6569       (cons-for-list* args target representation))
     6545     (cond ((>= 4 length 1)
     6546      (cons-for-list/list* args target representation t))
    65706547          (t
    65716548           (compile-function-call form target representation)))))
Note: See TracChangeset for help on using the changeset viewer.