TYPE-DIFFERENCE is lame

Bug #309124 reported by Nikodemus Siivola
2
Affects Status Importance Assigned to Milestone
SBCL
Fix Released
Medium
Nikodemus Siivola

Bug Description

In the following function constraint propagator optimizes nothing:

(defun foo (x)
  (declare (integer x))
  (declare (optimize speed))
  (cond ((typep x 'fixnum)
         "hala")
        ((typep x 'fixnum)
         "buba")
        ((typep x 'bignum)
         "hip")
        (t
         "zuz")))

Tags: types
description: updated
Changed in sbcl:
importance: Undecided → Medium
status: New → Confirmed
Revision history for this message
Nikodemus Siivola (nikodemus) wrote :

This is actually not a constraint propagation issue per se, but a type-system issue.

Our current TYPE-DIFFERENCE is lame. The version below adds just the special case for numeric types, which is enough to allow the compiler to do a better job for this case.

Are there other types than numeric, union, and member types that have interesting differences?

(defun type-difference (x y)
 (if (and (numeric-type-p x) (numeric-type-p y))
    (type-intersection x (type-negation y))
    (let ((x-types (if (union-type-p x) (union-type-types x) (list x)))
          (y-types (if (union-type-p y) (union-type-types y) (list y))))
      (collect ((res))
        (dolist (x-type x-types)
          (if (member-type-p x-type)
              (let ((xset (alloc-xset))
                    (fp-zeroes nil))
                (mapc-member-type-members
                 (lambda (elt)
                   (multiple-value-bind (ok sure) (ctypep elt y)
                     (unless sure
                       (return-from type-difference nil))
                     (unless ok
                       (if (fp-zero-p elt)
                           (pushnew elt fp-zeroes)
                           (add-to-xset elt xset)))))
                 x-type)
                (unless (and (xset-empty-p xset) (not fp-zeroes))
                  (res (make-member-type :xset xset :fp-zeroes fp-zeroes))))
              (dolist (y-type y-types (res x-type))
                (multiple-value-bind (val win) (csubtypep x-type y-type)
                  (unless win (return-from type-difference nil))
                  (when val (return))
                  (when (types-equal-or-intersect x-type y-type)
                    (return-from type-difference nil))))))
        (let ((y-mem (find-if #'member-type-p y-types)))
          (when y-mem
            (dolist (x-type x-types)
              (unless (member-type-p x-type)
                (mapc-member-type-members
                 (lambda (member)
                   (multiple-value-bind (ok sure) (ctypep member x-type)
                     (when (or (not sure) ok)
                       (return-from type-difference nil))))
                 y-mem)))))
        (apply #'type-union (res))))))

tags: added: types
removed: compiler-ir1 constraints
summary: - constraint propagation problem
+ TYPE-DIFFERENCE is lame
Changed in sbcl:
assignee: nobody → Nikodemus Siivola (nikodemus)
Revision history for this message
Nikodemus Siivola (nikodemus) wrote :

In SBCL 1.0.36.14.

Changed in sbcl:
status: Confirmed → Fix Committed
Changed in sbcl:
status: Fix Committed → Fix Released
To post a comment you must log in.
This report contains Public information  
Everyone can see this information.

Other bug subscribers

Remote bug watches

Bug watches keep track of this bug in other bug trackers.