guile-cvs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

guile/guile-core/libguile ChangeLog feature.c g...


From: Dirk Herrmann
Subject: guile/guile-core/libguile ChangeLog feature.c g...
Date: Fri, 08 Dec 2000 09:08:36 -0800

CVSROOT:        /cvs
Module name:    guile
Changes by:     Dirk Herrmann <address@hidden>  00/12/08 09:08:35

Modified files:
        guile-core/libguile: ChangeLog feature.c gh_data.c goops.c 
                             load.c print.c read.c snarf.h stacks.c 
                             struct.c symbols.c throw.c unif.c ramap.c 

Log message:
        * Use scm_mem2symbol or scm_str2symbol to create symbol objects.

CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/ChangeLog.diff?r1=1.1198&r2=1.1199
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/feature.c.diff?r1=1.43&r2=1.44
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/gh_data.c.diff?r1=1.47&r2=1.48
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/goops.c.diff?r1=1.8&r2=1.9
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/load.c.diff?r1=1.48&r2=1.49
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/print.c.diff?r1=1.107&r2=1.108
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/read.c.diff?r1=1.61&r2=1.62
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/snarf.h.diff?r1=1.40&r2=1.41
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/stacks.c.diff?r1=1.51&r2=1.52
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/struct.c.diff?r1=1.66&r2=1.67
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/symbols.c.diff?r1=1.70&r2=1.71
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/throw.c.diff?r1=1.72&r2=1.73
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/unif.c.diff?r1=1.95&r2=1.96
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/ramap.c.diff?r1=1.59&r2=1.60

Patches:
Index: guile/guile-core/libguile/ChangeLog
diff -u guile/guile-core/libguile/ChangeLog:1.1198 
guile/guile-core/libguile/ChangeLog:1.1199
--- guile/guile-core/libguile/ChangeLog:1.1198  Fri Dec  8 08:32:36 2000
+++ guile/guile-core/libguile/ChangeLog Fri Dec  8 09:08:34 2000
@@ -1,5 +1,40 @@
 2000-12-08  Dirk Herrmann  <address@hidden>
 
+       * feature.c (scm_add_feature), gh_data.c (gh_symbol2scm), goops.c
+       (scm_sys_prep_layout_x, scm_make_class, scm_add_slot,
+       scm_init_goops), load.c (init_build_info), print.c
+       (scm_init_print), read.c (scm_lreadr), snarf.h (SCM_SYMBOL,
+       SCM_GLOBAL_SYMBOL), stacks.c (scm_init_stacks), struct.c
+       (scm_make_struct_layout), symbols.c (scm_sysintern0,
+       scm_string_to_symbol, scm_gensym), throw.c
+       (scm_handle_by_message):  Use scm_mem2symbol or scm_str2symbol
+       instead of scm_intern_* to create a symbol object.
+
+       * goops.c (Intern):  Removed.
+
+       (CALL_GF1, CALL_GF2, CALL_GF3, CALL_GF4, build_class_class_slots,
+       create_basic_classes, scm_class_name, scm_class_direct_supers,
+       scm_class_direct_slots, scm_class_direct_subclasses,
+       scm_class_direct_methods, scm_class_precedence_list,
+       scm_class_slots, scm_class_environment,
+       scm_generic_function_methods, scm_method_generic_function,
+       scm_method_specializers, scm_method_procedure,
+       scm_accessor_method_slot_definition, purgatory, scm_make,
+       make_stdcls, create_standard_classes, make_class_from_template,
+       scm_make_class):  Replaced calls to Intern with calls to
+       scm_str2symbol.
+
+       * ramap.c (init_raprocs):  Use scm_symbol_binding instead of
+       scm_intern.
+
+       * symbols.c (scm_sym2vcell):  Add a bogus return to avoid compiler
+       warnings.
+
+       * unif.c (scm_array_prototype):  Fix prototype return value for
+       svects and llvects.
+
+2000-12-08  Dirk Herrmann  <address@hidden>
+
        * symbols.[ch] (scm_mem2symbol, scm_str2symbol):  New functions.
        These shall replace all those calls to scm_intern... which are
        only required to create a scheme symbol from a C string or a field
