// get kwsorter field, with appropriate error check and message
JL_DLLEXPORT jl_value_t *jl_get_keyword_sorter(jl_value_t *f)
{
jl_methtable_t *mt = jl_gf_mtable(f);
if (mt->kwsorter == NULL)
jl_errorf("function %s does not accept keyword arguments", jl_symbol_name(mt->name));
return mt->kwsorter;
}
static jl_value_t *jl_invoke_julia_macro(jl_array_t *args, jl_module_t *inmodule, jl_module_t **ctx)
{
jl_ptls_t ptls = jl_get_ptls_states();
JL_TIMING(MACRO_INVOCATION);
size_t nargs = jl_array_len(args) + 1;
JL_NARGSV("macrocall", 3); // macro name, location, and module
jl_value_t **margs;
JL_GC_PUSHARGS(margs, nargs);
int i;
margs[0] = jl_array_ptr_ref(args, 0);
// __source__ argument
jl_value_t *lno = jl_array_ptr_ref(args, 1);
margs[1] = lno;
if (!jl_typeis(lno, jl_linenumbernode_type)) {
margs[1] = jl_new_struct(jl_linenumbernode_type, jl_box_long(0), jl_nothing);
}
margs[2] = (jl_value_t*)inmodule;
for (i = 3; i < nargs; i++)
margs[i] = jl_array_ptr_ref(args, i - 1);
size_t last_age = ptls->world_age;
size_t world = jl_world_counter;
ptls->world_age = world;
jl_value_t *result;
JL_TRY {
margs[0] = jl_toplevel_eval(*ctx, margs[0]);
jl_method_instance_t *mfunc = jl_method_lookup(jl_gf_mtable(margs[0]), margs, nargs, 1, world);
if (mfunc == NULL) {
jl_method_error((jl_function_t*)margs[0], margs, nargs, world);
// unreachable
}
*ctx = mfunc->def.method->module;
result = mfunc->invoke(mfunc, margs, nargs);
}
JL_CATCH {
if (jl_loaderror_type == NULL) {
jl_rethrow();
}
else {
jl_value_t *lno = margs[1];
jl_value_t *file = jl_fieldref(lno, 1);
if (jl_is_symbol(file))
margs[0] = jl_cstr_to_string(jl_symbol_name((jl_sym_t*)file));
else
margs[0] = jl_cstr_to_string("<macrocall>");
margs[1] = jl_fieldref(lno, 0); // extract and allocate line number
jl_rethrow_other(jl_new_struct(jl_loaderror_type, margs[0], margs[1],
ptls->exception_in_transit));
}
}
ptls->world_age = last_age;
JL_GC_POP();
return result;
}
value_t fl_invoke_julia_macro(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
if (nargs < 1)
argcount(fl_ctx, "invoke-julia-macro", nargs, 1);
jl_lambda_info_t *mfunc = NULL;
jl_value_t **margs;
// Reserve one more slot for the result
JL_GC_PUSHARGS(margs, nargs + 1);
int i;
for(i=1; i < nargs; i++) margs[i] = scm_to_julia(fl_ctx, args[i], 1);
jl_value_t *result = NULL;
JL_TRY {
margs[0] = scm_to_julia(fl_ctx, args[0], 1);
margs[0] = jl_toplevel_eval(margs[0]);
mfunc = jl_method_lookup(jl_gf_mtable(margs[0]), margs, nargs, 1);
if (mfunc == NULL) {
JL_GC_POP();
jl_method_error((jl_function_t*)margs[0], margs, nargs);
// unreachable
}
margs[nargs] = result = jl_call_method_internal(mfunc, margs, nargs);
}
JL_CATCH {
JL_GC_POP();
value_t opaque = cvalue(fl_ctx, jl_ast_ctx(fl_ctx)->jvtype, sizeof(void*));
*(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = jl_exception_in_transit;
return fl_list2(fl_ctx, jl_ast_ctx(fl_ctx)->error_sym, opaque);
}
// protect result from GC, otherwise it could be freed during future
// macro expansions, since it will be referenced only from scheme and
// not julia.
// all calls to invoke-julia-macro happen under `jl_macroexpand`,
// `jl_expand` or `jl_parse_eval_all` so the preserved array is rooted there.
assert(result != NULL);
jl_ast_preserve(fl_ctx, result);
value_t scm = julia_to_scm(fl_ctx, result);
fl_gc_handle(fl_ctx, &scm);
value_t scmresult;
jl_module_t *defmod = mfunc->def->module;
if (defmod == NULL || defmod == jl_current_module) {
scmresult = fl_cons(fl_ctx, scm, fl_ctx->F);
}
else {
value_t opaque = cvalue(fl_ctx, jl_ast_ctx(fl_ctx)->jvtype, sizeof(void*));
*(jl_value_t**)cv_data((cvalue_t*)ptr(opaque)) = (jl_value_t*)defmod;
scmresult = fl_cons(fl_ctx, scm, opaque);
}
fl_free_gc_handles(fl_ctx, 1);
JL_GC_POP();
return scmresult;
}
static void print_profile(void)
{
size_t i;
void **table = jl_base_module->bindings.table;
for(i=1; i < jl_base_module->bindings.size; i+=2) {
if (table[i] != HT_NOTFOUND) {
jl_binding_t *b = (jl_binding_t*)table[i];
if (b->value != NULL && jl_is_function(b->value) &&
jl_is_gf(b->value)) {
ios_printf(ios_stdout, "%d\t%s\n",
jl_gf_mtable(b->value)->ncalls,
jl_gf_name(b->value)->name);
}
}
}
}
DLLEXPORT
void jl_save_system_image(char *fname, char *startscriptname)
{
jl_gc_collect();
jl_gc_collect();
int en = jl_gc_is_enabled();
jl_gc_disable();
htable_reset(&backref_table, 50000);
ios_t f;
ios_file(&f, fname, 1, 1, 1, 1);
// orphan old Base module if present
jl_base_module = (jl_module_t*)jl_get_global(jl_main_module, jl_symbol("Base"));
// delete cached slow ASCIIString constructor if present
jl_methtable_t *mt = jl_gf_mtable((jl_function_t*)jl_ascii_string_type);
jl_array_t *spec = mt->defs->func->linfo->specializations;
if (spec->length > 0 &&
((jl_lambda_info_t*)jl_cellref(spec,0))->inferred == 0) {
mt->cache = JL_NULL;
mt->cache_arg1 = JL_NULL;
mt->defs->func->linfo->tfunc = (jl_value_t*)jl_null;
mt->defs->func->linfo->specializations = NULL;
}
jl_idtable_type = jl_get_global(jl_base_module, jl_symbol("ObjectIdDict"));
jl_serialize_value(&f, jl_array_type->env);
jl_serialize_value(&f, jl_main_module);
write_int32(&f, jl_get_t_uid_ctr());
write_int32(&f, jl_get_gs_ctr());
htable_reset(&backref_table, 0);
ios_t ss;
ios_file(&ss, startscriptname, 1, 0, 0, 0);
ios_copyall(&f, &ss);
ios_close(&ss);
ios_putc(0, &f);
ios_close(&f);
if (en) jl_gc_enable();
}
static void clear_tfunc_caches(void)
{
htable_t *t = &jl_system_module->bindings;
size_t i;
for(i=0; i < t->size; i+=2) {
if (t->table[i+1] == HT_NOTFOUND)
continue;
jl_binding_t *b = (jl_binding_t*)t->table[i+1];
if (b->value != NULL && jl_is_func(b->value) && jl_is_gf(b->value)) {
jl_function_t *f = (jl_function_t*)b->value;
jl_methtable_t *mt = jl_gf_mtable(f);
//mt->cache = NULL;
jl_methlist_t *ml = mt->defs;
while (ml != NULL) {
if (ml->func != NULL && ml->func->linfo != NULL)
ml->func->linfo->tfunc = (jl_value_t*)jl_null;
ml = ml->next;
}
}
}
}
DLLEXPORT
void jl_save_system_image(char *fname, char *startscriptname)
{
jl_gc_collect();
jl_gc_collect();
int en = jl_gc_is_enabled();
jl_gc_disable();
htable_reset(&backref_table, 50000);
ios_t f;
ios_file(&f, fname, 1, 1, 1, 1);
if (jl_current_module != jl_system_module) {
// set up for stage 1 bootstrap, where the System module is already
// loaded and we are loading an updated copy in a separate module.
// step 1: set Base.System = current_module
jl_binding_t *b = jl_get_binding_wr(jl_base_module, jl_symbol("System"));
b->value = (jl_value_t*)jl_current_module;
assert(b->constp);
// step 2: set current_module.Base = Base
jl_set_const(jl_current_module, jl_symbol("Base"), (jl_value_t*)jl_base_module);
// step 3: current_module.System = current_module
b = jl_get_binding_wr(jl_current_module, jl_symbol("System"));
b->value = (jl_value_t*)jl_current_module;
assert(b->constp);
// step 4: remove current_module.current_module
b = jl_get_binding_wr(jl_current_module, jl_current_module->name);
b->value = NULL; b->constp = 0;
// step 5: rename current_module to System
jl_current_module->name = jl_symbol("System");
// step 6: orphan old system module
jl_system_module = jl_current_module;
}
else {
// delete cached slow ASCIIString constructor
jl_methtable_t *mt = jl_gf_mtable((jl_function_t*)jl_ascii_string_type);
mt->cache = NULL;
mt->cache_1arg = NULL;
mt->defs->func->linfo->tfunc = (jl_value_t*)jl_null;
mt->defs->func->linfo->specializations = NULL;
}
jl_idtable_type = jl_get_global(jl_system_module, jl_symbol("IdTable"));
idtable_list = jl_alloc_cell_1d(0);
jl_serialize_value(&f, jl_array_type->env);
jl_serialize_value(&f, jl_base_module);
jl_serialize_value(&f, jl_current_module);
jl_serialize_value(&f, idtable_list);
//jl_serialize_finalizers(&f);
write_int32(&f, jl_get_t_uid_ctr());
write_int32(&f, jl_get_gs_ctr());
htable_reset(&backref_table, 0);
ios_t ss;
ios_file(&ss, startscriptname, 1, 0, 0, 0);
ios_copyall(&f, &ss);
ios_close(&ss);
ios_putc(0, &f);
ios_close(&f);
if (en) jl_gc_enable();
}
DLLEXPORT jl_value_t *jl_method_def(jl_sym_t *name, jl_value_t **bp, jl_value_t *bp_owner,
jl_binding_t *bnd,
jl_svec_t *argdata, jl_function_t *f, jl_value_t *isstaged,
jl_value_t *call_func, int iskw)
{
jl_module_t *module = (bnd ? bnd->owner : NULL);
// argdata is svec({types...}, svec(typevars...))
jl_tupletype_t *argtypes = (jl_tupletype_t*)jl_svecref(argdata,0);
jl_svec_t *tvars = (jl_svec_t*)jl_svecref(argdata,1);
jl_value_t *gf = NULL;
JL_GC_PUSH4(&gf, &tvars, &argtypes, &f);
if (bnd && bnd->value != NULL && !bnd->constp) {
jl_errorf("cannot define function %s; it already has a value", bnd->name->name);
}
if (*bp != NULL) {
gf = *bp;
if (!jl_is_gf(gf)) {
if (jl_is_datatype(gf)) {
// DataType: define `call`, for backwards compat with outer constructors
if (call_func == NULL)
call_func = (jl_value_t*)jl_module_call_func(jl_current_module);
size_t na = jl_nparams(argtypes);
jl_svec_t *newargtypes = jl_alloc_svec(1 + na);
jl_lambda_info_t *new_linfo = NULL;
JL_GC_PUSH2(&newargtypes, &new_linfo);
new_linfo = jl_copy_lambda_info(f->linfo);
f = jl_new_closure(f->fptr, f->env, new_linfo);
size_t i=0;
if (iskw) {
assert(na > 0);
// for kw sorter, keep container argument first
jl_svecset(newargtypes, 0, jl_tparam(argtypes, 0));
i++;
}
jl_svecset(newargtypes, i, jl_wrap_Type(gf));
i++;
for(; i < na+1; i++) {
jl_svecset(newargtypes, i, jl_tparam(argtypes, i-1));
}
argtypes = jl_apply_tuple_type(newargtypes);
JL_GC_POP();
gf = call_func;
name = call_sym;
// edit args, insert type first
if (!jl_is_expr(f->linfo->ast)) {
f->linfo->ast = jl_uncompress_ast(f->linfo, f->linfo->ast);
jl_gc_wb(f->linfo, f->linfo->ast);
}
else {
// Do not mutate the original ast since it might
// be reused somewhere else
f->linfo->ast = jl_copy_ast(f->linfo->ast);
jl_gc_wb(f->linfo, f->linfo->ast);
}
jl_array_t *al = jl_lam_args((jl_expr_t*)f->linfo->ast);
if (jl_array_len(al) == 0) {
al = jl_alloc_cell_1d(1);
jl_exprargset(f->linfo->ast, 0, (jl_value_t*)al);
}
else {
jl_array_grow_beg(al, 1);
}
if (iskw) {
jl_cellset(al, 0, jl_cellref(al, 1));
jl_cellset(al, 1, (jl_value_t*)jl_gensym());
}
else {
jl_cellset(al, 0, (jl_value_t*)jl_gensym());
}
}
if (!jl_is_gf(gf)) {
jl_errorf("cannot define function %s; it already has a value", name->name);
}
}
if (iskw) {
jl_methtable_t *mt = jl_gf_mtable(gf);
assert(!module);
module = mt->module;
bp = (jl_value_t**)&mt->kwsorter;
bp_owner = (jl_value_t*)mt;
gf = *bp;
}
}
// TODO
size_t na = jl_nparams(argtypes);
for(size_t i=0; i < na; i++) {
jl_value_t *elt = jl_tparam(argtypes,i);
if (!jl_is_type(elt) && !jl_is_typevar(elt)) {
jl_lambda_info_t *li = f->linfo;
jl_exceptionf(jl_argumenterror_type, "invalid type for argument %s in method definition for %s at %s:%d",
jl_lam_argname(li,i)->name, name->name, li->file->name, li->line);
}
}
int ishidden = !!strchr(name->name, '#');
for(size_t i=0; i < jl_svec_len(tvars); i++) {
jl_value_t *tv = jl_svecref(tvars,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");
}
}
if (bnd) {
bnd->constp = 1;
}
if (*bp == NULL) {
gf = (jl_value_t*)jl_new_generic_function(name, module);
*bp = gf;
if (bp_owner) jl_gc_wb(bp_owner, gf);
}
assert(jl_is_function(f));
assert(jl_is_tuple_type(argtypes));
assert(jl_is_svec(tvars));
jl_add_method((jl_function_t*)gf, argtypes, f, tvars, isstaged == jl_true);
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_wb(li, li->ast);
}
JL_GC_POP();
return gf;
}
