[Guile-commits] 71/87: slot-ref, slot-set! et al bypass "using-class" variants

[Andy Wingo]

wingo pushed a commit to branch wip-goops-refactor
in repository guile.

commit 319c1bf6a61b5304eb878765237e5c2029feaa48
Author: Andy Wingo <address@hidden>
Date:   Fri Jan 16 12:55:48 2015 +0100

    slot-ref, slot-set! et al bypass "using-class" variants
    
    * 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.
---
 module/oop/goops.scm |   24 ++++++++++++++++++++----
 1 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 499e34b..c36789a 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -896,19 +896,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))