#include "alist.h"
#include "weaks.h"
-#include "scm_validate.h"
+#include "validate.h"
#include "symbols.h"
#ifdef HAVE_STRING_H
SCM sym = SCM_CAR (scm_intern0 (name));
SCM vcell = scm_sym2vcell (sym, lookup_proc, SCM_BOOL_T);
if (vcell == SCM_BOOL_F)
- scm_misc_error ("sysintern", "can't define variable", sym);
+ scm_misc_error ("sysintern0", "can't define variable", sym);
return vcell;
}
else
return SCM_CDR (vcell);
}
-GUILE_PROC(scm_symbol_p, "symbol?", 1, 0, 0,
- (SCM x),
-"")
+SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0,
+ (SCM obj),
+ "Returns @t{#t} if @var{obj} is a symbol, otherwise returns @t{#f}. (r5rs)")
#define FUNC_NAME s_scm_symbol_p
{
- if SCM_IMP(x) return SCM_BOOL_F;
- return SCM_BOOL(SCM_SYMBOLP(x));
+ if SCM_IMP(obj) return SCM_BOOL_F;
+ return SCM_BOOL(SCM_SYMBOLP(obj));
}
#undef FUNC_NAME
-GUILE_PROC(scm_symbol_to_string, "symbol->string", 1, 0, 0,
+SCM_DEFINE (scm_symbol_to_string, "symbol->string", 1, 0, 0,
(SCM s),
-"")
+ "Returns the name of @var{symbol} as a string. If the symbol was part of\n"
+ "an object returned as the value of a literal expression\n"
+ "(section @pxref{Literal expressions}) or by a call to the @samp{read} procedure,\n"
+ "and its name contains alphabetic characters, then the string returned\n"
+ "will contain characters in the implementation's preferred standard\n"
+ "case---some implementations will prefer upper case, others lower case.\n"
+ "If the symbol was returned by @samp{string->symbol}, the case of\n"
+ "characters in the string returned will be the same as the case in the\n"
+ "string that was passed to @samp{string->symbol}. It is an error\n"
+ "to apply mutation procedures like @code{string-set!} to strings returned\n"
+ "by this procedure. (r5rs)\n\n"
+ "The following examples assume that the implementation's standard case is\n"
+ "lower case:\n\n"
+ "@format\n"
+ "@t{(symbol->string 'flying-fish) \n"
+ " ==> \"flying-fish\"\n"
+ "(symbol->string 'Martin) ==> \"martin\"\n"
+ "(symbol->string\n"
+ " (string->symbol "Malvina")) \n"
+ " ==> \"Malvina\"\n"
+ "}\n"
+ "@end format")
#define FUNC_NAME s_scm_symbol_to_string
{
- SCM_VALIDATE_SYMBOL(1,s);
+ SCM_VALIDATE_SYMBOL (1,s);
return scm_makfromstr(SCM_CHARS(s), (scm_sizet)SCM_LENGTH(s), 0);
}
#undef FUNC_NAME
-GUILE_PROC(scm_string_to_symbol, "string->symbol", 1, 0, 0,
+SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0,
(SCM s),
-"")
+ "Returns the symbol whose name is @var{string}. This procedure can\n"
+ "create symbols with names containing special characters or letters in\n"
+ "the non-standard case, but it is usually a bad idea to create such\n"
+ "symbols because in some implementations of Scheme they cannot be read as\n"
+ "themselves. See @samp{symbol->string}.\n\n"
+ "The following examples assume that the implementation's standard case is\n"
+ "lower case:\n\n"
+"@format\n"
+"@t{(eq? 'mISSISSIppi 'mississippi) \n"
+" ==> #t\n"
+"(string->symbol \"mISSISSIppi\") \n"
+" ==>\n"
+" @r{}the symbol with name \"mISSISSIppi\"\n"
+"(eq? 'bitBlt (string->symbol \"bitBlt\")) \n"
+" ==> #f\n"
+"(eq? 'JollyWog\n"
+" (string->symbol\n"
+" (symbol->string 'JollyWog))) \n"
+" ==> #t\n"
+"(string=? \"K. Harper, M.D.\"\n"
+" (symbol->string\n"
+" (string->symbol \"K. Harper, M.D.\"))) \n"
+" ==> #t\n"
+"}\n"
+ "@end format")
#define FUNC_NAME s_scm_string_to_symbol
{
SCM vcell;
SCM answer;
- SCM_VALIDATE_ROSTRING(1,s);
+ SCM_VALIDATE_ROSTRING (1,s);
vcell = scm_intern(SCM_ROCHARS(s), (scm_sizet)SCM_LENGTH(s));
answer = SCM_CAR (vcell);
return answer;
#undef FUNC_NAME
-GUILE_PROC(scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
+SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
(SCM o, SCM s, SCM softp),
-"Intern a new symbol in @var{obarray}, a symbol table, with name
-@var{string}.
-
-If @var{obarray} is @code{#f}, use the default system symbol table. If
-@var{obarray} is @code{#t}, the symbol should not be interned in any
-symbol table; merely return the pair (@var{symbol}
-. @var{#<undefined>}).
-
-The @var{soft?} argument determines whether new symbol table entries
-should be created when the specified symbol is not already present in
-@var{obarray}. If @var{soft?} is specified and is a true value, then
-new entries should not be added for symbols not already present in the
-table; instead, simply return @code{#f}.")
+ "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
+ "@var{string}.\n\n"
+ "If @var{obarray} is @code{#f}, use the default system symbol table. If\n"
+ "@var{obarray} is @code{#t}, the symbol should not be interned in any\n"
+ "symbol table; merely return the pair (@var{symbol}\n"
+ ". @var{#<undefined>}).\n\n"
+ "The @var{soft?} argument determines whether new symbol table entries\n"
+ "should be created when the specified symbol is not already present in\n"
+ "@var{obarray}. If @var{soft?} is specified and is a true value, then\n"
+ "new entries should not be added for symbols not already present in the\n"
+ "table; instead, simply return @code{#f}.")
#define FUNC_NAME s_scm_string_to_obarray_symbol
{
SCM vcell;
SCM answer;
int softness;
- SCM_VALIDATE_ROSTRING(2,s);
+ SCM_VALIDATE_ROSTRING (2,s);
SCM_ASSERT((o == SCM_BOOL_F)
|| (o == SCM_BOOL_T)
|| (SCM_VECTORP(o)),
}
#undef FUNC_NAME
-GUILE_PROC(scm_intern_symbol, "intern-symbol", 2, 0, 0,
+SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0,
(SCM o, SCM s),
-"Add a new symbol to @var{obarray} with name @var{string}, bound to an
-unspecified initial value. The symbol table is not modified if a symbol
-with this name is already present.")
+ "Add a new symbol to @var{obarray} with name @var{string}, bound to an\n"
+ "unspecified initial value. The symbol table is not modified if a symbol\n"
+ "with this name is already present.")
#define FUNC_NAME s_scm_intern_symbol
{
scm_sizet hval;
- SCM_VALIDATE_SYMBOL(2,s);
+ SCM_VALIDATE_SYMBOL (2,s);
if (o == SCM_BOOL_F)
o = scm_symhash;
- SCM_VALIDATE_VECTOR(1,o);
+ SCM_VALIDATE_VECTOR (1,o);
hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s), SCM_LENGTH(o));
/* If the symbol is already interned, simply return. */
SCM_REDEFER_INTS;
}
#undef FUNC_NAME
-GUILE_PROC(scm_unintern_symbol, "unintern-symbol", 2, 0, 0,
+SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0,
(SCM o, SCM s),
-"Remove the symbol with name @var{string} from @var{obarray}. This
-function returns @code{#t} if the symbol was present and @code{#f}
-otherwise.")
+ "Remove the symbol with name @var{string} from @var{obarray}. This\n"
+ "function returns @code{#t} if the symbol was present and @code{#f}\n"
+ "otherwise.")
#define FUNC_NAME s_scm_unintern_symbol
{
scm_sizet hval;
- SCM_VALIDATE_SYMBOL(2,s);
+ SCM_VALIDATE_SYMBOL (2,s);
if (o == SCM_BOOL_F)
o = scm_symhash;
- SCM_VALIDATE_VECTOR(1,o);
+ SCM_VALIDATE_VECTOR (1,o);
hval = scm_strhash (SCM_UCHARS (s), SCM_LENGTH (s), SCM_LENGTH(o));
SCM_DEFER_INTS;
{
}
#undef FUNC_NAME
-GUILE_PROC(scm_symbol_binding, "symbol-binding", 2, 0, 0,
+SCM_DEFINE (scm_symbol_binding, "symbol-binding", 2, 0, 0,
(SCM o, SCM s),
-"Look up in @var{obarray} the symbol whose name is @var{string}, and
-return the value to which it is bound. If @var{obarray} is @code{#f},
-use the global symbol table. If @var{string} is not interned in
-@var{obarray}, an error is signalled.")
+ "Look up in @var{obarray} the symbol whose name is @var{string}, and\n"
+ "return the value to which it is bound. If @var{obarray} is @code{#f},\n"
+ "use the global symbol table. If @var{string} is not interned in\n"
+ "@var{obarray}, an error is signalled.")
#define FUNC_NAME s_scm_symbol_binding
{
SCM vcell;
- SCM_VALIDATE_SYMBOL(2,s);
+ SCM_VALIDATE_SYMBOL (2,s);
if (o == SCM_BOOL_F)
o = scm_symhash;
- SCM_VALIDATE_VECTOR(1,o);
+ SCM_VALIDATE_VECTOR (1,o);
vcell = scm_sym2ovcell (s, o);
return SCM_CDR(vcell);
}
#undef FUNC_NAME
-GUILE_PROC(scm_symbol_interned_p, "symbol-interned?", 2, 0, 0,
+SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 2, 0, 0,
(SCM o, SCM s),
-"Return @var{#t} if @var{obarray} contains a symbol with name
-@var{string}, and @var{#f} otherwise.")
+ "Return @var{#t} if @var{obarray} contains a symbol with name\n"
+ "@var{string}, and @var{#f} otherwise.")
#define FUNC_NAME s_scm_symbol_interned_p
{
SCM vcell;
- SCM_VALIDATE_SYMBOL(2,s);
+ SCM_VALIDATE_SYMBOL (2,s);
if (o == SCM_BOOL_F)
o = scm_symhash;
- SCM_VALIDATE_VECTOR(1,o);
+ SCM_VALIDATE_VECTOR (1,o);
vcell = scm_sym2ovcell_soft (s, o);
if (SCM_IMP(vcell) && (o == scm_symhash))
vcell = scm_sym2ovcell_soft (s, scm_weak_symhash);
#undef FUNC_NAME
-GUILE_PROC(scm_symbol_bound_p, "symbol-bound?", 2, 0, 0,
+SCM_DEFINE (scm_symbol_bound_p, "symbol-bound?", 2, 0, 0,
(SCM o, SCM s),
-"Return @var{#t} if @var{obarray} contains a symbol with name
-@var{string} bound to a defined value. This differs from
-@var{symbol-bound?} in that the mere mention of a symbol usually causes
-it to be interned; @code{symbol-bound?} determines whether a symbol has
-been given any meaningful value.")
+ "Return @var{#t} if @var{obarray} contains a symbol with name\n"
+ "@var{string} bound to a defined value. This differs from\n"
+ "@var{symbol-bound?} in that the mere mention of a symbol usually causes\n"
+ "it to be interned; @code{symbol-bound?} determines whether a symbol has\n"
+ "been given any meaningful value.")
#define FUNC_NAME s_scm_symbol_bound_p
{
SCM vcell;
- SCM_VALIDATE_SYMBOL(2,s);
+ SCM_VALIDATE_SYMBOL (2,s);
if (o == SCM_BOOL_F)
o = scm_symhash;
- SCM_VALIDATE_VECTOR(1,o);
+ SCM_VALIDATE_VECTOR (1,o);
vcell = scm_sym2ovcell_soft (s, o);
return (( SCM_NIMP(vcell)
&& (SCM_CDR(vcell) != SCM_UNDEFINED))
#undef FUNC_NAME
-GUILE_PROC(scm_symbol_set_x, "symbol-set!", 3, 0, 0,
+SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0,
(SCM o, SCM s, SCM v),
-"Find the symbol in @var{obarray} whose name is @var{string}, and rebind
-it to @var{value}. An error is signalled if @var{string} is not present
-in @var{obarray}.")
+ "Find the symbol in @var{obarray} whose name is @var{string}, and rebind\n"
+ "it to @var{value}. An error is signalled if @var{string} is not present\n"
+ "in @var{obarray}.")
#define FUNC_NAME s_scm_symbol_set_x
{
SCM vcell;
- SCM_VALIDATE_SYMBOL(2,s);
+ SCM_VALIDATE_SYMBOL (2,s);
if (o == SCM_BOOL_F)
o = scm_symhash;
- SCM_VALIDATE_VECTOR(1,o);
+ SCM_VALIDATE_VECTOR (1,o);
vcell = scm_sym2ovcell (s, o);
SCM_SETCDR (vcell, v);
return SCM_UNSPECIFIED;
}
-GUILE_PROC(scm_symbol_fref, "symbol-fref", 1, 0, 0,
+SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0,
(SCM s),
-"Return the contents of @var{symbol}'s @dfn{function slot}.")
+ "Return the contents of @var{symbol}'s @dfn{function slot}.")
#define FUNC_NAME s_scm_symbol_fref
{
- SCM_VALIDATE_SYMBOL(1,s);
+ SCM_VALIDATE_SYMBOL (1,s);
SCM_DEFER_INTS;
if (SCM_TYP7(s) == scm_tc7_ssymbol)
msymbolize (s);
#undef FUNC_NAME
-GUILE_PROC(scm_symbol_pref, "symbol-pref", 1, 0, 0,
+SCM_DEFINE (scm_symbol_pref, "symbol-pref", 1, 0, 0,
(SCM s),
-"Return the @dfn{property list} currently associated with @var{symbol}.")
+ "Return the @dfn{property list} currently associated with @var{symbol}.")
#define FUNC_NAME s_scm_symbol_pref
{
- SCM_VALIDATE_SYMBOL(1,s);
+ SCM_VALIDATE_SYMBOL (1,s);
SCM_DEFER_INTS;
if (SCM_TYP7(s) == scm_tc7_ssymbol)
msymbolize (s);
#undef FUNC_NAME
-GUILE_PROC(scm_symbol_fset_x, "symbol-fset!", 2, 0, 0,
+SCM_DEFINE (scm_symbol_fset_x, "symbol-fset!", 2, 0, 0,
(SCM s, SCM val),
-"Change the binding of @var{symbol}'s function slot.")
+ "Change the binding of @var{symbol}'s function slot.")
#define FUNC_NAME s_scm_symbol_fset_x
{
- SCM_VALIDATE_SYMBOL(1,s);
+ SCM_VALIDATE_SYMBOL (1,s);
SCM_DEFER_INTS;
if (SCM_TYP7(s) == scm_tc7_ssymbol)
msymbolize (s);
#undef FUNC_NAME
-GUILE_PROC(scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
+SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
(SCM s, SCM val),
-"Change the binding of @var{symbol}'s property slot.")
+ "Change the binding of @var{symbol}'s property slot.")
#define FUNC_NAME s_scm_symbol_pset_x
{
- SCM_VALIDATE_SYMBOL(1,s);
+ SCM_VALIDATE_SYMBOL (1,s);
SCM_DEFER_INTS;
if (SCM_TYP7(s) == scm_tc7_ssymbol)
msymbolize (s);
#undef FUNC_NAME
-GUILE_PROC(scm_symbol_hash, "symbol-hash", 1, 0, 0,
+SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0,
(SCM s),
-"Return the hash value derived from @var{symbol}'s name, i.e. the integer
-index into @var{symbol}'s obarray at which it is stored.")
+ "Return the hash value derived from @var{symbol}'s name, i.e. the integer\n"
+ "index into @var{symbol}'s obarray at which it is stored.")
#define FUNC_NAME s_scm_symbol_hash
{
- SCM_VALIDATE_SYMBOL(1,s);
+ SCM_VALIDATE_SYMBOL (1,s);
if (SCM_TYP7(s) == scm_tc7_ssymbol)
msymbolize (s);
return SCM_MAKINUM ((unsigned long)s ^ SCM_SYMBOL_HASH (s));
}
-GUILE_PROC(scm_builtin_bindings, "builtin-bindings", 0, 0, 0,
- (),
-"Create and return a copy of the global symbol table, removing all
-unbound symbols.")
+SCM_DEFINE (scm_builtin_bindings, "builtin-bindings", 0, 0, 0,
+ (),
+ "Create and return a copy of the global symbol table, removing all\n"
+ "unbound symbols.")
#define FUNC_NAME s_scm_builtin_bindings
{
int length = SCM_LENGTH (scm_symhash);
#undef FUNC_NAME
-GUILE_PROC(scm_builtin_weak_bindings, "builtin-weak-bindings", 0, 0, 0,
- (),
-"")
+SCM_DEFINE (scm_builtin_weak_bindings, "builtin-weak-bindings", 0, 0, 0,
+ (),
+ "")
#define FUNC_NAME s_scm_builtin_weak_bindings
{
int length = SCM_LENGTH (scm_weak_symhash);
static SCM gensym_prefix;
/* :FIXME:OPTIMIZE */
-GUILE_PROC (scm_gensym, "gensym", 0, 2, 0,
+SCM_DEFINE (scm_gensym, "gensym", 0, 2, 0,
(SCM name, SCM obarray),
-"Create a new, unique symbol in @var{obarray}, using the global symbol
-table by default. If @var{name} is specified, it should be used as a
-prefix for the new symbol's name. The default prefix is @code{%%gensym}.")
+ "Create a new, unique symbol in @var{obarray}, using the global symbol\n"
+ "table by default. If @var{name} is specified, it should be used as a\n"
+ "prefix for the new symbol's name. The default prefix is @code{%%gensym}.")
#define FUNC_NAME s_scm_gensym
{
SCM new;
if (SCM_UNBNDP (name))
name = gensym_prefix;
else
- SCM_VALIDATE_ROSTRING(1,name);
+ SCM_VALIDATE_ROSTRING (1,name);
new = name;
if (SCM_UNBNDP (obarray))
goto skip_test;
}
else
- SCM_ASSERT (SCM_NIMP (obarray)
- && (SCM_VECTORP (obarray) || SCM_WVECTP (obarray)),
+ SCM_ASSERT ((SCM_VECTORP (obarray) || SCM_WVECTP (obarray)),
obarray,
SCM_ARG2,
FUNC_NAME);
HCoop / bpt / guile.git / blobdiff