Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Start of new HLL-interop infrastructure. 
Builds upon the Parrot HLL identifiers. This mechanism will be used to
fix various Rakudo issues when NQP-defiend objects are encountered. It
will also replace the special-case perl6ize_type with a more general
and more portable mechanism, that can work in an environment where all
objects are 6model objects.
  • Loading branch information
@jnthn
jnthn committed Apr 9, 2013
1 parent 09d22fc commit 6b1f913
Show file tree
Hide file tree
Showing 4 changed files with 200 additions and 26 deletions.
139 changes: 136 additions & 3 deletions src/6model/sixmodelobject.c
View file
Expand Up @@ -7,9 +7,12 @@
#include "serialization_context.h"

/* Cached type IDs. */
static INTVAL stable_id = 0;
static INTVAL smo_id = 0;
static INTVAL sc_id = 0;
static INTVAL stable_id = 0;
static INTVAL smo_id = 0;
static INTVAL sc_id = 0;
static INTVAL ownedrpa_id = 0;
static INTVAL qrpa_id = 0;
static INTVAL ownedhash_id = 0;

/* Cached strings. */
static STRING *find_method_str = NULL;
Expand Down Expand Up @@ -169,6 +172,136 @@ static INTVAL default_type_check (PARROT_INTERP, PMC *to_check, PMC *wanted) {
return 0;
}

/* Gets configuration hash for a HLL. */
PMC * get_hll_config(PARROT_INTERP, STRING *hll) {
PMC *global_context = VTABLE_get_pmc_keyed_str(interp, interp->root_namespace,
Parrot_str_new_constant(interp, "_GLOBAL_CONTEXT"));
PMC *config = VTABLE_get_pmc_keyed_str(interp,
VTABLE_get_pmc_keyed_str(interp, global_context, Parrot_str_new_constant(interp, "hllConfig")),
hll);

if (PMC_IS_NULL(config)) {
config = Parrot_pmc_new(interp, enum_class_Hash);
/* TODO: Populate with initial values. */

VTABLE_set_pmc_keyed_str(interp,
VTABLE_get_pmc_keyed_str(interp, global_context, Parrot_str_new_constant(interp, "hllConfig")),
hll,
config);
}

return config;
}

/* Does a HLL interop transformation as needed. */
PMC * hllize(PARROT_INTERP, PMC *obj, INTVAL hll_id) {
/* Look up HLL mapping information. */
PMC *config = get_hll_config(interp, Parrot_hll_get_HLL_name(interp, hll_id));

/* Is the input type a 6model type? */
if (obj->vtable->base_type == smo_id) {
/* XXX TODO: appropriate mapping. */
return obj;
}

/* Otherwise, it's a Parrot type. */
if (ownedrpa_id == 0)
ownedrpa_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "OwnedResizablePMCArray", 0));
if (qrpa_id == 0)
qrpa_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "QRPA", 0));
if (ownedhash_id == 0)
ownedhash_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "OwnedHash", 0));
if (obj->vtable->base_type == enum_class_String) {
if (VTABLE_exists_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_type_str"))) {
PMC *type = VTABLE_get_pmc_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_type_str"));
PMC *result = REPR(type)->allocate(interp, STABLE(type));
REPR(result)->initialize(interp, STABLE(result), OBJECT_BODY(result));
REPR(result)->box_funcs->set_str(interp, STABLE(result), OBJECT_BODY(result), VTABLE_get_string(interp, obj));
PARROT_GC_WRITE_BARRIER(interp, result);
return result;
}
else if (VTABLE_exists_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_str"))) {
PMC *result;
PMC *code = VTABLE_get_pmc_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_str"));
Parrot_ext_call(interp, code, "S->P", VTABLE_get_string(interp, obj), &result);
return result;
}
else {
return obj;
}
}
else if (obj->vtable->base_type == enum_class_Integer) {
if (VTABLE_exists_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_type_int"))) {
PMC *type = VTABLE_get_pmc_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_type_int"));
PMC *result = REPR(type)->allocate(interp, STABLE(type));
REPR(result)->initialize(interp, STABLE(result), OBJECT_BODY(result));
REPR(result)->box_funcs->set_int(interp, STABLE(result), OBJECT_BODY(result), VTABLE_get_integer(interp, obj));
return result;
}
else if (VTABLE_exists_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_int"))) {
PMC *result;
PMC *code = VTABLE_get_pmc_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_int"));
Parrot_ext_call(interp, code, "I->P", VTABLE_get_integer(interp, obj), &result);
return result;
}
else {
return obj;
}
}
else if (obj->vtable->base_type == enum_class_Float) {
if (VTABLE_exists_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_type_num"))) {
PMC *type = VTABLE_get_pmc_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_type_num"));
PMC *result = REPR(type)->allocate(interp, STABLE(type));
REPR(result)->initialize(interp, STABLE(result), OBJECT_BODY(result));
REPR(result)->box_funcs->set_num(interp, STABLE(result), OBJECT_BODY(result), VTABLE_get_number(interp, obj));
return result;
}
else if (VTABLE_exists_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_num"))) {
PMC *result;
PMC *code = VTABLE_get_pmc_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_num"));
Parrot_ext_call(interp, code, "N->P", VTABLE_get_number(interp, obj), &result);
return result;
}
else {
return obj;
}
}
else if (obj->vtable->base_type == enum_class_ResizablePMCArray
|| obj->vtable->base_type == ownedrpa_id
|| obj->vtable->base_type == qrpa_id) {
if (VTABLE_exists_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_array"))) {
PMC *result;
PMC *code = VTABLE_get_pmc_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_array"));
Parrot_ext_call(interp, code, "P->P", obj, &result);
return result;
}
else {
return obj;
}
}
else if (obj->vtable->base_type == enum_class_Hash
|| obj->vtable->base_type == ownedhash_id) {
if (VTABLE_exists_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_hash"))) {
PMC *result;
PMC *code = VTABLE_get_pmc_keyed_str(interp, config, Parrot_str_new_constant(interp, "foreign_transform_hash"));
Parrot_ext_call(interp, code, "P->P", obj, &result);
return result;
}
else {
return obj;
}
}
else if (obj->vtable->base_type == enum_class_Null) {
if (VTABLE_exists_keyed_str(interp, config, Parrot_str_new_constant(interp, "null_value")))
return VTABLE_get_pmc_keyed_str(interp, config, Parrot_str_new_constant(interp, "null_value"));
else
return obj;
}
else {
return obj;
}
}

