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:
parent
79c2ca26ae
commit
c6fb41fcbf
1 changed files with 8 additions and 8 deletions
|
@ -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)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue