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

slot-ref, slot-set! et al bypass "using-class" variants

Browse source 
* module/oop/goops.scm (slot-ref, slot-set!, slot-bound?, slot-exists?):
  Bypass slot-ref-using-class, slot-set-using-class!, and so on.  Those
  interfaces are public and have to check that the class is indeed a
  class, they should check that the object is an instance of the class,
  and so on, whereas if we get the class via class-of we know that the
  invariant holds.
This commit is contained in:
Andy Wingo 2015-01-16 12:55:48 +01:00
parent 761338f60c
commit f15c0f545b
1 changed files with 20 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

24
module/oop/goops.scm
View file

@ -897,19 +897,35 @@ followed by its associated value. If @var{l} does not hold a value for
(define (slot-ref obj slot-name)
"Return the value from @var{obj}'s slot with the nam var{slot_name}."
(slot-ref-using-class (class-of obj) obj slot-name))
(unless (symbol? slot-name)
(scm-error 'wrong-type-arg #f "Not a symbol: ~S"
(list slot-name) #f))
(let* ((class (class-of obj))
(val (get-slot-value-using-name class obj slot-name)))
(if (unbound? val)
(slot-unbound class obj slot-name)
val)))
(define (slot-set! obj slot-name value)
"Set the slot named @var{slot_name} of @var{obj} to @var{value}."
(slot-set-using-class! (class-of obj) obj slot-name value))
(unless (symbol? slot-name)
(scm-error 'wrong-type-arg #f "Not a symbol: ~S"
(list slot-name) #f))
(set-slot-value-using-name! (class-of obj) obj slot-name value))
(define (slot-bound? obj slot-name)
"Return the value from @var{obj}'s slot with the nam var{slot_name}."
(slot-bound-using-class? (class-of obj) obj slot-name))
(unless (symbol? slot-name)
(scm-error 'wrong-type-arg #f "Not a symbol: ~S"
(list slot-name) #f))
(not (unbound? (get-slot-value-using-name (class-of obj) obj slot-name))))
(define (slot-exists? obj 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))
(unless (symbol? slot-name)
(scm-error 'wrong-type-arg #f "Not a symbol: ~S"
(list slot-name) #f))
(test-slot-existence (class-of obj) obj slot-name))