/* Creates an STable that references the given REPR and HOW. */
PMC * create_stable(PARROT_INTERP, REPROps *REPR, PMC *HOW) {
PMC *st_pmc = Parrot_pmc_new_init(interp, stable_id, HOW);
Expand Down
17 changes: 17 additions & 0 deletions src/6model/sixmodelobject.h
View file
Expand Up @@ -88,6 +88,15 @@ typedef struct {
/* This flag is set if we consider the method cche authoritative. */
#define METHOD_CACHE_AUTHORITATIVE 4

/* HLL type roles. */
#define HLL_ROLE_NONE 0
#define HLL_ROLE_INT 1
#define HLL_ROLE_NUM 2
#define HLL_ROLE_STR 3
#define HLL_ROLE_ARRAY 4
#define HLL_ROLE_HASH 5
#define HLL_ROLE_CODE 6

/* S-Tables (short for Shared Table) contains the commonalities shared between
* a (HOW, REPR) pairing (for example, (HOW for the class Dog, P6Opaque). */
typedef struct SixModel_REPROps REPROps;
Expand Down Expand Up @@ -165,6 +174,12 @@ struct SixModel_STable {

/* The PMC that wraps this s-table. */
PMC *stable_pmc;

/* The HLL that this type is owned by, if any. */
INTVAL hll_owner;

/* The role that the type plays in the HLL, if any. */
INTVAL hll_role;
};

/* A representation is what controls the layout of an object and access and
Expand Down Expand Up @@ -420,6 +435,8 @@ void set_wrapping_object(PMC *wrapper);
PMC * wrap_object(PARROT_INTERP, void *obj);
PMC * create_stable(PARROT_INTERP, REPROps *REPR, PMC *HOW);
PMC * decontainerize(PARROT_INTERP, PMC *var);
PMC * get_hll_config(PARROT_INTERP, STRING *hll);
PMC * hllize(PARROT_INTERP, PMC *obj, INTVAL hll_id);

/* Dynamic representation registration. */
typedef PMC * (*wrap_object_t)(PARROT_INTERP, void *obj);
Expand Down
15 changes: 13 additions & 2 deletions src/QAST/Operations.nqp
View file
Expand Up @@ -1119,7 +1119,14 @@ my %const_map := nqp::hash(
'CCLASS_BLANK', pir::const::CCLASS_BLANK,
'CCLASS_CONTROL', pir::const::CCLASS_CONTROL,
'CCLASS_PUNCTUATION', pir::const::CCLASS_PUNCTUATION,
'CCLASS_ALPHANUMERIC', pir::const::CCLASS_ALPHANUMERIC
'CCLASS_ALPHANUMERIC', pir::const::CCLASS_ALPHANUMERIC,
'HLL_ROLE_NONE', 0,
'HLL_ROLE_INT', 1,
'HLL_ROLE_NUM', 2,
'HLL_ROLE_STR', 3,
'HLL_ROLE_ARRAY', 4,
'HLL_ROLE_HASH', 5,
'HLL_ROLE_CODE', 6
);
QAST::Operations.add_core_op('const', -> $qastcomp, $op {
if nqp::existskey(%const_map, $op.name) {
Expand Down Expand Up @@ -2046,7 +2053,11 @@ QAST::Operations.add_core_op('bindhllsym', -> $qastcomp, $op {
$op[2]
))
});
QAST::Operations.add_core_pirop_mapping('sethllconfig', 'sethllconfig', 'PsP');
QAST::Operations.add_core_pirop_mapping('sethllconfig', 'nqp_sethllconfig', 'PsP');
QAST::Operations.add_core_pirop_mapping('settypehll', 'nqp_settypehll', '0Ps');
QAST::Operations.add_core_pirop_mapping('settypehllrole', 'nqp_settypehllrole', '0Pi');
QAST::Operations.add_core_pirop_mapping('hllize', 'nqp_hllize', 'PP');
QAST::Operations.add_core_pirop_mapping('hllizefor', 'nqp_hllizefor', 'PPs');

# regex engine related opcodes
QAST::Operations.add_core_pirop_mapping('nfafromstatelist', 'nqp_nfa_from_statelist', 'PPP');
Expand Down
55 changes: 34 additions & 21 deletions src/ops/nqp.ops
View file
Expand Up @@ -294,26 +294,6 @@ static INTVAL * nqp_nfa_run(PARROT_INTERP, NFABody *nfa, STRING *target, INTVAL
return fates;
}

static PMC *get_hll_config(PARROT_INTERP, STRING *hll) {
PMC *global_context = VTABLE_get_pmc_keyed_str(interp, interp->root_namespace,
Parrot_str_new_constant(interp, "_GLOBAL_CONTEXT"));
PMC *config = VTABLE_get_pmc_keyed_str(interp,
VTABLE_get_pmc_keyed_str(interp, global_context, Parrot_str_new_constant(interp, "hllConfig")),
hll);

if (PMC_IS_NULL(config)) {
config = Parrot_pmc_new(interp, enum_class_Hash);
/* TODO: Populate with initial values. */

VTABLE_set_pmc_keyed_str(interp,
VTABLE_get_pmc_keyed_str(interp, global_context, Parrot_str_new_constant(interp, "hllConfig")),
hll,
config);
}

return config;
}

/* Constants for values the type field above may have. */
#define BIND_VAL_INT 1
#define BIND_VAL_NUM 2
Expand Down Expand Up @@ -2985,7 +2965,7 @@ inline op captureposprimspec(out INT, invar PMC, in INT) :base_core {
}
}

inline op sethllconfig(out PMC, in STR, invar PMC) {
inline op nqp_sethllconfig(out PMC, in STR, invar PMC) {
PMC *config = get_hll_config(interp, $2);

if (VTABLE_exists_keyed_str(interp, $3, Parrot_str_new_constant(interp, "list"))) {
Expand Down Expand Up @@ -3038,3 +3018,36 @@ inline op sethllconfig(out PMC, in STR, invar PMC) {

$1 = config;
}

inline op nqp_settypehll(invar PMC, in STR) {
INTVAL hll_id = Parrot_hll_register_HLL(interp, $2);
STABLE($1)->hll_owner = hll_id;
}

inline op nqp_settypehllrole(invar PMC, in INT) {
STABLE($1)->hll_role = $2;
}

inline op nqp_hllize(out PMC, invar PMC) {
INTVAL obj_hll = $2->vtable->base_type == smo_id
? STABLE($2)->hll_owner
: 0;
PMC * cur_sub = Parrot_pcc_get_sub(interp, CURRENT_CONTEXT(interp));
INTVAL cur_hll;
GETATTR_Sub_HLL_id(interp, cur_sub, cur_hll);
if (obj_hll == cur_hll)
$1 = $2;
else
$1 = hllize(interp, $2, cur_hll);
}

inline op nqp_hllizefor(out PMC, invar PMC, in STR) {
INTVAL obj_hll = $2->vtable->base_type == smo_id
? STABLE($2)->hll_owner
: 0;
INTVAL tgt_hll = Parrot_hll_register_HLL(interp, $3);
if (obj_hll == tgt_hll)
$1 = $2;
else
$1 = hllize(interp, $2, tgt_hll);
}

0 comments on commit 6b1f913

Please sign in to comment.