* symbols.h (scm_builtin_bindings, scm_builtin_weak_bindings,

scm_gensym): Added prototypes.

* symbols.c (scm_gensym): New function.  This will speed up
certain types of applications (such as macro systems) which
generate lots of symbols.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 4d18bfe..647f631 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,12 @@
+Tue Sep  2 00:27:07 1997  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
+
+       * symbols.h (scm_builtin_bindings, scm_builtin_weak_bindings,
+       scm_gensym): Added prototypes.
+
+       * symbols.c (scm_gensym): New function.  This will speed up
+       certain types of applications (such as macro systems) which
+       generate lots of symbols.
+
 Mon Sep  1 22:30:33 1997  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
 
        * numbers.c (logand, logior, logxor): Handle 0 or 1 arguments.

diff --git a/libguile/symbols.c b/libguile/symbols.c
index 47cd345..5d10faf 100644 (file)
--- a/libguile/symbols.c
+++ b/libguile/symbols.c
@@ -829,11 +829,49 @@ scm_builtin_weak_bindings ()
   return obarray;
 }
 
+static int gensym_counter;
+static SCM gensym_prefix;
 
+/*fixme* Optimize */
+SCM_PROC (s_gensym, "gensym", 0, 2, 0, scm_gensym);
+
+SCM
+scm_gensym (name, obarray)
+     SCM name;
+     SCM obarray;
+{
+  SCM new;
+  if (SCM_UNBNDP (name))
+    name = gensym_prefix;
+  else
+    SCM_ASSERT (SCM_ROSTRINGP (name), name, SCM_ARG1, s_gensym);
+  new = name;
+  if (SCM_UNBNDP (obarray))
+    {
+      obarray = SCM_BOOL_F;
+      goto skip_test;
+    }
+  else
+    SCM_ASSERT (SCM_NIMP (obarray)
+               && (SCM_VECTORP (obarray) || SCM_WVECTP (obarray)),
+               obarray,
+               SCM_ARG2,
+               s_gensym);
+  while (scm_string_to_obarray_symbol (obarray, new, SCM_BOOL_T)
+        != SCM_BOOL_F)
+    skip_test:
+    new = scm_string_append
+      (scm_cons2 (name,
+                 scm_number_to_string (SCM_MAKINUM (gensym_counter++),
+                                       SCM_UNDEFINED),
+                 SCM_EOL));
+  return scm_string_to_obarray_symbol (obarray, new, SCM_BOOL_F);
+}
 
 void
 scm_init_symbols ()
 {
+  gensym_counter = 0;
+  gensym_prefix = scm_permanent_object (scm_makfrom0str ("%%gensym"));
 #include "symbols.x"
 }
-

diff --git a/libguile/symbols.h b/libguile/symbols.h
index e646c97..c2ced26 100644 (file)
--- a/libguile/symbols.h
+++ b/libguile/symbols.h
@@ -132,6 +132,9 @@ extern SCM scm_symbol_pref SCM_P ((SCM s));
 extern SCM scm_symbol_fset_x SCM_P ((SCM s, SCM val));
 extern SCM scm_symbol_pset_x SCM_P ((SCM s, SCM val));
 extern SCM scm_symbol_hash SCM_P ((SCM s));
+extern SCM scm_builtin_bindings SCM_P ((void));
+extern SCM scm_builtin_weak_bindings SCM_P ((void));
+extern SCM scm_gensym SCM_P ((SCM name, SCM obarray));
 extern void scm_init_symbols SCM_P ((void));
 
 extern int scm_can_use_top_level_lookup_closure_var;