Exemple #1
0
static dfsch_slot_t* make_slots(dfsch_object_t* slot_desc){
  dfsch_object_t* i = slot_desc;
  size_t slot_count = dfsch_list_length_check(slot_desc);
  dfsch_slot_t* slots = GC_MALLOC((slot_count + 1) * sizeof(dfsch_slot_t));
  dfsch_slot_t* j = slots;

  while (slot_count && DFSCH_PAIR_P(i)){
    dfsch_object_t* name;
    dfsch_object_t* type;
    if (DFSCH_PAIR_P(DFSCH_FAST_CAR(i))){
      dfsch_object_t* args = DFSCH_FAST_CAR(i);
      DFSCH_OBJECT_ARG(args, name);
    } else {
      name = DFSCH_FAST_CAR(i);
    }

    j->type = DFSCH_OBJECT_SLOT_TYPE;
    j->name = dfsch_symbol(name);
    j->documentation = NULL;

    j++;
    slot_count--;
    i = DFSCH_FAST_CDR(i);
  }

  j->type = NULL;
  j->name = NULL;
  j->access = DFSCH_SLOT_ACCESS_RW;
  j->documentation = NULL;

  return slots;
}
Exemple #2
0
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;
}
Exemple #3
0
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);  
  
}
Exemple #4
0
static int all_constants_p(dfsch_object_t* list){
  while (DFSCH_PAIR_P(list)){
    if (dfsch_constant_expression_value(DFSCH_FAST_CAR(list), 
                                        NULL) == DFSCH_INVALID_OBJECT) {
      return 0;
    }
    list = DFSCH_FAST_CDR(list);
  }
  return 1;
}
Exemple #5
0
static void default_initialize_instance(dfsch_object_t* obj,
                                        class_t* klass,
                                        dfsch_object_t* args){
  dfsch_object_t* i = klass->initvalues;

  while (DFSCH_PAIR_P(i)){
    dfsch_object_t* j = DFSCH_FAST_CAR(i);
    dfsch_object_t* value;
    dfsch_object_t* slot;

    DFSCH_OBJECT_ARG(j, value);
    DFSCH_OBJECT_ARG(j, slot);

    dfsch_slot_set(obj, slot, value, 1);

    i = DFSCH_FAST_CDR(i);
  }

  while (DFSCH_PAIR_P(args)){                                 
    dfsch_object_t* keyword;                                
    dfsch_object_t* value;                                  
    dfsch_object_t* slot;
    keyword = DFSCH_FAST_CAR(args);                       
    args = DFSCH_FAST_CDR(args);                                
    if (!DFSCH_PAIR_P(args)){                                     
      dfsch_error("Value expected for keyword", keyword);
    }                                                               
    value = DFSCH_FAST_CAR(args);                         
    args = DFSCH_FAST_CDR(args);
    
    slot = dfsch_assq(keyword, klass->initargs);

    if (!slot){
      dfsch_error("Unknown keyword", keyword);      
    }
    
    dfsch_slot_set(obj, dfsch_list_item(slot, 1), value, 1);
  }
}
Exemple #6
0
dfsch_object_t* dfsch_constant_expression_value(dfsch_object_t* expression,
                                                dfsch_object_t* env){
  if (DFSCH_SYMBOL_P(expression)){
    if (!env){
      return DFSCH_INVALID_OBJECT;
    }
    return dfsch_variable_constant_value(expression, env);
  } else if (dfsch_quote_expression_p(expression)){
    return DFSCH_FAST_CAR(expression);
  } else if (DFSCH_PAIR_P(expression)){
    return DFSCH_INVALID_OBJECT;
  } else {
    return expression;
  }
}
Exemple #7
0
static void build_args(dfsch_object_t* list, int* pargc, char*** pargv){
  int alloc = 16;
  char** argv = GC_MALLOC(sizeof(char*) * alloc);
  int argc = 0;
  
  while (DFSCH_PAIR_P(list)){
    if (alloc <= argc){
      alloc *= 2;
      argv = GC_REALLOC(argv, sizeof(char*) * alloc);
    }

    argv[argc] = convert_arg(DFSCH_FAST_CAR(list));

    argc++;
    list = DFSCH_FAST_CDR(list);
  }
  *pargc = argc;
  *pargv = argv;
}
Exemple #8
0
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);
}
Exemple #9
0
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);
  }
}
Exemple #10
0
Fichier : load.c Projet : adh/dfsch
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));
}