GOOPS - metaclass with extra-slots made trying to define a getter, a setter or an accessor will raise an exception

GOOPS - metaclass with extra-slots made trying to define a getter, a setter or an accessor will raise an exception

[David Pirotte]

[-- Attachment #1.1: Type: text/plain, Size: 2113 bytes --]

Hello,

Using a metaclass that defines extra-slots, will only work if the extra-slots are
made 'exclusively' using the expression:

	(make <slot> #:name name)

If one tries to pass a setter, a getter or an accessor, it raises an exception.
Attached a code snipset to reproduce the error: drop it anywhere and load it, then
enter ',bt' to see the backtrace ...

	I pasted the error I get, below my signature, so one can compare
	I am using Guile 2.2.4.1-cdb19

As you can see, the error is triggered by (oop goops) add-method! - called by 
compute-slot-accessors - which complains that the accessor name (or getter or setter
name) is not a valid generic function.

Though I think it should be automatically created if it does not exists, I also
tried to create it - which you may try uncommenting line 20 and 21 of the code
snipset - but that didn't solve the problem.

Thanks,
David


scheme@(guile-user)> (load "/usr/alto/projects/g-golf/foo-acc.scm")
;;; note: source file /usr/alto/projects/g-golf/foo-acc.scm
;;;       newer than compiled /home/david/.cache/guile/ccache/2.2-LE-8-3.A/usr/alto/projects/g-golf/foo-acc.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;       or pass the --no-auto-compile argument to disable.
;;; compiling /usr/alto/projects/g-golf/foo-acc.scm
;;; compiled /home/david/.cache/guile/ccache/2.2-LE-8-3.A/usr/alto/projects/g-golf/foo-acc.scm.go
scm-error!x

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
scheme@(foo-acc) [1]> ,bt
In ice-9/boot-9.scm:
   2316:4  7 (save-module-excursion _)
  3835:12  6 (_)
In /usr/alto/projects/g-golf/foo-acc.scm:
     36:0  5 (_)
In oop/goops.scm:
   3032:4  4 (_ _ . _)
   2925:2  3 (_ #<<foo-class> <foo> 563eb337f360> _)
In srfi/srfi-1.scm:
    640:9  2 (for-each #<procedure 563eb2b3b4c0 at oop/goops.scm:2720:3 (slot)> (#<<slot> x 563eb337f…> …))
In oop/goops.scm:
   2730:9  1 (_ #<<slot> x 563eb337f1b0>)
In unknown file:
           0 (scm-error goops-error #f "~S is not a valid generic function" (!x) ())
scheme@(foo-acc) [1]> 

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: foo-acc.scm --]
[-- Type: text/x-scheme, Size: 981 bytes --]


(define-module (foo-acc)
  #:use-module (oop goops)

  #:export (<foo-class>
            <foo>))


(define %props
  '("x"
    "y"))


(define-class <foo-class> (<class>))

(define (compute-extra-slots props slots)
  (map (lambda (prop)
         (let ((name (string->symbol prop))
               (acc (string->symbol (string-append "!" prop)))
               #;(gen (make <generic> #:name acc)))
           #;(module-define! (current-module) acc gen)
           #;(make <slot> #:name name)
           #;(make <slot> #:name name #:getter name)
           (make <slot> #:name name #:accessor acc)))
    props))

(define-method (compute-slots (class <foo-class>))
  (let* ((slots (next-method))
         (extra (compute-extra-slots %props slots)))
    (slot-set! class 'direct-slots
               (append (slot-ref class 'direct-slots)
                       extra))
    (append slots extra)))


(define-class <foo> ()
  #:metaclass <foo-class>)

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]