cvsuser 05/03/16 06:21:34
Modified: classes fixedpmcarray.pmc
src mmd.c
Log:
MMD 4 - more pieces; array sort
* more MMD stuff - search classes
* rewrite fixedpmcarray.quicksort
Revision Changes Path
1.31 +60 -88 parrot/classes/fixedpmcarray.pmc
Index: fixedpmcarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/fixedpmcarray.pmc,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- fixedpmcarray.pmc 9 Mar 2005 14:51:58 -0000 1.30
+++ fixedpmcarray.pmc 16 Mar 2005 14:21:33 -0000 1.31
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: fixedpmcarray.pmc,v 1.30 2005/03/09 14:51:58 leo Exp $
+$Id: fixedpmcarray.pmc,v 1.31 2005/03/16 14:21:33 leo Exp $
=head1 NAME
@@ -21,111 +21,83 @@
#include "parrot/parrot.h"
-/*
- * need this as long this hack is using qsort
- */
-static Interp* the_interp;
-static PMC* sort_cmp_pmc;
+static void
+swap(void **x, void **y)
+{
+ void *t = *x;
+ *x = *y;
+ *y = t;
+}
-static int
-sort_compare(void *a, void *b)
+typedef INTVAL (*sort_func_t)(Interp *, void*, void*);
+
+static INTVAL
+COMPARE(Interp *interpreter, void *a, void *b, PMC *cmp)
{
- PMC *pa = *(PMC**)a;
- PMC *pb = *(PMC**)b;
- return mmd_dispatch_i_pp(the_interp, pa, pb, MMD_CMP);
+ if (!cmp)
+ return mmd_dispatch_i_pp(interpreter, a, b, MMD_CMP);
+ if (cmp->vtable->base_type == enum_class_NCI) {
+ sort_func_t f = (sort_func_t)D2FPTR(PMC_struct_val(cmp));
+ return f(interpreter, a, b);
+ }
+ return Parrot_runops_fromc_args_reti(interpreter, cmp, "IPP", a, b);
}
-static int
-sort_ext_compare(void *a, void *b)
+static void
+quicksort(Interp *interpreter, void **data, UINTVAL n, PMC *cmp)
{
- PMC *pa = *(PMC**)a;
- PMC *pb = *(PMC**)b;
- return Parrot_runops_fromc_args_reti(the_interp,
- sort_cmp_pmc, "IPP", pa, pb);
+ UINTVAL i, j, ln, rn;
+
+ while (n > 1) {
+ swap(&data[0], &data[n/2]);
+ for (i = 0, j = n; ; ) {
+ do
+ --j;
+ while (COMPARE(interpreter, data[j], data[0], cmp) > 0);
+ do
+ ++i;
+ while (i < j && COMPARE(interpreter, data[i], data[0], cmp) < 0);
+ if (i >= j)
+ break;
+ swap(&data[i], &data[j]);
+ }
+ swap(&data[j], &data[0]);
+ ln = j;
+ rn = n - ++j;
+ if (ln < rn) {
+ quicksort(interpreter, data, ln, cmp);
+ data += j;
+ n = rn;
+ }
+ else {
+ quicksort(interpreter, data + j, rn, cmp);
+ n = ln;
+ }
+ }
}
pmclass FixedPMCArray need_ext does array {
/*
-=item C<void* sort(PMC* cmp_func)>
+=item C<METHOD void sort(PMC* cmp_func)>
Sort this array, optionally using the provided cmp_func
=cut
*/
+
METHOD void sort(PMC *cmp_func) {
- int (*func)(void*, void*);
- PMC *first;
- INTVAL type;
- PMC *s;
-
- the_interp = INTERP;
- if (REG_INT(3) == 0) {
- first = ((PMC**)PMC_data(SELF))[0];
- /* XXX simulate MMD inheritance: Int isa TT */
- type = first->vtable->base_type - 1;
- s = mmd_vtfind(INTERP, MMD_CMP, type, 0);
- /* cmp was overriden ? */
- if (s->vtable->base_type == enum_class_Sub) {
- cmp_func = s;
- goto use_sub;
- }
-default_sort:
- func = sort_compare;
-use_func:
- qsort(PMC_data(SELF), PMC_int_val(SELF), sizeof(PMC *),
- (int (*)(const void*, const void*))func);
- }
- else {
- void *regs;
- int run_core;
- /*
- * cmp_func is a PASM PMC
- * TODO check, if it's NCI
- */
-use_sub:
- run_core = INTERP->run_core;
- if (PMC_IS_NULL(cmp_func) ||
- cmp_func == Parrot_base_vtables[enum_class_None]->class) {
- /* a NULL or None PMC was passed
- */
- goto default_sort;
- }
- else {
- if (cmp_func->vtable->base_type == enum_class_NCI) {
- /* the C function inside is at struct_val
- * hopefully this function does compare
- */
- func = (int (*)(void*, void*)) PMC_struct_val(cmp_func);
- /*
- * XXX not yet -cmp doesn't take an interpreter arg
- */
- /* goto use_func; */
- goto default_sort;
- }
- }
- /*
- * save registers once, as the compare function will be called
- * repeatedly
- */
- func = sort_ext_compare;
- sort_cmp_pmc = cmp_func;
- /*
- * TODO fix errors with JIT or prederefed core
- */
- if (run_core == PARROT_JIT_CORE) {
-#ifdef HAVE_COMPUTED_GOTO
- INTERP->run_core = PARROT_CGOTO_CORE;
-#else
- INTERP->run_core = PARROT_FAST_CORE;
-#endif
- }
- qsort(PMC_data(SELF), PMC_int_val(SELF), sizeof(PMC *),
- (int (*)(const void*, const void*))func);
- INTERP->run_core = run_core;
- }
+ UINTVAL n;
+
+
+ n = (UINTVAL) PMC_int_val(SELF);
+ if (n <= 1)
+ return;
+ if (REG_INT(3) == 0)
+ cmp_func = NULL;
+ quicksort(interpreter, PMC_data(SELF), n, cmp_func);
}
/*
1.52 +104 -4 parrot/src/mmd.c
Index: mmd.c
===================================================================
RCS file: /cvs/public/parrot/src/mmd.c,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- mmd.c 14 Mar 2005 14:45:40 -0000 1.51
+++ mmd.c 16 Mar 2005 14:21:34 -0000 1.52
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: mmd.c,v 1.51 2005/03/14 14:45:40 leo Exp $
+$Id: mmd.c,v 1.52 2005/03/16 14:21:34 leo Exp $
=head1 NAME
@@ -663,10 +663,13 @@
static PMC* mmd_arg_tuple_func(Interp *, STRING *signature, va_list args);
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
*);
static int mmd_search_lexical(Interp *, STRING *meth, PMC *arg_tuple, PMC
*);
static int mmd_search_package(Interp *, STRING *meth, PMC *arg_tuple, PMC
*);
static int mmd_search_global(Interp *, STRING *meth, PMC *arg_tuple, PMC *);
static int mmd_search_builtin(Interp *, STRING *meth, PMC *arg_tuple, PMC
*);
+static int mmd_maybe_candidate(Interp *, PMC *pmc, PMC *arg_tuple, PMC *cl);
+static void mmd_sort_candidates(Interp *, PMC *arg_tuple, PMC *cl);
/*
@@ -705,7 +708,9 @@
va_start(args, signature);
arg_tuple = mmd_arg_tuple_inline(interpreter, signature, args);
va_end(args);
-
+ /*
+ * default search policy
+ */
return mmd_search_default(interpreter, meth, arg_tuple);
}
@@ -778,10 +783,104 @@
static PMC*
mmd_search_default(Interp *interpreter, STRING *meth, PMC *arg_tuple)
{
- PMC *candidate_list;
+ PMC *candidate_list, *pmc;
+ INTVAL i, n;
+ STRING *_sub;
+ /*
+ * 2) create a list of matching functions
+ */
candidate_list = mmd_search_scopes(interpreter, meth, arg_tuple);
- return NULL;
+ /*
+ * 3) if list is empty fail
+ * if the first found function is a plain Sub: finito
+ */
+ n = VTABLE_elements(interpreter, candidate_list);
+ if (!n)
+ return NULL;
+ pmc = VTABLE_get_pmc_keyed_int(interpreter, candidate_list, 0);
+ _sub = CONST_STRING(interpreter, "Sub");
+
+ if (VTABLE_isa(interpreter, pmc, _sub)) {
+ return pmc;
+ }
+ /*
+ * 4) first is a MultiSub - go through all found MultiSubs and check
+ * the first arguments MRO, add all MultiSubs and plain methods,
+ * where the first argument matches
+ */
+ mmd_search_classes(interpreter, meth, arg_tuple, candidate_list);
+ /*
+ * 5) sort the list
+ */
+ mmd_sort_candidates(interpreter, arg_tuple, candidate_list);
+ /*
+ * 6) Uff, return first one
+ */
+ pmc = VTABLE_get_pmc_keyed_int(interpreter, candidate_list, 0);
+ return pmc;
+}
+
+/*
+
+=item C<static void mmd_search_classes(Interp *, STRING *meth, PMC
*arg_tuple, PMC *cl)>
+
+Search all the classes in all MultiSubs of the candidates C<cl> and return
+a list of all candidates.
+
+*/
+
+static void
+mmd_search_classes(Interp *interpreter, STRING *meth, PMC *arg_tuple, PMC
*cl)
+{
+ PMC *pmc, *mro, *class;
+ INTVAL i, n, type1;
+ STRING *namespace_name;
+
+ /*
+ * get the class of the first argument
+ */
+ type1 = VTABLE_get_integer_keyed_int(interpreter, arg_tuple, 0);
+ if (type1 < 0) {
+ internal_exception(1, "unimplemted native MMD type");
+ /* TODO create some class namespace */
+ }
+ else {
+ mro = Parrot_base_vtables[type1]->mro;
+ n = VTABLE_elements(interpreter, mro);
+ for (i = 0; i < n; ++i) {
+ class = VTABLE_get_pmc_keyed_int(interpreter, mro, i);
+ namespace_name = VTABLE_namespace_name(interpreter, class);
+ pmc = Parrot_find_global(interpreter, namespace_name, meth);
+ if (pmc) {
+ /*
+ * mmd_is_hidden would consider all previous candidates
+ * XXX pass current n so that only candidates from this
+ * mro are used?
+ */
+ if (mmd_maybe_candidate(interpreter, pmc, arg_tuple, cl))
+ break;
+ }
+ }
+ }
+ return cl;
+}
+
+/*
+
+=item C<static void mmd_sort_candidates(Interp *, PMC *arg_tuple, PMC *cl)>
+
+Sort the candidate list C<cl> by Manhattan Distance
+
+*/
+
+static void
+mmd_sort_candidates(Interp *interpreter, PMC *arg_tuple, PMC *cl)
+{
+ INTVAL n;
+
+ n = VTABLE_elements(interpreter, cl);
+
}
/*
@@ -862,6 +961,7 @@
if (VTABLE_isa(interpreter, pmc, _sub)) {
/* a plain sub stops outer searches */
/* TODO check arity of sub */
+
VTABLE_push_pmc(interpreter, cl, pmc);
return 1;
}