Index: guile/guile-core/libguile/feature.c
diff -u guile/guile-core/libguile/feature.c:1.43 
guile/guile-core/libguile/feature.c:1.44
--- guile/guile-core/libguile/feature.c:1.43    Fri Nov 17 08:25:03 2000
+++ guile/guile-core/libguile/feature.c Fri Dec  8 09:08:34 2000
@@ -65,7 +65,7 @@
 scm_add_feature (const char *str)
 {
   SCM old = SCM_CDR (features);
-  SCM new = scm_cons (SCM_CAR (scm_intern (str, strlen (str))), old);
+  SCM new = scm_cons (scm_str2symbol (str), old);
   SCM_SETCDR (features, new);
 }
 
Index: guile/guile-core/libguile/gh_data.c
diff -u guile/guile-core/libguile/gh_data.c:1.47 
guile/guile-core/libguile/gh_data.c:1.48
--- guile/guile-core/libguile/gh_data.c:1.47    Wed Dec  6 07:16:59 2000
+++ guile/guile-core/libguile/gh_data.c Fri Dec  8 09:08:34 2000
@@ -129,7 +129,7 @@
 SCM 
 gh_symbol2scm (const char *symbol_str)
 {
-  return SCM_CAR (scm_intern (symbol_str, strlen (symbol_str)));
+  return scm_str2symbol(symbol_str);
 }
 
 SCM
Index: guile/guile-core/libguile/goops.c
diff -u guile/guile-core/libguile/goops.c:1.8 
guile/guile-core/libguile/goops.c:1.9
--- guile/guile-core/libguile/goops.c:1.8       Fri Dec  1 09:57:42 2000
+++ guile/guile-core/libguile/goops.c   Fri Dec  8 09:08:34 2000
@@ -89,20 +89,15 @@
 #define GETVAR(v) (SCM_CDDR (scm_apply (scm_goops_lookup_closure, \
                                        SCM_LIST2 ((v), SCM_BOOL_F), \
                                        SCM_EOL)))
-static SCM
-Intern (const char *s)
-{
-  return SCM_CAR (scm_intern (s, strlen (s)));
-}
 
 /* Fixme: Should use already interned symbols */
-#define CALL_GF1(name,a)       (scm_apply (GETVAR (Intern(name)), \
+#define CALL_GF1(name,a)       (scm_apply (GETVAR (scm_str2symbol (name)), \
                                            SCM_LIST1 (a), SCM_EOL))
-#define CALL_GF2(name,a,b)     (scm_apply (GETVAR (Intern(name)), \
+#define CALL_GF2(name,a,b)     (scm_apply (GETVAR (scm_str2symbol (name)), \
                                            SCM_LIST2 (a, b), SCM_EOL))
-#define CALL_GF3(name,a,b,c)   (scm_apply (GETVAR (Intern(name)), \
+#define CALL_GF3(name,a,b,c)   (scm_apply (GETVAR (scm_str2symbol (name)), \
                                            SCM_LIST3 (a, b, c), SCM_EOL))
