Changeset 11519


Ignore:
Timestamp:
12/30/08 21:48:34 (12 years ago)
Author:
vvoutilainen
Message:

Remove code repetition in the beginning of p2-compiland.

File:
1 edited

Legend:

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

    r11518 r11519  
    84678467        (unless (or (memq '&OPTIONAL args) (memq '&KEY args))
    84688468          (let ((arg-count (length args)))
    8469             (cond ((and (= arg-count 2) (eq (%car args) '&REST))
    8470                    (setf *using-arg-array* nil)
    8471                    (setf *hairy-arglist-p* nil)
    8472                    (setf descriptor (get-descriptor (lisp-object-arg-types 1)
    8473                                                     +lisp-object+))
    8474                    (setf (compiland-kind compiland) :internal)
    8475                    (setf super "org/armedbear/lisp/Primitive0R")
    8476                    (setf args (cdr args))
    8477                    (setf execute-method-name "_execute")
    8478                    (setf execute-method (make-method :name execute-method-name
    8479                                                      :descriptor descriptor)))
    8480                   ((and (= arg-count 3) (eq (%cadr args) '&REST))
    8481                    (setf *using-arg-array* nil)
    8482                    (setf *hairy-arglist-p* nil)
    8483                    (setf descriptor (get-descriptor (lisp-object-arg-types 2)
    8484                                                     +lisp-object+))
    8485                    (setf (compiland-kind compiland) :internal)
    8486                    (setf super "org/armedbear/lisp/Primitive1R")
    8487                    (setf args (list (first args) (third args)))
    8488                    (setf execute-method-name "_execute")
    8489                    (setf execute-method (make-method :name execute-method-name
    8490                                                      :descriptor descriptor)))
    8491                   ((and (= arg-count 4) (eq (%caddr args) '&REST))
    8492                    (setf *using-arg-array* nil)
    8493                    (setf *hairy-arglist-p* nil)
    8494                    (setf descriptor (get-descriptor (list +lisp-object+ +lisp-object+ +lisp-object+)
    8495                                                     +lisp-object+))
    8496                    (setf (compiland-kind compiland) :internal)
    8497                    (setf super "org/armedbear/lisp/Primitive2R")
    8498                    (setf args (list (first args) (second args) (fourth args)))
    8499                    (setf execute-method-name "_execute")
    8500                    (setf execute-method (make-method :name execute-method-name
    8501                                                      :descriptor descriptor)))
    8502                   )))))
     8469      (when
     8470    (cond ((and (= arg-count 2) (eq (%car args) '&REST))
     8471           (setf descriptor (get-descriptor
     8472           (lisp-object-arg-types 1)
     8473           +lisp-object+)
     8474           super "org/armedbear/lisp/Primitive0R"
     8475           args (cdr args)))
     8476          ((and (= arg-count 3) (eq (%cadr args) '&REST))
     8477           (setf descriptor (get-descriptor
     8478           (lisp-object-arg-types 2)
     8479           +lisp-object+)
     8480           super "org/armedbear/lisp/Primitive1R"
     8481           args (list (first args) (third args))))
     8482          ((and (= arg-count 4) (eq (%caddr args) '&REST))
     8483           (setf descriptor (get-descriptor
     8484           (list +lisp-object+
     8485                 +lisp-object+ +lisp-object+)
     8486           +lisp-object+)
     8487           super "org/armedbear/lisp/Primitive2R"
     8488           args (list (first args)
     8489          (second args) (fourth args)))))
     8490        (setf *using-arg-array* nil
     8491        *hairy-arglist-p* nil
     8492        (compiland-kind compiland) :internal
     8493        execute-method-name "_execute"
     8494        execute-method (make-method
     8495            :name execute-method-name
     8496            :descriptor descriptor)))))))
    85038497
    85048498    (dolist (var (compiland-arg-vars compiland))
Note: See TracChangeset for help on using the changeset viewer.