// Check whether v is a scalar for purposes of inlining fused-broadcast
// arguments when lowering; should agree with broadcast.jl on what is a
// scalar. When in doubt, return false, since this is only an optimization.
value_t fl_julia_scalar(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
argcount(fl_ctx, "julia-scalar?", nargs, 1);
if (fl_isnumber(fl_ctx, args[0]) || fl_isstring(fl_ctx, args[0]))
return fl_ctx->T;
else if (iscvalue(args[0]) && fl_ctx->jl_sym == cv_type((cvalue_t*)ptr(args[0]))) {
jl_value_t *v = *(jl_value_t**)cptr(args[0]);
if (jl_isa(v,(jl_value_t*)jl_number_type) || jl_is_string(v))
return fl_ctx->T;
}
return fl_ctx->F;
}
static int smallp(value_t v)
{
if (tinyp(v)) return 1;
if (fl_isnumber(v)) return 1;
if (iscons(v)) {
if (tinyp(car_(v)) && (tinyp(cdr_(v)) ||
(iscons(cdr_(v)) && tinyp(car_(cdr_(v))) &&
cdr_(cdr_(v))==NIL)))
return 1;
return 0;
}
if (isvector(v)) {
size_t s = vector_size(v);
return (s == 0 || (tinyp(vector_elt(v,0)) &&
(s == 1 || (s == 2 &&
tinyp(vector_elt(v,1))))));
}
return 0;
}
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;
}
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;
}
