bug#74073: GOOPS - specialized make method upon user defined class 'does not work'

[David Pirotte]

Hello,

        GOOPS - specialized make method upon user defined class 'does
        not work': those methods are properly defined and added to the
        make (make-instance) generic function, but not eligible as
        applicable methods ...

The bug is so easy to reproduce [1] and i did dig a bit into what i
think the problem is, though i fail to 'relly fix it'.

I would be grateful if those who know GOOPS internals would look at
this bug and help me find a proper fix.

Many thanks,
David

[1]     a reproducible example, an attempt to explain the cause, but
        i failed to find a proper fix

Consider the following short module


;; a (foo) module
(define-module (foo)
  #:use-module (oop goops)

  #:duplicates (merge-generics
                replace
                warn-override-core
                warn
                last)

  #:export (<foo>))


(define-class <foo> ())

(define-method (make (c-lass <foo>) . initargs)
  (let ((callback (get-keyword #:callback initargs #f))
        (data (get-keyword #:data initargs #f)))
    (peek 'make-foo callback data)))
;; enf of (foo)


If you drop this file into your-path, then

  guile
  (add-to-load-path your-path)
  ,use (foo)

  (make <foo> #:callback 'callback #:data 'data)
  => #<<foo> 7f0ac4b2b310>


so as you can see, it didn't called the specialized method, otherwise it
would have peeked ";;; (make-foo callback data", and no instance would
have been created, since we 'bypass' the default make-instance method
(on purpose, g-golf requires such a 'bypass' in some context).

the method is well defined, and part of the make generic-function, as
expected:

  make
  => #<<generic> make-instance (2)>

  (generic-function-methods make)
  => (#<<method> (<foo> . <top>) 7f69f9fa0d80> #<<method> (<class> .
  <top>) 7f69…>)

however, it is (unexpectedly) not part of the applicable methods for
(list <foo> #:callback 'callback #:data 'data) arguments:

  (compute-applicable-methods make (list <foo> #:callback 'callback
  #:data 'data)) => (#<<method> (<class> . <top>) 7f69f9ea6440>)

afaict, this is because compute-applicable-methods, in (oop goops) lines
2007 - 2040, calls (method-applicable? m types), with types bind to (map
calls-of args), and within its core, loops over the types, checking if a
method is applicable by calling

  (memq (car specs) (class-precedence-list (car types)))
  ;; with specs bound to the method specializers

given the above defs, it fails upon the first make (method) argument,
<foo>, because, manually run the above code ourselves, as expected, we
get:

  ;; (car types)
  (class-of <foo>)
  => #<<class> <class> 7f69f9e2c380>

  ;; (memq (car specs) (class-precedence-list (car types)))
  (memq <foo> (class-precedence-list <class>))
  => #f

I am not sure what a proper fix would be, i naively tried this, in the
core of %compute-applicable-methods:

  ;; instead of
  ...
  (let ((n (length args))       ;; by the way n is unused and could be
  removed
         (types (map class-of args)))
    ...)

  ;; this
  (let ((n (length args))
        (types (map (lambda (arg)
                      (if (is-a? arg <class>)
                          arg
                          (class-of arg)))
                 args)))
    ...)

but this fails, more precisely:

(1)  if i patch (oop goops), then

  make
  make install
  guile -q
  =>
  guile: uncaught exception:
  No applicable method for #<<generic> make-instance (1)> in call
  (make-instance Error while printing exception. Cannot exit gracefully
  when init is in progress; aborting. Aborted (core dumped)

(2) i leave (oop goops) 'untouched'

  fire emacs
  geiser-guile
  ,use (oop goops)

  then edit (oop goops) with the above change, C-x e
  uṕon both %compute-applicable-methods and compute-applicable-methods

  ,use (oop goops)
  (add-to-load-path (getcwd))
  ,use (foo)
  (make <foo> #:callback 'callback #:data 'data)
  $5 = #<<foo> 7ff44ed06020>

  (compute-applicable-methods make (list <foo> #:callback 'callback
  #:data 'data)) $6 = (#<<method> (<foo> . <top>) 7ff4583a0d80>)

it doesn't work because applicable methods are being memoized, i don't
know how/where the cache invalidation occurs, _and also_ the
compute-applicable-methods result is also 'wrong', because it should
return both the specialized method, and the default method defined by
oops, in that order -

pgp2mOP0PqLNz.pgp
Description: OpenPGP digital signature