dfsch_object_t* dfsch_compile_expression_list(dfsch_object_t* list,
dfsch_object_t* env){
dfsch_object_t *head;
dfsch_object_t *tail;
dfsch_object_t *i = list;
head = tail = NULL;
while(DFSCH_PAIR_P(i)){
dfsch_object_t* tmp =
dfsch_cons(dfsch_compile_expression(DFSCH_FAST_CAR(i), env), NULL);
if (head){
DFSCH_FAST_CDR_MUT(tail) = tmp;
tail = tmp;
}else{
head = tail = tmp;
}
i = DFSCH_FAST_CDR(i);
}
if (i && !DFSCH_PAIR_P(i)){
dfsch_type_error(i, DFSCH_LIST_TYPE, 1);
}
return dfsch_list_annotate((dfsch_object_t*)head,
DFSCH_SYM_COMPILED_FROM, list);
}
void dfsch_load_add_module_source(dfsch_object_t* ctx,
dfsch_object_t* src){
dfsch_object_t* path = dfsch_env_get_cstr(ctx, "*load-path*");
if (path != DFSCH_INVALID_OBJECT){
dfsch_set_cstr(ctx, "*load-path*", dfsch_cons(src, path));
} else {
dfsch_define_cstr(ctx, "*load-path*", dfsch_list(1, src));
}
}
static int read_callback(dfsch_object_t *obj, read_ctx_t* ctx){
dfsch_object_t* new_tail = dfsch_cons(obj, NULL);
if (!ctx->head){
ctx->head = new_tail;
}else{
dfsch_set_cdr(ctx->tail, new_tail);
}
ctx->tail = new_tail;
return 1;
}
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);
}
void dfsch_provide(dfsch_object_t* env, char* name){
dfsch_object_t* modules = dfsch_env_get_cstr(env, "*load-modules*");
if (modules == DFSCH_INVALID_OBJECT){
modules = NULL;
}
if (search_modules(modules, name)){
dfsch_error("Module already provided", dfsch_make_string_cstr(name));
}
/*
* there should be define - module list is related to environment, but
* this distinction is in most cases totally irrelevant, because modules
* are mostly loaded into toplevel environment.
*/
dfsch_define_cstr(env, "*load-modules*",
dfsch_cons(dfsch_make_string_cstr(name),
modules));
}
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);
}
}
