Author: leo
Date: Mon May 2 01:29:42 2005
New Revision: 7953
Modified:
trunk/include/parrot/mmd.h
trunk/ops/object.ops
trunk/src/mmd.c
trunk/t/pmc/mmd.t
Log:
MMD 39 - builtin MMDs as methods
* see note on p6i
Modified: trunk/include/parrot/mmd.h
==============================================================================
--- trunk/include/parrot/mmd.h (original)
+++ trunk/include/parrot/mmd.h Mon May 2 01:29:42 2005
@@ -74,6 +74,8 @@
PMC *Parrot_MMD_search_default_infix(Interp *, STRING *meth,
INTVAL left_type, INTVAL right_type);
+int Parrot_run_maybe_mmd_meth(Interp*, PMC *object, STRING *meth, STRING *sig);
+int Parrot_run_maybe_mmd_func(Interp*, STRING *meth, STRING *sig);
/*
* in src/objects.c :
*/
Modified: trunk/ops/object.ops
==============================================================================
--- trunk/ops/object.ops (original)
+++ trunk/ops/object.ops Mon May 2 01:29:42 2005
@@ -123,13 +123,17 @@
op callmethodcc(in STR) :object_base {
opcode_t *dest;
PMC *method_pmc, *object;
- opcode_t *next = expr NEXT();
+ opcode_t *next;
STRING *meth;
meth = $1;
- REG_PMC(1) = new_ret_continuation_pmc(interpreter, next);
+ object = REG_PMC(2);
+ if (Parrot_run_maybe_mmd_meth(interpreter, object, meth, REG_STR(1)))
+ goto NEXT();
- interpreter->ctx.current_object = object = REG_PMC(2);
+ next = expr NEXT();
+ REG_PMC(1) = new_ret_continuation_pmc(interpreter, next);
+ interpreter->ctx.current_object = object;
interpreter->ctx.current_method = meth;
method_pmc = VTABLE_find_method(interpreter, object, meth);
if (!method_pmc) {
Modified: trunk/src/mmd.c
==============================================================================
--- trunk/src/mmd.c (original)
+++ trunk/src/mmd.c Mon May 2 01:29:42 2005
@@ -140,6 +140,7 @@
Parrot_base_vtables[r]->isa_str, _isa, 0) >= 0)) {
/* TODO check dest too */
nci = pmc_new(interpreter, enum_class_Bound_NCI);
+ dod_register_pmc(interpreter, nci); /* XXX */
*is_pmc = 2;
PMC_struct_val(nci) = func;
return D2FPTR(nci);
@@ -802,6 +803,72 @@
return ret;
}
+int
+Parrot_run_maybe_mmd_meth(Interp* interpreter, PMC *object,
+ STRING *meth, STRING *sig)
+{
+ INTVAL mmd_func;
+ char *c_meth, *c_sig;
+ int ret = 0, inplace, compare;
+ PMC *dest;
+
+
+ /*
+ * check if it's a known MMD function
+ */
+ c_meth = string_to_cstring(interpreter, meth);
+ c_sig = string_to_cstring(interpreter, sig);
+ if ( (mmd_func = Parrot_MMD_method_idx(interpreter, c_meth)) >= 0) {
+ /* yep - run it instantly */
+ ret = 1;
+ inplace = c_meth[2] == 'i' && c_meth[3] == '_';
+ compare = mmd_func >= MMD_EQ && mmd_func <= MMD_STRCMP;
+ assert(c_sig[0] == 'O');
+ switch (c_sig[1]) {
+ case 'P':
+ if (inplace)
+ mmd_dispatch_v_pp(interpreter,
+ object, REG_PMC(5), mmd_func);
+ else if (compare)
+ REG_INT(5) = mmd_dispatch_i_pp(interpreter,
+ object, REG_PMC(5), mmd_func);
+ else
+ REG_PMC(5) = mmd_dispatch_p_ppp(interpreter,
+ object, REG_PMC(5), NULL, mmd_func);
+ break;
+ case 'I':
+ if (inplace)
+ mmd_dispatch_v_pi(interpreter,
+ object, REG_INT(5), mmd_func);
+ else
+ REG_PMC(5) = mmd_dispatch_p_pip(interpreter,
+ object, REG_INT(5), NULL, mmd_func);
+ break;
+ case 'N':
+ if (inplace)
+ mmd_dispatch_v_pn(interpreter,
+ object, REG_NUM(5), mmd_func);
+ else
+ REG_PMC(5) = mmd_dispatch_p_pnp(interpreter,
+ object, REG_NUM(5), NULL, mmd_func);
+ break;
+ case 'S':
+ if (inplace)
+ mmd_dispatch_v_ps(interpreter,
+ object, REG_STR(5), mmd_func);
+ else
+ REG_PMC(5) = mmd_dispatch_p_psp(interpreter,
+ object, REG_STR(5), NULL, mmd_func);
+ break;
+ }
+
+ }
+ string_cstring_free(c_meth);
+ string_cstring_free(c_sig);
+ return ret;
+}
+
+
/*
=item C<void
@@ -1228,11 +1295,11 @@
PMC* arg_tuple, *pmc;
PMC *candidate_list;
INTVAL n;
-
/*
* 1) create argument tuple
*/
arg_tuple = mmd_arg_tuple_func(interpreter, signature);
+
n = VTABLE_elements(interpreter, multi);
if (!n)
return NULL;
Modified: trunk/t/pmc/mmd.t
==============================================================================
--- trunk/t/pmc/mmd.t (original)
+++ trunk/t/pmc/mmd.t Mon May 2 01:29:42 2005
@@ -660,12 +660,11 @@
pir_output_is(<<'CODE', <<'OUTPUT', "__add as method");
.sub main @MAIN
.local pmc d, l, r
- d = new Integer
l = new Integer
r = new Integer
l = 3
r = 39
- l."__add"(r, d)
+ d = l."__add"(r)
print d
print "\n"
end
@@ -677,12 +676,11 @@
pir_output_is(<<'CODE', <<'OUTPUT', "__add as method - inherited");
.sub main @MAIN
.local pmc d, l, r
- d = new PerlInt
l = new PerlInt
r = new PerlInt
l = 3
r = 39
- l."__add"(r, d)
+ d = l."__add"(r)
print d
print "\n"
.end
@@ -693,12 +691,11 @@
pir_output_is(<<'CODE', <<'OUTPUT', "__add as method - Int, Float");
.sub main @MAIN
.local pmc d, l, r
- d = new Integer
l = new Integer
r = new Float
l = 3
r = 39.42
- l."__add"(r, d)
+ d = l."__add"(r)
print d
print "\n"
end
@@ -749,9 +746,6 @@
42
OUTPUT
-TODO: {
- local $TODO = "ongoing changes to MMD - disabled";
- $TODO .= '.'; # else used once warning
pir_output_is(<<'CODE', <<'OUTPUT', "Integer subclasses");
.sub main @MAIN
.local pmc d, l, r, cl
@@ -759,8 +753,8 @@
d = new "AInt"
l = new "AInt"
r = new "AInt"
- l = 3
- r = 39
+ l = 4
+ r = 38
print l
print "\n"
print r
@@ -773,15 +767,18 @@
d = l."__add"(r)
print d
print "\n"
+ l."__i_add"(r)
+ print l
+ print "\n"
.end
CODE
-3
-39
+4
+38
+42
42
42
OUTPUT
-}
pir_output_is(<<'CODE', <<'OUTPUT', "Integer subclasses, n_add");
.sub main @MAIN
