Re: [Sbcl-devel] A possible type inferencing bug...

[Christophe R. <cs...@ca...>]

Brian Rowe <bri...@gm...> writes:

> I was playing with the code from Luis G. Lopez's recent  "Beautiful
> Patterns" post on c.l.l, and I found what I think is a bug with type
> inferencing. The following bit of code refuses to compile on version
> 0.9.4 and 0.9.5.32 (according to a1k0n on #lisp):
>
> (- y (* (signum x) (sqrt (abs (- (* b x) c)))))
>
> The above throws the following:
>
> 0.0 can't be converted to type NIL.
>    [Condition of type SIMPLE-TYPE-ERROR]

Yeah.  This is fundamentally the same bug as Rick Taube's (earlier
this month) and an earlier bug on this list c. 0.9.3.x.  I
investigated this a little this morning, but I'm sorry, I'm not going
to have time to deal with it properly before the next freeze / release
period.

The immediate cause is in ROUND-NUMERIC-BOUND, which receives a NIL
format and then attempts to coerce to that.  Given that, below is a
band-aid which might make things work superficially, if put in an init
file.  However, the problem lies further back, in that
ROUND-NUMERIC-BOUND should never receive NIL as a format.  The cause
of /that/, which is what needs the proper fix, is that the compiler's
type derivation routines suffer from abstraction violation: they use
MAKE-NUMERIC-TYPE directly, rather than asking the type engine to
parse specifiers: and they haven't been updated for the many changes
in type representation over the last half decade.  So, I think the
right fix is to deal with the type derivation side...

Cheers,

Christophe

(in-package "SB-KERNEL")
(defun round-numeric-bound (x class format up-p)
  (if x
      (let ((cx (if (consp x) (car x) x)))
        (ecase class
          ((nil rational) x)
          (integer
           (if (and (consp x) (integerp cx))
               (if up-p (1+ cx) (1- cx))
               (if up-p (ceiling cx) (floor cx))))
          (float
           (let ((res
                  (cond
                    ((and format (subtypep format 'double-float))
                     (if (<= most-negative-double-float cx most-positive-double-float)
                         (coerce cx format)
                         nil))
                    (t
                     (if (<= most-negative-single-float cx most-positive-single-float)
                         ;; FIXME
                         (coerce cx (or format 'single-float))
                         nil)))))
             (if (consp x) (list res) res)))))
      nil))