Exemplo n.º 1
0
void jl_check_static_parameter_conflicts(jl_lambda_info_t *li, jl_tuple_t *t, jl_sym_t *fname)
{
    jl_array_t *vinfo;
    size_t nvars;

    if (li->ast && jl_is_expr(li->ast)) {
        vinfo = jl_lam_vinfo((jl_expr_t*)li->ast);
        nvars = jl_array_len(vinfo);
        for(size_t i=0; i < jl_tuple_len(t); i++) {
            for(size_t j=0; j < nvars; j++) {
                jl_value_t *tv = jl_tupleref(t,i);
                if (jl_is_typevar(tv)) {
                    if ((jl_sym_t*)jl_arrayref((jl_array_t*)jl_arrayref(vinfo,j),0) ==
                        ((jl_tvar_t*)tv)->name) {
                        JL_PRINTF(JL_STDERR,
                                  "Warning: local variable %s conflicts with a static parameter in %s",
                                  ((jl_tvar_t*)tv)->name->name, fname->name);
                        print_func_loc(JL_STDERR, li);
                        JL_PRINTF(JL_STDERR, ".\n");
                    }
                }
            }
        }
    }
}
Exemplo n.º 2
0
SEXP jr_data_frame(jl_value_t *tt)
{
    SEXP ans = R_NilValue;
    SEXP rnames, d;
    jl_array_t *names = (jl_array_t *) jl_get_nth_field(jl_get_nth_field(tt, 1), 1);
    jl_array_t *columns = (jl_array_t *) jl_get_nth_field(tt, 0);
    JL_GC_PUSH2(&names, &columns);

    size_t n = jl_array_len(jl_get_nth_field(jl_arrayref(columns, 0), 0));
    size_t m = jl_array_len(columns);
    PROTECT(ans = Rf_allocVector(VECSXP, m));
    PROTECT(rnames = Rf_allocVector(STRSXP, m));
    for(size_t i=0; i<m; i++)
    {
        SET_VECTOR_ELT(ans, i, jr_data_array((jl_value_t *) jl_arrayref(columns, i)));
        SET_STRING_ELT(rnames, i, Rf_mkChar(((jl_sym_t *) jl_arrayref(names, i))->name));
    }
    Rf_setAttrib(ans, R_NamesSymbol, rnames);
    Rf_setAttrib(ans, R_ClassSymbol, Rf_mkString("data.frame"));
    d = PROTECT(Rf_allocVector(INTSXP ,n));
    for(size_t i=0; i<n; i++){
        INTEGER(d)[i] = i+1;
    }
    Rf_setAttrib(ans, R_RowNamesSymbol, d);
    UNPROTECT(3);
    JL_GC_POP();
    return ans;
}
Exemplo n.º 3
0
// this is a run-time function
// warning: cannot allocate memory except using alloc_temp_arg_space
extern "C" DLLEXPORT void *jl_value_to_pointer(jl_value_t *jt, jl_value_t *v, int argn,
                                     int addressof)
{
    jl_value_t *jvt = (jl_value_t*)jl_typeof(v);
    if (addressof) {
        if (jvt == jt) {
            if (jl_is_bitstype(jvt)) {
                size_t osz = jl_datatype_size(jt);
                return alloc_temp_arg_copy(jl_data_ptr(v), osz);
            }
            else if (!jl_is_tuple(jvt) && jl_is_leaf_type(jvt) && !jl_is_array_type(jvt)) {
                return v + 1;
            }
        }
        goto value_to_pointer_error;
    }
    else {
        if (jl_is_cpointer_type(jvt) && jl_tparam0(jvt) == jt) {
            return (void*)jl_unbox_voidpointer(v);
        }
    }

    if (((jl_value_t*)jl_uint8_type == jt ||
         (jl_value_t*)jl_int8_type == jt) && jl_is_byte_string(v)) {
        return jl_string_data(v);
    }
    if (jl_is_array_type(jvt)) {
        if (jl_tparam0(jl_typeof(v)) == jt || jt==(jl_value_t*)jl_bottom_type)
            return ((jl_array_t*)v)->data;
        if (jl_is_cpointer_type(jt)) {
            jl_array_t *ar = (jl_array_t*)v;
            void **temp=(void**)alloc_temp_arg_space((1+jl_array_len(ar))*sizeof(void*));
            size_t i;
            for(i=0; i < jl_array_len(ar); i++) {
                temp[i] = jl_value_to_pointer(jl_tparam0(jt),
                                              jl_arrayref(ar, i), argn, 0);
            }
            temp[i] = 0;
            return temp;
        }
    }

 value_to_pointer_error:
    std::map<int, std::string>::iterator it = argNumberStrings.find(argn);
    if (it == argNumberStrings.end()) {
        std::stringstream msg;
        msg << "argument ";
        msg << argn;
        argNumberStrings[argn] = msg.str();
        it = argNumberStrings.find(argn);
    }
    jl_value_t *targ=NULL, *pty=NULL;
    JL_GC_PUSH2(&targ, &pty);
    targ = (jl_value_t*)jl_tuple1(jt);
    pty = (jl_value_t*)jl_apply_type((jl_value_t*)jl_pointer_type,
                                     (jl_tuple_t*)targ);
    jl_type_error_rt("ccall", (*it).second.c_str(), pty, v);
    // doesn't return
    return (jl_value_t*)jl_null;
}
Exemplo n.º 4
0
static SEXP Julia_R_MD_NA_DataFrame(jl_value_t *Var)
{
  SEXP ans, names, rownames;
  char evalcmd[evalsize];
  int i;
  const char *dfname = "DataFrameName0tmp";
  jl_set_global(jl_main_module, jl_symbol(dfname), (jl_value_t *)Var);
  //Get Frame cols
  snprintf(evalcmd, evalsize, "size(%s,2)", dfname);
  jl_value_t *cols = jl_eval_string(evalcmd);
  int collen = jl_unbox_long(cols);
  jl_value_t *eachcolvector;
  jl_value_t *coltype;
  //Create VECSXP

  //Create SEXP for Each Column and assign
  PROTECT(ans = allocVector(VECSXP, collen));
  for (i = 0; i < collen; i++)
  {

    snprintf(evalcmd, evalsize, "%s[%d]", dfname, i + 1);
    eachcolvector = jl_eval_string(evalcmd);
    snprintf(evalcmd, evalsize, "isa(%s[%d],PooledDataArray)", dfname, i + 1);
    coltype = jl_eval_string(evalcmd);
    if (jl_unbox_bool(coltype))
      SET_VECTOR_ELT(ans, i, Julia_R_MD_NA_Factor(eachcolvector));
    else
      SET_VECTOR_ELT(ans, i, Julia_R_MD_NA(eachcolvector));
  }
  //set names attribute
  snprintf(evalcmd, evalsize, "names(%s)", dfname);
  jl_value_t *ret = jl_eval_string(evalcmd);
  jl_value_t *onesymbol;
  if (jl_is_array(ret))
  {
    PROTECT(names = allocVector(STRSXP, collen));
    for (i = 0; i < jl_array_len(ret); i++)
    {
      onesymbol = jl_arrayref((jl_array_t *)ret, i);
      if (jl_is_symbol(onesymbol))
        SET_STRING_ELT(names, i, mkChar(((jl_sym_t *)onesymbol)->name));
    }
    setAttrib(ans, R_NamesSymbol, names);
    UNPROTECT(1);
  }
  //set row names
  snprintf(evalcmd, evalsize, "size(%s,1)", dfname);
  jl_value_t *rows = jl_eval_string(evalcmd);
  int rowlen = jl_unbox_long(rows);
  PROTECT(rownames = allocVector(INTSXP, rowlen));
  for (i = 0; i < rowlen; i++)
    INTEGER(rownames)[i] = i + 1;
  setAttrib(ans, R_RowNamesSymbol, rownames);
  UNPROTECT(1);
  //set class as data frame
  setAttrib(ans, R_ClassSymbol, mkString("data.frame"));
  //SET_OBJECT(ans, 1) ;
  UNPROTECT(1);
  return ans;
}
Exemplo n.º 5
0
SEXP jr_dict(jl_value_t *tt)
{
    SEXP ans = R_NilValue;
    SEXP rnames;
    jl_function_t *str = jl_get_function(jl_base_module, "string");
    jl_function_t *getindex = jl_get_function(jl_base_module, "getindex");
    jl_array_t *keys = (jl_array_t *) jl_call1(
        jl_get_function(jl_base_module, "collect"),
        jl_call1(jl_get_function(jl_base_module, "keys"), tt)
    );
    size_t m = jl_array_len(keys);
    PROTECT(rnames = Rf_allocVector(STRSXP, m));
    PROTECT(ans = Rf_allocVector(VECSXP, m));
    jl_value_t *key, *value;
    for(size_t i=0; i<m; i++)
    {
        key = jl_arrayref(keys, i);
        value = jl_call2(getindex, tt, key);
        SET_VECTOR_ELT(ans, i, jr_cast(value));
        key = jl_call1(str, key);
        SET_STRING_ELT(rnames, i, Rf_mkChar(jl_string_data(key)));
    }
    Rf_setAttrib(ans, R_NamesSymbol, rnames);
    UNPROTECT(2);
    return ans;
}
Exemplo n.º 6
0
void jl_write_compiler_output(void)
{
    if (!jl_generating_output())
        return;

    if (!jl_options.incremental)
        jl_precompile(jl_options.compile_enabled == JL_OPTIONS_COMPILE_ALL);

    if (!jl_module_init_order) {
        jl_printf(JL_STDERR, "WARNING: --output requested, but no modules defined during run\n");
        return;
    }

    jl_array_t *worklist = jl_module_init_order;
    JL_GC_PUSH1(&worklist);
    jl_module_init_order = jl_alloc_vec_any(0);
    int i, l = jl_array_len(worklist);
    for (i = 0; i < l; i++) {
        jl_value_t *m = jl_arrayref(worklist, i);
        if (jl_get_global((jl_module_t*)m, jl_symbol("__init__"))) {
            jl_array_ptr_1d_push(jl_module_init_order, m);
        }
    }

    if (jl_options.incremental) {
        if (jl_options.outputji)
            if (jl_save_incremental(jl_options.outputji, worklist))
                jl_exit(1);
        if (jl_options.outputbc || jl_options.outputunoptbc)
            jl_printf(JL_STDERR, "WARNING: incremental output to a .bc file is not implemented\n");
        if (jl_options.outputo)
            jl_printf(JL_STDERR, "WARNING: incremental output to a .o file is not implemented\n");
    }
    else {
        ios_t *s = NULL;
        if (jl_options.outputo || jl_options.outputbc || jl_options.outputunoptbc)
            s = jl_create_system_image();

        if (jl_options.outputji) {
            if (s == NULL) {
                jl_save_system_image(jl_options.outputji);
            }
            else {
                ios_t f;
                if (ios_file(&f, jl_options.outputji, 1, 1, 1, 1) == NULL)
                    jl_errorf("cannot open system image file \"%s\" for writing", jl_options.outputji);
                ios_write(&f, (const char*)s->buf, (size_t)s->size);
                ios_close(&f);
            }
        }

        if (jl_options.outputo || jl_options.outputbc || jl_options.outputunoptbc)
            jl_dump_native(jl_options.outputbc,
                           jl_options.outputunoptbc,
                           jl_options.outputo,
                           (const char*)s->buf, (size_t)s->size);
    }
    JL_GC_POP();
}
Exemplo n.º 7
0
jl_value_t *jl_method_def(jl_sym_t *name, jl_value_t **bp, jl_binding_t *bnd,
                          jl_tuple_t *argtypes, jl_function_t *f, jl_tuple_t *t)
{
    jl_value_t *gf;
    if (bnd) {
        //jl_declare_constant(bnd);
        if (bnd->value != NULL && !bnd->constp) {
            jl_errorf("cannot define function %s; it already has a value",
                      bnd->name->name);
        }
        bnd->constp = 1;
    }
    if (*bp == NULL) {
        gf = (jl_value_t*)jl_new_generic_function(name);
        *bp = gf;
    }
    else {
        gf = *bp;
        if (!jl_is_gf(gf)) {
            if (jl_is_datatype(gf) &&
                ((jl_function_t*)gf)->fptr == jl_f_ctor_trampoline) {
                jl_add_constructors((jl_datatype_t*)gf);
            }
            if (!jl_is_gf(gf)) {
                jl_error("invalid method definition: not a generic function");
            }
        }
    }
    JL_GC_PUSH1(&gf);
    assert(jl_is_function(f));
    assert(jl_is_tuple(argtypes));
    assert(jl_is_tuple(t));

    for(size_t i=0; i < jl_tuple_len(argtypes); i++) {
        jl_value_t *elt = jl_tupleref(argtypes,i);
        if (!jl_is_type(elt) && !jl_is_typevar(elt)) {
            jl_lambda_info_t *li = f->linfo;
            jl_errorf("invalid type for argument %s in method definition for %s at %s:%d",
                      jl_is_expr(li->ast) ?
                      ((jl_sym_t*)jl_arrayref(jl_lam_args((jl_expr_t*)li->ast),i))->name :
                      "?",
                      name->name, li->file->name, li->line);
        }
    }

    for(size_t i=0; i < jl_tuple_len(t); i++) {
        if (!jl_is_typevar(jl_tupleref(t,i)))
            jl_type_error_rt(name->name, "method definition",
                             (jl_value_t*)jl_tvar_type, jl_tupleref(t,i));
    }
    jl_add_method((jl_function_t*)gf, argtypes, f, t);
    if (jl_boot_file_loaded &&
        f->linfo && f->linfo->ast && jl_is_expr(f->linfo->ast)) {
        jl_lambda_info_t *li = f->linfo;
        li->ast = jl_compress_ast(li, li->ast);
    }
    JL_GC_POP();
    return gf;
}
Exemplo n.º 8
0
jl_sym_t *jl_lam_argname(jl_lambda_info_t *li, int i)
{
    jl_expr_t *ast;
    if (jl_is_expr(li->ast))
        ast = (jl_expr_t*)li->ast;
    else
        ast = (jl_expr_t*)jl_uncompress_ast(li, li->ast);
    return (jl_sym_t*)jl_arrayref(jl_lam_args(ast),i);
}
Exemplo n.º 9
0
//this function is for factor convert it maybe not safe
//because PooledDataArray.refs is Uint32 or bigger
//but in pratice it should be ok
static SEXP Julia_R_MD_INT(jl_value_t *Var)
{
  SEXP ans = R_NilValue;
  jl_value_t *val;
  if (((jl_array_t *)Var)->ptrarray)
    val = jl_cellref(Var, 0);
  else
    val = jl_arrayref((jl_array_t *)Var, 0);
  int len = jl_array_len(Var);
  if (len == 0) return ans;

  if (jl_is_int32(val))
  {
    int32_t *p = (int32_t *) jl_array_data(Var);
    jlint_to_r_md;
  }
  else if (jl_is_int64(val))
  {
    int64_t *p = (int64_t *) jl_array_data(Var);
    jlint_to_r_md;
  }
  else if (jl_is_int8(val))
  {
    int8_t *p = (int8_t *) jl_array_data(Var);
    jlint_to_r_md;
  }
  else if (jl_is_int16(val))
  {
    int16_t *p = (int16_t *) jl_array_data(Var);
    jlint_to_r_md;
  }
  else if (jl_is_uint8(val))
  {
    uint8_t *p = (uint8_t *) jl_array_data(Var);
    jlint_to_r_md;
  }
  else if (jl_is_uint16(val))
  {
    uint16_t *p = (uint16_t *) jl_array_data(Var);
    jlint_to_r_md;
  }
  else if (jl_is_uint32(val))
  {
    uint32_t *p = (uint32_t *) jl_array_data(Var);
    jlint_to_r_md;
  }
  else if (jl_is_uint64(val))
  {
    uint64_t *p = (uint64_t *) jl_array_data(Var);
    jlint_to_r_md;
  }
  return ans;
}
Exemplo n.º 10
0
// this is a run-time function
// warning: cannot allocate memory except using alloc_temp_arg_space
extern "C" void *jl_value_to_pointer(jl_value_t *jt, jl_value_t *v, int argn)
{
    if ((jl_value_t*)jl_typeof(v) == jt) {
        assert(jl_is_bits_type(jt));
        size_t osz = jl_bitstype_nbits(jt)/8;
        return alloc_temp_arg_copy(jl_bits_data(v), osz);
    }
    if (((jl_value_t*)jl_uint8_type == jt ||
         (jl_value_t*)jl_int8_type == jt) && jl_is_byte_string(v)) {
        return jl_string_data(v);
    }
    if (jl_is_array(v)) {
        if (jl_tparam0(jl_typeof(v)) == jt || jt==(jl_value_t*)jl_bottom_type)
            return ((jl_array_t*)v)->data;
        if (jl_is_cpointer_type(jt)) {
            jl_array_t *ar = (jl_array_t*)v;
            void **temp=(void**)alloc_temp_arg_space(ar->length*sizeof(void*));
            size_t i;
            for(i=0; i < ar->length; i++) {
                temp[i] = jl_value_to_pointer(jl_tparam0(jt),
                                              jl_arrayref(ar, i), argn);
            }
            return temp;
        }
    }
    std::map<int, std::string>::iterator it = argNumberStrings.find(argn);
    if (it == argNumberStrings.end()) {
        std::stringstream msg;
        msg << "argument ";
        msg << argn;
        argNumberStrings[argn] = msg.str();
        it = argNumberStrings.find(argn);
    }
    jl_value_t *targ=NULL, *pty=NULL;
    JL_GC_PUSH(&targ, &pty);
    targ = (jl_value_t*)jl_tuple1(jt);
    pty = (jl_value_t*)jl_apply_type((jl_value_t*)jl_pointer_type,
                                     (jl_tuple_t*)targ);
    jl_type_error_rt("ccall", (*it).second.c_str(), pty, v);
    // doesn't return
    return (jl_value_t*)jl_null;
}
Exemplo n.º 11
0
Arquivo: jl4R.c Projeto: rcqls/jl4R
//Maybe try to use cpp stuff to get the output inside julia system (ccall,cgen and cgutils)
//-| TODO: after adding in the jlapi.c jl_is_<C_type> functions replace the strcmp!
SEXP jl_value_to_SEXP(jl_value_t *res) {
  size_t i=0,nd,d;
  SEXP resR;
  SEXPTYPE aryTyR;
  jl_value_t *tmp;
  char *resTy, *aryTy, *aryTy2;

  if(res!=NULL) { //=> get a result
    resTy=(char*)jl_typeof_str(res);
    //DANGEROUS?? printf("typeof=%s\n",jl_typeof_str(res));
    if(strcmp(jl_typeof_str(res),"Int64")==0 || strcmp(jl_typeof_str(res),"Int32")==0)
    //if(jl_is_long(res)) //does not work because of DLLEXPORT
    {
      //printf("elt=%d\n",jl_unbox_long(res));
      PROTECT(resR=NEW_INTEGER(1));
      INTEGER_POINTER(resR)[0]=jl_unbox_long(res);
      UNPROTECT(1);
      return resR;
    }
    else
    if(strcmp(resTy,"Float64")==0)
    //if(jl_is_float64(res))
    {
      PROTECT(resR=NEW_NUMERIC(1));
      NUMERIC_POINTER(resR)[0]=jl_unbox_float64(res);
      UNPROTECT(1);
      return resR;
    }
    else
    if(strcmp(resTy,"Float32")==0)
    //if(jl_is_float64(res))
    {

      PROTECT(resR=NEW_NUMERIC(1));
      NUMERIC_POINTER(resR)[0]=jl_unbox_float32(res);
      UNPROTECT(1);
      return resR;
    }
    else
    if(strcmp(resTy,"Bool")==0)
    //if(jl_is_bool(res))
    {
      PROTECT(resR=NEW_LOGICAL(1));
      LOGICAL(resR)[0]=(jl_unbox_bool(res)  ? TRUE : FALSE);
      UNPROTECT(1);
      return resR;
    }
    else
    if(strcmp(resTy,"DataType")==0)
    //if(jl_is_bool(res))
    {
      PROTECT(resR=NEW_CHARACTER(1));
      CHARACTER_POINTER(resR)[0]=mkChar(jl_typename_str(res));
      UNPROTECT(1);
      return resR;
    }
    else
    if(strcmp(resTy,"Nothing")==0)
    //if(jl_is_bool(res))
    {
      return R_NilValue;
    }
    else
    if(strcmp(resTy,"Complex")==0)
    //if(jl_is_bool(res))
    {

      tmp=(jl_value_t*)jl_get_field(res, "re");
      PROTECT(resR=NEW_COMPLEX(1));
      if(strcmp(jl_typeof_str(tmp),"Float64")==0) {
        COMPLEX(resR)[0].r=jl_unbox_float64(tmp);
        COMPLEX(resR)[0].i=jl_unbox_float64(jl_get_field(res, "im"));
      } else if(strcmp(jl_typeof_str(tmp),"Int64")==0) {
        COMPLEX(resR)[0].r=jl_unbox_long(tmp);
        COMPLEX(resR)[0].i=jl_unbox_long(jl_get_field(res, "im"));
      }
      UNPROTECT(1);
      return resR;
    }
    else
    if(strcmp(resTy,"Regex")==0)
    //if(jl_is_bool(res))
    {
      // call=(jl_function_t*)jl_get_global(jl_base_module, jl_symbol("show"));
      // printf("ici\n");
      // if (call) tmp=jl_call1(call,res);
      // else printf("call failed!\n");
      // printf("ici\n");
      // resR = jl_value_to_VALUE(jl_get_field(res, "pattern"));
      // return resR;
    }
    else
    if(strcmp(resTy,"ASCIIString")==0 || strcmp(resTy,"UTF8String")==0)
    {
      PROTECT(resR=NEW_CHARACTER(1));
      CHARACTER_POINTER(resR)[0]=mkChar(jl_bytestring_ptr(res));
      UNPROTECT(1);
      return resR;
    }
    else
    if(strcmp(jl_typeof_str(res),"Tuple")==0 )
    //if(jl_is_array(res))
    {
      d=jl_nfields(res); //BEFORE 0.3: d=jl_tuple_len(res);
      PROTECT(resR=allocVector(VECSXP,d));
      for(i=0;i<d;i++) {
        //BEFORE 0.3: SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_tupleref(res,i)));
        SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_fieldref(res,i)));
      }
      UNPROTECT(1);
      return resR;
    }
    if(strcmp(resTy,"Array")==0)
    //if(jl_is_array(res))
    {
      nd = jl_array_rank(res);
      //Rprintf("array_ndims=%d\n",(int)nd);
      aryTy=(char*)jl_typename_str(jl_array_eltype(res));
      aryTy2=(char*)jl_typeof_str(jl_array_eltype(res));
      //Rprintf("type elt=%s,%s\n",aryTy,(char*)jl_typeof_str(jl_array_eltype(res)));
      if(strcmp(aryTy2,"DataType")!=0) return R_NilValue;
      if(strcmp(aryTy,"ASCIIString")==0 || strcmp(aryTy,"UTF8String")==0) aryTyR=STRSXP;
      else if(strcmp(aryTy,"Int64")==0 || strcmp(aryTy,"Int32")==0) aryTyR=INTSXP;
      else if(strcmp(aryTy,"Bool")==0) aryTyR=LGLSXP;
      else if(strcmp(aryTy,"Complex")==0) aryTyR=CPLXSXP;
      else if(strcmp(aryTy,"Float64")==0 || strcmp(aryTy,"Float32")==0) aryTyR=REALSXP;
      else aryTyR=VECSXP;
      if(nd==1) {//Vector
        d = jl_array_size(res, 0);
        //Rprintf("array_dim[1]=%d\n",(int)d);
        PROTECT(resR=allocVector(aryTyR,d));

        for(i=0;i<d;i++) {
          switch(aryTyR) {
            case STRSXP:
              SET_STRING_ELT(resR,i,mkChar(jl_bytestring_ptr(jl_arrayref((jl_array_t *)res,i))));
              break;
            case INTSXP:
              INTEGER(resR)[i]=jl_unbox_long(jl_arrayref((jl_array_t *)res,i));
              break;
            case LGLSXP:
              LOGICAL(resR)[i]=(jl_unbox_bool(jl_arrayref((jl_array_t *)res,i)) ? TRUE : FALSE);
              break;
            case REALSXP:
              REAL(resR)[i]=jl_unbox_float64(jl_arrayref((jl_array_t *)res,i));
              break;
            case CPLXSXP:
              tmp=(jl_value_t*)jl_get_field(jl_arrayref((jl_array_t *)res,i), "re");
              if(strcmp(jl_typeof_str(tmp),"Float64")==0) {
                COMPLEX(resR)[i].r=jl_unbox_float64(tmp);
                COMPLEX(resR)[i].i=jl_unbox_float64(jl_get_field(jl_arrayref((jl_array_t *)res,i), "im"));
              } else if(strcmp(jl_typeof_str(tmp),"Int64")==0) {
                COMPLEX(resR)[i].r=jl_unbox_long(tmp);
                COMPLEX(resR)[i].i=jl_unbox_long(jl_get_field(jl_arrayref((jl_array_t *)res,i), "im"));
              }
              break;
            case VECSXP:
              SET_ELEMENT(resR,i,jl_value_to_SEXP(jl_arrayref((jl_array_t *)res,i)));
          }
        }
        UNPROTECT(1);
        return resR;
      }
      //TODO: multidim array ruby equivalent???? Is it necessary

    }
    return R_NilValue;
    /*PROTECT(resR=NEW_CHARACTER(1));
    CHARACTER_POINTER(resR)[0]=mkChar(jl_typeof_str(res));
    // resR=rb_str_new2("__unconverted(");
    // rb_str_cat2(resR, jl_typeof_str(res));
    // rb_str_cat2(resR, ")__\n");
    UNPROTECT(1);
    //printf("%s\n",jl_bytestring_ptr(jl_eval_string("\"$(ans)\"")));
    return resR;*/
  }
  //=> No result (command incomplete or syntax error)
  // jlapi_print_stderr(); //If this happens but this is really not sure!
  // resR=rb_str_new2("__incomplete");
  // if(jl_exception_occurred()!=NULL) {
  //   rb_str_cat2(resR, "(");
  //     rb_str_cat2(resR,jl_typeof_str(jl_exception_occurred()));
  //   jl_value_t* err=jl_get_field(jl_exception_occurred(),"msg");
  //   if(err!=NULL) printf("%s: %s\n",jl_typeof_str(jl_exception_occurred()),jl_bytestring_ptr(err));
  //   jl_exception_clear();
  //   rb_str_cat2(resR, ")");
  // }
  // rb_str_cat2(resR, "__");
  return R_NilValue;//resR;
}
Exemplo n.º 12
0
static SEXP Julia_R_MD_NA(jl_value_t *Var)
{
  SEXP ans = R_NilValue;
  char *strData = "Varname0tmp.data";
  char *strNA = "bitunpack(Varname0tmp.na)";
  jl_set_global(jl_main_module, jl_symbol("Varname0tmp"), (jl_value_t *)Var);
  jl_value_t *retData = jl_eval_string(strData);
  jl_value_t *retNA = jl_eval_string(strNA);
  jl_value_t *val;

  if (((jl_array_t *)retData)->ptrarray)
    val = jl_cellref(retData, 0);
  else
    val = jl_arrayref((jl_array_t *)retData, 0);
  int len = jl_array_len(retData);
  if (len == 0)
    return ans;

  int ndims = jl_array_ndims(retData);
  SEXP dims;
  PROTECT(dims = allocVector(INTSXP, ndims));
  for (size_t i = 0; i < ndims; i++)
    INTEGER(dims)[i] = jl_array_dim(retData, i);
  UNPROTECT(1);

  //bool array
  char *pNA = (char *) jl_array_data(retNA);

  if (jl_is_bool(val))
  {
    char *p = (char *) jl_array_data(retData);
    PROTECT(ans = allocArray(LGLSXP, dims));
    for (size_t i = 0; i < len; i++)
      if (pNA[i])
        LOGICAL(ans)[i] = NA_LOGICAL;
      else
        LOGICAL(ans)[i] = p[i];
    UNPROTECT(1);
  }
  else if (jl_is_int32(val))
  {
    int32_t *p = (int32_t *) jl_array_data(retData);
    jlint_to_r_na;
  }
  //int64
  else if (jl_is_int64(val))
  {
    int64_t *p = (int64_t *) jl_array_data(retData);
    jlbiggerint_to_r_na;
  }
  //more integer type
  else if (jl_is_int8(val))
  {
    int8_t *p = (int8_t *) jl_array_data(retData);
    jlint_to_r_na;
  }
  else if (jl_is_int16(val))
  {
    int16_t *p = (int16_t *) jl_array_data(retData);
    jlint_to_r_na;
  }
  else if (jl_is_uint8(val))
  {
    uint8_t *p = (uint8_t *) jl_array_data(retData);
    jlint_to_r_na;
  }
  else if (jl_is_uint16(val))
  {
    uint16_t *p = (uint16_t *) jl_array_data(retData);
    jlint_to_r_na;
  }
  else if (jl_is_uint32(val))
  {
    uint32_t *p = (uint32_t *) jl_array_data(retData);
    jlbiggerint_to_r_na;
  }
  else if (jl_is_uint64(val))
  {
    uint64_t *p = (uint64_t *) jl_array_data(retData);
    jlbiggerint_to_r_na;
  }
  //double
  else if (jl_is_float64(val))
  {
    double *p = (double *) jl_array_data(retData);
    jlfloat_to_r_na;
  }
  else if (jl_is_float32(val))
  {
    float *p = (float *) jl_array_data(retData);
    jlfloat_to_r_na;
  }
  //convert string array to STRSXP
  else if (jl_is_utf8_string(val))
  {
    PROTECT(ans = allocArray(STRSXP, dims));
    for (size_t i = 0; i < len; i++)
      if (pNA[i])
        SET_STRING_ELT(ans, i, NA_STRING);
      else
        SET_STRING_ELT(ans, i, mkCharCE(jl_string_data(jl_cellref(retData, i)), CE_UTF8));
    UNPROTECT(1);
  }
  else if (jl_is_ascii_string(val))
  {
    PROTECT(ans = allocArray(STRSXP, dims));
    for (size_t i = 0; i < len; i++)
      if (pNA[i])
        SET_STRING_ELT(ans, i, NA_STRING);
      else
        SET_STRING_ELT(ans, i, mkChar(jl_string_data(jl_cellref(retData, i))));
    UNPROTECT(1);
  }
  return ans;
}
Exemplo n.º 13
0
static SEXP Julia_R_MD(jl_value_t *Var)
{
  SEXP ans = R_NilValue;
  jl_value_t *val;
  if (((jl_array_t *)Var)->ptrarray)
    val = jl_cellref(Var, 0);
  else
    val = jl_arrayref((jl_array_t *)Var, 0);
  //get Julia dims and set R array Dims
  int len = jl_array_len(Var);
  if (len == 0)
    return ans;

  int ndims = jl_array_ndims(Var);
  SEXP dims;
  PROTECT(dims = allocVector(INTSXP, ndims));
  for (size_t i = 0; i < ndims; i++)
  {
    INTEGER(dims)[i] = jl_array_dim(Var, i);
  }
  UNPROTECT(1);

  if (jl_is_bool(val))
  {
    char *p = (char *) jl_array_data(Var);
    PROTECT(ans = allocArray(LGLSXP, dims));
    for (size_t i = 0; i < len; i++)
      LOGICAL(ans)[i] = p[i];
    UNPROTECT(1);
  }
  else if (jl_is_int32(val))
  {
    int32_t *p = (int32_t *) jl_array_data(Var);
    jlint_to_r;
  }
  //int64
  else if (jl_is_int64(val))
  {
    int64_t *p = (int64_t *) jl_array_data(Var);
    jlbiggerint_to_r;  
  }
  //more integer type
  else if (jl_is_int8(val))
  {
    int8_t *p = (int8_t *) jl_array_data(Var);
    jlint_to_r;
  }
  else if (jl_is_int16(val))
  {
    int16_t *p = (int16_t *) jl_array_data(Var);
    jlint_to_r;
  }
  else if (jl_is_uint8(val))
  {
    uint8_t *p = (uint8_t *) jl_array_data(Var);
    jlint_to_r;
  }
  else if (jl_is_uint16(val))
  {
    uint16_t *p = (uint16_t *) jl_array_data(Var);
    jlint_to_r;
  }
  else if (jl_is_uint32(val))
  {
    uint32_t *p = (uint32_t *) jl_array_data(Var);
    jlbiggerint_to_r;
  }
  else if (jl_is_uint64(val))
  {
    uint64_t *p = (uint64_t *) jl_array_data(Var);
    jlbiggerint_to_r;
  }
  //double
  else if (jl_is_float64(val))
  {
    double *p = (double *) jl_array_data(Var);
    jlfloat_to_r;
  }
  else if (jl_is_float32(val))
  {
    float *p = (float *) jl_array_data(Var);
    jlfloat_to_r;
  }
  //convert string array to STRSXP ,but not sure it is corret?
  else if (jl_is_utf8_string(val))
  {
    PROTECT(ans = allocArray(STRSXP, dims));
    for (size_t i = 0; i < len; i++)
      SET_STRING_ELT(ans, i, mkCharCE(jl_string_data(jl_cellref(Var, i)), CE_UTF8));
    UNPROTECT(1);
  }
  else if (jl_is_ascii_string(val))
  {
    PROTECT(ans = allocArray(STRSXP, dims));
    for (size_t i = 0; i < len; i++)
      SET_STRING_ELT(ans, i, mkChar(jl_string_data(jl_cellref(Var, i))));
    UNPROTECT(1);
  }
  return ans;
}
Exemplo n.º 14
0
jl_value_t *jl_method_def(jl_sym_t *name, jl_value_t **bp, jl_binding_t *bnd,
                          jl_tuple_t *argtypes, jl_function_t *f, jl_tuple_t *t)
{
    jl_value_t *gf;
    if (bnd) {
        //jl_declare_constant(bnd);
        if (bnd->value != NULL && !bnd->constp) {
            jl_errorf("cannot define function %s; it already has a value",
                      bnd->name->name);
        }
        bnd->constp = 1;
    }
    if (*bp == NULL) {
        gf = (jl_value_t*)jl_new_generic_function(name);
        *bp = gf;
    }
    else {
        gf = *bp;
        if (!jl_is_gf(gf)) {
            if (jl_is_datatype(gf) &&
                ((jl_function_t*)gf)->fptr == jl_f_ctor_trampoline) {
                jl_add_constructors((jl_datatype_t*)gf);
            }
            if (!jl_is_gf(gf)) {
                jl_error("invalid method definition: not a generic function");
            }
        }
    }
    JL_GC_PUSH1(&gf);
    assert(jl_is_function(f));
    assert(jl_is_tuple(argtypes));
    assert(jl_is_tuple(t));

    for(size_t i=0; i < jl_tuple_len(argtypes); i++) {
        jl_value_t *elt = jl_tupleref(argtypes,i);
        if (!jl_is_type(elt) && !jl_is_typevar(elt)) {
            jl_lambda_info_t *li = f->linfo;
            jl_errorf("invalid type for argument %s in method definition for %s at %s:%d",
                      jl_is_expr(li->ast) ?
                      ((jl_sym_t*)jl_arrayref(jl_lam_args((jl_expr_t*)li->ast),i))->name :
                      "?",
                      name->name, li->file->name, li->line);
        }
    }

    int ishidden = !!strchr(name->name, '#');
    for(size_t i=0; i < jl_tuple_len(t); i++) {
        jl_value_t *tv = jl_tupleref(t,i);
        if (!jl_is_typevar(tv))
            jl_type_error_rt(name->name, "method definition", (jl_value_t*)jl_tvar_type, tv);
        if (!ishidden && !type_contains((jl_value_t*)argtypes, tv)) {
            JL_PRINTF(JL_STDERR, "Warning: static parameter %s does not occur in signature for %s",
                      ((jl_tvar_t*)tv)->name->name, name->name);
            print_func_loc(JL_STDERR, f->linfo);
            JL_PRINTF(JL_STDERR, ".\nThe method will not be callable.\n");
        }
    }
    jl_add_method((jl_function_t*)gf, argtypes, f, t);
    if (jl_boot_file_loaded &&
        f->linfo && f->linfo->ast && jl_is_expr(f->linfo->ast)) {
        jl_lambda_info_t *li = f->linfo;
        li->ast = jl_compress_ast(li, li->ast);
    }
    JL_GC_POP();
    return gf;
}
Exemplo n.º 15
0
DLLEXPORT size_t jl_static_show(JL_STREAM *out, jl_value_t *v)
{
    // mimic jl_show, but never calling a julia method
    size_t n = 0;
    if (v == NULL) {
        n += JL_PRINTF(out, "<null>");
    }
    else if (jl_is_lambda_info(v)) {
        jl_lambda_info_t *li = (jl_lambda_info_t*)v;
        n += jl_static_show(out, (jl_value_t*)li->module);
        n += JL_PRINTF(out, ".%s", li->name->name);
        if (li->specTypes) {
            n += jl_static_show(out, (jl_value_t*)li->specTypes);
        }
        else {
            n += JL_PRINTF(out, "(?)");
        }
    }
    else if (jl_is_tuple(v)) {
        n += jl_show_tuple(out, (jl_tuple_t*)v, "(", ")", 1);
    }
    else if (jl_is_vararg_type(v)) {
        n += jl_static_show(out, jl_tparam0(v));
        n += JL_PRINTF(out, "...");
    }
    else if (jl_is_datatype(v)) {
        jl_datatype_t *dv = (jl_datatype_t*)v;
        if (dv->name->module != jl_core_module) {
            n += jl_static_show(out, (jl_value_t*)dv->name->module);
            JL_PUTS(".", out); n += 1;
        }
        n += JL_PRINTF(out, "%s", dv->name->name->name);
        if (dv->parameters) {
            size_t j, tlen = jl_tuple_len(dv->parameters);
            if (tlen > 0) {
                n += JL_PRINTF(out, "{");
                for (j = 0; j < tlen; j++) {
                    jl_value_t *p = jl_tupleref(dv->parameters,j);
                    n += jl_static_show(out, p);
                    if (j != tlen-1)
                        n += JL_PRINTF(out, ", ");
                }
                n += JL_PRINTF(out, "}");
            }
        }
    }
    else if (jl_is_func(v)) {
        if (jl_is_gf(v)) {
            n += JL_PRINTF(out, "%s", jl_gf_name(v)->name);
        }
        else {
            n += JL_PRINTF(out, "<# function>");
        }
    }
    else if (jl_typeis(v, jl_intrinsic_type)) {
        n += JL_PRINTF(out, "<# intrinsic function %d>", *(uint32_t*)jl_data_ptr(v));
    }
    else if (jl_is_int64(v)) {
        n += JL_PRINTF(out, "%d", jl_unbox_int64(v));
    }
    else if (jl_is_int32(v)) {
        n += JL_PRINTF(out, "%d", jl_unbox_int32(v));
    }
    else if (jl_typeis(v,jl_int16_type)) {
        n += JL_PRINTF(out, "%d", jl_unbox_int16(v));
    }
    else if (jl_typeis(v,jl_int8_type)) {
        n += JL_PRINTF(out, "%d", jl_unbox_int8(v));
    }
    else if (jl_is_uint64(v)) {
        n += JL_PRINTF(out, "0x%016x", jl_unbox_uint64(v));
    }
    else if (jl_is_uint32(v)) {
        n += JL_PRINTF(out, "0x%08x", jl_unbox_uint32(v));
    }
    else if (jl_typeis(v,jl_uint16_type)) {
        n += JL_PRINTF(out, "0x%04x", jl_unbox_uint16(v));
    }
    else if (jl_typeis(v,jl_uint8_type)) {
        n += JL_PRINTF(out, "0x%02x", jl_unbox_uint8(v));
    }
    else if (jl_is_cpointer(v)) {
#ifdef _P64
        n += JL_PRINTF(out, "0x%016x", jl_unbox_voidpointer(v));
#else
        n += JL_PRINTF(out, "0x%08x", jl_unbox_voidpointer(v));
#endif
    }
    else if (jl_is_float32(v)) {
        n += JL_PRINTF(out, "%g", jl_unbox_float32(v));
    }
    else if (jl_is_float64(v)) {
        n += JL_PRINTF(out, "%g", jl_unbox_float64(v));
    }
    else if (v == jl_true) {
        n += JL_PRINTF(out, "true");
    }
    else if (v == jl_false) {
        n += JL_PRINTF(out, "false");
    }
    else if (jl_is_byte_string(v)) {
        n += JL_PRINTF(out, "\"%s\"", jl_iostr_data(v));
    }
    else if (v == jl_bottom_type) {
        n += JL_PRINTF(out, "Void");
    }
    else if (jl_is_uniontype(v)) {
        n += JL_PRINTF(out, "Union");
        n += jl_static_show(out, (jl_value_t*)((jl_uniontype_t*)v)->types);
    }
    else if (jl_is_typector(v)) {
        n += jl_static_show(out, ((jl_typector_t*)v)->body);
    }
    else if (jl_is_typevar(v)) {
        n += JL_PRINTF(out, "%s", ((jl_tvar_t*)v)->name->name);
    }
    else if (jl_is_module(v)) {
        jl_module_t *m = (jl_module_t*)v;
        if (m->parent != m && m->parent != jl_main_module) {
            n += jl_static_show(out, (jl_value_t*)m->parent);
            n += JL_PRINTF(out, ".");
        }
        n += JL_PRINTF(out, "%s", m->name->name);
    }
    else if (jl_is_symbol(v)) {
        n += JL_PRINTF(out, ":%s", ((jl_sym_t*)v)->name);
    }
    else if (jl_is_symbolnode(v)) {
        n += JL_PRINTF(out, "%s::", jl_symbolnode_sym(v)->name);
        n += jl_static_show(out, jl_symbolnode_type(v));
    }
    else if (jl_is_getfieldnode(v)) {
        n += jl_static_show(out, jl_getfieldnode_val(v));
        n += JL_PRINTF(out, ".%s", jl_getfieldnode_name(v)->name);
        n += JL_PRINTF(out, "::");
        n += jl_static_show(out, jl_getfieldnode_type(v));
    }
    else if (jl_is_labelnode(v)) {
        n += JL_PRINTF(out, "%d:", jl_labelnode_label(v));
    }
    else if (jl_is_gotonode(v)) {
        n += JL_PRINTF(out, "goto %d", jl_gotonode_label(v));
    }
    else if (jl_is_quotenode(v)) {
        n += JL_PRINTF(out, "quote ");
        n += jl_static_show(out, jl_fieldref(v,0));
        n += JL_PRINTF(out, " end");
    }
    else if (jl_is_newvarnode(v)) {
        n += JL_PRINTF(out, "<newvar ");
        n += jl_static_show(out, jl_fieldref(v,0));
        n += JL_PRINTF(out, ">");
    }
    else if (jl_is_topnode(v)) {
        n += JL_PRINTF(out, "top(");
        n += jl_static_show(out, jl_fieldref(v,0));
        n += JL_PRINTF(out, ")");
    }
    else if (jl_is_linenode(v)) {
        n += JL_PRINTF(out, "# line %d", jl_linenode_line(v));
    }
    else if (jl_is_expr(v)) {
        jl_expr_t *e = (jl_expr_t*)v;
        if (e->head == assign_sym && jl_array_len(e->args) == 2) {
            n += jl_static_show(out, jl_exprarg(e,0));
            n += JL_PRINTF(out, " = ");
            n += jl_static_show(out, jl_exprarg(e,1));
        }
        else {
            char sep = ' ';
            if (e->head == body_sym)
                sep = '\n';
            n += JL_PRINTF(out, "Expr(:%s", e->head->name);
            size_t i, len = jl_array_len(e->args);
            for (i = 0; i < len; i++) {
                n += JL_PRINTF(out, ",%c", sep);
                n += jl_static_show(out, jl_exprarg(e,i));
            }
            n += JL_PRINTF(out, ")::");
            n += jl_static_show(out, e->etype);
        }
    }
    else if (jl_is_array(v)) {
        n += jl_static_show(out, jl_typeof(v));
        n += JL_PRINTF(out, "[");
        size_t j, tlen = jl_array_len(v);
        for (j = 0; j < tlen; j++) {
            n += jl_static_show(out, jl_arrayref((jl_array_t*)v,j));
            if (j != tlen-1)
               n += JL_PRINTF(out, ", ");
        }
        n += JL_PRINTF(out, "]");
    }
    else if (jl_typeis(v,jl_loaderror_type)) {
        n += JL_PRINTF(out, "LoadError(at ");
        n += jl_static_show(out, jl_fieldref(v, 0));
        n += JL_PRINTF(out, " line ");
        n += jl_static_show(out, jl_fieldref(v, 1));
        n += JL_PRINTF(out, ": ");
        n += jl_static_show(out, jl_fieldref(v, 2));
        n += JL_PRINTF(out, ")");
    }
    else if (jl_typeis(v,jl_errorexception_type)) {
        n += JL_PRINTF(out, "ErrorException(");
        n += jl_static_show(out, jl_fieldref(v, 0));
        n += JL_PRINTF(out, ")");
    }
    else if (jl_is_datatype(jl_typeof(v))) {
        jl_datatype_t *t = (jl_datatype_t*)jl_typeof(v);
        n += jl_static_show(out, (jl_value_t*)t);
        n += JL_PRINTF(out, "(");
        size_t nb = jl_datatype_size(t);
        size_t tlen = jl_tuple_len(t->names);
        if (nb > 0 && tlen == 0) {
            char *data = (char*)jl_data_ptr(v);
            n += JL_PRINTF(out, "0x");
            for(int i=nb-1; i >= 0; --i)
                n += JL_PRINTF(out, "%02hhx", data[i]);
        }
        else {
            jl_value_t *fldval=NULL;
            JL_GC_PUSH1(&fldval);
            for (size_t i = 0; i < tlen; i++) {
                n += JL_PRINTF(out, ((jl_sym_t*)jl_tupleref(t->names, i))->name);
                //jl_fielddesc_t f = t->fields[i];
                n += JL_PRINTF(out, "=");
                fldval = jl_get_nth_field(v, i);
                n += jl_static_show(out, fldval);
                if (i != tlen-1)
                    n += JL_PRINTF(out, ", ");
            }
            JL_GC_POP();
        }
        n += JL_PRINTF(out, ")");
    }
    else {
        n += JL_PRINTF(out, "<?::");
        n += jl_static_show(out, jl_typeof(v));
        n += JL_PRINTF(out, ">");
    }
    return n;
}