add and change NEWS for 2.8.0 release
[parrot.git] / src / multidispatch.c
blobeb85c72cef3921c876b7df9e7cb870a7dc13464e
1 /*
2 Copyright (C) 2003-2010, Parrot Foundation.
3 $Id$
5 =head1 NAME
7 src/multidispatch.c - Multimethod dispatch for binary opcode functions
9 =head1 SYNOPSIS
11 This system is set up to handle type-based dispatching for binary (two
12 argument) functions. This includes, though isn't necessarily limited to, binary
13 operators such as addition or subtraction.
15 =head1 DESCRIPTION
17 The MMD system is straightforward, and currently must be explicitly invoked,
18 for example by a vtable function. (We reserve the right to use MMD in all
19 circumstances, but currently do not).
21 =head2 API
23 For the purposes of the API, each MMD-able function is assigned a unique
24 number which is used to find the correct function table. This is the
25 C<func_num> parameter in the following functions. While Parrot isn't
26 restricted to a predefined set of functions, it I<does> set things up so
27 that all the binary vtable functions have a MMD table preinstalled for
28 them, with default behaviour.
30 =head2 Remarks
32 =head2 Functions
34 =over 4
36 =cut
40 #include "parrot/compiler.h"
41 #include "parrot/parrot.h"
42 #include "parrot/multidispatch.h"
43 #include "parrot/oplib/ops.h"
44 #include "multidispatch.str"
45 #include "pmc/pmc_nci.h"
46 #include "pmc/pmc_nativepccmethod.h"
47 #include "pmc/pmc_sub.h"
48 #include "pmc/pmc_callcontext.h"
50 /* HEADERIZER HFILE: include/parrot/multidispatch.h */
52 /* HEADERIZER BEGIN: static */
53 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
55 static void mmd_add_multi_global(PARROT_INTERP,
56 ARGIN(STRING *sub_name),
57 ARGIN(PMC *sub_obj))
58 __attribute__nonnull__(1)
59 __attribute__nonnull__(2)
60 __attribute__nonnull__(3);
62 static void mmd_add_multi_to_namespace(PARROT_INTERP,
63 ARGIN(STRING *ns_name),
64 ARGIN(STRING *sub_name),
65 ARGIN(PMC *sub_obj))
66 __attribute__nonnull__(1)
67 __attribute__nonnull__(2)
68 __attribute__nonnull__(3)
69 __attribute__nonnull__(4);
71 PARROT_CANNOT_RETURN_NULL
72 PARROT_WARN_UNUSED_RESULT
73 static PMC* mmd_build_type_tuple_from_long_sig(PARROT_INTERP,
74 ARGIN(STRING *long_sig))
75 __attribute__nonnull__(1)
76 __attribute__nonnull__(2);
78 PARROT_CANNOT_RETURN_NULL
79 PARROT_WARN_UNUSED_RESULT
80 static PMC* mmd_build_type_tuple_from_type_list(PARROT_INTERP,
81 ARGIN(PMC *type_list))
82 __attribute__nonnull__(1)
83 __attribute__nonnull__(2);
85 PARROT_WARN_UNUSED_RESULT
86 PARROT_CAN_RETURN_NULL
87 static STRING * mmd_cache_key_from_types(PARROT_INTERP,
88 ARGIN(const char *name),
89 ARGIN(PMC *types))
90 __attribute__nonnull__(1)
91 __attribute__nonnull__(2)
92 __attribute__nonnull__(3);
94 PARROT_WARN_UNUSED_RESULT
95 PARROT_CAN_RETURN_NULL
96 static STRING * mmd_cache_key_from_values(PARROT_INTERP,
97 ARGIN(const char *name),
98 ARGIN(PMC *values))
99 __attribute__nonnull__(1)
100 __attribute__nonnull__(2)
101 __attribute__nonnull__(3);
103 PARROT_WARN_UNUSED_RESULT
104 PARROT_CAN_RETURN_NULL
105 static PMC* mmd_cvt_to_types(PARROT_INTERP, ARGIN(PMC *multi_sig))
106 __attribute__nonnull__(1)
107 __attribute__nonnull__(2);
109 static UINTVAL mmd_distance(PARROT_INTERP,
110 ARGIN(PMC *pmc),
111 ARGIN(PMC *arg_tuple))
112 __attribute__nonnull__(1)
113 __attribute__nonnull__(2)
114 __attribute__nonnull__(3);
116 static void mmd_search_by_sig_obj(PARROT_INTERP,
117 ARGIN(STRING *name),
118 ARGIN(PMC *sig_obj),
119 ARGIN(PMC *candidates))
120 __attribute__nonnull__(1)
121 __attribute__nonnull__(2)
122 __attribute__nonnull__(3)
123 __attribute__nonnull__(4);
125 static void mmd_search_global(PARROT_INTERP,
126 ARGIN(STRING *name),
127 ARGIN(PMC *cl))
128 __attribute__nonnull__(1)
129 __attribute__nonnull__(2)
130 __attribute__nonnull__(3);
132 PARROT_WARN_UNUSED_RESULT
133 PARROT_CAN_RETURN_NULL
134 static PMC * Parrot_mmd_get_cached_multi_sig(PARROT_INTERP,
135 ARGIN(PMC *sub_pmc))
136 __attribute__nonnull__(1)
137 __attribute__nonnull__(2);
139 static int Parrot_mmd_maybe_candidate(PARROT_INTERP,
140 ARGIN(PMC *pmc),
141 ARGIN(PMC *cl))
142 __attribute__nonnull__(1)
143 __attribute__nonnull__(2)
144 __attribute__nonnull__(3);
146 PARROT_CANNOT_RETURN_NULL
147 static PMC * Parrot_mmd_sort_candidates(PARROT_INTERP,
148 ARGIN(PMC *arg_tuple),
149 ARGIN(PMC *cl))
150 __attribute__nonnull__(1)
151 __attribute__nonnull__(2)
152 __attribute__nonnull__(3);
154 #define ASSERT_ARGS_mmd_add_multi_global __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
155 PARROT_ASSERT_ARG(interp) \
156 , PARROT_ASSERT_ARG(sub_name) \
157 , PARROT_ASSERT_ARG(sub_obj))
158 #define ASSERT_ARGS_mmd_add_multi_to_namespace __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
159 PARROT_ASSERT_ARG(interp) \
160 , PARROT_ASSERT_ARG(ns_name) \
161 , PARROT_ASSERT_ARG(sub_name) \
162 , PARROT_ASSERT_ARG(sub_obj))
163 #define ASSERT_ARGS_mmd_build_type_tuple_from_long_sig \
164 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
165 PARROT_ASSERT_ARG(interp) \
166 , PARROT_ASSERT_ARG(long_sig))
167 #define ASSERT_ARGS_mmd_build_type_tuple_from_type_list \
168 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
169 PARROT_ASSERT_ARG(interp) \
170 , PARROT_ASSERT_ARG(type_list))
171 #define ASSERT_ARGS_mmd_cache_key_from_types __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
172 PARROT_ASSERT_ARG(interp) \
173 , PARROT_ASSERT_ARG(name) \
174 , PARROT_ASSERT_ARG(types))
175 #define ASSERT_ARGS_mmd_cache_key_from_values __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
176 PARROT_ASSERT_ARG(interp) \
177 , PARROT_ASSERT_ARG(name) \
178 , PARROT_ASSERT_ARG(values))
179 #define ASSERT_ARGS_mmd_cvt_to_types __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
180 PARROT_ASSERT_ARG(interp) \
181 , PARROT_ASSERT_ARG(multi_sig))
182 #define ASSERT_ARGS_mmd_distance __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
183 PARROT_ASSERT_ARG(interp) \
184 , PARROT_ASSERT_ARG(pmc) \
185 , PARROT_ASSERT_ARG(arg_tuple))
186 #define ASSERT_ARGS_mmd_search_by_sig_obj __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
187 PARROT_ASSERT_ARG(interp) \
188 , PARROT_ASSERT_ARG(name) \
189 , PARROT_ASSERT_ARG(sig_obj) \
190 , PARROT_ASSERT_ARG(candidates))
191 #define ASSERT_ARGS_mmd_search_global __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
192 PARROT_ASSERT_ARG(interp) \
193 , PARROT_ASSERT_ARG(name) \
194 , PARROT_ASSERT_ARG(cl))
195 #define ASSERT_ARGS_Parrot_mmd_get_cached_multi_sig \
196 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
197 PARROT_ASSERT_ARG(interp) \
198 , PARROT_ASSERT_ARG(sub_pmc))
199 #define ASSERT_ARGS_Parrot_mmd_maybe_candidate __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
200 PARROT_ASSERT_ARG(interp) \
201 , PARROT_ASSERT_ARG(pmc) \
202 , PARROT_ASSERT_ARG(cl))
203 #define ASSERT_ARGS_Parrot_mmd_sort_candidates __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
204 PARROT_ASSERT_ARG(interp) \
205 , PARROT_ASSERT_ARG(arg_tuple) \
206 , PARROT_ASSERT_ARG(cl))
207 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
208 /* HEADERIZER END: static */
211 #define MMD_DEBUG 0
216 =item C<PMC* Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP, STRING *name, PMC
217 *invoke_sig)>
219 Collect a list of possible candidates for a given sub name and call signature.
220 Rank the possible candidates by Manhattan Distance, and return the best
221 matching candidate. The candidate list is cached in the CallSignature object,
222 to allow for iterating through it.
224 Currently this only looks in the global "MULTI" namespace.
226 =cut
230 PARROT_EXPORT
231 PARROT_WARN_UNUSED_RESULT
232 PARROT_CANNOT_RETURN_NULL
233 PMC*
234 Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *invoke_sig))
236 ASSERT_ARGS(Parrot_mmd_find_multi_from_sig_obj)
237 PMC * const candidate_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
239 mmd_search_by_sig_obj(interp, name, invoke_sig, candidate_list);
240 mmd_search_global(interp, name, candidate_list);
242 return Parrot_mmd_sort_manhattan_by_sig_pmc(interp, candidate_list, invoke_sig);
247 =item C<void Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP, const char
248 *name, const char *sig, ...)>
250 Dispatches to a MultiSub from a variable-sized list of C arguments. The
251 multiple dispatch system will figure out which sub should be called based on
252 the types of the arguments passed in.
254 Return arguments must be passed as a reference to the PMC, string, number, or
255 integer, so the result can be set.
257 =cut
261 PARROT_EXPORT
262 PARROT_CAN_RETURN_NULL
263 void
264 Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP,
265 ARGIN(const char *name), ARGIN(const char *sig), ...)
267 ASSERT_ARGS(Parrot_mmd_multi_dispatch_from_c_args)
268 PMC *call_obj, *sub;
269 va_list args;
270 const char *arg_sig, *ret_sig;
272 Parrot_pcc_split_signature_string(sig, &arg_sig, &ret_sig);
274 va_start(args, sig);
275 call_obj = Parrot_pcc_build_call_from_varargs(interp, PMCNULL, arg_sig, &args);
277 /* Check the cache. */
278 sub = Parrot_mmd_cache_lookup_by_types(interp, interp->op_mmd_cache, name,
279 VTABLE_get_pmc(interp, call_obj));
281 if (PMC_IS_NULL(sub)) {
282 sub = Parrot_mmd_find_multi_from_sig_obj(interp,
283 Parrot_str_new_constant(interp, name), call_obj);
285 if (!PMC_IS_NULL(sub))
286 Parrot_mmd_cache_store_by_types(interp, interp->op_mmd_cache, name,
287 VTABLE_get_pmc(interp, call_obj), sub);
290 if (PMC_IS_NULL(sub))
291 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_METHOD_NOT_FOUND,
292 "Multiple Dispatch: No suitable candidate found for '%s',"
293 " with signature '%s'", name, sig);
295 #if MMD_DEBUG
296 Parrot_io_eprintf(interp, "candidate found for '%s', with signature '%s'\n",
297 name, sig);
298 Parrot_io_eprintf(interp, "type of candidate found: %Ss\n",
299 VTABLE_name(interp, sub));
300 #endif
302 Parrot_pcc_invoke_from_sig_object(interp, sub, call_obj);
303 call_obj = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
304 Parrot_pcc_fill_params_from_varargs(interp, call_obj, ret_sig, &args,
305 PARROT_ERRORS_RESULT_COUNT_FLAG);
306 va_end(args);
312 =item C<PMC * Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP, STRING *name,
313 STRING *long_sig)>
315 Find the best candidate multi for a given sub name and signature. The signature
316 is a string containing a comma-delimited list of type names.
318 Currently only searches the global MULTI namespace.
320 =cut
324 PARROT_EXPORT
325 PARROT_CAN_RETURN_NULL
326 PARROT_WARN_UNUSED_RESULT
327 PMC *
328 Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP, ARGIN(STRING *name),
329 ARGIN(STRING *long_sig))
331 ASSERT_ARGS(Parrot_mmd_find_multi_from_long_sig)
332 STRING * const multi_str = CONST_STRING(interp, "MULTI");
333 PMC * const ns = Parrot_ns_make_namespace_keyed_str(interp,
334 interp->root_namespace, multi_str);
335 PMC * const multi_sub = Parrot_ns_get_global(interp, ns, name);
337 if (PMC_IS_NULL(multi_sub)) {
338 return PMCNULL;
340 else {
341 PMC * const type_tuple = mmd_build_type_tuple_from_long_sig(interp, long_sig);
342 return Parrot_mmd_sort_candidates(interp, type_tuple, multi_sub);
349 =item C<PMC * Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP, PMC
350 *candidates, PMC *invoke_sig)>
352 Given an array PMC (usually a MultiSub) and a CallSignature PMC, sorts the mmd
353 candidates by their manhattan distance to the signature args and returns the
354 best one.
356 =cut
360 PARROT_EXPORT
361 PARROT_CAN_RETURN_NULL
362 PARROT_WARN_UNUSED_RESULT
363 PMC *
364 Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP, ARGIN(PMC *candidates),
365 ARGIN(PMC *invoke_sig))
367 ASSERT_ARGS(Parrot_mmd_sort_manhattan_by_sig_pmc)
368 const INTVAL n = VTABLE_elements(interp, candidates);
370 if (!n)
371 return PMCNULL;
373 return Parrot_mmd_sort_candidates(interp,
374 VTABLE_get_pmc(interp, invoke_sig), candidates);
379 =item C<static PMC* mmd_build_type_tuple_from_type_list(PARROT_INTERP, PMC
380 *type_list)>
382 Construct a FixedIntegerArray of type numbers from an array of
383 type names. Used for multiple dispatch.
385 =cut
389 PARROT_CANNOT_RETURN_NULL
390 PARROT_WARN_UNUSED_RESULT
391 static PMC*
392 mmd_build_type_tuple_from_type_list(PARROT_INTERP, ARGIN(PMC *type_list))
394 ASSERT_ARGS(mmd_build_type_tuple_from_type_list)
395 INTVAL param_count = VTABLE_elements(interp, type_list);
396 PMC *multi_sig = Parrot_pmc_new_constant_init_int(interp,
397 enum_class_FixedIntegerArray, param_count);
398 INTVAL i;
400 for (i = 0; i < param_count; ++i) {
401 STRING *type_name = VTABLE_get_string_keyed_int(interp, type_list, i);
402 INTVAL type;
404 if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "DEFAULT")))
405 type = enum_type_PMC;
406 else if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "STRING")))
407 type = enum_type_STRING;
408 else if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "INTVAL")))
409 type = enum_type_INTVAL;
410 else if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "FLOATVAL")))
411 type = enum_type_FLOATVAL;
412 else
413 type = Parrot_pmc_get_type_str(interp, type_name);
415 VTABLE_set_integer_keyed_int(interp, multi_sig, i, type);
418 return multi_sig;
424 =item C<static PMC* mmd_build_type_tuple_from_long_sig(PARROT_INTERP, STRING
425 *long_sig)>
427 Construct a FixedIntegerArray of type numbers from a comma-delimited string of
428 type names. Used for multiple dispatch.
430 =cut
434 PARROT_CANNOT_RETURN_NULL
435 PARROT_WARN_UNUSED_RESULT
436 static PMC*
437 mmd_build_type_tuple_from_long_sig(PARROT_INTERP, ARGIN(STRING *long_sig))
439 ASSERT_ARGS(mmd_build_type_tuple_from_long_sig)
440 PMC *type_list = Parrot_str_split(interp, CONST_STRING(interp, ","), long_sig);
442 return mmd_build_type_tuple_from_type_list(interp, type_list);
448 =item C<PMC* Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, PMC
449 *sig_obj)>
451 Construct a FixedIntegerArray of type numbers from the arguments of a Call
452 Signature object. Used for multiple dispatch.
454 =cut
458 PARROT_EXPORT
459 PARROT_CANNOT_RETURN_NULL
460 PARROT_WARN_UNUSED_RESULT
461 PMC*
462 Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, ARGIN(PMC *sig_obj))
464 ASSERT_ARGS(Parrot_mmd_build_type_tuple_from_sig_obj)
465 return VTABLE_get_pmc(interp, sig_obj);
471 =item C<static PMC* mmd_cvt_to_types(PARROT_INTERP, PMC *multi_sig)>
473 Given a ResizablePMCArray PMC containing some form of type identifier (either
474 the string name of a class or a PMC representing the type), resolves all type
475 references to type IDs, if possible. If that's not possible, returns PMCNULL.
476 In that case you can't dispatch to the multi variant with this type signature,
477 as Parrot doesn't yet know about the respective types requested -- you have to
478 register them first.
480 Otherwise, returns a ResizableIntegerArray PMC full of type IDs representing
481 the signature of a multi variant to which you may be able to dispatch.
483 {{**DEPRECATE**}}
485 =cut
489 PARROT_WARN_UNUSED_RESULT
490 PARROT_CAN_RETURN_NULL
491 static PMC*
492 mmd_cvt_to_types(PARROT_INTERP, ARGIN(PMC *multi_sig))
494 ASSERT_ARGS(mmd_cvt_to_types)
495 PMC *ar = PMCNULL;
496 const INTVAL n = VTABLE_elements(interp, multi_sig);
497 INTVAL i;
499 for (i = 0; i < n; ++i) {
500 PMC * const sig_elem = VTABLE_get_pmc_keyed_int(interp, multi_sig, i);
501 INTVAL type;
503 if (sig_elem->vtable->base_type == enum_class_String) {
504 STRING * const sig = VTABLE_get_string(interp, sig_elem);
506 if (!sig)
507 return PMCNULL;
509 type = Parrot_pmc_get_type_str(interp, sig);
511 if (type == enum_type_undef)
512 return PMCNULL;
514 else if (sig_elem->vtable->base_type == enum_class_Integer) {
515 type = VTABLE_get_integer(interp, sig_elem);
517 else
518 type = Parrot_pmc_get_type(interp, sig_elem);
520 /* create destination PMC only as necessary */
521 if (PMC_IS_NULL(ar))
522 ar = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
524 VTABLE_set_integer_keyed_int(interp, ar, i, type);
527 return ar;
533 =item C<static PMC * Parrot_mmd_get_cached_multi_sig(PARROT_INTERP, PMC
534 *sub_pmc)>
536 Get the cached multisig of the given sub, if one exists. The cached signature
537 might be in different formats, so put it into a type tuple like the rest of the
538 MMD system expects.
540 =cut
544 PARROT_WARN_UNUSED_RESULT
545 PARROT_CAN_RETURN_NULL
546 static PMC *
547 Parrot_mmd_get_cached_multi_sig(PARROT_INTERP, ARGIN(PMC *sub_pmc))
549 ASSERT_ARGS(Parrot_mmd_get_cached_multi_sig)
550 if (VTABLE_isa(interp, sub_pmc, CONST_STRING(interp, "Sub"))) {
551 Parrot_Sub_attributes *sub;
552 PMC *multi_sig;
554 PMC_get_sub(interp, sub_pmc, sub);
555 multi_sig = sub->multi_signature;
557 if (multi_sig->vtable->base_type == enum_class_FixedPMCArray) {
558 PMC *converted_sig = mmd_cvt_to_types(interp, multi_sig);
560 if (PMC_IS_NULL(converted_sig))
561 return PMCNULL;
563 multi_sig = sub->multi_signature = converted_sig;
566 return multi_sig;
569 return PMCNULL;
573 #define MMD_BIG_DISTANCE 0x7fff
577 =item C<static UINTVAL mmd_distance(PARROT_INTERP, PMC *pmc, PMC *arg_tuple)>
579 Create Manhattan Distance of sub C<pmc> against given argument types.
580 0xffff is the maximum distance
582 =cut
586 static UINTVAL
587 mmd_distance(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *arg_tuple))
589 ASSERT_ARGS(mmd_distance)
590 PMC *multi_sig, *mro;
591 Parrot_Sub_attributes *sub;
592 INTVAL args, dist, i, j, n, m;
594 if (pmc->vtable->base_type == enum_class_NativePCCMethod) {
595 GETATTR_NativePCCMethod_mmd_multi_sig(interp, pmc, multi_sig);
596 if (PMC_IS_NULL(multi_sig)) {
597 STRING *long_sig;
599 GETATTR_NativePCCMethod_mmd_long_signature(interp, pmc, long_sig);
600 multi_sig = mmd_build_type_tuple_from_long_sig(interp, long_sig);
601 SETATTR_NativePCCMethod_mmd_multi_sig(interp, pmc, multi_sig);
604 else if (pmc->vtable->base_type == enum_class_NCI) {
605 GETATTR_NCI_multi_sig(interp, pmc, multi_sig);
606 if (PMC_IS_NULL(multi_sig)) {
607 STRING *long_sig;
609 GETATTR_NCI_long_signature(interp, pmc, long_sig);
610 multi_sig = mmd_build_type_tuple_from_long_sig(interp, long_sig);
611 SETATTR_NCI_multi_sig(interp, pmc, multi_sig);
614 else {
615 PMC_get_sub(interp, pmc, sub);
617 if (!sub->multi_signature)
618 return 0; /* not a multi; no distance */
620 multi_sig = Parrot_mmd_get_cached_multi_sig(interp, pmc);
623 if (PMC_IS_NULL(multi_sig))
624 return MMD_BIG_DISTANCE;
626 n = VTABLE_elements(interp, multi_sig);
627 args = VTABLE_elements(interp, arg_tuple);
630 * arg_tuple may have more arguments - only the
631 * n multi_sig invocants are counted
633 if (args < n)
634 return MMD_BIG_DISTANCE;
636 dist = 0;
638 if (args > n)
639 dist = PARROT_MMD_MAX_CLASS_DEPTH;
641 /* now go through args */
642 for (i = 0; i < n; ++i) {
643 const INTVAL type_sig = VTABLE_get_integer_keyed_int(interp, multi_sig, i);
644 INTVAL type_call = VTABLE_get_integer_keyed_int(interp, arg_tuple, i);
645 if (type_sig == type_call)
646 continue;
648 /* promote primitives to their PMC equivalents, as PCC will autobox
649 * them. If it's a direct autobox, int->Integer, str->String, or
650 * num->Num, the distance is 1 and we move to the next arg. If it's
651 * autoboxing to "any" PMC type, we increment the distance and continue
652 * weighing other things. A direct autobox should be cheaper than an
653 * autobox plus type conversion or implicit type acceptance. */
654 switch (type_call) {
655 case enum_type_INTVAL:
656 if (type_sig == enum_class_Integer) { dist++; continue; }
657 if (type_sig == enum_type_PMC ||
658 (type_sig >= enum_class_default && type_sig < enum_class_core_max)) {
659 ++dist;
660 type_call = enum_class_Integer;
662 break;
663 case enum_type_FLOATVAL:
664 if (type_sig == enum_class_Float) { dist++; continue; }
665 if (type_sig == enum_type_PMC ||
666 (type_sig >= enum_class_default && type_sig < enum_class_core_max)) {
667 ++dist;
668 type_call = enum_class_Float;
670 break;
671 case enum_type_STRING:
672 if (type_sig == enum_class_String) { dist++; continue; }
673 if (type_sig == enum_type_PMC ||
674 (type_sig >= enum_class_default && type_sig < enum_class_core_max)) {
675 ++dist;
676 type_call = enum_class_String;
678 break;
679 default:
680 break;
684 * different native types are very different, except a PMC
685 * which matches any PMC
687 if (type_call <= 0 && type_sig == enum_type_PMC) {
688 ++dist;
689 continue;
692 if ((type_sig <= 0 && type_sig != enum_type_PMC) || type_call <= 0) {
693 dist = MMD_BIG_DISTANCE;
694 break;
698 * now consider MRO of types the signature type has to be somewhere
699 * in the MRO of the type_call
701 mro = interp->vtables[type_call]->mro;
702 m = VTABLE_elements(interp, mro);
704 for (j = 0; j < m; ++j) {
705 PMC * const cl = VTABLE_get_pmc_keyed_int(interp, mro, j);
707 if (cl->vtable->base_type == type_sig)
708 break;
709 if (VTABLE_type(interp, cl) == type_sig)
710 break;
712 ++dist;
716 * if the type wasn't in MRO check, if any PMC matches
717 * in that case use the distance + 1 (of an any PMC parent)
719 if (j == m && type_sig != enum_type_PMC) {
720 dist = MMD_BIG_DISTANCE;
721 break;
724 ++dist;
726 #if MMD_DEBUG
728 STRING *s1, *s2;
729 if (type_sig < 0)
730 s1 = Parrot_get_datatype_name(interp, type_sig);
731 else
732 s1 = interp->vtables[type_sig]->whoami;
734 if (type_call < 0)
735 s2 = Parrot_get_datatype_name(interp, type_call);
736 else
737 s2 = interp->vtables[type_call]->whoami;
739 Parrot_io_eprintf(interp, "arg %d: dist %d sig %Ss arg %Ss\n",
740 i, dist, s1, s2);
742 #endif
745 return dist;
751 =item C<static PMC * Parrot_mmd_sort_candidates(PARROT_INTERP, PMC *arg_tuple,
752 PMC *cl)>
754 Sort the candidate list C<cl> by Manhattan Distance, returning the best
755 candidate.
757 =cut
761 PARROT_CANNOT_RETURN_NULL
762 static PMC *
763 Parrot_mmd_sort_candidates(PARROT_INTERP, ARGIN(PMC *arg_tuple), ARGIN(PMC *cl))
765 ASSERT_ARGS(Parrot_mmd_sort_candidates)
766 PMC *best_candidate = PMCNULL;
767 INTVAL best_distance = MMD_BIG_DISTANCE;
768 const INTVAL n = VTABLE_elements(interp, cl);
769 INTVAL i;
771 for (i = 0; i < n; ++i) {
772 PMC * const pmc = VTABLE_get_pmc_keyed_int(interp, cl, i);
773 const INTVAL d = mmd_distance(interp, pmc, arg_tuple);
774 if (d < best_distance) {
775 best_candidate = pmc;
776 best_distance = d;
780 return best_candidate;
786 =item C<static int Parrot_mmd_maybe_candidate(PARROT_INTERP, PMC *pmc, PMC *cl)>
788 If the candidate C<pmc> is a Sub PMC, push it on the candidate list and
789 return TRUE to stop further search.
791 If the candidate is a MultiSub remember all matching Subs and return FALSE
792 to continue searching outer scopes.
794 =cut
798 static int
799 Parrot_mmd_maybe_candidate(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *cl))
801 ASSERT_ARGS(Parrot_mmd_maybe_candidate)
802 STRING * const _sub = CONST_STRING(interp, "Sub");
803 STRING * const _multi_sub = CONST_STRING(interp, "MultiSub");
805 INTVAL i, n;
807 if (VTABLE_isa(interp, pmc, _sub)) {
808 /* a plain sub stops outer searches */
809 VTABLE_push_pmc(interp, cl, pmc);
810 return 1;
813 /* not a Sub or MultiSub - ignore */
814 if (!VTABLE_isa(interp, pmc, _multi_sub))
815 return 0;
817 /* ok we have a multi sub pmc, which is an array of candidates */
818 n = VTABLE_elements(interp, pmc);
820 for (i = 0; i < n; ++i) {
821 PMC * const multi_sub = VTABLE_get_pmc_keyed_int(interp, pmc, i);
822 VTABLE_push_pmc(interp, cl, multi_sub);
825 return 0;
831 =item C<static void mmd_search_by_sig_obj(PARROT_INTERP, STRING *name, PMC
832 *sig_obj, PMC *candidates)>
834 Search the namespace of the first argument to the sub call for matching
835 candidates.
837 =cut
841 static void
842 mmd_search_by_sig_obj(PARROT_INTERP, ARGIN(STRING *name),
843 ARGIN(PMC *sig_obj), ARGIN(PMC *candidates))
845 ASSERT_ARGS(mmd_search_by_sig_obj)
846 PMC *first_arg = VTABLE_get_pmc_keyed_int(interp, sig_obj, 0);
847 PMC *ns, *multi_sub;
849 if (PMC_IS_NULL(first_arg))
850 return;
852 ns = VTABLE_get_namespace(interp, first_arg);
854 if (PMC_IS_NULL(ns))
855 return;
857 multi_sub = Parrot_ns_get_global(interp, ns, name);
859 if (PMC_IS_NULL(multi_sub))
860 return;
862 Parrot_mmd_maybe_candidate(interp, multi_sub, candidates);
868 =item C<static void mmd_search_global(PARROT_INTERP, STRING *name, PMC *cl)>
870 Search the builtin namespace for matching candidates.
872 =cut
876 static void
877 mmd_search_global(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *cl))
879 ASSERT_ARGS(mmd_search_global)
880 STRING * const multi_str = CONST_STRING(interp, "MULTI");
881 PMC * const ns = Parrot_ns_get_namespace_keyed_str(interp,
882 interp->root_namespace, multi_str);
883 PMC *multi_sub = Parrot_ns_get_global(interp, ns, name);
885 if (PMC_IS_NULL(multi_sub))
886 return;
888 Parrot_mmd_maybe_candidate(interp, multi_sub, cl);
894 =item C<static void mmd_add_multi_global(PARROT_INTERP, STRING *sub_name, PMC
895 *sub_obj)>
897 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
898 stored in the global MULTI namespace.
900 =cut
904 static void
905 mmd_add_multi_global(PARROT_INTERP, ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
907 ASSERT_ARGS(mmd_add_multi_global)
908 STRING * const multi_str = CONST_STRING(interp, "MULTI");
909 PMC * const ns = Parrot_ns_make_namespace_keyed_str(interp,
910 interp->root_namespace, multi_str);
911 PMC *multi_sub = Parrot_ns_get_global(interp, ns, sub_name);
913 if (PMC_IS_NULL(multi_sub)) {
914 multi_sub = Parrot_pmc_new_constant(interp, enum_class_MultiSub);
915 Parrot_ns_set_global(interp, ns, sub_name, multi_sub);
918 PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
919 VTABLE_push_pmc(interp, multi_sub, sub_obj);
925 =item C<static void mmd_add_multi_to_namespace(PARROT_INTERP, STRING *ns_name,
926 STRING *sub_name, PMC *sub_obj)>
928 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
929 added as a method to a class.
931 =cut
935 static void
936 mmd_add_multi_to_namespace(PARROT_INTERP, ARGIN(STRING *ns_name),
937 ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
939 ASSERT_ARGS(mmd_add_multi_to_namespace)
940 PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
941 interp->HLL_namespace,
942 Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
943 PMC * const ns = Parrot_ns_make_namespace_keyed_str(interp, hll_ns, ns_name);
944 PMC *multi_sub = Parrot_ns_get_global(interp, ns, sub_name);
946 if (PMC_IS_NULL(multi_sub)) {
947 multi_sub = Parrot_pmc_new_constant(interp, enum_class_MultiSub);
948 Parrot_ns_set_global(interp, ns, sub_name, multi_sub);
951 PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
952 VTABLE_push_pmc(interp, multi_sub, sub_obj);
958 =item C<void Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP, STRING *sub_name,
959 STRING *long_sig, PMC *sub_obj)>
961 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
962 stored in the global MULTI namespace.
964 =cut
968 PARROT_EXPORT
969 void
970 Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP,
971 ARGIN(STRING *sub_name), ARGIN(STRING *long_sig), ARGIN(PMC *sub_obj))
973 ASSERT_ARGS(Parrot_mmd_add_multi_from_long_sig)
974 Parrot_Sub_attributes *sub;
975 STRING *sub_str = CONST_STRING(interp, "Sub");
976 PMC *type_list = Parrot_str_split(interp, CONST_STRING(interp, ","), long_sig);
977 STRING *ns_name = VTABLE_get_string_keyed_int(interp, type_list, 0);
979 /* Attach a type tuple array to the sub for multi dispatch */
980 PMC *multi_sig = mmd_build_type_tuple_from_type_list(interp, type_list);
982 if (sub_obj->vtable->base_type == enum_class_NativePCCMethod) {
983 SETATTR_NativePCCMethod_mmd_multi_sig(interp, sub_obj, multi_sig);
985 else if (sub_obj->vtable->base_type == enum_class_NCI) {
986 SETATTR_NCI_multi_sig(interp, sub_obj, multi_sig);
988 else if (VTABLE_isa(interp, sub_obj, sub_str)) {
989 PMC_get_sub(interp, sub_obj, sub);
990 sub->multi_signature = multi_sig;
993 mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
994 mmd_add_multi_global(interp, sub_name, sub_obj);
1000 =item C<void Parrot_mmd_add_multi_from_c_args(PARROT_INTERP, const char
1001 *sub_name, const char *short_sig, const char *long_sig, funcptr_t
1002 multi_func_ptr)>
1004 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
1005 stored in the specified namespace.
1007 =cut
1011 PARROT_EXPORT
1012 void
1013 Parrot_mmd_add_multi_from_c_args(PARROT_INTERP,
1014 ARGIN(const char *sub_name), ARGIN(const char *short_sig),
1015 ARGIN(const char *long_sig), ARGIN(funcptr_t multi_func_ptr))
1017 ASSERT_ARGS(Parrot_mmd_add_multi_from_c_args)
1018 STRING *comma = CONST_STRING(interp, ",");
1019 STRING *sub_name_str = Parrot_str_new_constant(interp, sub_name);
1020 STRING *long_sig_str = Parrot_str_new_constant(interp, long_sig);
1021 STRING *short_sig_str = Parrot_str_new_constant(interp, short_sig);
1022 PMC *type_list = Parrot_str_split(interp, comma, long_sig_str);
1023 STRING *ns_name = VTABLE_get_string_keyed_int(interp, type_list, 0);
1025 /* Create an NCI sub for the C function */
1026 PMC *sub_obj = Parrot_pmc_new_constant(interp, enum_class_NCI);
1027 PMC *multi_sig = mmd_build_type_tuple_from_long_sig(interp,
1028 long_sig_str);
1030 VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig_str,
1031 F2DPTR(multi_func_ptr));
1033 /* Attach a type tuple array to the NCI sub for multi dispatch */
1034 SETATTR_NCI_multi_sig(interp, sub_obj, multi_sig);
1036 mmd_add_multi_to_namespace(interp, ns_name, sub_name_str, sub_obj);
1037 mmd_add_multi_global(interp, sub_name_str, sub_obj);
1042 =item C<void Parrot_mmd_add_multi_list_from_c_args(PARROT_INTERP, const
1043 multi_func_list *mmd_info, INTVAL elements)>
1045 Create a collection of multiple dispatch subs from a C structure of
1046 information. Iterate through the list of details passed in. For each entry
1047 create a MultiSub or add a variant to an existing MultiSub. MultiSubs are
1048 created in the global 'MULTI' namespace in the Parrot HLL.
1050 Typically used to create all the multiple dispatch routines
1051 declared in a PMC from the PMC's class initialization function.
1053 =cut
1057 PARROT_EXPORT
1058 void
1059 Parrot_mmd_add_multi_list_from_c_args(PARROT_INTERP,
1060 ARGIN(const multi_func_list *mmd_info), INTVAL elements)
1062 ASSERT_ARGS(Parrot_mmd_add_multi_list_from_c_args)
1063 INTVAL i;
1064 for (i = 0; i < elements; ++i) {
1065 funcptr_t func_ptr = mmd_info[i].func_ptr;
1067 STRING *sub_name = mmd_info[i].multi_name;
1068 STRING *long_sig = mmd_info[i].full_sig;
1069 STRING *short_sig = mmd_info[i].short_sig;
1070 STRING *ns_name = mmd_info[i].ns_name;
1072 /* Create an NCI sub for the C function */
1073 PMC *sub_obj = Parrot_pmc_new_constant(interp, enum_class_NCI);
1075 VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig,
1076 F2DPTR(func_ptr));
1078 /* Attach a type tuple array to the NCI sub for multi dispatch */
1079 SETATTR_NCI_long_signature(interp, sub_obj, long_sig);
1081 mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
1082 mmd_add_multi_global(interp, sub_name, sub_obj);
1089 =item C<MMD_Cache * Parrot_mmd_cache_create(PARROT_INTERP)>
1091 Creates and returns a new MMD cache.
1093 =cut
1097 PARROT_EXPORT
1098 PARROT_CANNOT_RETURN_NULL
1099 MMD_Cache *
1100 Parrot_mmd_cache_create(PARROT_INTERP)
1102 ASSERT_ARGS(Parrot_mmd_cache_create)
1103 /* String hash. */
1104 Hash *cache = parrot_new_hash(interp);
1105 return cache;
1111 =item C<static STRING * mmd_cache_key_from_values(PARROT_INTERP, const char
1112 *name, PMC *values)>
1114 Generates an MMD cache key from an array of values.
1116 =cut
1120 PARROT_WARN_UNUSED_RESULT
1121 PARROT_CAN_RETURN_NULL
1122 static STRING *
1123 mmd_cache_key_from_values(PARROT_INTERP, ARGIN(const char *name),
1124 ARGIN(PMC *values))
1126 ASSERT_ARGS(mmd_cache_key_from_values)
1127 /* Build array of type IDs, which we'll then use as a string to key into
1128 * the hash. */
1129 const INTVAL num_values = VTABLE_elements(interp, values);
1130 const INTVAL name_len = name ? strlen(name) + 1: 0;
1131 const size_t id_size = num_values * sizeof (INTVAL) + name_len;
1132 INTVAL *type_ids = mem_gc_allocate_n_typed(interp, num_values + name_len, INTVAL);
1133 STRING *key;
1134 INTVAL i;
1136 for (i = 0; i < num_values; ++i) {
1137 const INTVAL id = VTABLE_type(interp, VTABLE_get_pmc_keyed_int(interp, values, i));
1138 if (id == 0) {
1139 mem_gc_free(interp, type_ids);
1140 return NULL;
1143 type_ids[i] = id;
1146 if (name)
1147 strcpy((char *)(type_ids + num_values), name);
1149 key = Parrot_str_new(interp, (char *)type_ids, id_size);
1150 mem_gc_free(interp, type_ids);
1152 return key;
1158 =item C<PMC * Parrot_mmd_cache_lookup_by_values(PARROT_INTERP, MMD_Cache *cache,
1159 const char *name, PMC *values)>
1161 Takes an array of values for the call and does a lookup in the MMD cache.
1163 =cut
1167 PARROT_EXPORT
1168 PARROT_WARN_UNUSED_RESULT
1169 PARROT_CAN_RETURN_NULL
1170 PMC *
1171 Parrot_mmd_cache_lookup_by_values(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1172 ARGIN(const char *name), ARGIN(PMC *values))
1174 ASSERT_ARGS(Parrot_mmd_cache_lookup_by_values)
1175 STRING * const key = mmd_cache_key_from_values(interp, name, values);
1177 if (key)
1178 return (PMC *)parrot_hash_get(interp, cache, key);
1180 return PMCNULL;
1186 =item C<void Parrot_mmd_cache_store_by_values(PARROT_INTERP, MMD_Cache *cache,
1187 const char *name, PMC *values, PMC *chosen)>
1189 Takes an array of values for the call along with a chosen candidate and puts
1190 it into the cache.
1192 =cut
1196 PARROT_EXPORT
1197 void
1198 Parrot_mmd_cache_store_by_values(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1199 ARGIN(const char *name), ARGIN(PMC *values), ARGIN(PMC *chosen))
1201 ASSERT_ARGS(Parrot_mmd_cache_store_by_values)
1202 STRING * const key = mmd_cache_key_from_values(interp, name, values);
1204 if (key)
1205 parrot_hash_put(interp, cache, key, chosen);
1211 =item C<static STRING * mmd_cache_key_from_types(PARROT_INTERP, const char
1212 *name, PMC *types)>
1214 Generates an MMD cache key from an array of types.
1216 =cut
1220 PARROT_WARN_UNUSED_RESULT
1221 PARROT_CAN_RETURN_NULL
1222 static STRING *
1223 mmd_cache_key_from_types(PARROT_INTERP, ARGIN(const char *name),
1224 ARGIN(PMC *types))
1226 ASSERT_ARGS(mmd_cache_key_from_types)
1227 /* Build array of type IDs, which we'll then use as a string to key into
1228 * the hash. */
1229 const INTVAL num_types = VTABLE_elements(interp, types);
1230 const INTVAL name_len = name ? strlen(name) + 1: 0;
1231 const size_t id_size = num_types * sizeof (INTVAL) + name_len;
1232 INTVAL * const type_ids = mem_gc_allocate_n_typed(interp, num_types + name_len, INTVAL);
1234 STRING *key;
1235 INTVAL i;
1237 for (i = 0; i < num_types; ++i) {
1238 const INTVAL id = VTABLE_get_integer_keyed_int(interp, types, i);
1240 if (id == 0) {
1241 mem_gc_free(interp, type_ids);
1242 return NULL;
1245 type_ids[i] = id;
1248 if (name)
1249 strcpy((char *)(type_ids + num_types), name);
1251 key = Parrot_str_new(interp, (char *)type_ids, id_size);
1253 mem_gc_free(interp, type_ids);
1254 return key;
1260 =item C<PMC * Parrot_mmd_cache_lookup_by_types(PARROT_INTERP, MMD_Cache *cache,
1261 const char *name, PMC *types)>
1263 Takes an array of types for the call and does a lookup in the MMD cache.
1265 =cut
1269 PARROT_EXPORT
1270 PARROT_WARN_UNUSED_RESULT
1271 PARROT_CAN_RETURN_NULL
1272 PMC *
1273 Parrot_mmd_cache_lookup_by_types(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1274 ARGIN(const char *name), ARGIN(PMC *types))
1276 ASSERT_ARGS(Parrot_mmd_cache_lookup_by_types)
1277 const STRING * const key = mmd_cache_key_from_types(interp, name, types);
1279 if (key)
1280 return (PMC *)parrot_hash_get(interp, cache, key);
1282 return PMCNULL;
1288 =item C<void Parrot_mmd_cache_store_by_types(PARROT_INTERP, MMD_Cache *cache,
1289 const char *name, PMC *types, PMC *chosen)>
1291 Takes an array of types for the call along with a chosen candidate and puts
1292 it into the cache. The name parameter is optional, and if the cache is already
1293 tied to an individual multi can be null.
1295 =cut
1299 PARROT_EXPORT
1300 void
1301 Parrot_mmd_cache_store_by_types(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1302 ARGIN(const char *name), ARGIN(PMC *types), ARGIN(PMC *chosen))
1304 ASSERT_ARGS(Parrot_mmd_cache_store_by_types)
1305 STRING * const key = mmd_cache_key_from_types(interp, name, types);
1307 if (key)
1308 parrot_hash_put(interp, cache, key, chosen);
1314 =item C<void Parrot_mmd_cache_mark(PARROT_INTERP, MMD_Cache *cache)>
1316 GC-marks an MMD cache.
1318 =cut
1322 PARROT_EXPORT
1323 void
1324 Parrot_mmd_cache_mark(PARROT_INTERP, ARGMOD(MMD_Cache *cache))
1326 ASSERT_ARGS(Parrot_mmd_cache_mark)
1327 /* As a small future optimization, note that we only *really* need to mark
1328 * keys - the candidates will be referenced outside the cache, provided it's
1329 * invalidated properly. */
1330 parrot_mark_hash(interp, cache);
1336 =item C<void Parrot_mmd_cache_destroy(PARROT_INTERP, MMD_Cache *cache)>
1338 Destroys an MMD cache.
1340 =cut
1344 PARROT_EXPORT
1345 void
1346 Parrot_mmd_cache_destroy(PARROT_INTERP, ARGMOD(MMD_Cache *cache))
1348 ASSERT_ARGS(Parrot_mmd_cache_destroy)
1349 parrot_hash_destroy(interp, cache);
1355 =back
1357 =head1 SEE ALSO
1359 F<include/parrot/multidispatch.h>,
1360 F<http://svn.perl.org/perl6/doc/trunk/design/apo/A12.pod>,
1361 F<http://svn.perl.org/perl6/doc/trunk/design/syn/S12.pod>
1363 =cut
1369 * Local variables:
1370 * c-file-style: "parrot"
1371 * End:
1372 * vim: expandtab shiftwidth=4: