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]>
(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>)
pgpK8xn0xheWU.pgp
Description: OpenPGP digital signature