static int command_proc(command_context_t* ctx,
Tcl_Interp* interp,
int argc, char** argv){
dfsch_object_t *head;
dfsch_object_t *cur;
dfsch_object_t *res;
int i;
int ret;
head = cur = dfsch_multicons(argc-1);
for(i = 1; i < argc; ++i){
DFSCH_FAST_CAR(cur) = dfsch_make_string_cstr(argv[i]);
cur = DFSCH_FAST_CDR(cur);
}
DFSCH_SCATCH_BEGIN {
res = dfsch_apply(ctx->proc, head);
Tcl_SetResult(interp, dfsch_object_2_string(res, -1, 0),
TCL_VOLATILE);
ret = TCL_OK;
} DFSCH_SCATCH {
ret = TCL_ERROR;
} DFSCH_SCATCH_END;
return ret;
}
static void instance_write(dfsch_object_t*obj, dfsch_writer_state_t* state){
class_t* i = DFSCH_TYPE_OF(obj);
while (DFSCH_INSTANCE_P(i, DFSCH_CLASS_TYPE)){
if (i->write_instance){
dfsch_apply(i->write_instance, dfsch_list(2, obj, state));
return;
}
i = i->standard_type.superclass;
}
dfsch_write_unreadable_with_slots(state, obj);
}
static void call_initialize_instance(dfsch_object_t* obj,
class_t* klass,
dfsch_object_t* args){
class_t* i = klass;
while (DFSCH_INSTANCE_P(i, DFSCH_CLASS_TYPE)){
if (i->initialize_instance){
dfsch_apply(i->initialize_instance, dfsch_cons(obj, args));
return;
}
i = i->standard_type.superclass;
}
default_initialize_instance(obj, klass, args);
}
static dfsch_object_t* compile_funcall(dfsch_object_t* expression,
dfsch_object_t* operator,
dfsch_object_t* args,
dfsch_object_t* env){
if (pure_function_p(operator) && all_constants_p(args)){
dfsch_object_t* res = DFSCH_INVALID_OBJECT;
DFSCH_IGNORE_ERRORS {
res = dfsch_apply(operator, dfsch_eval_list(args, env));
} DFSCH_END_IGNORE_ERRORS;
if (res != DFSCH_INVALID_OBJECT){
return dfsch_make_constant_ast_node(res);
}
}
void dfsch_load(dfsch_object_t* env, char* name,
dfsch_object_t* path_list,
int as_toplevel){
struct stat st;
dfsch_object_t* path;
char *pathpart;
char *fname;
str_list_t* l;
int i;
for (i = 0; i < sizeof(builtin_modules) / sizeof(builtin_module_t); i++){
if (strcmp(builtin_modules[i].name, name) == 0){
builtin_modules[i].register_proc(env);
return;
}
}
if (path_list){
path = path_list;
} else {
path = dfsch_env_get_cstr(env, "*load-path*");
if (path == DFSCH_INVALID_OBJECT){
path = NULL;
}
}
while (DFSCH_PAIR_P(path)){
dfsch_object_t* pp = DFSCH_FAST_CAR(path);
if (!dfsch_string_p(pp)){
if (dfsch_apply(pp, dfsch_list(2,
env,
dfsch_make_string_cstr(name)))){
return;
}
path = DFSCH_FAST_CDR(path);
continue;
}
l = sl_create();
sl_append(l, dfsch_string_to_cstr(DFSCH_FAST_CAR(path)));
sl_append(l, "/");
sl_append(l, name);
pathpart = sl_value(l);
if (stat(pathpart, &st) == 0){
if (S_ISREG(st.st_mode) || S_ISLNK(st.st_mode)){
for (i = 0; i < sizeof(loaders) / sizeof(module_loader_t); i++){
if (strcmp(pathpart + strlen(pathpart) - strlen(loaders[i].path_ext),
loaders[i].path_ext) == 0){
loaders[i].load(pathpart, env, as_toplevel);
return;
}
}
dfsch_load_scm(env, pathpart, 0);
return;
}
}
for (i = 0; i < sizeof(loaders) / sizeof(module_loader_t); i++){
fname = stracat(pathpart, loaders[i].path_ext);
if (stat(fname, &st) == 0 && (S_ISREG(st.st_mode) ||
S_ISLNK(st.st_mode))){
loaders[i].load(fname, env, as_toplevel);
return;
}
}
path = dfsch_cdr(path);
}
dfsch_error("Module not found", dfsch_make_string_cstr(name));
}
