// wrap expr in a thunk AST jl_lambda_info_t *jl_wrap_expr(jl_value_t *expr) { // `(lambda () (() () ()) ,expr) jl_expr_t *le=NULL, *bo=NULL; jl_value_t *vi=NULL; jl_value_t *mt = jl_an_empty_cell; JL_GC_PUSH(&le, &vi, &bo); le = jl_exprn(lambda_sym, 3); jl_cellset(le->args, 0, mt); vi = (jl_value_t*)jl_alloc_cell_1d(3); jl_cellset(vi, 0, mt); jl_cellset(vi, 1, mt); jl_cellset(vi, 2, mt); jl_cellset(le->args, 1, vi); if (!jl_is_expr(expr) || ((jl_expr_t*)expr)->head != body_sym) { bo = jl_exprn(body_sym, 1); jl_cellset(bo->args, 0, (jl_value_t*)jl_exprn(return_sym, 1)); jl_cellset(((jl_expr_t*)jl_exprarg(bo,0))->args, 0, expr); expr = (jl_value_t*)bo; } jl_cellset(le->args, 2, expr); jl_lambda_info_t *li = jl_new_lambda_info((jl_value_t*)le, jl_null); JL_GC_POP(); return li; }
// return a new lambda-info that has some extra static parameters // merged in. jl_lambda_info_t *jl_add_static_parameters(jl_lambda_info_t *l, jl_tuple_t *sp) { JL_GC_PUSH(&sp); if (l->sparams->length > 0) sp = jl_tuple_append(sp, l->sparams); jl_lambda_info_t *nli = jl_new_lambda_info(l->ast, sp); nli->name = l->name; nli->fptr = l->fptr; nli->module = l->module; nli->file = l->file; nli->line = l->line; JL_GC_POP(); return nli; }
static jl_lambda_info_t *jl_copy_lambda_info(jl_lambda_info_t *linfo) { jl_lambda_info_t *new_linfo = jl_new_lambda_info(linfo->ast, linfo->sparams, linfo->module); new_linfo->tfunc = linfo->tfunc; new_linfo->name = linfo->name; new_linfo->roots = linfo->roots; new_linfo->specTypes = linfo->specTypes; new_linfo->unspecialized = linfo->unspecialized; new_linfo->specializations = linfo->specializations; new_linfo->def = linfo->def; new_linfo->capt = linfo->capt; new_linfo->file = linfo->file; new_linfo->line = linfo->line; return new_linfo; }
jl_lambda_info_t *jl_copy_lambda_info(jl_lambda_info_t *linfo) { jl_lambda_info_t *new_linfo = jl_new_lambda_info(linfo->ast, linfo->sparam_syms, linfo->sparam_vals, linfo->module); new_linfo->rettype = linfo->rettype; new_linfo->tfunc = linfo->tfunc; new_linfo->name = linfo->name; new_linfo->roots = linfo->roots; new_linfo->specTypes = linfo->specTypes; new_linfo->unspecialized = linfo->unspecialized; new_linfo->specializations = linfo->specializations; new_linfo->def = linfo->def; new_linfo->file = linfo->file; new_linfo->line = linfo->line; new_linfo->fptr = linfo->fptr; new_linfo->jlcall_api = linfo->jlcall_api; new_linfo->functionObjects.functionObject = linfo->functionObjects.functionObject; new_linfo->functionObjects.specFunctionObject = linfo->functionObjects.specFunctionObject; new_linfo->functionID = linfo->functionID; new_linfo->specFunctionID = linfo->specFunctionID; new_linfo->needs_sparam_vals_ducttape = linfo->needs_sparam_vals_ducttape; return new_linfo; }
static jl_value_t *scm_to_julia_(value_t e) { if (fl_isnumber(e)) { if (iscprim(e)) { numerictype_t nt = cp_numtype((cprim_t*)ptr(e)); switch (nt) { case T_DOUBLE: return (jl_value_t*)jl_box_float64(*(double*)cp_data((cprim_t*)ptr(e))); case T_FLOAT: return (jl_value_t*)jl_box_float32(*(float*)cp_data((cprim_t*)ptr(e))); case T_INT64: return (jl_value_t*)jl_box_int64(*(int64_t*)cp_data((cprim_t*)ptr(e))); case T_UINT8: return (jl_value_t*)jl_box_uint8(*(uint8_t*)cp_data((cprim_t*)ptr(e))); case T_UINT16: return (jl_value_t*)jl_box_uint16(*(uint16_t*)cp_data((cprim_t*)ptr(e))); case T_UINT32: return (jl_value_t*)jl_box_uint32(*(uint32_t*)cp_data((cprim_t*)ptr(e))); case T_UINT64: return (jl_value_t*)jl_box_uint64(*(uint64_t*)cp_data((cprim_t*)ptr(e))); default: ; } } if (isfixnum(e)) { int64_t ne = numval(e); #ifdef __LP64__ return (jl_value_t*)jl_box_int64(ne); #else if (ne > S32_MAX || ne < S32_MIN) return (jl_value_t*)jl_box_int64(ne); return (jl_value_t*)jl_box_int32((int32_t)ne); #endif } uint64_t n = toulong(e, "scm_to_julia"); #ifdef __LP64__ return (jl_value_t*)jl_box_int64((int64_t)n); #else if (n > S32_MAX) return (jl_value_t*)jl_box_int64((int64_t)n); return (jl_value_t*)jl_box_int32((int32_t)n); #endif } if (issymbol(e)) { if (!fl_isgensym(e)) { char *sn = symbol_name(e); if (!strcmp(sn, "true")) return jl_true; else if (!strcmp(sn, "false")) return jl_false; } return (jl_value_t*)scmsym_to_julia(e); } if (fl_isstring(e)) { return jl_pchar_to_string(cvalue_data(e), cvalue_len(e)); } if (e == FL_F) { return jl_false; } if (e == FL_T) { return jl_true; } if (e == FL_NIL) { return (jl_value_t*)jl_null; } if (iscons(e)) { value_t hd = car_(e); if (issymbol(hd)) { jl_sym_t *sym = scmsym_to_julia(hd); /* tree node types: goto gotoifnot label return lambda call = quote null top method body file new line enter leave */ size_t n = llength(e)-1; size_t i; if (sym == lambda_sym) { jl_expr_t *ex = jl_exprn(lambda_sym, n); e = cdr_(e); value_t largs = car_(e); jl_cellset(ex->args, 0, full_list(largs)); e = cdr_(e); value_t ee = car_(e); jl_array_t *vinf = jl_alloc_cell_1d(3); jl_cellset(vinf, 0, full_list(car_(ee))); ee = cdr_(ee); jl_cellset(vinf, 1, full_list_of_lists(car_(ee))); ee = cdr_(ee); jl_cellset(vinf, 2, full_list_of_lists(car_(ee))); assert(!iscons(cdr_(ee))); jl_cellset(ex->args, 1, vinf); e = cdr_(e); for(i=2; i < n; i++) { assert(iscons(e)); jl_cellset(ex->args, i, scm_to_julia_(car_(e))); e = cdr_(e); } return (jl_value_t*)jl_new_lambda_info((jl_value_t*)ex, jl_null); } e = cdr_(e); if (sym == line_sym && n==1) { return jl_new_struct(jl_linenumbernode_type, scm_to_julia_(car_(e))); } if (sym == label_sym) { return jl_new_struct(jl_labelnode_type, scm_to_julia_(car_(e))); } if (sym == goto_sym) { return jl_new_struct(jl_gotonode_type, scm_to_julia_(car_(e))); } if (sym == quote_sym) { return jl_new_struct(jl_quotenode_type, scm_to_julia_(car_(e))); } if (sym == top_sym) { return jl_new_struct(jl_topnode_type, scm_to_julia_(car_(e))); } jl_expr_t *ex = jl_exprn(sym, n); for(i=0; i < n; i++) { assert(iscons(e)); jl_cellset(ex->args, i, scm_to_julia_(car_(e))); e = cdr_(e); } return (jl_value_t*)ex; } else { jl_error("malformed tree"); } } if (iscprim(e) && cp_class((cprim_t*)ptr(e))==wchartype) { jl_value_t *wc = jl_box32(jl_char_type, *(int32_t*)cp_data((cprim_t*)ptr(e))); return wc; } if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jvtype) { return *(jl_value_t**)cv_data((cvalue_t*)ptr(e)); } jl_error("malformed tree"); return (jl_value_t*)jl_null; }
static jl_value_t *scm_to_julia_(value_t e, int eo) { if (fl_isnumber(e)) { int64_t i64; if (isfixnum(e)) { i64 = numval(e); } else { assert(iscprim(e)); cprim_t *cp = (cprim_t*)ptr(e); numerictype_t nt = cp_numtype(cp); switch (nt) { case T_DOUBLE: return (jl_value_t*)jl_box_float64(*(double*)cp_data(cp)); case T_FLOAT: return (jl_value_t*)jl_box_float32(*(float*)cp_data(cp)); case T_UINT8: return (jl_value_t*)jl_box_uint8(*(uint8_t*)cp_data(cp)); case T_UINT16: return (jl_value_t*)jl_box_uint16(*(uint16_t*)cp_data(cp)); case T_UINT32: return (jl_value_t*)jl_box_uint32(*(uint32_t*)cp_data(cp)); case T_UINT64: return (jl_value_t*)jl_box_uint64(*(uint64_t*)cp_data(cp)); default: ; } i64 = conv_to_int64(cp_data(cp), nt); } if ( #ifdef _P64 jl_compileropts.int_literals==32 #else jl_compileropts.int_literals!=64 #endif ) { if (i64 > (int64_t)S32_MAX || i64 < (int64_t)S32_MIN) return (jl_value_t*)jl_box_int64(i64); return (jl_value_t*)jl_box_int32((int32_t)i64); } else { return (jl_value_t*)jl_box_int64(i64); } } if (issymbol(e)) { if (e == true_sym) return jl_true; else if (e == false_sym) return jl_false; return (jl_value_t*)scmsym_to_julia(e); } if (fl_isstring(e)) { return jl_pchar_to_string((char*)cvalue_data(e), cvalue_len(e)); } if (e == FL_F) { return jl_false; } if (e == FL_T) { return jl_true; } if (e == FL_NIL) { return (jl_value_t*)jl_null; } if (iscons(e)) { value_t hd = car_(e); if (issymbol(hd)) { jl_sym_t *sym = scmsym_to_julia(hd); /* tree node types: goto gotoifnot label return lambda call = quote null top method body file new line enter leave */ size_t n = llength(e)-1; size_t i; if (sym == null_sym && n == 0) return jl_nothing; if (sym == lambda_sym) { jl_expr_t *ex = jl_exprn(lambda_sym, n); e = cdr_(e); value_t largs = car_(e); jl_cellset(ex->args, 0, full_list(largs,eo)); e = cdr_(e); value_t ee = car_(e); jl_array_t *vinf = jl_alloc_cell_1d(3); jl_cellset(vinf, 0, full_list(car_(ee),eo)); ee = cdr_(ee); jl_cellset(vinf, 1, full_list_of_lists(car_(ee),eo)); ee = cdr_(ee); jl_cellset(vinf, 2, full_list_of_lists(car_(ee),eo)); assert(!iscons(cdr_(ee))); jl_cellset(ex->args, 1, vinf); e = cdr_(e); for(i=2; i < n; i++) { assert(iscons(e)); jl_cellset(ex->args, i, scm_to_julia_(car_(e), eo)); e = cdr_(e); } return (jl_value_t*)jl_new_lambda_info((jl_value_t*)ex, jl_null); } e = cdr_(e); if (!eo) { if (sym == line_sym && n==1) { return jl_new_struct(jl_linenumbernode_type, scm_to_julia_(car_(e),0)); } if (sym == label_sym) { return jl_new_struct(jl_labelnode_type, scm_to_julia_(car_(e),0)); } if (sym == goto_sym) { return jl_new_struct(jl_gotonode_type, scm_to_julia_(car_(e),0)); } if (sym == quote_sym) { return jl_new_struct(jl_quotenode_type, scm_to_julia_(car_(e),0)); } if (sym == top_sym) { return jl_new_struct(jl_topnode_type, scm_to_julia_(car_(e),0)); } if (sym == newvar_sym) { return jl_new_struct(jl_newvarnode_type, scm_to_julia_(car_(e),0)); } } jl_expr_t *ex = jl_exprn(sym, n); // allocate a fresh args array for empty exprs passed to macros if (eo && n == 0) ex->args = jl_alloc_cell_1d(0); for(i=0; i < n; i++) { assert(iscons(e)); jl_cellset(ex->args, i, scm_to_julia_(car_(e),eo)); e = cdr_(e); } return (jl_value_t*)ex; } else { jl_error("malformed tree"); } } if (iscprim(e) && cp_class((cprim_t*)ptr(e))==wchartype) { jl_value_t *wc = jl_box32(jl_char_type, *(int32_t*)cp_data((cprim_t*)ptr(e))); return wc; } if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jvtype) { return *(jl_value_t**)cv_data((cvalue_t*)ptr(e)); } jl_error("malformed tree"); return (jl_value_t*)jl_null; }