/* Implemented in Scheme */
static void write_walk(ScmObj obj, ScmPort *port)
{
static ScmObj proc = SCM_UNDEFINED;
SCM_ASSERT(port->writeState);
ScmHashTable *ht = port->writeState->sharedTable;
SCM_ASSERT(ht != NULL);
SCM_BIND_PROC(proc, "%write-walk-rec", Scm_GaucheInternalModule());
Scm_ApplyRec3(proc, obj, SCM_OBJ(port), SCM_OBJ(ht));
}
ScmObj Scm_ComparatorHashFunction(ScmComparator *cmpr)
{
if (SCM_FALSEP(cmpr->hashFn)) {
static ScmObj p = SCM_UNDEFINED;
SCM_BIND_PROC(p, "comparator-hash-function",
Scm_GaucheModule());
return Scm_ApplyRec1(p, SCM_OBJ(cmpr)); /* this fills hashFn */
} else {
return cmpr->hashFn;
}
}
/* C-level accessors, that take care of on-demand filling of slots. */
ScmObj Scm_ComparatorComparisonProcedure(ScmComparator *cmpr)
{
if (SCM_FALSEP(cmpr->compareFn)) {
static ScmObj p = SCM_UNDEFINED;
SCM_BIND_PROC(p, "comparator-comparison-procedure",
Scm_GaucheModule());
return Scm_ApplyRec1(p, SCM_OBJ(cmpr)); /* this fills compareFn */
} else {
return cmpr->compareFn;
}
}
ScmObj Scm_ComparatorOrderingPredicate(ScmComparator *cmpr)
{
if (SCM_FALSEP(cmpr->orderFn)) {
static ScmObj p = SCM_UNDEFINED;
SCM_BIND_PROC(p, "comparator-ordering-predicate",
Scm_GaucheModule());
return Scm_ApplyRec1(p, SCM_OBJ(cmpr)); /* this fills orderFn */
} else {
return cmpr->orderFn;
}
}
void invoke_other_version(const char *version, int argc, char **argv)
{
static ScmObj invoke_other_version = SCM_UNDEFINED;
SCM_BIND_PROC(invoke_other_version, "%invoke-other-version",
Scm_GaucheInternalModule());
ScmEvalPacket epkt;
Scm_Apply(invoke_other_version,
SCM_LIST2(SCM_MAKE_STR_COPYING(version),
Scm_CStringArrayToList((const char**)argv, argc, 0)),
&epkt);
/* %invoke-other-version won't return. If we're here,
we even failed to call it. */
Scm_Panic("Failed to call %%invoke-other-version. Installation problem?");
}
