static int search_modules(dfsch_object_t* modules, char* name){
while(modules){
if (strcmp(name, dfsch_string_to_cstr(dfsch_car(modules))) == 0){
return 1;
}
modules = dfsch_cdr(modules);
}
return 0;
}
static char* convert_arg(dfsch_object_t* obj){
if (dfsch_keyword_p(obj)){
char* str = dfsch_symbol(obj);
if (strlen(str) == 1){
return dfsch_saprintf("-%s", str);
} else {
return dfsch_saprintf("--%s", str);
}
} else if (dfsch_string_p(obj)) {
return dfsch_string_to_cstr(obj);
} else {
return dfsch_object_2_string(obj, 10, 1);
}
}
char* dfsch_tcl_quote_list(dfsch_object_t* list){
dfsch_str_list_t* sl = dfsch_sl_create();
dfsch_object_t* i;
while (DFSCH_PAIR_P(list)){
dfsch_sl_append(sl, " ");
i = DFSCH_FAST_CAR(list);
if (dfsch_string_p(i)){
dfsch_sl_append(sl, dfsch_tcl_quote(dfsch_string_to_cstr(i)));
} else if (dfsch_keyword_p(i)){
dfsch_sl_append(sl, dfsch_saprintf("-%s", dfsch_symbol(i)));
} else if (DFSCH_PAIR_P(i)){
dfsch_sl_append(sl, dfsch_tcl_quote(dfsch_tcl_quote_list(i)));
} else {
dfsch_sl_append(sl, dfsch_tcl_quote(dfsch_object_2_string(i, 10, 1)));
}
list = DFSCH_FAST_CDR(list);
}
return dfsch_sl_value(sl);
}
static void finalize_slots_definition(class_t* klass,
dfsch_object_t* env,
dfsch_object_t* slot_definitions){
dfsch_object_t* i = slot_definitions;
while (DFSCH_PAIR_P(i)){
dfsch_object_t* slot_def = DFSCH_FAST_CAR(i);
if (DFSCH_PAIR_P(slot_def)){
dfsch_slot_t* slot =
find_direct_slot(klass,
dfsch_symbol(DFSCH_FAST_CAR(slot_def)));
slot_def = DFSCH_FAST_CDR(slot_def);
while (DFSCH_PAIR_P((slot_def))){
dfsch_object_t* keyword;
dfsch_object_t* value;
keyword = DFSCH_FAST_CAR(slot_def);
slot_def = DFSCH_FAST_CDR(slot_def);
if (!DFSCH_PAIR_P(slot_def)){
dfsch_error("Value expected for slot option", keyword);
}
value = DFSCH_FAST_CAR(slot_def);
slot_def = DFSCH_FAST_CDR(slot_def);
if(dfsch_compare_keyword(keyword, "accessor")){
dfsch_object_t* accessor =
dfsch__make_slot_accessor_for_slot(klass, slot);
dfsch_method_t* method =
dfsch_make_method(accessor, NULL, dfsch_cons(klass, NULL),
accessor);
dfsch_define_method(env, value, method);
} else if(dfsch_compare_keyword(keyword, "reader")){
dfsch_object_t* accessor =
dfsch__make_slot_reader_for_slot(klass, slot);
dfsch_method_t* method =
dfsch_make_method(accessor, NULL, dfsch_cons(klass, NULL),
accessor);
dfsch_define_method(env, value, method);
} else if(dfsch_compare_keyword(keyword, "write")){
dfsch_object_t* accessor =
dfsch__make_slot_writer_for_slot(klass, slot);
dfsch_method_t* method =
dfsch_make_method(accessor, NULL, dfsch_cons(klass, NULL),
accessor);
dfsch_define_method(env, value, method);
} else if(dfsch_compare_keyword(keyword, "initform")){
klass->initvalues = dfsch_cons(dfsch_list(2,
dfsch_eval(value, env),
slot),
klass->initvalues);
} else if(dfsch_compare_keyword(keyword, "initarg")){
klass->initargs = dfsch_cons(dfsch_list(2, value, slot),
klass->initargs);
} else if(dfsch_compare_keyword(keyword, "documentation")){
slot->documentation = dfsch_string_to_cstr(value);
}
}
}
i = DFSCH_FAST_CDR(i);
}
}
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));
}
