Ejemplo n.º 1
0
static jl_value_t *from_td_val(td_val_t *v)
{
    td_tag_t tag = td_typeof(v);
    switch (tag) {
    case TD_INT8:
        return jl_box_int8(td_int8(v));
    case TD_UINT8:
        return jl_box_uint8(td_uint8(v));
    case TD_INT16:
        return jl_box_int16(td_int16(v));
    case TD_UINT16:
        return jl_box_uint16(td_uint16(v));
    case TD_INT32:
        return jl_box_int32(td_int32(v));
    case TD_UINT32:
        return jl_box_uint32(td_uint32(v));
    case TD_INT64:
        return jl_box_int64(td_int64(v));
    case TD_UINT64:
        return jl_box_uint64(td_uint64(v));
    case TD_FLOAT:
        return jl_box_float32(td_float(v));
    case TD_DOUBLE:
        return jl_box_float64(td_double(v));
    case TD_UTF8:
        return jl_pchar_to_string(td_dataptr(v), td_length(v));
    case TD_ARRAY:
        return (jl_value_t*)
               jl_ptr_to_array_1d((jl_value_t*)jl_apply_array_type((jl_datatype_t*)td_type_to_jl(td_eltype(v)), 1),
                                  td_dataptr(v), td_length(v), 0);
    default:
        return jl_nothing;
    }
}
Ejemplo n.º 2
0
// Note that this function updates len
static jl_value_t *jl_new_bits_internal(jl_value_t *dt, void *data, size_t *len)
{
    assert(jl_is_datatype(dt));
    jl_datatype_t *bt = (jl_datatype_t*)dt;
    size_t nb = jl_datatype_size(bt);
    if (nb == 0)
        return jl_new_struct_uninit(bt);
    *len = LLT_ALIGN(*len, bt->alignment);
    data = (char*)data + (*len);
    *len += nb;
    if (bt == jl_uint8_type)   return jl_box_uint8(*(uint8_t*)data);
    if (bt == jl_int64_type)   return jl_box_int64(*(int64_t*)data);
    if (bt == jl_bool_type)    return (*(int8_t*)data) ? jl_true:jl_false;
    if (bt == jl_int32_type)   return jl_box_int32(*(int32_t*)data);
    if (bt == jl_float64_type) return jl_box_float64(*(double*)data);

    jl_value_t *v = (jl_value_t*)newobj((jl_value_t*)bt, NWORDS(nb));
    switch (nb) {
    case  1: *(int8_t*)   jl_data_ptr(v) = *(int8_t*)data;    break;
    case  2: *(int16_t*)  jl_data_ptr(v) = *(int16_t*)data;   break;
    case  4: *(int32_t*)  jl_data_ptr(v) = *(int32_t*)data;   break;
    case  8: *(int64_t*)  jl_data_ptr(v) = *(int64_t*)data;   break;
    case 16: *(bits128_t*)jl_data_ptr(v) = *(bits128_t*)data; break;
    default: memcpy(jl_data_ptr(v), data, nb);
    }
    return v;
}
Ejemplo n.º 3
0
t_real SqwJl::operator()(t_real dh, t_real dk, t_real dl, t_real dE) const
{
	if(!m_bOk)
	{
		tl::log_err("Julia interpreter has not initialised, cannot query S(q,w).");
		return t_real(0);
	}

	std::lock_guard<std::mutex> lock(*m_pmtx);

	jl_value_t *phklE[4] =
		{ jl_box_float64(dh), jl_box_float64(dk),
		jl_box_float64(dl), jl_box_float64(dE) };
	jl_value_t *pSqw = jl_call((jl_function_t*)m_pSqw, phklE, 4);
	return t_real(jl_unbox_float64(pSqw));
}
Ejemplo n.º 4
0
static jl_value_t *jl_new_bits_internal(jl_value_t *dt, void *data, size_t *len)
{
    if (jl_is_tuple(dt)) {
        jl_tuple_t *tuple = (jl_tuple_t*)dt;
        *len = LLT_ALIGN(*len, jl_new_bits_align(dt));
        size_t i, l = jl_tuple_len(tuple);
        jl_value_t *v = (jl_value_t*) jl_alloc_tuple(l);
        JL_GC_PUSH1(v);
        for (i = 0; i < l; i++) {
            jl_tupleset(v,i,jl_new_bits_internal(jl_tupleref(tuple,i), (char*)data, len));
        }
        JL_GC_POP();
        return v;
    }

    jl_datatype_t *bt = (jl_datatype_t*)dt;
    size_t nb = jl_datatype_size(bt);
    if (nb == 0)
        return jl_new_struct_uninit(bt);
    *len = LLT_ALIGN(*len, bt->alignment);
    data = (char*)data + (*len);
    *len += nb;
    if (bt == jl_uint8_type)   return jl_box_uint8(*(uint8_t*)data);
    if (bt == jl_int64_type)   return jl_box_int64(*(int64_t*)data);
    if (bt == jl_bool_type)    return (*(int8_t*)data) ? jl_true:jl_false;
    if (bt == jl_int32_type)   return jl_box_int32(*(int32_t*)data);
    if (bt == jl_float64_type) return jl_box_float64(*(double*)data);

    jl_value_t *v =
        (jl_value_t*)allocobj((NWORDS(LLT_ALIGN(nb,sizeof(void*)))+1)*
                              sizeof(void*));
    v->type = (jl_value_t*)bt;
    switch (nb) {
    case  1: *(int8_t*)   jl_data_ptr(v) = *(int8_t*)data;    break;
    case  2: *(int16_t*)  jl_data_ptr(v) = *(int16_t*)data;   break;
    case  4: *(int32_t*)  jl_data_ptr(v) = *(int32_t*)data;   break;
    case  8: *(int64_t*)  jl_data_ptr(v) = *(int64_t*)data;   break;
    case 16: *(bits128_t*)jl_data_ptr(v) = *(bits128_t*)data; break;
    default: memcpy(jl_data_ptr(v), data, nb);
    }
    return v;
}
Ejemplo n.º 5
0
Archivo: alloc.c Proyecto: FizzyP/julia
jl_value_t *jl_new_bits(jl_datatype_t *bt, void *data)
{
    if (bt == jl_uint8_type)        return jl_box_uint8(*(uint8_t*)data);
    else if (bt == jl_int64_type)   return jl_box_int64(*(int64_t*)data);
    else if (bt == jl_bool_type)    return (*(int8_t*)data) ? jl_true:jl_false;
    else if (bt == jl_int32_type)   return jl_box_int32(*(int32_t*)data);
    else if (bt == jl_float64_type) return jl_box_float64(*(double*)data);
    
    size_t nb = jl_datatype_size(bt);
    jl_value_t *v = 
        (jl_value_t*)allocobj((NWORDS(LLT_ALIGN(nb,sizeof(void*)))+1)*
                              sizeof(void*));
    v->type = (jl_value_t*)bt;
    switch (nb) {
    case  1: *(int8_t*)   jl_data_ptr(v) = *(int8_t*)data;    break;
    case  2: *(int16_t*)  jl_data_ptr(v) = *(int16_t*)data;   break;
    case  4: *(int32_t*)  jl_data_ptr(v) = *(int32_t*)data;   break;
    case  8: *(int64_t*)  jl_data_ptr(v) = *(int64_t*)data;   break;
    case 16: *(bits128_t*)jl_data_ptr(v) = *(bits128_t*)data; break;
    default: memcpy(jl_data_ptr(v), data, nb);
    }
    return v;
}
Ejemplo n.º 6
0
Archivo: ast.c Proyecto: RZEWa60/julia
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;
}
Ejemplo n.º 7
0
Archivo: ast.c Proyecto: ararslan/julia
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");
}
Ejemplo n.º 8
0
int main()
{
    jl_init(NULL);

    {
        // Simple running Julia code

        jl_eval_string("println(sqrt(2.0))");
    }

    {
        // Accessing the return value

        jl_value_t *ret = jl_eval_string("sqrt(2.0)");

        if (jl_is_float64(ret)) {
            double retDouble = jl_unbox_float64(ret);
            printf("sqrt(2.0) in C: %e\n", retDouble);
        }
    }

    {
        // Same as above but with function handle (more flexible)

        jl_function_t *func = jl_get_function(jl_base_module, "sqrt");
        jl_value_t* argument = jl_box_float64(2.0);
        jl_value_t* ret = jl_call1(func, argument);

        if (jl_is_float64(ret)) {
            double retDouble = jl_unbox_float64(ret);
            printf("sqrt(2.0) in C: %e\n", retDouble);
        }
    }

    {
        // 1D arrays

        jl_value_t* array_type = jl_apply_array_type( jl_float64_type, 1 );
        jl_array_t* x          = jl_alloc_array_1d(array_type , 10);
        JL_GC_PUSH1(&x);

        double* xData = jl_array_data(x);

        size_t i;
        for(i=0; i<jl_array_len(x); i++)
            xData[i] = i;

        jl_function_t *func  = jl_get_function(jl_base_module, "reverse!");
        jl_call1(func, (jl_value_t*) x);

        printf("x = [");
        for(i=0; i<jl_array_len(x); i++)
            printf("%e ", xData[i]);
        printf("]\n");

        JL_GC_POP();
    }

    {
        // define julia function and call it

        jl_eval_string("my_func(x) = 2*x");

        jl_function_t *func = jl_get_function(jl_current_module, "my_func");
        jl_value_t* arg = jl_box_float64(5.0);
        double ret = jl_unbox_float64(jl_call1(func, arg));

        printf("my_func(5.0) = %f\n", ret);
    }

    {
        // call c function

        jl_eval_string("println( ccall( :my_c_sqrt, Float64, (Float64,), 2.0 ) )");
    }

    {
        // check for exceptions

        jl_eval_string("this_function_does_not_exist()");

        if (jl_exception_occurred()) {
            jl_show(jl_stderr_obj(), jl_exception_occurred());
            jl_printf(jl_stderr_stream(), "\n");
        }
    }

    jl_atexit_hook();
    return 0;
}
Ejemplo n.º 9
0
DLLEXPORT jl_value_t *jlapi_box_float64(double x) {
  return jl_box_float64(x);
}
Ejemplo n.º 10
0
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;
}
Ejemplo n.º 11
0
	inline jl_value_t* box(double val) { return jl_box_float64(val); }
Ejemplo n.º 12
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;
}