-#define CALL_GF4(name,a,b,c,d) (scm_apply (GETVAR (Intern(name)), \
+#define CALL_GF4(name,a,b,c,d) (scm_apply (GETVAR (scm_str2symbol (name)), \
                                            SCM_LIST4 (a, b, c, d), SCM_EOL))
 
 /* Class redefinition protocol:
@@ -548,7 +543,7 @@
       s[i + 1] = a;
       slots = SCM_CDR (slots);
     }
-  SCM_SLOT (class, scm_si_layout) = SCM_CAR (scm_intern (s, n));
+  SCM_SLOT (class, scm_si_layout) = scm_mem2symbol (s, n);
   if (s)
     scm_must_free (s);
   return SCM_UNSPECIFIED;
@@ -685,59 +680,59 @@
 build_class_class_slots ()
 {
   return maplist (
-         scm_cons (SCM_LIST3 (Intern ("layout"),
+         scm_cons (SCM_LIST3 (scm_str2symbol ("layout"),
                              k_class,
                              scm_class_protected_read_only),
-        scm_cons (SCM_LIST3 (Intern ("vcell"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("vcell"),
                              k_class,
                              scm_class_opaque),
-        scm_cons (SCM_LIST3 (Intern ("vtable"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("vtable"),
                              k_class,
                              scm_class_self),
-        scm_cons (Intern ("print"),
-        scm_cons (SCM_LIST3 (Intern ("procedure"),
+        scm_cons (scm_str2symbol ("print"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("procedure"),
                              k_class,
                              scm_class_protected_opaque),
-        scm_cons (SCM_LIST3 (Intern ("setter"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("setter"),
                              k_class,
                              scm_class_protected_opaque),
-        scm_cons (Intern ("redefined"),
-        scm_cons (SCM_LIST3 (Intern ("h0"),
+        scm_cons (scm_str2symbol ("redefined"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("h0"),
                              k_class,
                              scm_class_int),
-        scm_cons (SCM_LIST3 (Intern ("h1"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("h1"),
                              k_class,
                              scm_class_int),
-        scm_cons (SCM_LIST3 (Intern ("h2"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("h2"),
                              k_class,
                              scm_class_int),
-        scm_cons (SCM_LIST3 (Intern ("h3"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("h3"),
                              k_class,
                              scm_class_int),
-        scm_cons (SCM_LIST3 (Intern ("h4"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("h4"),
                              k_class,
                              scm_class_int),
-        scm_cons (SCM_LIST3 (Intern ("h5"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("h5"),
                              k_class,
                              scm_class_int),
-        scm_cons (SCM_LIST3 (Intern ("h6"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("h6"),
                              k_class,
                              scm_class_int),
-        scm_cons (SCM_LIST3 (Intern ("h7"),
+        scm_cons (SCM_LIST3 (scm_str2symbol ("h7"),
                              k_class,
                              scm_class_int),
-        scm_cons (Intern ("name"),
-        scm_cons (Intern ("direct-supers"),
-        scm_cons (Intern ("direct-slots"),
-        scm_cons (Intern ("direct-subclasses"),
-        scm_cons (Intern ("direct-methods"),
-        scm_cons (Intern ("cpl"),
-        scm_cons (Intern ("default-slot-definition-class"),
-        scm_cons (Intern ("slots"),
-        scm_cons (Intern ("getters-n-setters"), /* name-access */
-        scm_cons (Intern ("keyword-access"),
-        scm_cons (Intern ("nfields"),
-        scm_cons (Intern ("environment"),
+        scm_cons (scm_str2symbol ("name"),
+        scm_cons (scm_str2symbol ("direct-supers"),
+        scm_cons (scm_str2symbol ("direct-slots"),
+        scm_cons (scm_str2symbol ("direct-subclasses"),
+        scm_cons (scm_str2symbol ("direct-methods"),
+        scm_cons (scm_str2symbol ("cpl"),
+        scm_cons (scm_str2symbol ("default-slot-definition-class"),
+        scm_cons (scm_str2symbol ("slots"),
+        scm_cons (scm_str2symbol ("getters-n-setters"), /* name-access */
+        scm_cons (scm_str2symbol ("keyword-access"),
+        scm_cons (scm_str2symbol ("nfields"),
+        scm_cons (scm_str2symbol ("environment"),
         SCM_EOL))))))))))))))))))))))))))));
 }
 
@@ -749,7 +744,7 @@
   /**** <scm_class_class> ****/
   SCM cs = scm_makfrom0str (SCM_CLASS_CLASS_LAYOUT
                            + 2 * scm_vtable_offset_user);
-  SCM name = Intern ("<class>");
+  SCM name = scm_str2symbol ("<class>");
   scm_class_class = scm_permanent_object (scm_make_vtable_vtable (cs,
                                                                  SCM_INUM0,
                                                                  SCM_EOL));
@@ -775,7 +770,7 @@
   DEFVAR(name, scm_class_class);
 
   /**** <scm_class_top> ****/
-  name = Intern ("<top>");
+  name = scm_str2symbol ("<top>");
   scm_class_top = scm_permanent_object (scm_basic_make_class (scm_class_class,
                                                    name,
                                                    SCM_EOL,
@@ -784,7 +779,7 @@
   DEFVAR(name, scm_class_top);
   
   /**** <scm_class_object> ****/
-  name  = Intern("<object>");
+  name  = scm_str2symbol ("<object>");
   scm_class_object = scm_permanent_object (scm_basic_make_class 
(scm_class_class,
                                                       name,
                                                       SCM_LIST1 
(scm_class_top),
@@ -823,7 +818,7 @@
 scm_class_name (SCM obj)
 {
   SCM_ASSERT (SCM_NIMP (obj) && CLASSP (obj), obj, SCM_ARG1, s_class_name);
-  return scm_slot_ref (obj, Intern ("name"));
+  return scm_slot_ref (obj, scm_str2symbol ("name"));
 }
 
 SCM_PROC (s_class_direct_supers, "class-direct-supers", 1, 0, 0, 
scm_class_direct_supers);
@@ -832,7 +827,7 @@
 scm_class_direct_supers (SCM obj)
 {
   SCM_ASSERT (SCM_NIMP (obj) && CLASSP (obj), obj, SCM_ARG1, 
s_class_direct_supers);
-  return scm_slot_ref (obj, Intern("direct-supers"));
+  return scm_slot_ref (obj, scm_str2symbol ("direct-supers"));
 }
 
 SCM_PROC (s_class_direct_slots, "class-direct-slots", 1, 0, 0, 
scm_class_direct_slots);
@@ -842,7 +837,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && CLASSP (obj),
              obj, SCM_ARG1, s_class_direct_slots);
-  return scm_slot_ref (obj, Intern ("direct-slots"));
+  return scm_slot_ref (obj, scm_str2symbol ("direct-slots"));
 }
 
 SCM_PROC (s_class_direct_subclasses, "class-direct-subclasses", 1, 0, 0, 
scm_class_direct_subclasses);
@@ -852,7 +847,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && CLASSP (obj),
              obj, SCM_ARG1, s_class_direct_subclasses);
-  return scm_slot_ref(obj, Intern ("direct-subclasses"));
+  return scm_slot_ref(obj, scm_str2symbol ("direct-subclasses"));
 }
 
 SCM_PROC (s_class_direct_methods, "class-direct-methods", 1, 0, 0, 
scm_class_direct_methods);
@@ -862,7 +857,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && CLASSP (obj),
              obj, SCM_ARG1, s_class_direct_methods);
-  return scm_slot_ref (obj, Intern("direct-methods"));
+  return scm_slot_ref (obj, scm_str2symbol ("direct-methods"));
 }
 
 SCM_PROC (s_class_direct_precedence_list, "class-precedence-list", 1, 0, 0, 
scm_class_precedence_list);
@@ -872,7 +867,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && CLASSP (obj),
              obj, SCM_ARG1, s_class_direct_precedence_list);
-  return scm_slot_ref (obj, Intern ("cpl"));
+  return scm_slot_ref (obj, scm_str2symbol ("cpl"));
 }
 
 SCM_PROC (s_class_slots, "class-slots", 1, 0, 0, scm_class_slots);
@@ -882,7 +877,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && CLASSP (obj),
              obj, SCM_ARG1, s_class_slots);
-  return scm_slot_ref (obj, Intern ("slots"));
+  return scm_slot_ref (obj, scm_str2symbol ("slots"));
 }
 
 SCM_PROC (s_class_environment, "class-environment", 1, 0, 0, 
scm_class_environment);
@@ -892,7 +887,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && CLASSP (obj),
              obj, SCM_ARG1, s_class_environment);
-  return scm_slot_ref(obj, Intern ("environment"));
+  return scm_slot_ref(obj, scm_str2symbol ("environment"));
 }
 
 
@@ -913,7 +908,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && GENERICP (obj),
              obj, SCM_ARG1, s_generic_function_methods);
-  return scm_slot_ref (obj, Intern ("methods"));
+  return scm_slot_ref (obj, scm_str2symbol ("methods"));
 }
 
 
@@ -924,7 +919,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && METHODP (obj),
              obj, SCM_ARG1, s_method_generic_function);
-  return scm_slot_ref (obj, Intern ("generic-function"));
+  return scm_slot_ref (obj, scm_str2symbol ("generic-function"));
 }
 
 SCM_PROC (s_method_specializers, "method-specializers", 1, 0, 0, 
scm_method_specializers);
@@ -934,7 +929,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && METHODP (obj),
              obj, SCM_ARG1, s_method_specializers);
