mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 14:50:19 +02:00
Code Activity

* symbols.c (scm_gensym): Reimplemented. Now only takes one

Browse source 
optional argument which should be a *string*.
(scm_gentemp): Reimplemented and moved from boot-9.scm.
This commit is contained in:
Mikael Djurfeldt 2000-09-12 05:44:00 +00:00
parent 5bcdfa2ea8
commit e1313058e1
1 changed files with 77 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

104
libguile/symbols.c
View file

@ -844,45 +844,95 @@ SCM_DEFINE (scm_builtin_weak_bindings, "builtin-weak-bindings", 0, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
static int gensym_counter; #define MAX_PREFIX_LENGTH 30
static SCM gensym_prefix;
/* :FIXME:OPTIMIZE */ static int gensym_counter;
SCM_DEFINE (scm_gensym, "gensym", 0, 2, 0,
(SCM name, SCM obarray), SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0,
"Create a new, unique symbol in @var{obarray}, using the global symbol\n" (SCM prefix),
"table by default. If @var{name} is specified, it should be used as a\n" "Create a new symbol with name constructed from a prefix and a counter value.\n"
"prefix for the new symbol's name. The default prefix is @code{%%gensym}.") "The string PREFIX can be specified as an optional argument.\n"
"Default prefix is @code{g}. The counter is increased by 1 at each call.\n"
"There is no provision for resetting the counter.")
#define FUNC_NAME s_scm_gensym #define FUNC_NAME s_scm_gensym
{ {
SCM new; char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
if (SCM_UNBNDP (name)) char *name = buf;
name = gensym_prefix; int len;
if (SCM_UNBNDP (prefix))
{
name[0] = 'g';
len = 1;
}
else else
{ {
SCM_VALIDATE_SYMBOL (1, name); SCM_VALIDATE_STRINGORSUBSTR (1, prefix);
name = scm_symbol_to_string (name); len = SCM_ROLENGTH (prefix);
if (len > MAX_PREFIX_LENGTH)
name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
strncpy (name, SCM_ROCHARS (prefix), len);
}
{
int n_digits = scm_iint2str (gensym_counter++, 10, &name[len]);
SCM res = SCM_CAR (scm_intern (name, len + n_digits));
if (name != buf)
scm_must_free (name);
return res;
}
}
#undef FUNC_NAME
static int gentemp_counter;
SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
(SCM prefix, SCM obarray),
"Create a new symbol with a name unique in an obarray.\n"
"The name is constructed from an optional string PREFIX and a counter\n"
"value. The default prefix is @var{t}. The OBARRAY is specified as a\n"
"second optional argument. Default is the system obarray where all\n"
"normal symbols are interned. The counter is increased by 1 at each\n"
"call. There is no provision for resetting the counter.")
#define FUNC_NAME s_scm_gentemp
{
char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
char *name = buf;
int len, n_digits;
if (SCM_UNBNDP (prefix))
{
name[0] = 't';
len = 1;
}
else
{
SCM_VALIDATE_STRINGORSUBSTR (1, prefix);
len = SCM_ROLENGTH (prefix);
if (len > MAX_PREFIX_LENGTH)
name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
strncpy (name, SCM_ROCHARS (prefix), len);
} }
new = name;
if (SCM_UNBNDP (obarray)) if (SCM_UNBNDP (obarray))
{ obarray = scm_symhash;
obarray = SCM_BOOL_F;
goto skip_test;
}
else else
SCM_ASSERT ((SCM_VECTORP (obarray) || SCM_WVECTP (obarray)), SCM_ASSERT ((SCM_VECTORP (obarray) || SCM_WVECTP (obarray)),
obarray, obarray,
SCM_ARG2, SCM_ARG2,
FUNC_NAME); FUNC_NAME);
while (!SCM_FALSEP (scm_string_to_obarray_symbol (obarray, new, SCM_BOOL_T))) do
skip_test: n_digits = scm_iint2str (gentemp_counter++, 10, &name[len]);
new = scm_string_append while (!SCM_FALSEP (scm_intern_obarray_soft (name,
(scm_cons2 (name, len + n_digits,
scm_number_to_string (SCM_MAKINUM (gensym_counter++), obarray,
SCM_UNDEFINED), 1)));
SCM_EOL)); {
return scm_string_to_obarray_symbol (obarray, new, SCM_BOOL_F); SCM vcell = scm_intern_obarray_soft (name,
len + n_digits,
obarray,
0);
if (name != buf)
scm_must_free (name);
return SCM_CAR (vcell);
}
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -890,7 +940,7 @@ void
scm_init_symbols () scm_init_symbols ()
{ {
gensym_counter = 0; gensym_counter = 0;
gensym_prefix = scm_permanent_object (scm_makfrom0str ("%%gensym")); gentemp_counter = 0;
#include "libguile/symbols.x" #include "libguile/symbols.x"
} }