/* Symbol printer.
NB: Uninterned symbols are treated as sharable objects (can be written
with #n= syntax). It is handled by upper layer (write.c) so we don't
worry about it in this routine.
*/
static void symbol_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
{
if (Scm_WriteContextMode(ctx) == SCM_WRITE_DISPLAY) {
SCM_PUTS(SCM_SYMBOL_NAME(obj), port);
} else {
#if !GAUCHE_UNIFY_SYMBOL_KEYWORD
if (SCM_KEYWORDP(obj)) {
SCM_PUTC(':', port);
/* We basically print keyword names in the same way as symbols
(i.e. using |-escape if necessary). However, as a convention,
two things are different from the default symbol writer.
(1) We don't check the noninitials; :1 is unambiguously a
keyword, so we don't need to print :|1|.
(2) A keyword with an empty name can be printed just as :,
instead of :||.
These conventions are useful if we pass the S-expression with
these keywords to other Scheme implementations that don't support
CL-style keywords; they would just read those ones as symbols.
*/
Scm_WriteSymbolName(SCM_KEYWORD(obj)->name, port, ctx,
(SCM_SYMBOL_WRITER_NOESCAPE_INITIAL
|SCM_SYMBOL_WRITER_NOESCAPE_EMPTY));
return;
}
#endif /*!GAUCHE_UNIFY_SYMBOL_KEYWORD*/
if (!SCM_SYMBOL_INTERNED(obj)) SCM_PUTZ("#:", -1, port);
Scm_WriteSymbolName(SCM_SYMBOL_NAME(obj), port, ctx, 0);
}
}
/* In unified keyword, we include preceding ':' to the name. */
ScmObj Scm_MakeKeyword(ScmString *name)
{
#if GAUCHE_UNIFY_SYMBOL_KEYWORD
/* We could optimize this later. */
ScmObj prefix = Scm_MakeString(":", 1, 1, SCM_STRING_IMMUTABLE);
ScmObj sname = Scm_StringAppend2(SCM_STRING(prefix), name);
ScmSymbol *s = make_sym(SCM_CLASS_KEYWORD, SCM_STRING(sname), TRUE);
Scm_DefineConst(Scm_KeywordModule(), s, SCM_OBJ(s));
return SCM_OBJ(s);
#else /*!GAUCHE_UNIFY_SYMBOL_KEYWORD*/
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
ScmObj r = Scm_HashTableRef(keywords.table, SCM_OBJ(name), SCM_FALSE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
if (SCM_KEYWORDP(r)) return r;
ScmKeyword *k = SCM_NEW(ScmKeyword);
SCM_SET_CLASS(k, SCM_CLASS_KEYWORD);
k->name = SCM_STRING(Scm_CopyString(name));
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
r = Scm_HashTableSet(keywords.table, SCM_OBJ(name), SCM_OBJ(k),
SCM_DICT_NO_OVERWRITE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
return r;
#endif /*!GAUCHE_UNIFY_SYMBOL_KEYWORD*/
}
/* In unified keyword, we include preceding ':' to the name. */
ScmObj Scm_MakeKeyword(ScmString *name)
{
#if GAUCHE_KEEP_DISJOINT_KEYWORD_OPTION
if (keyword_disjoint_p) {
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
ScmObj r = Scm_HashTableRef(keywords.table, SCM_OBJ(name), SCM_FALSE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
if (SCM_KEYWORDP(r)) return r;
ScmKeyword *k = SCM_NEW(ScmKeyword);
SCM_SET_CLASS(k, SCM_CLASS_KEYWORD);
k->name = SCM_STRING(Scm_CopyString(name));
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
r = Scm_HashTableSet(keywords.table, SCM_OBJ(name), SCM_OBJ(k),
SCM_DICT_NO_OVERWRITE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
return r;
}
#endif /*GAUCHE_KEEP_DISJOINT_KEYWORD_OPTION*/
ScmObj sname = Scm_StringAppend2(&keyword_prefix, name);
ScmSymbol *s = make_sym(SCM_CLASS_KEYWORD, SCM_STRING(sname), TRUE);
Scm_DefineConst(Scm__GaucheKeywordModule(), s, SCM_OBJ(s));
return SCM_OBJ(s);
}
/* Returns a keyword whose name is NAME. Note that preceding ':' is not
* a part of the keyword name.
*/
ScmObj Scm_MakeKeyword(ScmString *name)
{
ScmObj r;
ScmKeyword *k;
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
r = Scm_HashTableRef(keywords.table, SCM_OBJ(name), SCM_FALSE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
if (SCM_KEYWORDP(r)) return r;
k = SCM_NEW(ScmKeyword);
SCM_SET_CLASS(k, SCM_CLASS_KEYWORD);
k->name = SCM_STRING(Scm_CopyString(name));
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
r = Scm_HashTableSet(keywords.table, SCM_OBJ(name), SCM_OBJ(k),
SCM_DICT_NO_OVERWRITE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
return r;
}