-  return scm_slot_ref (obj, Intern ("specializers"));
+  return scm_slot_ref (obj, scm_str2symbol ("specializers"));
 }
 
 SCM_PROC (s_method_procedure, "method-procedure", 1, 0, 0, 
scm_method_procedure);
@@ -944,7 +939,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && METHODP (obj),
              obj, SCM_ARG1, s_method_procedure);
-  return scm_slot_ref (obj, Intern ("procedure"));
+  return scm_slot_ref (obj, scm_str2symbol ("procedure"));
 }
 
 SCM_PROC (s_accessor_method_slot_definition, 
"accessor-method-slot-definition", 1, 0, 0, 
scm_accessor_method_slot_definition);
@@ -954,7 +949,7 @@
 {
   SCM_ASSERT (SCM_NIMP (obj) && SCM_ACCESSORP (obj),
              obj, SCM_ARG1, s_method_procedure);
-  return scm_slot_ref (obj, Intern ("slot-definition"));
+  return scm_slot_ref (obj, scm_str2symbol ("slot-definition"));
 }  
 
 
@@ -1529,7 +1524,7 @@
 static SCM
 purgatory (void *args)
 {
-  return scm_apply (GETVAR (Intern ("change-class")), (SCM) args, SCM_EOL);
+  return scm_apply (GETVAR (scm_str2symbol ("change-class")), (SCM) args, 
SCM_EOL);
 }
 
 void
