mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

More GOOPS comments

Browse source 
* module/oop/goops.scm: More expository comments.
This commit is contained in:
Andy Wingo 2015-01-14 00:01:51 +01:00
parent 9ae00706e4
commit b89432ffbf
1 changed files with 34 additions and 31 deletions
Download patch file Download diff file Expand all files Collapse all files

65
module/oop/goops.scm
View file

@ -785,14 +785,16 @@ followed by its associated value. If @var{l} does not hold a value for
;;; ;;;
;;; Slot access. ;;; Slot access. This protocol is a bit of a mess: there's the `slots'
;;; slot, which ostensibly holds "slot definitions" but really just has
;;; specially formatted lists. And then there's the `getters-n-setters'
;;; slot, which mirrors `slots' but should in theory indicates how to
;;; get at slots for a particular instance -- never mind that `slots'
;;; was also computed for a particular instance, and that
;;; `getters-n-setters' is a strangely structured chain of pairs.
;;; Perhaps we can fix this in the future, following the CLOS MOP, to
;;; have proper <effective-slot-definition> objects.
;;; ;;;
;; In the future, this function will return the effective slot
;; definition associated with SLOT_NAME. Now it just returns some of
;; the information which will be stored in the effective slot
;; definition.
;;
(define (get-slot-value-using-name class obj slot-name) (define (get-slot-value-using-name class obj slot-name)
(match (assq slot-name (struct-ref class class-index-getters-n-setters)) (match (assq slot-name (struct-ref class class-index-getters-n-setters))
(#f (slot-missing class obj slot-name)) (#f (slot-missing class obj slot-name))
@ -813,8 +815,6 @@ followed by its associated value. If @var{l} does not hold a value for
(and (assq slot-name (struct-ref class class-index-getters-n-setters)) (and (assq slot-name (struct-ref class class-index-getters-n-setters))
#t)) #t))
;; ========================================
(define (check-slot-args class obj slot-name) (define (check-slot-args class obj slot-name)
(unless (class? class) (unless (class? class)
(scm-error 'wrong-type-arg #f "Not a class: ~S" (scm-error 'wrong-type-arg #f "Not a class: ~S"
@ -845,28 +845,19 @@ followed by its associated value. If @var{l} does not hold a value for
(check-slot-args class obj slot-name) (check-slot-args class obj slot-name)
(test-slot-existence class obj slot-name)) (test-slot-existence class obj slot-name))
;; Class redefinition protocol: ;;;
;; ;;; Before we go on, some notes about class redefinition. In GOOPS,
;; A class is represented by a heap header h1 which points to a ;;; classes can be redefined. Redefinition of a class marks the class
;; malloc:ed memory block m1. ;;; as invalid, and instances will be lazily migrated over to the new
;; ;;; representation as they are accessed. Migration happens when
;; When a new version of a class is created, a new header h2 and ;;; `class-of' is called on an instance. For more technical details on
;; memory block m2 are allocated. The headers h1 and h2 then switch ;;; object redefinition, see struct.h.
;; pointers so that h1 refers to m2 and h2 to m1. In this way, names ;;;
;; bound to h1 will point to the new class at the same time as h2 will ;;; In the following interfaces, class-of handles the redefinition
;; be a handle which the GC will use to free m1. ;;; protocol. I would think though that there is some thread-unsafety
;; ;;; here though as the { class, object data } pair needs to be accessed
;; The `redefined' slot of m1 will be set to point to h1. An old ;;; atomically, not the { class, object } pair.
;; instance will have its class pointer (the CAR of the heap header) ;;;
;; pointing to m1. The non-immediate `redefined'-slot in m1 indicates
;; the class modification and the new class pointer can be found via
;; h1.
;;
;; In the following interfaces, class-of handles the redefinition
;; protocol. There would seem to be some thread-unsafety though as the
;; { class, object data } pair needs to be accessed atomically, not the
;; { class, object } pair.
(define (slot-ref obj slot-name) (define (slot-ref obj slot-name)
"Return the value from @var{obj}'s slot with the nam var{slot_name}." "Return the value from @var{obj}'s slot with the nam var{slot_name}."
@ -884,6 +875,12 @@ followed by its associated value. If @var{l} does not hold a value for
"Return @code{#t} if @var{obj} has a slot named @var{slot_name}." "Return @code{#t} if @var{obj} has a slot named @var{slot_name}."
(slot-exists-using-class? (class-of obj) obj slot-name)) (slot-exists-using-class? (class-of obj) obj slot-name))
;;;
;;; Method accessors.
;;;
(define (method-generic-function obj) (define (method-generic-function obj)
"Return the generic function for the method @var{obj}." "Return the generic function for the method @var{obj}."
(unless (is-a? obj <method>) (unless (is-a? obj <method>)
@ -905,6 +902,12 @@ followed by its associated value. If @var{l} does not hold a value for
(list obj) #f)) (list obj) #f))
(slot-ref obj 'procedure)) (slot-ref obj 'procedure))
;;;
;;; Generic functions!
;;;
(define *dispatch-module* (current-module)) (define *dispatch-module* (current-module))
;;; ;;;