Changeset 11846


Ignore:
Timestamp:
05/08/09 21:54:04 (12 years ago)
Author:
vvoutilainen
Message:

Yet another cleanup for p2-list/list*.
1) use pop instead of nbutlast
2) use if instead of when/unless
3) do clear-values in cons-for-list/list*
4) well, do _everything_ in cons-for-list/list* :)

File:
1 edited

Legend:

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

    r11844 r11846  
    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))))
     6508(defun cons-for-list/list* (form target representation &optional list-star-p)
     6509  (let* ((args (cdr form))
     6510   (length (length args))
     6511   (cons-heads (if list-star-p
     6512       (butlast args 1)
     6513           args)))
     6514    (cond ((>= 4 length 1)
     6515     (dolist (cons-head cons-heads)
     6516       (emit 'new +lisp-cons-class+)
     6517       (emit 'dup)
     6518       (compile-form cons-head 'stack nil))
     6519     (if list-star-p
     6520         (compile-form (first (last args)) 'stack nil)
     6521       (progn
     6522         (emit-invokespecial-init
     6523    +lisp-cons-class+ (lisp-object-arg-types 1))
     6524         (pop cons-heads))) ; we've handled one of the args, so remove it
     6525     (dolist (cons-head cons-heads)
     6526       (declare (ignore cons-head))
     6527       (emit-invokespecial-init
     6528        +lisp-cons-class+ (lisp-object-arg-types 2)))
     6529     (if list-star-p
     6530         (progn
     6531     (apply #'maybe-emit-clear-values args)
     6532     (emit-move-from-stack target representation))
     6533       (progn
     6534         (unless (every 'single-valued-p args)
     6535     (emit-clear-values))
     6536         (emit-move-from-stack target))))
     6537    (t
     6538     (compile-function-call form target representation)))))
     6539     
     6540 
    65276541
    65286542(defun p2-list (form target representation)
    6529   (let* ((args (cdr form))
    6530          (len (length args)))
    6531     (cond ((> len 4) ; list1() through list9() are defined in Lisp.java.
    6532            (compile-function-call form target representation))
    6533           (t
    6534            (cond ((zerop len)
    6535                   (emit-push-nil))
    6536                  ((>= 4 len 1)
    6537       (cons-for-list/list* args target representation)))
    6538            (unless (every 'single-valued-p args)
    6539              (emit-clear-values))
    6540            (emit-move-from-stack target)))))
     6543  (cons-for-list/list* form target representation))
    65416544
    65426545(defun p2-list* (form target representation)
    6543   (let* ((args (cdr form))
    6544          (length (length args)))
    6545      (cond ((>= 4 length 1)
    6546       (cons-for-list/list* args target representation t))
    6547           (t
    6548            (compile-function-call form target representation)))))
     6546  (cons-for-list/list* form target representation t))
    65496547
    65506548(define-inlined-function compile-nth (form target representation)
Note: See TracChangeset for help on using the changeset viewer.