@@ -2064,7 +2059,7 @@
            scm_i_get_keyword (k_name,
                               args,
                               len - 1,
-                              Intern ("???"),
+                              scm_str2symbol ("???"),
                               s_make);
          SCM_SLOT (z, scm_si_direct_supers) = 
            scm_i_get_keyword (k_dsupers,
@@ -2142,7 +2137,7 @@
 static void
 make_stdcls (SCM *var, char *name, SCM meta, SCM super, SCM slots)
 {
-   SCM tmp = Intern(name);
+   SCM tmp = scm_str2symbol (name);
    
    *var = scm_permanent_object (scm_basic_make_class (meta,
                                                      tmp,
@@ -2160,26 +2155,26 @@
 create_standard_classes (void)
 {
   SCM slots;
-  SCM method_slots = SCM_LIST4 (Intern ("generic-function"), 
-                               Intern ("specializers"), 
-                               Intern ("procedure"),
-                               Intern ("code-table"));
-  SCM amethod_slots = SCM_LIST1 (SCM_LIST3 (Intern ("slot-definition"),
+  SCM method_slots = SCM_LIST4 (scm_str2symbol ("generic-function"), 
+                               scm_str2symbol ("specializers"), 
+                               scm_str2symbol ("procedure"),
+                               scm_str2symbol ("code-table"));
+  SCM amethod_slots = SCM_LIST1 (SCM_LIST3 (scm_str2symbol ("slot-definition"),
                                            k_init_keyword,
                                            k_slot_definition));
 #ifdef USE_THREADS
-  SCM mutex_slot = SCM_LIST1 (Intern ("make-mutex"));
+  SCM mutex_slot = SCM_LIST1 (scm_str2symbol ("make-mutex"));
 #else
   SCM mutex_slot = SCM_BOOL_F;
 #endif
-  SCM gf_slots = SCM_LIST4 (Intern ("methods"),
-                           SCM_LIST3 (Intern ("n-specialized"),
+  SCM gf_slots = SCM_LIST4 (scm_str2symbol ("methods"),
+                           SCM_LIST3 (scm_str2symbol ("n-specialized"),
                                       k_init_value,
                                       SCM_INUM0),
-                           SCM_LIST3 (Intern ("used-by"),
+                           SCM_LIST3 (scm_str2symbol ("used-by"),
                                       k_init_value,
                                       SCM_BOOL_F),
-                           SCM_LIST3 (Intern ("cache-mutex"),
+                           SCM_LIST3 (scm_str2symbol ("cache-mutex"),
                                       k_init_thunk,
                                       scm_closure (SCM_LIST2 (SCM_EOL,
                                                               mutex_slot),
@@ -2225,10 +2220,10 @@
   
   make_stdcls (&scm_class_foreign_class, "<foreign-class>",
               scm_class_class, scm_class_class,
-              SCM_LIST2 (SCM_LIST3 (Intern ("constructor"),
+              SCM_LIST2 (SCM_LIST3 (scm_str2symbol ("constructor"),
                                     k_class,
                                     scm_class_opaque),
-                         SCM_LIST3 (Intern ("destructor"),
+                         SCM_LIST3 (scm_str2symbol ("destructor"),
                                     k_class,
                                     scm_class_opaque)));
   make_stdcls (&scm_class_foreign_object,  "<foreign-object>",
@@ -2336,7 +2331,7 @@
     {
       char buffer[100];
       sprintf (buffer, template, type_name);
-      name = Intern (buffer);
+      name = scm_str2symbol (buffer);
     }
   else
     name = SCM_GOOPS_UNBOUND;
@@ -2481,7 +2476,7 @@
                size_t (*destructor) (void *))
 {
   SCM name, class;
-  name = Intern (s_name);
+  name = scm_str2symbol (s_name);
   if (SCM_IMP (supers))
     supers = SCM_LIST1 (scm_class_foreign_object);
   class = scm_basic_basic_make_class (meta, name, supers, SCM_EOL);
@@ -2498,7 +2493,7 @@
       SCM_SET_CLASS_INSTANCE_SIZE (class, size);
     }
   
-  SCM_SLOT (class, scm_si_layout) = SCM_CAR (scm_intern ("", 0));
+  SCM_SLOT (class, scm_si_layout) = scm_str2symbol ("");
   SCM_SLOT (class, scm_si_constructor) = (SCM) constructor;
 
   return class;
@@ -2534,8 +2529,8 @@
                                       SCM_LIST3 (set, sym_o, sym_x)),
                            SCM_EOL);
     {
-      SCM name = SCM_CAR (scm_intern0 (slot_name));
-      SCM aname = SCM_CAR (scm_intern0 (accessor_name));
+      SCM name = scm_str2symbol (slot_name);
+      SCM aname = scm_str2symbol (accessor_name);
       SCM gf = scm_ensure_accessor (aname);
       SCM slot = SCM_LIST5 (name,
                            k_class, slot_class,
@@ -2692,7 +2687,7 @@
   create_port_classes ();
 
   {
-    SCM name = SCM_CAR (scm_intern0 ("no-applicable-method"));
+    SCM name = scm_str2symbol ("no-applicable-method");
     scm_no_applicable_method
       = scm_permanent_object (scm_make (SCM_LIST3 (scm_class_generic,
                                                   k_name,
Index: guile/guile-core/libguile/load.c
diff -u guile/guile-core/libguile/load.c:1.48 
guile/guile-core/libguile/load.c:1.49
--- guile/guile-core/libguile/load.c:1.48       Wed Nov 22 03:20:03 2000
+++ guile/guile-core/libguile/load.c    Fri Dec  8 09:08:34 2000
@@ -496,7 +496,7 @@
   unsigned int i;
 
   for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++)
-    *loc = scm_acons (SCM_CAR (scm_intern0 (info[i].name)),
+    *loc = scm_acons (scm_str2symbol (info[i].name),
                      scm_makfrom0str (info[i].value),
                      *loc);
 }
Index: guile/guile-core/libguile/print.c
diff -u guile/guile-core/libguile/print.c:1.107 
guile/guile-core/libguile/print.c:1.108
--- guile/guile-core/libguile/print.c:1.107     Tue Dec  5 06:07:03 2000
+++ guile/guile-core/libguile/print.c   Fri Dec  8 09:08:34 2000
@@ -1138,7 +1138,7 @@
   vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
   layout = scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT));
   type = scm_make_struct (vtable, SCM_INUM0, SCM_LIST1 (layout));
-  scm_set_struct_vtable_name_x (type, SCM_CAR (scm_intern0 ("print-state")));
+  scm_set_struct_vtable_name_x (type, scm_str2symbol ("print-state"));
   print_state_pool = scm_permanent_object (scm_cons (type, SCM_EOL));
 
   scm_print_state_vtable = type;
Index: guile/guile-core/libguile/ramap.c
diff -u guile/guile-core/libguile/ramap.c:1.59 
guile/guile-core/libguile/ramap.c:1.60
--- guile/guile-core/libguile/ramap.c:1.59      Fri Nov 17 08:25:04 2000
+++ guile/guile-core/libguile/ramap.c   Fri Dec  8 09:08:34 2000
@@ -2038,7 +2038,7 @@
 init_raprocs (ra_iproc *subra)
 {
   for (; subra->name; subra++)
-    subra->sproc = SCM_CDR (scm_intern (subra->name, strlen (subra->name)));
+    subra->sproc = scm_symbol_binding (SCM_BOOL_F, scm_str2symbol 
(subra->name));
 }
 
 
Index: guile/guile-core/libguile/read.c
diff -u guile/guile-core/libguile/read.c:1.61 
guile/guile-core/libguile/read.c:1.62
--- guile/guile-core/libguile/read.c:1.61       Fri Nov 17 08:25:04 2000
+++ guile/guile-core/libguile/read.c    Fri Dec  8 09:08:34 2000
@@ -381,8 +381,7 @@
 
        case '{':
          j = scm_read_token (c, tok_buf, port, 1);
-         p = scm_intern (SCM_STRING_CHARS (*tok_buf), j);
-         return SCM_CAR (p);
+         return scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j);
 
        case '\\':
          c = scm_getc (port);
@@ -404,8 +403,8 @@
          /* #:SYMBOL is a syntax for keywords supported in all contexts.  */
        case ':':
          j = scm_read_token ('-', tok_buf, port, 0);
-         p = scm_intern (SCM_STRING_CHARS (*tok_buf), j);
-         return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
+         p = scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j);
+         return scm_make_keyword_from_dash_symbol (p);
 
        default:
        callshrp:
@@ -509,8 +508,8 @@
       if (SCM_EQ_P (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))
        {
          j = scm_read_token ('-', tok_buf, port, 0);
-         p = scm_intern (SCM_STRING_CHARS (*tok_buf), j);
-         return scm_make_keyword_from_dash_symbol (SCM_CAR (p));
+         p = scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j);
+         return scm_make_keyword_from_dash_symbol (p);
        }
       /* fallthrough */
     default:
@@ -518,8 +517,7 @@
       /* fallthrough */
 
     tok:
-      p = scm_intern (SCM_STRING_CHARS (*tok_buf), j);
-      return SCM_CAR (p);
+      return scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j);
     }
 }
 
Index: guile/guile-core/libguile/snarf.h
diff -u guile/guile-core/libguile/snarf.h:1.40 
guile/guile-core/libguile/snarf.h:1.41
--- guile/guile-core/libguile/snarf.h:1.40      Wed Jun 21 01:43:12 2000
+++ guile/guile-core/libguile/snarf.h   Fri Dec  8 09:08:34 2000
@@ -153,11 +153,11 @@
 
 #define SCM_SYMBOL(c_name, scheme_name) \
 SCM_SNARF_HERE(static SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (SCM_CAR (scm_intern0 
(scheme_name))))
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_str2symbol (scheme_name)))
 
 #define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
 SCM_SNARF_HERE(SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (SCM_CAR (scm_intern0 
(scheme_name))))
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_str2symbol (scheme_name)))
 
 #define SCM_KEYWORD(c_name, scheme_name) \
 SCM_SNARF_HERE(static SCM c_name) \
Index: guile/guile-core/libguile/stacks.c
diff -u guile/guile-core/libguile/stacks.c:1.51 
guile/guile-core/libguile/stacks.c:1.52
--- guile/guile-core/libguile/stacks.c:1.51     Sat Nov 25 08:58:25 2000
+++ guile/guile-core/libguile/stacks.c  Fri Dec  8 09:08:34 2000
@@ -741,8 +741,7 @@
     = scm_permanent_object (scm_make_struct (vtable, SCM_INUM0,
                                             scm_cons (stack_layout,
                                                       SCM_EOL)));
-  scm_set_struct_vtable_name_x (scm_stack_type,
-                               SCM_CAR (scm_intern0 ("stack")));
+  scm_set_struct_vtable_name_x (scm_stack_type, scm_str2symbol ("stack"));
 #ifndef SCM_MAGIC_SNARFER
 #include "libguile/stacks.x"
 #endif
Index: guile/guile-core/libguile/struct.c
diff -u guile/guile-core/libguile/struct.c:1.66 
guile/guile-core/libguile/struct.c:1.67
--- guile/guile-core/libguile/struct.c:1.66     Tue Nov 28 08:37:40 2000
+++ guile/guile-core/libguile/struct.c  Fri Dec  8 09:08:34 2000
@@ -138,7 +138,7 @@
          }
 #endif
       }
-    new_sym = SCM_CAR (scm_intern_obarray (field_desc, len, SCM_BOOL_F));
+    new_sym = scm_mem2symbol (field_desc, len);
   }
   return scm_return_first (new_sym, fields);
 }
Index: guile/guile-core/libguile/symbols.c
diff -u guile/guile-core/libguile/symbols.c:1.70 
guile/guile-core/libguile/symbols.c:1.71
--- guile/guile-core/libguile/symbols.c:1.70    Fri Dec  8 08:32:36 2000
+++ guile/guile-core/libguile/symbols.c Fri Dec  8 09:08:34 2000
@@ -125,7 +125,7 @@
       else if (SCM_VARIABLEP (var))
        return SCM_VARVCELL (var);
       else
-       scm_wta (sym, "strangely interned symbol? ", "");
+       return scm_wta (sym, "strangely interned symbol? ", "");
     }
   else
     {
@@ -402,7 +402,7 @@
   if (scm_module_system_booted_p
       && SCM_NIMP (lookup_proc = SCM_TOP_LEVEL_LOOKUP_CLOSURE))
     {
-      SCM sym = SCM_CAR (scm_intern0 (name));
+      SCM sym = scm_str2symbol (name);
       SCM vcell = scm_sym2vcell (sym, lookup_proc, SCM_BOOL_T);
       if (SCM_FALSEP (vcell))
          scm_misc_error ("sysintern0", "can't define variable", sym);
@@ -499,13 +499,8 @@
            "@end format")
 #define FUNC_NAME s_scm_string_to_symbol
 {
-  SCM vcell;
-  SCM answer;
-
-  SCM_VALIDATE_STRING (1,s);
-  vcell = scm_intern (SCM_STRING_CHARS (s), SCM_STRING_LENGTH (s));
-  answer = SCM_CAR (vcell);
-  return answer;
+  SCM_VALIDATE_STRING (1, s);
+  return scm_mem2symbol (SCM_STRING_CHARS (s), SCM_STRING_LENGTH (s));
 }
 #undef FUNC_NAME
 
@@ -846,7 +841,7 @@
     }
   {
     int n_digits = scm_iint2str (gensym_counter++, 10, &name[len]);
-    SCM res = SCM_CAR (scm_intern (name, len + n_digits));
+    SCM res = scm_mem2symbol (name, len + n_digits);
     if (name != buf)
       scm_must_free (name);
     return res;
Index: guile/guile-core/libguile/throw.c
diff -u guile/guile-core/libguile/throw.c:1.72 
guile/guile-core/libguile/throw.c:1.73
--- guile/guile-core/libguile/throw.c:1.72      Fri Nov 17 08:25:04 2000
+++ guile/guile-core/libguile/throw.c   Fri Dec  8 09:08:34 2000
@@ -479,7 +479,7 @@
 SCM
 scm_handle_by_message (void *handler_data, SCM tag, SCM args)
 {
-  if (SCM_NFALSEP (scm_eq_p (tag, SCM_CAR (scm_intern0 ("quit")))))
+  if (SCM_NFALSEP (scm_eq_p (tag, scm_str2symbol ("quit"))))
     {
       exit (scm_exit_status (args));
     }
Index: guile/guile-core/libguile/unif.c
diff -u guile/guile-core/libguile/unif.c:1.95 
guile/guile-core/libguile/unif.c:1.96
--- guile/guile-core/libguile/unif.c:1.95       Thu Nov 23 07:26:24 2000
+++ guile/guile-core/libguile/unif.c    Fri Dec  8 09:08:34 2000
@@ -2523,10 +2523,10 @@
     case scm_tc7_ivect:
       return SCM_MAKINUM (-1L);
     case scm_tc7_svect:
-      return SCM_CDR (scm_intern ("s", 1));
+      return scm_str2symbol ("s");
 #ifdef HAVE_LONG_LONGS
     case scm_tc7_llvect:
-      return SCM_CDR (scm_intern ("l", 1));
+      return scm_str2symbol ("l");
 #endif
     case scm_tc7_fvect:
       return scm_make_real (1.0);



reply via email to

[Prev in Thread] Current Thread [Next in Thread]