defconst, defvar: proclaim special at compile-time

[bpt/guile.git] / libguile / goops.c

diff --git a/libguile/goops.c b/libguile/goops.c
index 42b7a1b..1f7ec90 100644 (file)
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -55,9 +55,6 @@
 #define SCM_OUT_PCLASS_INDEX      SCM_I_MAX_PORT_TYPE_COUNT
 #define SCM_INOUT_PCLASS_INDEX    (2 * SCM_I_MAX_PORT_TYPE_COUNT)
 
-#define SCM_GOOPS_UNBOUND SCM_UNBOUND
-#define SCM_GOOPS_UNBOUNDP(x) (scm_is_eq (x, SCM_GOOPS_UNBOUND))
-
 /* Objects have identity, so references to classes and instances are by
    value, not by reference.  Redefinition of a class or modification of
    an instance causes in-place update; you can think of GOOPS as
@@ -91,11 +88,6 @@ static SCM var_method_generic_function = SCM_BOOL_F;
 static SCM var_method_specializers = SCM_BOOL_F;
 static SCM var_method_procedure = SCM_BOOL_F;
 
-static SCM var_slot_ref_using_class = SCM_BOOL_F;
-static SCM var_slot_set_using_class_x = SCM_BOOL_F;
-static SCM var_slot_bound_using_class_p = SCM_BOOL_F;
-static SCM var_slot_exists_using_class_p = SCM_BOOL_F;
-
 static SCM var_slot_ref = SCM_BOOL_F;
 static SCM var_slot_set_x = SCM_BOOL_F;
 static SCM var_slot_bound_p = SCM_BOOL_F;
@@ -136,6 +128,7 @@ static SCM class_hashtable;
 static SCM class_fluid;
 static SCM class_dynamic_state;
 static SCM class_frame;
+static SCM class_keyword;
 static SCM class_vm_cont;
 static SCM class_bytevector;
 static SCM class_uvec;
@@ -154,11 +147,9 @@ SCM scm_i_smob_class[SCM_I_MAX_SMOB_TYPE_COUNT];
 
 SCM scm_module_goops;
 
-static SCM scm_make_unbound (void);
-static SCM scm_unbound_p (SCM obj);
 static SCM scm_sys_make_vtable_vtable (SCM layout);
 static SCM scm_sys_init_layout_x (SCM class, SCM layout);
-static SCM scm_sys_clear_fields_x (SCM obj);
+static SCM scm_sys_clear_fields_x (SCM obj, SCM unbound);
 static SCM scm_sys_goops_early_init (void);
 static SCM scm_sys_goops_loaded (void);
 
@@ -433,55 +424,6 @@ scm_method_procedure (SCM obj)
 
 \f
 
-SCM_DEFINE (scm_make_unbound, "make-unbound", 0, 0, 0,
-           (),
-           "Return the unbound value.")
-#define FUNC_NAME s_scm_make_unbound
-{
-  return SCM_GOOPS_UNBOUND;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_unbound_p, "unbound?", 1, 0, 0,
-           (SCM obj),
-           "Return @code{#t} if @var{obj} is unbound.")
-#define FUNC_NAME s_scm_unbound_p
-{
-  return SCM_GOOPS_UNBOUNDP (obj) ? SCM_BOOL_T : SCM_BOOL_F;
-}
-#undef FUNC_NAME
-
-
-\f
-
-SCM
-scm_slot_ref_using_class (SCM class, SCM obj, SCM slot_name)
-{
-  return scm_call_3 (scm_variable_ref (var_slot_ref_using_class),
-                     class, obj, slot_name);
-}
-
-SCM
-scm_slot_set_using_class_x (SCM class, SCM obj, SCM slot_name, SCM value)
-{
-  return scm_call_4 (scm_variable_ref (var_slot_set_using_class_x),
-                     class, obj, slot_name, value);
-}
-
-SCM
-scm_slot_bound_using_class_p (SCM class, SCM obj, SCM slot_name)
-{
-  return scm_call_3 (scm_variable_ref (var_slot_bound_using_class_p),
-                     class, obj, slot_name);
-}
-
-SCM
-scm_slot_exists_using_class_p (SCM class, SCM obj, SCM slot_name)
-{
-  return scm_call_3 (scm_variable_ref (var_slot_exists_using_class_p),
-                     class, obj, slot_name);
-}
-
 SCM
 scm_slot_ref (SCM obj, SCM slot_name)
 {
@@ -509,8 +451,8 @@ scm_slot_exists_p (SCM obj, SCM slot_name)
 
 \f
 
-SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 1, 0, 0,
-           (SCM obj),
+SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 2, 0, 0,
+           (SCM obj, SCM unbound),
             "")
 #define FUNC_NAME s_scm_sys_clear_fields_x
 {
@@ -526,7 +468,7 @@ SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 1, 0, 0,
   /* Set all SCM-holding slots to the GOOPS unbound value.  */
   for (i = 0; i < n; i++)
     if (scm_i_symbol_ref (layout, i*2) == 'p')
-      SCM_STRUCT_SLOT_SET (obj, i, SCM_GOOPS_UNBOUND);
+      SCM_STRUCT_SLOT_SET (obj, i, unbound);
 
   return SCM_UNSPECIFIED;
 }
@@ -977,11 +919,6 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
   /* For SCM_SUBCLASSP.  */
   var_class_precedence_list = scm_c_lookup ("class-precedence-list");
 
-  var_slot_ref_using_class = scm_c_lookup ("slot-ref-using-class");
-  var_slot_set_using_class_x = scm_c_lookup ("slot-set-using-class!");
-  var_slot_bound_using_class_p = scm_c_lookup ("slot-bound-using-class?");
-  var_slot_exists_using_class_p = scm_c_lookup ("slot-exists-using-class?");
-
   var_slot_ref = scm_c_lookup ("slot-ref");
   var_slot_set_x = scm_c_lookup ("slot-set!");
   var_slot_bound_p = scm_c_lookup ("slot-bound?");
@@ -1037,6 +974,7 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
   class_fluid = scm_variable_ref (scm_c_lookup ("<fluid>"));
   class_dynamic_state = scm_variable_ref (scm_c_lookup ("<dynamic-state>"));
   class_frame = scm_variable_ref (scm_c_lookup ("<frame>"));
+  class_keyword = scm_variable_ref (scm_c_lookup ("<keyword>"));
   class_vm_cont = scm_variable_ref (scm_c_lookup ("<vm-continuation>"));
   class_bytevector = scm_variable_ref (scm_c_lookup ("<bytevector>"));
   class_uvec = scm_variable_ref (scm_c_lookup ("<uvec>"));
@@ -1115,6 +1053,10 @@ scm_init_goops_builtins (void *unused)
                 scm_from_int (SCM_VTABLE_FLAG_GOOPS_CLASS));
   scm_c_define ("vtable-flag-goops-valid",
                 scm_from_int (SCM_VTABLE_FLAG_GOOPS_VALID));
+  scm_c_define ("vtable-flag-goops-slot",
+                scm_from_int (SCM_VTABLE_FLAG_GOOPS_SLOT));
+  scm_c_define ("vtable-flag-goops-static",
+                scm_from_int (SCM_VTABLE_FLAG_GOOPS_STATIC));
 }
 
 void