static value_t fl_truncate(value_t *args, u_int32_t nargs) { argcount("truncate", nargs, 1); if (isfixnum(args[0])) return args[0]; if (iscprim(args[0])) { cprim_t *cp = (cprim_t*)ptr(args[0]); void *data = cp_data(cp); numerictype_t nt = cp_numtype(cp); double d; if (nt == T_FLOAT) d = (double)*(float*)data; else if (nt == T_DOUBLE) d = *(double*)data; else return args[0]; if (d > 0) { if (d > (double)U64_MAX) return args[0]; return return_from_uint64((uint64_t)d); } if (d > (double)S64_MAX || d < (double)S64_MIN) return args[0]; return return_from_int64((int64_t)d); } type_error("truncate", "number", args[0]); }
static value_t fl_integer_valuedp(value_t *args, u_int32_t nargs) { argcount("integer-valued?", nargs, 1); value_t v = args[0]; if (isfixnum(v)) { return FL_T; } else if (iscprim(v)) { numerictype_t nt = cp_numtype((cprim_t*)ptr(v)); if (nt < T_FLOAT) return FL_T; void *data = cp_data((cprim_t*)ptr(v)); if (nt == T_FLOAT) { float f = *(float*)data; if (f < 0) f = -f; if (f <= FLT_MAXINT && (float)(int32_t)f == f) return FL_T; } else { assert(nt == T_DOUBLE); double d = *(double*)data; if (d < 0) d = -d; if (d <= DBL_MAXINT && (double)(int64_t)d == d) return FL_T; } } return FL_F; }
static value_t fl_integerp(value_t *args, u_int32_t nargs) { argcount("integer?", nargs, 1); value_t v = args[0]; return (isfixnum(v) || (iscprim(v) && cp_numtype((cprim_t*)ptr(v)) < T_FLOAT)) ? FL_T : FL_F; }
static inline int tinyp(fl_context_t *fl_ctx, value_t v) { if (issymbol(v)) return (u8_strwidth(symbol_name(fl_ctx, v)) < SMALL_STR_LEN); if (fl_isstring(fl_ctx, v)) return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN); return (isfixnum(v) || isbuiltin(v) || v==fl_ctx->F || v==fl_ctx->T || v==fl_ctx->NIL || v == fl_ctx->FL_EOF); }
static inline int tinyp(value_t v) { if (issymbol(v)) return (u8_strwidth(symbol_name(v)) < SMALL_STR_LEN); if (fl_isstring(v)) return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN); return (isfixnum(v) || isbuiltin(v) || v==FL_F || v==FL_T || v==FL_NIL || v == FL_EOF); }
static double todouble(value_t a, char *fname) { if (isfixnum(a)) return (double)numval(a); if (iscprim(a)) { cprim_t *cp = (cprim_t*)ptr(a); numerictype_t nt = cp_numtype(cp); return conv_to_double(cp_data(cp), nt); } type_error(fname, "number", a); }
static value_t fl_fixnum(value_t *args, u_int32_t nargs) { argcount("fixnum", nargs, 1); if (isfixnum(args[0])) { return args[0]; } else if (iscprim(args[0])) { cprim_t *cp = (cprim_t*)ptr(args[0]); return fixnum(conv_to_long(cp_data(cp), cp_numtype(cp))); } type_error("fixnum", "number", args[0]); }
value_t fl_julia_logmsg(fl_context_t *fl_ctx, value_t *args, uint32_t nargs) { int kwargs_len = (int)nargs - 6; if (nargs < 6 || kwargs_len % 2 != 0) { lerror(fl_ctx, fl_ctx->ArgError, "julia-logmsg: bad argument list - expected " "level (symbol) group (symbol) id file line msg . kwargs"); } value_t arg_level = args[0]; value_t arg_group = args[1]; value_t arg_id = args[2]; value_t arg_file = args[3]; value_t arg_line = args[4]; value_t arg_msg = args[5]; value_t *arg_kwargs = args + 6; if (!isfixnum(arg_level) || !issymbol(arg_group) || !issymbol(arg_id) || !issymbol(arg_file) || !isfixnum(arg_line) || !fl_isstring(fl_ctx, arg_msg)) { lerror(fl_ctx, fl_ctx->ArgError, "julia-logmsg: Unexpected type in argument list"); } // Abuse scm_to_julia here to convert arguments. This is meant for `Expr`s // but should be good enough provided we're only passing simple numbers, // symbols and strings. jl_value_t *group=NULL, *id=NULL, *file=NULL, *line=NULL, *msg=NULL; jl_array_t *kwargs=NULL; JL_GC_PUSH6(&group, &id, &file, &line, &msg, &kwargs); group = scm_to_julia(fl_ctx, arg_group, NULL); id = scm_to_julia(fl_ctx, arg_id, NULL); file = scm_to_julia(fl_ctx, arg_file, NULL); line = scm_to_julia(fl_ctx, arg_line, NULL); msg = scm_to_julia(fl_ctx, arg_msg, NULL); kwargs = jl_alloc_vec_any(kwargs_len); for (int i = 0; i < kwargs_len; ++i) { jl_array_ptr_set(kwargs, i, scm_to_julia(fl_ctx, arg_kwargs[i], NULL)); } jl_log(numval(arg_level), NULL, group, id, file, line, (jl_value_t*)kwargs, msg); JL_GC_POP(); return fl_ctx->T; }
jl_value_t *jl_parse_next(int *plineno) { value_t c = fl_applyn(0, symbol_value(symbol("jl-parser-next"))); if (c == FL_F) return NULL; if (iscons(c)) { value_t a = car_(c); if (isfixnum(a)) { *plineno = numval(a); return scm_to_julia(cdr_(c)); } } return scm_to_julia(c); }
jl_value_t *jl_parse_next() { value_t c = fl_applyn(0, symbol_value(symbol("jl-parser-next"))); if (c == FL_F) return NULL; if (iscons(c)) { value_t a = car_(c); if (isfixnum(a)) { jl_lineno = numval(a); //jl_printf(JL_STDERR, " on line %d\n", jl_lineno); return scm_to_julia(cdr_(c)); } } return scm_to_julia(c); }
jl_value_t *jl_parse_next(void) { value_t c = fl_applyn(0, symbol_value(symbol("jl-parser-next"))); if (c == FL_EOF) return NULL; if (iscons(c)) { if (cdr_(c) == FL_EOF) return NULL; value_t a = car_(c); if (isfixnum(a)) { jl_lineno = numval(a); //jl_printf(JL_STDERR, " on line %d\n", jl_lineno); c = cdr_(c); } } // for error, get most recent line number if (iscons(c) && car_(c) == fl_error_sym) jl_lineno = numval(fl_applyn(0, symbol_value(symbol("jl-parser-current-lineno")))); return scm_to_julia(c,0); }
static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, int eo) { if (fl_isnumber(fl_ctx, 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); } #ifdef _P64 return (jl_value_t*)jl_box_int64(i64); #else if (i64 > (int64_t)S32_MAX || i64 < (int64_t)S32_MIN) return (jl_value_t*)jl_box_int64(i64); else return (jl_value_t*)jl_box_int32((int32_t)i64); #endif } if (issymbol(e)) { if (e == jl_ast_ctx(fl_ctx)->true_sym) return jl_true; else if (e == jl_ast_ctx(fl_ctx)->false_sym) return jl_false; return (jl_value_t*)scmsym_to_julia(fl_ctx, e); } if (fl_isstring(fl_ctx, e)) return jl_pchar_to_string((char*)cvalue_data(e), cvalue_len(e)); if (iscons(e) || e == fl_ctx->NIL) { value_t hd; jl_sym_t *sym; if (e == fl_ctx->NIL) { hd = e; } else { hd = car_(e); if (hd == jl_ast_ctx(fl_ctx)->ssavalue_sym) return jl_box_ssavalue(numval(car_(cdr_(e)))); else if (hd == jl_ast_ctx(fl_ctx)->slot_sym) return jl_box_slotnumber(numval(car_(cdr_(e)))); else if (hd == jl_ast_ctx(fl_ctx)->null_sym && llength(e) == 1) return jl_nothing; } if (issymbol(hd)) sym = scmsym_to_julia(fl_ctx, hd); else sym = list_sym; size_t n = llength(e)-1; if (issymbol(hd)) e = cdr_(e); else n++; if (!eo) { if (sym == line_sym && n==1) { jl_value_t *linenum = scm_to_julia_(fl_ctx, car_(e), 0); JL_GC_PUSH1(&linenum); jl_value_t *temp = jl_new_struct(jl_linenumbernode_type, linenum); JL_GC_POP(); return temp; } jl_value_t *scmv = NULL, *temp = NULL; JL_GC_PUSH1(&scmv); if (sym == label_sym) { scmv = scm_to_julia_(fl_ctx,car_(e),0); temp = jl_new_struct(jl_labelnode_type, scmv); JL_GC_POP(); return temp; } if (sym == goto_sym) { scmv = scm_to_julia_(fl_ctx,car_(e),0); temp = jl_new_struct(jl_gotonode_type, scmv); JL_GC_POP(); return temp; } if (sym == inert_sym || (sym == quote_sym && (!iscons(car_(e))))) { scmv = scm_to_julia_(fl_ctx,car_(e),0); temp = jl_new_struct(jl_quotenode_type, scmv); JL_GC_POP(); return temp; } if (sym == top_sym) { scmv = scm_to_julia_(fl_ctx,car_(e),0); assert(jl_is_symbol(scmv)); temp = jl_module_globalref(jl_base_relative_to(jl_current_module), (jl_sym_t*)scmv); JL_GC_POP(); return temp; } if (sym == core_sym) { scmv = scm_to_julia_(fl_ctx,car_(e),0); assert(jl_is_symbol(scmv)); temp = jl_module_globalref(jl_core_module, (jl_sym_t*)scmv); JL_GC_POP(); return temp; } if (sym == globalref_sym) { scmv = scm_to_julia_(fl_ctx,car_(e),0); temp = scm_to_julia_(fl_ctx,car_(cdr_(e)),0); assert(jl_is_module(scmv)); assert(jl_is_symbol(temp)); temp = jl_module_globalref((jl_module_t*)scmv, (jl_sym_t*)temp); JL_GC_POP(); return temp; } if (sym == newvar_sym) { scmv = scm_to_julia_(fl_ctx,car_(e),0); temp = jl_new_struct(jl_newvarnode_type, scmv); JL_GC_POP(); return temp; } JL_GC_POP(); } else if (sym == inert_sym && !iscons(car_(e))) { sym = quote_sym; } jl_value_t *ex = (jl_value_t*)jl_exprn(sym, n); JL_GC_PUSH1(&ex); // allocate a fresh args array for empty exprs passed to macros if (eo && n == 0) { ((jl_expr_t*)ex)->args = jl_alloc_vec_any(0); jl_gc_wb(ex, ((jl_expr_t*)ex)->args); } size_t i; for(i=0; i < n; i++) { assert(iscons(e)); jl_array_ptr_set(((jl_expr_t*)ex)->args, i, scm_to_julia_(fl_ctx, car_(e), eo)); e = cdr_(e); } if (sym == lambda_sym) ex = (jl_value_t*)jl_new_lambda_info_from_ast((jl_expr_t*)ex); JL_GC_POP(); if (sym == list_sym) return (jl_value_t*)((jl_expr_t*)ex)->args; return (jl_value_t*)ex; } if (iscprim(e) && cp_class((cprim_t*)ptr(e)) == fl_ctx->wchartype) { return jl_box32(jl_char_type, *(int32_t*)cp_data((cprim_t*)ptr(e))); } if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jl_ast_ctx(fl_ctx)->jvtype) { return *(jl_value_t**)cv_data((cvalue_t*)ptr(e)); } jl_error("malformed tree"); return jl_nothing; }
static bool is_self_evaluating(object_t *obj) { return isfixnum(obj) || isboolean(obj) || ischaracter(obj) || isstring(obj) || isprimitiveproc(obj); }
// strange comparisons are resolved arbitrarily but consistently. // ordering: number < cprim < function < vector < cvalue < symbol < cons static value_t bounded_compare(value_t a, value_t b, int bound, int eq) { value_t d; compare_top: if (a == b) return fixnum(0); if (bound <= 0) return NIL; int taga = tag(a); int tagb = cmptag(b); int c; switch (taga) { case TAG_NUM : case TAG_NUM1: if (isfixnum(b)) { return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1); } if (iscprim(b)) { if (cp_class((cprim_t*)ptr(b)) == wchartype) return fixnum(1); return fixnum(numeric_compare(a, b, eq, 1, NULL)); } return fixnum(-1); case TAG_SYM: if (eq) return fixnum(1); if (tagb < TAG_SYM) return fixnum(1); if (tagb > TAG_SYM) return fixnum(-1); return fixnum(strcmp(symbol_name(a), symbol_name(b))); case TAG_VECTOR: if (isvector(b)) return bounded_vector_compare(a, b, bound, eq); break; case TAG_CPRIM: if (cp_class((cprim_t*)ptr(a)) == wchartype) { if (!iscprim(b) || cp_class((cprim_t*)ptr(b)) != wchartype) return fixnum(-1); } else if (iscprim(b) && cp_class((cprim_t*)ptr(b)) == wchartype) { return fixnum(1); } c = numeric_compare(a, b, eq, 1, NULL); if (c != 2) return fixnum(c); break; case TAG_CVALUE: if (iscvalue(b)) { if (cv_isPOD((cvalue_t*)ptr(a)) && cv_isPOD((cvalue_t*)ptr(b))) return cvalue_compare(a, b); return fixnum(1); } break; case TAG_FUNCTION: if (tagb == TAG_FUNCTION) { if (uintval(a) > N_BUILTINS && uintval(b) > N_BUILTINS) { function_t *fa = (function_t*)ptr(a); function_t *fb = (function_t*)ptr(b); d = bounded_compare(fa->bcode, fb->bcode, bound-1, eq); if (d==NIL || numval(d) != 0) return d; d = bounded_compare(fa->vals, fb->vals, bound-1, eq); if (d==NIL || numval(d) != 0) return d; d = bounded_compare(fa->env, fb->env, bound-1, eq); if (d==NIL || numval(d) != 0) return d; return fixnum(0); } return (uintval(a) < uintval(b)) ? fixnum(-1) : fixnum(1); } break; case TAG_CONS: if (tagb < TAG_CONS) return fixnum(1); d = bounded_compare(car_(a), car_(b), bound-1, eq); if (d==NIL || numval(d) != 0) return d; a = cdr_(a); b = cdr_(b); bound--; goto compare_top; } return (taga < tagb) ? fixnum(-1) : fixnum(1); }
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_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod) { if (fl_isnumber(fl_ctx, 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); } #ifdef _P64 return (jl_value_t*)jl_box_int64(i64); #else if (i64 > (int64_t)S32_MAX || i64 < (int64_t)S32_MIN) return (jl_value_t*)jl_box_int64(i64); else return (jl_value_t*)jl_box_int32((int32_t)i64); #endif } if (issymbol(e)) { if (e == jl_ast_ctx(fl_ctx)->true_sym) return jl_true; else if (e == jl_ast_ctx(fl_ctx)->false_sym) return jl_false; return (jl_value_t*)scmsym_to_julia(fl_ctx, e); } if (fl_isstring(fl_ctx, e)) return jl_pchar_to_string((char*)cvalue_data(e), cvalue_len(e)); if (iscons(e) || e == fl_ctx->NIL) { value_t hd; jl_sym_t *sym; if (e == fl_ctx->NIL) { hd = e; } else { hd = car_(e); if (hd == jl_ast_ctx(fl_ctx)->ssavalue_sym) return jl_box_ssavalue(numval(car_(cdr_(e)))); else if (hd == jl_ast_ctx(fl_ctx)->slot_sym) return jl_box_slotnumber(numval(car_(cdr_(e)))); else if (hd == jl_ast_ctx(fl_ctx)->null_sym && llength(e) == 1) return jl_nothing; } if (issymbol(hd)) sym = scmsym_to_julia(fl_ctx, hd); else sym = list_sym; size_t n = llength(e)-1; if (issymbol(hd)) e = cdr_(e); else n++; // nodes with special representations jl_value_t *ex = NULL, *temp = NULL; if (sym == line_sym && (n == 1 || n == 2)) { jl_value_t *linenum = scm_to_julia_(fl_ctx, car_(e), mod); jl_value_t *file = jl_nothing; JL_GC_PUSH2(&linenum, &file); if (n == 2) file = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod); temp = jl_new_struct(jl_linenumbernode_type, linenum, file); JL_GC_POP(); return temp; } JL_GC_PUSH1(&ex); if (sym == label_sym) { ex = scm_to_julia_(fl_ctx, car_(e), mod); temp = jl_new_struct(jl_labelnode_type, ex); } else if (sym == goto_sym) { ex = scm_to_julia_(fl_ctx, car_(e), mod); temp = jl_new_struct(jl_gotonode_type, ex); } else if (sym == newvar_sym) { ex = scm_to_julia_(fl_ctx, car_(e), mod); temp = jl_new_struct(jl_newvarnode_type, ex); } else if (sym == globalref_sym) { ex = scm_to_julia_(fl_ctx, car_(e), mod); temp = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod); assert(jl_is_module(ex)); assert(jl_is_symbol(temp)); temp = jl_module_globalref((jl_module_t*)ex, (jl_sym_t*)temp); } else if (sym == top_sym) { assert(mod && "top should not be generated by the parser"); ex = scm_to_julia_(fl_ctx, car_(e), mod); assert(jl_is_symbol(ex)); temp = jl_module_globalref(jl_base_relative_to(mod), (jl_sym_t*)ex); } else if (sym == core_sym) { ex = scm_to_julia_(fl_ctx, car_(e), mod); assert(jl_is_symbol(ex)); temp = jl_module_globalref(jl_core_module, (jl_sym_t*)ex); } else if (sym == inert_sym || (sym == quote_sym && (!iscons(car_(e))))) { ex = scm_to_julia_(fl_ctx, car_(e), mod); temp = jl_new_struct(jl_quotenode_type, ex); } if (temp) { JL_GC_POP(); return temp; } ex = (jl_value_t*)jl_exprn(sym, n); size_t i; for (i = 0; i < n; i++) { assert(iscons(e)); jl_array_ptr_set(((jl_expr_t*)ex)->args, i, scm_to_julia_(fl_ctx, car_(e), mod)); e = cdr_(e); } if (sym == lambda_sym) ex = (jl_value_t*)jl_new_code_info_from_ast((jl_expr_t*)ex); JL_GC_POP(); if (sym == list_sym) return (jl_value_t*)((jl_expr_t*)ex)->args; return (jl_value_t*)ex; } if (iscprim(e) && cp_class((cprim_t*)ptr(e)) == fl_ctx->wchartype) { uint32_t c, u = *(uint32_t*)cp_data((cprim_t*)ptr(e)); if (u < 0x80) { c = u << 24; } else { c = ((u << 0) & 0x0000003f) | ((u << 2) & 0x00003f00) | ((u << 4) & 0x003f0000) | ((u << 6) & 0x3f000000); c = u < 0x00000800 ? (c << 16) | 0xc0800000 : u < 0x00010000 ? (c << 8) | 0xe0808000 : (c << 0) | 0xf0808080 ; } return jl_box_char(c); } if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jl_ast_ctx(fl_ctx)->jvtype) { return *(jl_value_t**)cv_data((cvalue_t*)ptr(e)); } jl_error("malformed tree"); }
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; }