mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

Remove "redefined" class slot

Browse source 
* module/oop/goops.scm (fold-class-slots): Remove "redefined" field from
  class objects.  Redefinable classes are now handled in a layer on top
  of GOOPS core.
This commit is contained in:
Andy Wingo 2017-09-14 09:14:29 +02:00
parent ee5994a517
commit 78d587c5e1
1 changed files with 0 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/oop/goops.scm
View file

@ -191,7 +191,6 @@
(name #:class <protected-hidden-slot>) (name #:class <protected-hidden-slot>)
(nfields #:class <hidden-slot>) (nfields #:class <hidden-slot>)
(%reserved #:class <hidden-slot>) (%reserved #:class <hidden-slot>)
(redefined)
(direct-supers) (direct-supers)
(direct-slots) (direct-slots)
(direct-subclasses) (direct-subclasses)
@ -327,7 +326,6 @@
(struct-set! <class> class-index-direct-methods '()) (struct-set! <class> class-index-direct-methods '())
(struct-set! <class> class-index-cpl '()) (struct-set! <class> class-index-cpl '())
(struct-set! <class> class-index-slots '()) (struct-set! <class> class-index-slots '())
(struct-set! <class> class-index-redefined #f)
<class>))) <class>)))
;;; ;;;
@ -437,7 +435,6 @@ followed by its associated value. If @var{l} does not hold a value for
(struct-set! <slot> class-index-direct-methods '()) (struct-set! <slot> class-index-direct-methods '())
(struct-set! <slot> class-index-cpl (list <slot>)) (struct-set! <slot> class-index-cpl (list <slot>))
(struct-set! <slot> class-index-slots '()) (struct-set! <slot> class-index-slots '())
(struct-set! <slot> class-index-redefined #f)
<slot>))) <slot>)))
;;; Access to slot objects is performance-sensitive for slot-ref, so in ;;; Access to slot objects is performance-sensitive for slot-ref, so in
@ -830,7 +827,6 @@ slots as we go."
(struct-set! z class-index-direct-supers dsupers) (struct-set! z class-index-direct-supers dsupers)
(struct-set! z class-index-direct-subclasses '()) (struct-set! z class-index-direct-subclasses '())
(struct-set! z class-index-direct-methods '()) (struct-set! z class-index-direct-methods '())
(struct-set! z class-index-redefined #f)
(let ((cpl (compute-cpl z))) (let ((cpl (compute-cpl z)))
(struct-set! z class-index-cpl cpl) (struct-set! z class-index-cpl cpl)
(when (memq <slot> cpl) (when (memq <slot> cpl)
@ -1030,13 +1026,6 @@ slots as we go."
"An internal routine to redefine a SMOB class that was added after "An internal routine to redefine a SMOB class that was added after
GOOPS was loaded, and on which scm_set_smob_apply installed an apply GOOPS was loaded, and on which scm_set_smob_apply installed an apply
function." function."
;; Why not use class-redefinition? We would, except that loading the
;; compiler to compile effective methods can happen while GOOPS has
;; only been partially loaded, and loading the compiler might cause
;; SMOB types to be defined that need this facility. Instead we make
;; a very specific hack, not a general solution. Probably the right
;; solution is to avoid using the compiler, but that is another kettle
;; of fish.
(unless (memq <applicable> (class-precedence-list class)) (unless (memq <applicable> (class-precedence-list class))
(unless (null? (class-slots class)) (unless (null? (class-slots class))
(error "SMOB object has slots?")) (error "SMOB object has slots?"))
@ -2695,7 +2684,6 @@ var{initargs}."
(get-keyword #:dsupers initargs '())) (get-keyword #:dsupers initargs '()))
(struct-set! class class-index-direct-subclasses '()) (struct-set! class class-index-direct-subclasses '())
(struct-set! class class-index-direct-methods '()) (struct-set! class class-index-direct-methods '())
(struct-set! class class-index-redefined #f)
(struct-set! class class-index-cpl (compute-cpl class)) (struct-set! class class-index-cpl (compute-cpl class))
(when (get-keyword #:static-slot-allocation? initargs #f) (when (get-keyword #:static-slot-allocation? initargs #f)
(match (filter class-has-statically-allocated-slots? (match (filter class-has-statically-allocated-slots?