Ejemplo n.º 1
0
Archivo: compiler.c Proyecto: adh/dfsch
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);  
  
}
Ejemplo n.º 2
0
Archivo: load.c Proyecto: adh/dfsch
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));
  }
}
Ejemplo n.º 3
0
Archivo: load.c Proyecto: adh/dfsch
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;
}
Ejemplo n.º 4
0
Archivo: object.c Proyecto: leia/dfsch
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);
}
Ejemplo n.º 5
0
Archivo: load.c Proyecto: adh/dfsch
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));
}
Ejemplo n.º 6
0
Archivo: object.c Proyecto: leia/dfsch
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);
  }
}