undefined-fun warning on with-slots+(setf slot-value) on structures due to lossage in type derivation

[Tobias C. Rittweiler]

If you compile

  (defstruct foo
    slot)

  (defun quux (cont)
    (funcall cont))

  (defun bar (foo-struct)
    (declare (type foo foo-struct))
    (with-slots (slot) foo-struct
      (tagbody
         (quux #'(lambda ()
                   (setf slot :value)
                   (go TAG)))
         TAG)))

you'll get the following undefined-function warning:

  ; file: /tmp/quux.lisp
  ; in: DEFUN BAR
  ; (SETF SLOT :VALUE)
  ; --> SETQ SETF
  ; ==>
  ; (SB-PCL::SET-SLOT-VALUE #:G37 'SLOT :VALUE)
  ;
  ; caught STYLE-WARNING:
  ; undefined function: (SB-PCL::SLOT-ACCESSOR :GLOBAL SLOT SB-PCL::WRITER)

This is same function definition but with the use of WITH-SLOTS
expanded:

  (defun bar2 (foo-struct)
    (declare (type foo foo-struct))
    (LET ((G951 FOO-STRUCT))
      (DECLARE (IGNORABLE G951))
      (DECLARE (SB-PCL::%VARIABLE-REBINDING G951 FOO-STRUCT))
      G951
      (SYMBOL-MACROLET ((SLOT (SLOT-VALUE G951 'SLOT)))
        (TAGBODY
           (QUUX #'(LAMBDA ()
                     (SETF SLOT :VALUE)
                     (GO TAG)))
         TAG))))

The reason for that warning is that SBCL is, for some reason, not able
to derive the type of the G951 gensym in the closure passed to QUUX.

SBCL needs to know that G951 is of a structure type so it can transform
the SLOT-VALUE to the structure's accessor function.

I guess that SBCL gives up on type derivation at some point.

Notice that

  (defun bar3 (foo-struct)
    (declare (type foo foo-struct))
    (SYMBOL-MACROLET ((SLOT (SLOT-VALUE foo-struct 'SLOT)))
      (TAGBODY
         (QUUX #'(LAMBDA ()
                   (SETF SLOT :VALUE)
                   (GO TAG)))
       TAG)))

That is the alpha-converted version of the expansion, does _not_ trigger
the warning.

Ideally some compiler wizard will be able to hack type derivation.

I wonder why the definition of WITH-SLOTS contains this bit:

  ,@(let ((instance (extract-the instance)))
     (and (symbolp instance)
          `((declare (%variable-rebinding ,in ,instance)))))

Which is responsible for that %VARIABLE-REBINDING declaration you see in
BAR2.

Can't WITH-SLOTS simply omit the gensym-binding if the INSTANCE is a
symbol (and not a symbol-macro)?

[Tobias C. Rittweiler (tcr)]

This bug seems not to be reproducible on Linux x86-32, but on x86-64 it is.
SBCL version 1.0.34.7 on both systems.

[Nikodemus Siivola (nikodemus)]

The undefined function warning is a separate issue from the type derivation lossage, being only due to a missing muffling in ACCESSOR-SET-SLOT-VALUE.

The derived type on the other hand: it is not lost, but the transform fires before the type has propagated. Redefining the deftransforms as follows gets the propagated type:

(deftransform slot-value ((object slot-name) (t (constant-arg symbol)) *
                          :node node)
  (let ((c-slot-name (lvar-value slot-name)))
    (if (sb-pcl::interned-symbol-p c-slot-name)
        (let* ((type (lvar-type object))
               (dd (when (structure-classoid-p type)
                     (find-defstruct-description
                      (sb-kernel::structure-classoid-name type))))
               (dsd (when dd
                      (find c-slot-name (dd-slots dd) :key #'dsd-name))))
          (cond (dsd
                 `(,(dsd-accessor-name dsd) object))
                (t
                 (delay-ir1-transform node :constraint)
                 `(sb-pcl::accessor-slot-value object ',c-slot-name))))
        (give-up-ir1-transform "slot name is not an interned symbol"))))

(deftransform sb-pcl::set-slot-value ((object slot-name new-value)
                                      (t (constant-arg symbol) t)
                                      * :node node)
  (let ((c-slot-name (lvar-value slot-name)))
    (if (sb-pcl::interned-symbol-p c-slot-name)
        (let* ((type (lvar-type object))
               (dd (when (structure-classoid-p type)
                     (find-defstruct-description
                      (sb-kernel::structure-classoid-name type))))
               (dsd (when dd
                      (find c-slot-name (dd-slots dd) :key #'dsd-name))))
          (cond (dsd
                 `(setf (,(dsd-accessor-name dsd) object) new-value))
                ((policy node (= safety 3))
                 ;; Safe code wants to check the type, and the global
                 ;; accessor won't do that. Also see the comment in the
                 ;; compiler-macro.
                 (give-up-ir1-transform "cannot use optimized accessor in safe code"))
                (t
                 (delay-ir1-transform node :constraint)
                 `(sb-pcl::accessor-set-slot-value object ',c-slot-name new-value))))
        (give-up-ir1-transform "slot name is not an interned symbol"))))

[Nikodemus Siivola (nikodemus)]

Attached patch waiting till freeze is over.

[Nikodemus Siivola (nikodemus)]

 status fixcommitted

In SBCL 1.0.36.5.