Esempio n. 1
0
File: ast.c Progetto: 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");
}
Esempio n. 2
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;
}