Changeset 14890

Jul 19, 2011, 3:19:39 AM (9 years ago)

Add NX2-RECONSTRUCT-CASE: if an IF form appears to be the expansion of
{E|C}CASE where the values are all FIXNUMs, return information that the
backend may use (e.g., to create a jump table or otherwise reduce the
number of comparisons.)

1 edited


  • trunk/source/compiler/nx2.lisp

    r14780 r14890  
    754754           t))))
     756(defun nx2-is-comparison-of-var-to-fixnums (form)
     757  ;; Catches some cases.  May miss some.
     758  (flet ((is-simple-comparison-of-var-to-fixnum (form)
     759           (let* ((var nil)
     760                  (fixval nil))
     761             (setq form (acode-unwrapped-form form))
     762             (when (acode-p form)
     763               (let* ((op (acode-operator form)))
     764                 (cond ((eql op (%nx1-operator eq))
     765                        (destructuring-bind (cc x y) (cdr form)
     766                          (when (eq :eq (acode-immediate-operand cc))
     767                            (if (setq var (nx2-lexical-reference-p x))
     768                              (setq fixval (acode-fixnum-form-p y))
     769                              (if (setq var (nx2-lexical-reference-p y))
     770                                (setq fixval (acode-fixnum-form-p x)))))))
     771                       ((eql op (%nx1-operator %izerop))
     772                        (destructuring-bind (cc val) (cdr form)
     773                          (when (eq :eq (acode-immediate-operand cc))
     774                            (setq var (nx2-lexical-reference-p val)
     775                                  fixval 0)))))))
     776             (if (and var fixval)
     777               (values var fixval)
     778               (values nil nil)))))
     779    (setq form (acode-unwrapped-form form))
     780    (multiple-value-bind (var val) (is-simple-comparison-of-var-to-fixnum form)
     781      (if var
     782        (values var (list val))
     783        (if (and (acode-p form) (eql (acode-operator form) (%nx1-operator or)))
     784          (collect ((vals))
     785            (if (multiple-value-setq (var val) (is-simple-comparison-of-var-to-fixnum (cadr form)))
     786              (progn
     787                (vals val)
     788                (dolist (clause (cddr form) (values var (vals)))
     789                  (multiple-value-bind (var1 val1)
     790                      (is-simple-comparison-of-var-to-fixnum clause)
     791                    (unless (eq var var1)
     792                      (return (values nil nil)))
     793                    (vals val1))))
     794              (values nil nil))))))))
     802;;; If an IF form (in acode) appears to be the expansion of a
     803;;; CASE/ECASE/CCASE where all values are fixnums, try to recover
     804;;; that information and let the backend decide what to do with it.
     805;;; (A backend might plausibly replace a sequence of comparisons with
     806;;; a jumptable.)
     807;;; Returns 4 values: a list of lists of fixnums, the corresponding true
     808;;; forms for each sublist, the variable being tested, and the "otherwise"
     809;;; or default form.
     810;;; Something like (IF (EQL X 1) (FOO) (BAR)) will return non-nil values.
     811;;; The backend -could- generate a jump table in that case, but probably
     812;;; wouldn't want to.
     813(defun nx2-reconstruct-case (test true false)
     814  (multiple-value-bind (var vals) (nx2-is-comparison-of-var-to-fixnums test)
     815    (if (not var)
     816      (values nil nil nil nil)
     817      (collect ((ranges)
     818                (trueforms))
     819        (let* ((otherwise nil))
     820          (ranges vals)
     821          (trueforms true)
     822          (labels ((descend (original)
     823                     (let* ((form (acode-unwrapped-form original)))
     824                       (if (or (not (acode-p form))
     825                               (not (eql (acode-operator form)
     826                                         (%nx1-operator if))))
     827                         (setq otherwise original)
     828                         (destructuring-bind (test true false) (cdr form)
     829                           (multiple-value-bind (v vals)
     830                               (nx2-is-comparison-of-var-to-fixnums test)
     831                             (cond ((eq v var)
     832                                    (ranges vals)
     833                                    (trueforms true)
     834                                    (descend false))
     835                                   (t (setq otherwise original)))))))))
     836            (descend false))
     837          (values (ranges) (trueforms) var otherwise))))))
Note: See TracChangeset for help on using the changeset viewer.