1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00

Minor GOOPS cleanups

* module/oop/goops.scm: Minor commenting fixes.
This commit is contained in:
Andy Wingo 2015-01-19 15:57:23 +01:00
parent 79c2ca26ae
commit c6fb41fcbf

View file

@ -247,9 +247,10 @@
;;; class-index-flags. `vtable-flag-vtable' indicates that instances of ;;; class-index-flags. `vtable-flag-vtable' indicates that instances of
;;; a vtable are themselves vtables, and `vtable-flag-validated' ;;; a vtable are themselves vtables, and `vtable-flag-validated'
;;; indicates that the struct's layout has been validated. goops.c ;;; indicates that the struct's layout has been validated. goops.c
;;; defines a couple of additional flags: one to indicate that a vtable ;;; defines a few additional flags: one to indicate that a vtable is
;;; is actually a class, and one to indicate that the class is "valid", ;;; actually a class, one to indicate that the class is "valid" (meaning
;;; meaning that it hasn't been redefined. ;;; that it hasn't been redefined), and one to indicate that instances
;;; of a class are slot definition objects (<slot> instances).
;;; ;;;
(define vtable-flag-goops-metaclass (define vtable-flag-goops-metaclass
(logior vtable-flag-vtable vtable-flag-goops-class)) (logior vtable-flag-vtable vtable-flag-goops-class))
@ -269,6 +270,10 @@
(define-inlinable (class? obj) (define-inlinable (class? obj)
(class-has-flags? (struct-vtable obj) vtable-flag-goops-metaclass)) (class-has-flags? (struct-vtable obj) vtable-flag-goops-metaclass))
(define-inlinable (slot? obj)
(and (struct? obj)
(class-has-flags? (struct-vtable obj) vtable-flag-goops-slot)))
(define-inlinable (instance? obj) (define-inlinable (instance? obj)
(class-has-flags? (struct-vtable obj) vtable-flag-goops-class)) (class-has-flags? (struct-vtable obj) vtable-flag-goops-class))
@ -377,7 +382,6 @@ subclasses of @var{c}."
;;; more of the protocol. Again, the CPL and class hierarchy slots ;;; more of the protocol. Again, the CPL and class hierarchy slots
;;; remain uninitialized. ;;; remain uninitialized.
;;; ;;;
(define* (get-keyword key l #:optional default) (define* (get-keyword key l #:optional default)
"Determine an associated value for the keyword @var{key} from the list "Determine an associated value for the keyword @var{key} from the list
@var{l}. The list @var{l} has to consist of an even number of elements, @var{l}. The list @var{l} has to consist of an even number of elements,
@ -426,10 +430,6 @@ followed by its associated value. If @var{l} does not hold a value for
(struct-set! <slot> class-index-redefined #f) (struct-set! <slot> class-index-redefined #f)
<slot>))) <slot>)))
(define-inlinable (slot? obj)
(and (struct? obj)
(class-has-flags? (struct-vtable obj) vtable-flag-goops-slot)))
(define-syntax-rule (define-slot-accessor name docstring %name field) (define-syntax-rule (define-slot-accessor name docstring %name field)
(begin (begin
(define-syntax-rule (%name obj) (define-syntax-rule (%name obj)