mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

fix some cache consistency issues with goops and extended generics

Browse source 
* module/oop/goops.scm (extended-by!, not-extended-by!)
  (upgrade-accessor, merge-generics): Invalidate the method cache after
  munging "extends" or "methods" fields.
  (invalidate-method-cache!): A new wrapper around
  %invalidate-method-cache!, that will also invalidate the caches of
  "extended-by" generics.
  (internal-add-method!, remove-class-accessors!): Use the new
  invalidate-method-cache!.
This commit is contained in:
Andy Wingo 2011-09-02 13:17:19 +02:00
parent cd4171d012
commit eddd81f465
1 changed files with 22 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

30
module/oop/goops.scm
View file

@ -366,13 +366,15 @@
(for-each (lambda (gf)
(slot-set! gf 'extended-by
(cons eg (slot-ref gf 'extended-by))))
gfs))
gfs)
(invalidate-method-cache! eg))
(define (not-extended-by! gfs eg)
(for-each (lambda (gf)
(slot-set! gf 'extended-by
(delq! eg (slot-ref gf 'extended-by))))
gfs))
gfs)
(invalidate-method-cache! eg))
(define* (ensure-generic old-definition #:optional name)
(cond ((is-a? old-definition <generic>) old-definition)
@ -441,6 +443,7 @@
(slot-set! method 'generic-function gws))
methods)
(slot-set! gws 'methods methods)
(invalidate-method-cache! gws)
gws))
;;;
@ -605,15 +608,25 @@
methods)
(loop (cdr l)))))))
(define (method-n-specializers m)
(length* (slot-ref m 'specializers)))
(define (calculate-n-specialized gf)
(fold (lambda (m n) (max n (method-n-specializers m)))
0
(generic-function-methods gf)))
(define (invalidate-method-cache! gf)
(%invalidate-method-cache! gf)
(slot-set! gf 'n-specialized (calculate-n-specialized gf))
(for-each (lambda (gf) (invalidate-method-cache! gf))
(slot-ref gf 'extended-by)))
(define internal-add-method!
(method ((gf <generic>) (m <method>))
(slot-set! m 'generic-function gf)
(slot-set! gf 'methods (compute-new-list-of-methods gf m))
(let ((specializers (slot-ref m 'specializers)))
(slot-set! gf 'n-specialized
(max (length* specializers)
(slot-ref gf 'n-specialized))))
(%invalidate-method-cache! gf)
(invalidate-method-cache! gf)
(add-method-in-classes! m)
*unspecified*))
@ -839,6 +852,7 @@
(slot-set! val2
'extended-by
(cons gf (delq! gf (slot-ref val2 'extended-by))))
(invalidate-method-cache! gf)
var)))
(module-define! duplicate-handlers 'merge-generics merge-generics)
@ -1022,7 +1036,7 @@
;; remove the method from its GF
(slot-set! gf 'methods
(delq1! m (slot-ref gf 'methods)))
(%invalidate-method-cache! gf)
(invalidate-method-cache! gf)
;; remove the method from its specializers
(remove-method-in-classes! m))))
(class-direct-methods c)))