* objects.c: rename usage of HAVE_ARRAYS to SCM_HAVE_ARRAYS.

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

diff --git a/libguile/objects.c b/libguile/objects.c
index 07a46e7..5628638 100644 (file)
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1999,2000,2001, 2003 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -39,8 +39,6 @@
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 \f
 
@@ -122,7 +120,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
          return scm_class_symbol;
        case scm_tc7_vector:
        case scm_tc7_wvect:
-#ifdef HAVE_ARRAYS
+#ifdef SCM_HAVE_ARRAYS
        case scm_tc7_bvect:
        case scm_tc7_byvect:
        case scm_tc7_svect:
@@ -134,7 +132,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 #endif
          return scm_class_vector;
        case scm_tc7_string:
-       case scm_tc7_substring:
          return scm_class_string;
        case scm_tc7_asubr:
        case scm_tc7_subr_0:
@@ -170,8 +167,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
                                    ? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x)
                                    : SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x))
                                 : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
-       case scm_tcs_cons_gloc:
-         /* must be a struct */
+       case scm_tcs_struct:
          if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)
            return SCM_CLASS_OF (x);
          else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
@@ -194,7 +190,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
                  SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
                  SCM class = scm_make_extended_class (!SCM_FALSEP (name)
                                                       ? SCM_SYMBOL_CHARS (name)
-                                                      : 0);
+                                                      : 0,
+                                                      SCM_I_OPERATORP (x));
                  SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
                  return class;
                }
@@ -206,7 +203,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
            return scm_class_unknown;
        }
 
-    case scm_tc3_cons_gloc:
+    case scm_tc3_struct:
     case scm_tc3_tc7_1:
     case scm_tc3_tc7_2:
     case scm_tc3_closure:
@@ -344,19 +341,19 @@ scm_call_generic_0 (SCM gf)
 SCM
 scm_call_generic_1 (SCM gf, SCM a1)
 {
-  return scm_apply_generic (gf, SCM_LIST1 (a1));
+  return scm_apply_generic (gf, scm_list_1 (a1));
 }
 
 SCM
 scm_call_generic_2 (SCM gf, SCM a1, SCM a2)
 {
-  return scm_apply_generic (gf, SCM_LIST2 (a1, a2));
+  return scm_apply_generic (gf, scm_list_2 (a1, a2));
 }
 
 SCM
 scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
 {
-  return scm_apply_generic (gf, SCM_LIST3 (a1, a2, a3));
+  return scm_apply_generic (gf, scm_list_3 (a1, a2, a3));
 }
 
 SCM_DEFINE (scm_entity_p, "entity?", 1, 0, 0, 
@@ -460,7 +457,7 @@ scm_i_make_class_object (SCM meta,
   SCM layout = scm_make_struct_layout (layout_string);
   c = scm_make_struct (meta,
                       SCM_INUM0,
-                      SCM_LIST4 (layout, SCM_BOOL_F, SCM_EOL, SCM_EOL));
+                      scm_list_4 (layout, SCM_BOOL_F, SCM_EOL, SCM_EOL));
   SCM_SET_CLASS_FLAGS (c, flags);
   return c;
 }
@@ -472,8 +469,8 @@ SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0,
 #define FUNC_NAME s_scm_make_class_object
 {
   unsigned long flags = 0;
-  SCM_VALIDATE_STRUCT (1,metaclass);
-  SCM_VALIDATE_STRING (2,layout);
+  SCM_VALIDATE_STRUCT (1, metaclass);
+  SCM_VALIDATE_STRING (2, layout);
   if (SCM_EQ_P (metaclass, scm_metaclass_operator))
     flags = SCM_CLASSF_OPERATOR;
   return scm_i_make_class_object (metaclass, layout, flags);
@@ -487,13 +484,13 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
 #define FUNC_NAME s_scm_make_subclass_object
 {
   SCM pl;
-  SCM_VALIDATE_STRUCT (1,class);
-  SCM_VALIDATE_STRING (2,layout);
+  SCM_VALIDATE_STRUCT (1, class);
+  SCM_VALIDATE_STRING (2, layout);
   pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
   /* Convert symbol->string */
   pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl));
   return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
-                                 scm_string_append (SCM_LIST2 (pl, layout)),
+                                 scm_string_append (scm_list_2 (pl, layout)),
                                  SCM_CLASS_FLAGS (class));
 }
 #undef FUNC_NAME
@@ -503,16 +500,16 @@ scm_init_objects ()
 {
   SCM ms = scm_makfrom0str (SCM_METACLASS_STANDARD_LAYOUT);
   SCM mt = scm_make_vtable_vtable (ms, SCM_INUM0,
-                                  SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
+                                  scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
   
   SCM os = scm_makfrom0str (SCM_METACLASS_OPERATOR_LAYOUT);
   SCM ot = scm_make_vtable_vtable (os, SCM_INUM0,
-                                  SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
+                                  scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
   
   SCM es = scm_makfrom0str (SCM_ENTITY_LAYOUT);
   SCM el = scm_make_struct_layout (es);
   SCM et = scm_make_struct (mt, SCM_INUM0,
-                           SCM_LIST4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL));
+                           scm_list_4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL));
 
   scm_c_define ("<class>", mt);
   scm_metaclass_standard = mt;
@@ -522,9 +519,7 @@ scm_init_objects ()
   SCM_SET_CLASS_DESTRUCTOR (et, scm_struct_free_entity);
   scm_c_define ("<entity>", et);
 
-#ifndef SCM_MAGIC_SNARFER
 #include "libguile/objects.x"
-#endif
 }
 
 /*