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"); } } } } } }
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; }
// 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; }
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; }
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; }
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(); }
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; }
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); }
//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; }
// 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; }
//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; }
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; }
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; }
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; }
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; }