cvsuser 05/03/17 03:45:27
Modified: classes bigint.pmc integer.pmc resizablepmcarray.pmc
src mmd.c
Log:
some more methods; MMD stuff
* BigInt cmp Integer
* Integer pow int
* resizablearray delete_keyed
* MMD distance sorting
Revision Changes Path
1.25 +7 -1 parrot/classes/bigint.pmc
Index: bigint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/bigint.pmc,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- bigint.pmc 12 Jan 2005 11:42:06 -0000 1.24
+++ bigint.pmc 17 Mar 2005 11:45:25 -0000 1.25
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: bigint.pmc,v 1.24 2005/01/12 11:42:06 leo Exp $
+$Id: bigint.pmc,v 1.25 2005/03/17 11:45:25 leo Exp $
=head1 NAME
@@ -699,6 +699,9 @@
MMD_PerlInt: {
return bigint_cmp_int(INTERP, SELF, PMC_int_val(value));
}
+MMD_Integer: {
+ return bigint_cmp_int(INTERP, SELF, PMC_int_val(value));
+ }
MMD_DEFAULT: {
internal_exception(1, "unimp cmp");
return 0;
@@ -712,6 +715,9 @@
MMD_PerlInt: {
return bigint_cmp_int(INTERP, SELF, PMC_int_val(value)) == 0;
}
+MMD_Integer: {
+ return bigint_cmp_int(INTERP, SELF, PMC_int_val(value)) == 0;
+ }
MMD_DEFAULT: {
internal_exception(1, "unimp eq");
return 0;
1.24 +21 -1 parrot/classes/integer.pmc
Index: integer.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/integer.pmc,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- integer.pmc 12 Jan 2005 11:42:06 -0000 1.23
+++ integer.pmc 17 Mar 2005 11:45:25 -0000 1.24
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: integer.pmc,v 1.23 2005/01/12 11:42:06 leo Exp $
+$Id: integer.pmc,v 1.24 2005/03/17 11:45:25 leo Exp $
=head1 NAME
@@ -575,6 +575,26 @@
=cut
*/
+ void pow_int (INTVAL b, PMC* dest) {
+ INTVAL a = PMC_int_val(SELF);
+ INTVAL i;
+ VTABLE_set_integer_native(INTERP, dest, a);
+ --b;
+ for (i = 0; i < b; ++i) {
+ mmd_dispatch_v_pip(interpreter, dest, a, dest, MMD_MULTIPLY_INT);
+ }
+
+ }
+
+/*
+
+=item C<void pow_int(INTVAL value, PMC *dest)>
+
+Rise SELF to the C<value>th power.
+
+=cut
+
+*/
void multiply_int (INTVAL b, PMC* dest) {
INTVAL a = PMC_int_val(SELF);
double cf = (double)a * (double)b;
1.21 +12 -4 parrot/classes/resizablepmcarray.pmc
Index: resizablepmcarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/resizablepmcarray.pmc,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- resizablepmcarray.pmc 10 Mar 2005 11:03:32 -0000 1.20
+++ resizablepmcarray.pmc 17 Mar 2005 11:45:25 -0000 1.21
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: resizablepmcarray.pmc,v 1.20 2005/03/10 11:03:32 leo Exp $
+$Id: resizablepmcarray.pmc,v 1.21 2005/03/17 11:45:25 leo Exp $
=head1 NAME
@@ -172,9 +172,17 @@
void delete_keyed (PMC* key) {
if (key->vtable->base_type == enum_class_Slice)
Parrot_py_set_slice(INTERP, SELF, key, NULL);
- else
- internal_exception(OUT_OF_BOUNDS,
- "ResizablePMCArray: unimplemented delete!");
+ else {
+ PMC **data;
+ INTVAL idx = key_integer(INTERP, key);
+ INTVAL i;
+ INTVAL n = PMC_int_val(SELF);
+ data = PMC_data(SELF);
+ for (i = idx; i < n - 1; ++i)
+ data[i] = data[i + 1];
+ PMC_int_val(SELF)--;
+ }
+
}
/*
1.53 +154 -7 parrot/src/mmd.c
Index: mmd.c
===================================================================
RCS file: /cvs/public/parrot/src/mmd.c,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- mmd.c 16 Mar 2005 14:21:34 -0000 1.52
+++ mmd.c 17 Mar 2005 11:45:27 -0000 1.53
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: mmd.c,v 1.52 2005/03/16 14:21:34 leo Exp $
+$Id: mmd.c,v 1.53 2005/03/17 11:45:27 leo Exp $
=head1 NAME
@@ -660,7 +660,7 @@
static PMC* mmd_arg_tuple_inline(Interp *, STRING *signature, va_list args);
-static PMC* mmd_arg_tuple_func(Interp *, STRING *signature, va_list args);
+static PMC* mmd_arg_tuple_func(Interp *, STRING *signature);
static PMC* mmd_search_default(Interp *, STRING *meth, PMC *arg_tuple);
static PMC* mmd_search_scopes(Interp *, STRING *meth, PMC *arg_tuple);
static void mmd_search_classes(Interp *, STRING *meth, PMC *arg_tuple, PMC
*);
@@ -692,9 +692,9 @@
* TODO move to header, when API is sane
*/
-PMC *
-Parrot_MMD_search_default_inline(Interp *interpreter, STRING *meth,
+PMC *Parrot_MMD_search_default_inline(Interp *, STRING *meth,
STRING *signature, ...);
+PMC *Parrot_MMD_search_default_func(Interp *, STRING *meth, STRING
*signature);
PMC *
Parrot_MMD_search_default_inline(Interp *interpreter, STRING *meth,
@@ -714,6 +714,21 @@
return mmd_search_default(interpreter, meth, arg_tuple);
}
+PMC *
+Parrot_MMD_search_default_func(Interp *interpreter, STRING *meth,
+ STRING *signature)
+{
+ PMC* arg_tuple;
+ /*
+ * 1) create argument tuple
+ */
+ arg_tuple = mmd_arg_tuple_func(interpreter, signature);
+ /*
+ * default search policy
+ */
+ return mmd_search_default(interpreter, meth, arg_tuple);
+}
+
/*
=item C<
@@ -722,6 +737,12 @@
Return a list of argument types. PMC arguments are specified as function
arguments.
+=item C<
+static PMC* mmd_arg_tuple_func(Interp *, STRING *signature)>
+
+Return a list of argument types. PMC arguments are take from registers
+P5 ... according to calling conventions.
+
=cut
*/
@@ -768,6 +789,51 @@
return arg_tuple;
}
+static PMC*
+mmd_arg_tuple_func(Interp *interpreter, STRING *signature)
+{
+ INTVAL sig_len, i, type, next_p;
+ PMC* arg_tuple, *arg;
+
+ arg_tuple = pmc_new(interpreter, enum_class_FixedIntegerArray);
+ sig_len = string_length(interpreter, signature);
+ if (!sig_len)
+ return arg_tuple;
+ VTABLE_set_integer_native(interpreter, arg_tuple, sig_len);
+ next_p = 5;
+ for (i = 0; i < sig_len; ++i) {
+ type = string_index(interpreter, signature, i);
+ switch (type) {
+ case 'I':
+ VTABLE_set_integer_keyed_int(interpreter, arg_tuple,
+ i, enum_type_INTVAL);
+ break;
+ case 'N':
+ VTABLE_set_integer_keyed_int(interpreter, arg_tuple,
+ i, enum_type_FLOATVAL);
+ break;
+ case 'S':
+ VTABLE_set_integer_keyed_int(interpreter, arg_tuple,
+ i, enum_type_STRING);
+ break;
+ case 'P':
+ if (next_p == 16)
+ internal_exception(1, "Unimp MMD too many args");
+ arg = REG_PMC(next_p++);
+ type = VTABLE_type(interpreter, arg);
+ VTABLE_set_integer_keyed_int(interpreter, arg_tuple,
+ i, type);
+ break;
+ default:
+ internal_exception(1,
+ "Unknown signature type %d in mmd_arg_tuple", type);
+ break;
+ }
+
+ }
+ return arg_tuple;
+}
+
/*
=item C<static PMC* mmd_search_default(Interp *, STRING *meth, PMC
*arg_tuple)>
@@ -828,6 +894,8 @@
Search all the classes in all MultiSubs of the candidates C<cl> and return
a list of all candidates.
+=cut
+
*/
static void
@@ -863,7 +931,36 @@
}
}
}
- return cl;
+}
+
+static INTVAL
+distance_cmp(Interp *interpreter, INTVAL a, INTVAL b)
+{
+ short da = a & 0xffff;
+ short db = b & 0xffff;
+ return da > db ? -1 : da < db ? 1 : 0;
+}
+
+extern void Parrot_FixedPMCArray_sort(Interp* , PMC* pmc, PMC *cmp_func);
+
+/*
+
+=item C<static UINTVAL mmd_distance(Interp *, PMC *pmc, PMC *arg_tuple)>
+
+Create Manhattan Distance of sub C<pmc> against given argument types.
+0xffff is the maximum distance
+
+=cut
+
+*/
+
+static UINTVAL
+mmd_distance(Interp *interpreter, PMC *pmc, PMC *arg_tuple)
+{
+ /*
+ * TODO need a signaute in the sub pmc
+ */
+ return 0;
}
/*
@@ -872,15 +969,55 @@
Sort the candidate list C<cl> by Manhattan Distance
+=cut
+
*/
static void
mmd_sort_candidates(Interp *interpreter, PMC *arg_tuple, PMC *cl)
{
- INTVAL n;
+ INTVAL i, n, d;
+ PMC *nci, *pmc, *sort;
+ INTVAL *helper;
+ PMC **data;
n = VTABLE_elements(interpreter, cl);
-
+ /*
+ * create a helper structure:
+ * bits 0..15 = distance
+ * bits 16..31 = idx in candidate list
+ */
+ sort = pmc_new(interpreter, enum_class_FixedIntegerArray);
+ VTABLE_set_integer_native(interpreter, sort, n);
+ helper = PMC_data(sort);
+ for (i = 0; i < n; ++i) {
+ pmc = VTABLE_get_pmc_keyed_int(interpreter, cl, i);
+ d = mmd_distance(interpreter, pmc, arg_tuple);
+ helper[i] = i << 16 | d;
+ }
+ /*
+ * need an NCI function pointer
+ */
+ nci = pmc_new(interpreter, enum_class_NCI);
+ PMC_struct_val(nci) = F2DPTR(distance_cmp);
+ /*
+ * sort it
+ */
+ Parrot_FixedPMCArray_sort(interpreter, sort, nci);
+ /*
+ * now helper has a sorted list of indices in the upper 16 bits
+ * fill helper with sorted candidates
+ */
+ data = PMC_data(cl);
+ for (i = 0; i < n; ++i) {
+ INTVAL idx = helper[i] >> 16;
+ LVALUE_CAST(PMC*, helper[i]) = data[idx];
+ }
+ /*
+ * use helper structure
+ */
+ PMC_data(cl) = helper;
+ PMC_data(sort) = data;
}
/*
@@ -947,6 +1084,8 @@
If the candidate is a MultiSub remember all matching Subs and return FALSE
to continue searching outer scopes.
+=cut
+
*/
static int
@@ -990,6 +1129,8 @@
Search the current lexical pad for matching candidates. Return TRUE if the
MMD search should stop.
+=cut
+
*/
static int
@@ -1019,6 +1160,8 @@
Search the current package namespace for matching candidates. Return TRUE if
the MMD search should stop.
+=cut
+
*/
static int
@@ -1044,6 +1187,8 @@
Search the global namespace for matching candidates. Return TRUE if
the MMD search should stop.
+=cut
+
*/
static int
@@ -1066,6 +1211,8 @@
Search the builtin namespace for matching candidates. Return TRUE if
the MMD search should stop.
+=cut
+
*/
static int
