1 /*
2 Copyright (C) 2003-2010, Parrot Foundation.
3
4 =head1 NAME
5
6 src/multidispatch.c - Multimethod dispatch for binary opcode functions
7
8 =head1 SYNOPSIS
9
10 This system is set up to handle type-based dispatching for binary (two
11 argument) functions. This includes, though isn't necessarily limited to, binary
12 operators such as addition or subtraction.
13
14 =head1 DESCRIPTION
15
16 The MMD system is straightforward, and currently must be explicitly invoked,
17 for example by a vtable function. (We reserve the right to use MMD in all
18 circumstances, but currently do not).
19
20 =head2 API
21
22 For the purposes of the API, each MMD-able function is assigned a unique
23 number which is used to find the correct function table. This is the
24 C<func_num> parameter in the following functions. While Parrot isn't
25 restricted to a predefined set of functions, it I<does> set things up so
26 that all the binary vtable functions have a MMD table preinstalled for
27 them, with default behaviour.
28
29 =head2 Remarks
30
31 =head2 Functions
32
33 =over 4
34
35 =cut
36
37 */
38
39 #include "parrot/compiler.h"
40 #include "parrot/parrot.h"
41 #include "parrot/multidispatch.h"
42 #include "parrot/oplib/ops.h"
43 #include "multidispatch.str"
44 #include "pmc/pmc_nci.h"
45 #include "pmc/pmc_nativepccmethod.h"
46 #include "pmc/pmc_sub.h"
47 #include "pmc/pmc_callcontext.h"
48
49 /* HEADERIZER HFILE: include/parrot/multidispatch.h */
50
51 /* HEADERIZER BEGIN: static */
52 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
53
54 static void mmd_add_multi_global(PARROT_INTERP,
55 ARGIN(STRING *sub_name),
56 ARGIN(PMC *sub_obj))
57 __attribute__nonnull__(1)
58 __attribute__nonnull__(2)
59 __attribute__nonnull__(3);
60
61 static void mmd_add_multi_to_namespace(PARROT_INTERP,
62 ARGIN(STRING *ns_name),
63 ARGIN(STRING *sub_name),
64 ARGIN(PMC *sub_obj))
65 __attribute__nonnull__(1)
66 __attribute__nonnull__(2)
67 __attribute__nonnull__(3)
68 __attribute__nonnull__(4);
69
70 PARROT_CANNOT_RETURN_NULL
71 PARROT_WARN_UNUSED_RESULT
72 static PMC* mmd_build_type_tuple_from_long_sig(PARROT_INTERP,
73 ARGIN(STRING *long_sig))
74 __attribute__nonnull__(1)
75 __attribute__nonnull__(2);
76
77 PARROT_CANNOT_RETURN_NULL
78 PARROT_WARN_UNUSED_RESULT
79 static PMC* mmd_build_type_tuple_from_type_list(PARROT_INTERP,
80 ARGIN(PMC *type_list))
81 __attribute__nonnull__(1)
82 __attribute__nonnull__(2);
83
84 PARROT_WARN_UNUSED_RESULT
85 PARROT_CAN_RETURN_NULL
86 static STRING * mmd_cache_key_from_types(PARROT_INTERP,
87 ARGIN(const char *name),
88 ARGIN(PMC *types))
89 __attribute__nonnull__(1)
90 __attribute__nonnull__(2)
91 __attribute__nonnull__(3);
92
93 PARROT_WARN_UNUSED_RESULT
94 PARROT_CAN_RETURN_NULL
95 static STRING * mmd_cache_key_from_values(PARROT_INTERP,
96 ARGIN(const char *name),
97 ARGIN(PMC *values))
98 __attribute__nonnull__(1)
99 __attribute__nonnull__(2)
100 __attribute__nonnull__(3);
101
102 PARROT_WARN_UNUSED_RESULT
103 PARROT_CAN_RETURN_NULL
104 static PMC* mmd_cvt_to_types(PARROT_INTERP, ARGIN(PMC *multi_sig))
105 __attribute__nonnull__(1)
106 __attribute__nonnull__(2);
107
108 static UINTVAL mmd_distance(PARROT_INTERP,
109 ARGIN(PMC *pmc),
110 ARGIN(PMC *arg_tuple))
111 __attribute__nonnull__(1)
112 __attribute__nonnull__(2)
113 __attribute__nonnull__(3);
114
115 static void mmd_search_by_sig_obj(PARROT_INTERP,
116 ARGIN(STRING *name),
117 ARGIN(PMC *sig_obj),
118 ARGIN(PMC *candidates))
119 __attribute__nonnull__(1)
120 __attribute__nonnull__(2)
121 __attribute__nonnull__(3)
122 __attribute__nonnull__(4);
123
124 static void mmd_search_global(PARROT_INTERP,
125 ARGIN(STRING *name),
126 ARGIN(PMC *cl))
127 __attribute__nonnull__(1)
128 __attribute__nonnull__(2)
129 __attribute__nonnull__(3);
130
131 PARROT_WARN_UNUSED_RESULT
132 PARROT_CAN_RETURN_NULL
133 static PMC * Parrot_mmd_get_cached_multi_sig(PARROT_INTERP,
134 ARGIN(PMC *sub_pmc))
135 __attribute__nonnull__(1)
136 __attribute__nonnull__(2);
137
138 static int Parrot_mmd_maybe_candidate(PARROT_INTERP,
139 ARGIN(PMC *pmc),
140 ARGIN(PMC *cl))
141 __attribute__nonnull__(1)
142 __attribute__nonnull__(2)
143 __attribute__nonnull__(3);
144
145 PARROT_CAN_RETURN_NULL
146 static PMC * Parrot_mmd_sort_candidates(PARROT_INTERP,
147 ARGIN(PMC *arg_tuple),
148 ARGIN(PMC *cl))
149 __attribute__nonnull__(1)
150 __attribute__nonnull__(2)
151 __attribute__nonnull__(3);
152
153 #define ASSERT_ARGS_mmd_add_multi_global __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
154 PARROT_ASSERT_ARG(interp) \
155 , PARROT_ASSERT_ARG(sub_name) \
156 , PARROT_ASSERT_ARG(sub_obj))
157 #define ASSERT_ARGS_mmd_add_multi_to_namespace __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
158 PARROT_ASSERT_ARG(interp) \
159 , PARROT_ASSERT_ARG(ns_name) \
160 , PARROT_ASSERT_ARG(sub_name) \
161 , PARROT_ASSERT_ARG(sub_obj))
162 #define ASSERT_ARGS_mmd_build_type_tuple_from_long_sig \
163 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
164 PARROT_ASSERT_ARG(interp) \
165 , PARROT_ASSERT_ARG(long_sig))
166 #define ASSERT_ARGS_mmd_build_type_tuple_from_type_list \
167 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
168 PARROT_ASSERT_ARG(interp) \
169 , PARROT_ASSERT_ARG(type_list))
170 #define ASSERT_ARGS_mmd_cache_key_from_types __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
171 PARROT_ASSERT_ARG(interp) \
172 , PARROT_ASSERT_ARG(name) \
173 , PARROT_ASSERT_ARG(types))
174 #define ASSERT_ARGS_mmd_cache_key_from_values __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
175 PARROT_ASSERT_ARG(interp) \
176 , PARROT_ASSERT_ARG(name) \
177 , PARROT_ASSERT_ARG(values))
178 #define ASSERT_ARGS_mmd_cvt_to_types __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
179 PARROT_ASSERT_ARG(interp) \
180 , PARROT_ASSERT_ARG(multi_sig))
181 #define ASSERT_ARGS_mmd_distance __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
182 PARROT_ASSERT_ARG(interp) \
183 , PARROT_ASSERT_ARG(pmc) \
184 , PARROT_ASSERT_ARG(arg_tuple))
185 #define ASSERT_ARGS_mmd_search_by_sig_obj __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
186 PARROT_ASSERT_ARG(interp) \
187 , PARROT_ASSERT_ARG(name) \
188 , PARROT_ASSERT_ARG(sig_obj) \
189 , PARROT_ASSERT_ARG(candidates))
190 #define ASSERT_ARGS_mmd_search_global __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
191 PARROT_ASSERT_ARG(interp) \
192 , PARROT_ASSERT_ARG(name) \
193 , PARROT_ASSERT_ARG(cl))
194 #define ASSERT_ARGS_Parrot_mmd_get_cached_multi_sig \
195 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
196 PARROT_ASSERT_ARG(interp) \
197 , PARROT_ASSERT_ARG(sub_pmc))
198 #define ASSERT_ARGS_Parrot_mmd_maybe_candidate __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
199 PARROT_ASSERT_ARG(interp) \
200 , PARROT_ASSERT_ARG(pmc) \
201 , PARROT_ASSERT_ARG(cl))
202 #define ASSERT_ARGS_Parrot_mmd_sort_candidates __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
203 PARROT_ASSERT_ARG(interp) \
204 , PARROT_ASSERT_ARG(arg_tuple) \
205 , PARROT_ASSERT_ARG(cl))
206 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
207 /* HEADERIZER END: static */
208
209 #define MMD_DEBUG 0
210
211 /*
212
213 =item C<PMC* Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP, STRING *name, PMC
214 *invoke_sig)>
215
216 Collect a list of possible candidates for a given sub name and call signature.
217 Rank the possible candidates by Manhattan Distance, and return the best
218 matching candidate. The candidate list is cached in the CallSignature object,
219 to allow for iterating through it.
220
221 Currently this only looks in the global "MULTI" namespace.
222
223 =cut
224
225 */
226
227 PARROT_EXPORT
228 PARROT_WARN_UNUSED_RESULT
229 PARROT_CANNOT_RETURN_NULL
230 PMC*
Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP,ARGIN (STRING * name),ARGIN (PMC * invoke_sig))231 Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *invoke_sig))
232 {
233 ASSERT_ARGS(Parrot_mmd_find_multi_from_sig_obj)
234 PMC * const candidate_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
235
236 mmd_search_by_sig_obj(interp, name, invoke_sig, candidate_list);
237 mmd_search_global(interp, name, candidate_list);
238
239 return Parrot_mmd_sort_manhattan_by_sig_pmc(interp, candidate_list, invoke_sig);
240 }
241
242 /*
243
244 =item C<void Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP, const char
245 *name, const char *sig, ...)>
246
247 Dispatches to a MultiSub from a variable-sized list of C arguments. The
248 multiple dispatch system will figure out which sub should be called based on
249 the types of the arguments passed in.
250
251 Return arguments must be passed as a reference to the PMC, string, number, or
252 integer, so the result can be set.
253
254 =cut
255
256 */
257
258 PARROT_EXPORT
259 PARROT_CAN_RETURN_NULL
260 void
Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP,ARGIN (const char * name),ARGIN (const char * sig),...)261 Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP,
262 ARGIN(const char *name), ARGIN(const char *sig), ...)
263 {
264 ASSERT_ARGS(Parrot_mmd_multi_dispatch_from_c_args)
265 PMC *call_obj, *sub;
266 va_list args;
267 const char *arg_sig, *ret_sig;
268
269 Parrot_pcc_split_signature_string(sig, &arg_sig, &ret_sig);
270
271 va_start(args, sig);
272 call_obj = Parrot_pcc_build_call_from_varargs(interp, PMCNULL, arg_sig, &args);
273
274 /* Check the cache. */
275 sub = Parrot_mmd_cache_lookup_by_types(interp, interp->op_mmd_cache, name,
276 VTABLE_get_pmc(interp, call_obj));
277
278 if (PMC_IS_NULL(sub)) {
279 sub = Parrot_mmd_find_multi_from_sig_obj(interp,
280 Parrot_str_new_constant(interp, name), call_obj);
281
282 if (!PMC_IS_NULL(sub))
283 Parrot_mmd_cache_store_by_types(interp, interp->op_mmd_cache, name,
284 VTABLE_get_pmc(interp, call_obj), sub);
285 }
286
287 if (PMC_IS_NULL(sub))
288 Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_METHOD_NOT_FOUND,
289 "Multiple Dispatch: No suitable candidate found for '%s',"
290 " with signature '%s'", name, sig);
291
292 #if MMD_DEBUG
293 Parrot_io_eprintf(interp, "candidate found for '%s', with signature '%s'\n",
294 name, sig);
295 Parrot_io_eprintf(interp, "type of candidate found: %Ss\n",
296 VTABLE_name(interp, sub));
297 #endif
298
299 Parrot_pcc_invoke_from_sig_object(interp, sub, call_obj);
300 call_obj = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
301 Parrot_pcc_fill_params_from_varargs(interp, call_obj, ret_sig, &args,
302 PARROT_ERRORS_RESULT_COUNT_FLAG);
303 va_end(args);
304 }
305
306 /*
307
308 =item C<PMC * Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP, STRING *name,
309 STRING *long_sig)>
310
311 Find the best candidate multi for a given sub name and signature. The signature
312 is a string containing a comma-delimited list of type names.
313
314 Currently only searches the global MULTI namespace.
315
316 =cut
317
318 */
319
320 PARROT_EXPORT
321 PARROT_CAN_RETURN_NULL
322 PARROT_WARN_UNUSED_RESULT
323 PMC *
Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP,ARGIN (STRING * name),ARGIN (STRING * long_sig))324 Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP, ARGIN(STRING *name),
325 ARGIN(STRING *long_sig))
326 {
327 ASSERT_ARGS(Parrot_mmd_find_multi_from_long_sig)
328 STRING * const multi_str = CONST_STRING(interp, "MULTI");
329 PMC * const ns = Parrot_ns_make_namespace_keyed_str(interp,
330 interp->root_namespace, multi_str);
331 PMC * const multi_sub = Parrot_ns_get_global(interp, ns, name);
332
333 if (PMC_IS_NULL(multi_sub)) {
334 return PMCNULL;
335 }
336 else {
337 PMC * const type_tuple = mmd_build_type_tuple_from_long_sig(interp, long_sig);
338 return Parrot_mmd_sort_candidates(interp, type_tuple, multi_sub);
339 }
340 }
341
342 /*
343
344 =item C<PMC * Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP, PMC
345 *candidates, PMC *invoke_sig)>
346
347 Given an array PMC (usually a MultiSub) and a CallSignature PMC, sorts the mmd
348 candidates by their manhattan distance to the signature args and returns the
349 best one.
350
351 =cut
352
353 */
354
355 PARROT_EXPORT
356 PARROT_CAN_RETURN_NULL
357 PARROT_WARN_UNUSED_RESULT
358 PMC *
Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP,ARGIN (PMC * candidates),ARGIN (PMC * invoke_sig))359 Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP, ARGIN(PMC *candidates),
360 ARGIN(PMC *invoke_sig))
361 {
362 ASSERT_ARGS(Parrot_mmd_sort_manhattan_by_sig_pmc)
363 const INTVAL n = VTABLE_elements(interp, candidates);
364
365 if (!n)
366 return PMCNULL;
367
368 return Parrot_mmd_sort_candidates(interp,
369 VTABLE_get_pmc(interp, invoke_sig), candidates);
370 }
371
372 /*
373
374 =item C<static PMC* mmd_build_type_tuple_from_type_list(PARROT_INTERP, PMC
375 *type_list)>
376
377 Construct a FixedIntegerArray of type numbers from an array of
378 type names. Used for multiple dispatch.
379
380 =cut
381
382 */
383
384 PARROT_CANNOT_RETURN_NULL
385 PARROT_WARN_UNUSED_RESULT
386 static PMC*
mmd_build_type_tuple_from_type_list(PARROT_INTERP,ARGIN (PMC * type_list))387 mmd_build_type_tuple_from_type_list(PARROT_INTERP, ARGIN(PMC *type_list))
388 {
389 ASSERT_ARGS(mmd_build_type_tuple_from_type_list)
390 INTVAL param_count = VTABLE_elements(interp, type_list);
391 PMC *multi_sig = Parrot_pmc_new_init_int(interp,
392 enum_class_FixedIntegerArray, param_count);
393 INTVAL i;
394
395 for (i = 0; i < param_count; ++i) {
396 STRING *type_name = VTABLE_get_string_keyed_int(interp, type_list, i);
397 INTVAL type;
398
399 if (STRING_equal(interp, type_name, CONST_STRING(interp, "DEFAULT")))
400 type = -enum_type_PMC;
401 else if (STRING_equal(interp, type_name, CONST_STRING(interp, "STRING")))
402 type = -enum_type_STRING;
403 else if (STRING_equal(interp, type_name, CONST_STRING(interp, "INTVAL")))
404 type = -enum_type_INTVAL;
405 else if (STRING_equal(interp, type_name, CONST_STRING(interp, "FLOATVAL")))
406 type = -enum_type_FLOATVAL;
407 else
408 type = Parrot_pmc_get_type_str(interp, type_name);
409
410 VTABLE_set_integer_keyed_int(interp, multi_sig, i, type);
411 }
412
413 return multi_sig;
414 }
415
416 /*
417
418 =item C<static PMC* mmd_build_type_tuple_from_long_sig(PARROT_INTERP, STRING
419 *long_sig)>
420
421 Construct a FixedIntegerArray of type numbers from a comma-delimited string of
422 type names. Used for multiple dispatch.
423
424 =cut
425
426 */
427
428 PARROT_CANNOT_RETURN_NULL
429 PARROT_WARN_UNUSED_RESULT
430 static PMC*
mmd_build_type_tuple_from_long_sig(PARROT_INTERP,ARGIN (STRING * long_sig))431 mmd_build_type_tuple_from_long_sig(PARROT_INTERP, ARGIN(STRING *long_sig))
432 {
433 ASSERT_ARGS(mmd_build_type_tuple_from_long_sig)
434 PMC *type_list = Parrot_str_split(interp, CONST_STRING(interp, ","), long_sig);
435
436 return mmd_build_type_tuple_from_type_list(interp, type_list);
437 }
438
439 /*
440
441 =item C<PMC* Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, PMC
442 *sig_obj)>
443
444 Construct a FixedIntegerArray of type numbers from the arguments of a Call
445 Signature object. Used for multiple dispatch.
446
447 =cut
448
449 */
450
451 PARROT_EXPORT
452 PARROT_CANNOT_RETURN_NULL
453 PARROT_WARN_UNUSED_RESULT
454 PMC*
Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP,ARGIN (PMC * sig_obj))455 Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, ARGIN(PMC *sig_obj))
456 {
457 ASSERT_ARGS(Parrot_mmd_build_type_tuple_from_sig_obj)
458 return VTABLE_get_pmc(interp, sig_obj);
459 }
460
461 /*
462
463 =item C<static PMC* mmd_cvt_to_types(PARROT_INTERP, PMC *multi_sig)>
464
465 Given a ResizablePMCArray PMC containing some form of type identifier (either
466 the string name of a class or a PMC representing the type), resolves all type
467 references to type IDs, if possible. If that's not possible, returns PMCNULL.
468 In that case you can't dispatch to the multi variant with this type signature,
469 as Parrot doesn't yet know about the respective types requested -- you have to
470 register them first.
471
472 Otherwise, returns a ResizableIntegerArray PMC full of type IDs representing
473 the signature of a multi variant to which you may be able to dispatch.
474
475 {{**DEPRECATE**}}
476
477 =cut
478
479 */
480
481 PARROT_WARN_UNUSED_RESULT
482 PARROT_CAN_RETURN_NULL
483 static PMC*
mmd_cvt_to_types(PARROT_INTERP,ARGIN (PMC * multi_sig))484 mmd_cvt_to_types(PARROT_INTERP, ARGIN(PMC *multi_sig))
485 {
486 ASSERT_ARGS(mmd_cvt_to_types)
487 PMC *ar = PMCNULL;
488 const INTVAL n = VTABLE_elements(interp, multi_sig);
489 INTVAL i;
490
491 for (i = 0; i < n; ++i) {
492 PMC * const sig_elem = VTABLE_get_pmc_keyed_int(interp, multi_sig, i);
493 INTVAL type;
494
495 if (sig_elem->vtable->base_type == enum_class_String) {
496 STRING * const sig = VTABLE_get_string(interp, sig_elem);
497
498 if (!sig)
499 return PMCNULL;
500
501 type = Parrot_pmc_get_type_str(interp, sig);
502
503 if (type == enum_type_undef)
504 return PMCNULL;
505 }
506 else if (sig_elem->vtable->base_type == enum_class_Integer) {
507 type = VTABLE_get_integer(interp, sig_elem);
508 }
509 else
510 type = Parrot_pmc_get_type(interp, sig_elem);
511
512 /* create destination PMC only as necessary */
513 if (PMC_IS_NULL(ar))
514 ar = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
515
516 VTABLE_set_integer_keyed_int(interp, ar, i, type);
517 }
518
519 return ar;
520 }
521
522 /*
523
524 =item C<static PMC * Parrot_mmd_get_cached_multi_sig(PARROT_INTERP, PMC
525 *sub_pmc)>
526
527 Get the cached multisig of the given sub, if one exists. The cached signature
528 might be in different formats, so put it into a type tuple like the rest of the
529 MMD system expects.
530
531 =cut
532
533 */
534
535 PARROT_WARN_UNUSED_RESULT
536 PARROT_CAN_RETURN_NULL
537 static PMC *
Parrot_mmd_get_cached_multi_sig(PARROT_INTERP,ARGIN (PMC * sub_pmc))538 Parrot_mmd_get_cached_multi_sig(PARROT_INTERP, ARGIN(PMC *sub_pmc))
539 {
540 ASSERT_ARGS(Parrot_mmd_get_cached_multi_sig)
541 if (VTABLE_isa(interp, sub_pmc, CONST_STRING(interp, "Sub"))) {
542 Parrot_Sub_attributes *sub;
543 PMC *multi_sig;
544
545 PMC_get_sub(interp, sub_pmc, sub);
546 multi_sig = sub->multi_signature;
547
548 if (multi_sig->vtable->base_type == enum_class_FixedPMCArray) {
549 PMC *converted_sig = mmd_cvt_to_types(interp, multi_sig);
550
551 if (PMC_IS_NULL(converted_sig))
552 return PMCNULL;
553
554 PARROT_GC_WRITE_BARRIER(interp, sub_pmc);
555 multi_sig = sub->multi_signature = converted_sig;
556 }
557
558 return multi_sig;
559 }
560
561 return PMCNULL;
562 }
563
564 #define MMD_BIG_DISTANCE 0x7fff
565
566 /*
567
568 =item C<static UINTVAL mmd_distance(PARROT_INTERP, PMC *pmc, PMC *arg_tuple)>
569
570 Create Manhattan Distance of sub C<pmc> against given argument types.
571 0xffff is the maximum distance
572
573 =cut
574
575 */
576
577 static UINTVAL
mmd_distance(PARROT_INTERP,ARGIN (PMC * pmc),ARGIN (PMC * arg_tuple))578 mmd_distance(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *arg_tuple))
579 {
580 ASSERT_ARGS(mmd_distance)
581 PMC *multi_sig, *mro;
582 Parrot_Sub_attributes *sub;
583 INTVAL args, dist, i, j, n, m;
584
585 if (pmc->vtable->base_type == enum_class_NativePCCMethod) {
586 GETATTR_NativePCCMethod_mmd_multi_sig(interp, pmc, multi_sig);
587 if (PMC_IS_NULL(multi_sig)) {
588 STRING *long_sig;
589
590 GETATTR_NativePCCMethod_mmd_long_signature(interp, pmc, long_sig);
591 multi_sig = mmd_build_type_tuple_from_long_sig(interp, long_sig);
592 PARROT_GC_WRITE_BARRIER(interp, pmc);
593 SETATTR_NativePCCMethod_mmd_multi_sig(interp, pmc, multi_sig);
594 }
595 }
596 else if (pmc->vtable->base_type == enum_class_NCI) {
597 GETATTR_NCI_multi_sig(interp, pmc, multi_sig);
598 if (PMC_IS_NULL(multi_sig)) {
599 STRING *long_sig;
600
601 GETATTR_NCI_long_signature(interp, pmc, long_sig);
602 multi_sig = mmd_build_type_tuple_from_long_sig(interp, long_sig);
603 PARROT_GC_WRITE_BARRIER(interp, pmc);
604 SETATTR_NCI_multi_sig(interp, pmc, multi_sig);
605 }
606 }
607 else {
608 PMC_get_sub(interp, pmc, sub);
609
610 if (!sub->multi_signature)
611 return 0; /* not a multi; no distance */
612
613 multi_sig = Parrot_mmd_get_cached_multi_sig(interp, pmc);
614 }
615
616 if (PMC_IS_NULL(multi_sig))
617 return MMD_BIG_DISTANCE;
618
619 n = VTABLE_elements(interp, multi_sig);
620 args = VTABLE_elements(interp, arg_tuple);
621
622 /*
623 * arg_tuple may have more arguments - only the
624 * n multi_sig invocants are counted
625 */
626 if (args < n)
627 return MMD_BIG_DISTANCE;
628
629 dist = 0;
630
631 if (args > n)
632 dist = PARROT_MMD_MAX_CLASS_DEPTH;
633
634 /* now go through args */
635 for (i = 0; i < n; ++i) {
636 const INTVAL type_sig = VTABLE_get_integer_keyed_int(interp, multi_sig, i);
637 INTVAL type_call = VTABLE_get_integer_keyed_int(interp, arg_tuple, i);
638 if (type_sig == type_call)
639 continue;
640
641 /* promote primitives to their PMC equivalents, as PCC will autobox
642 * them. If it's a direct autobox, int->Integer, str->String, or
643 * num->Num, the distance is 1 and we move to the next arg. If it's
644 * autoboxing to "any" PMC type, we increment the distance and continue
645 * weighing other things. A direct autobox should be cheaper than an
646 * autobox plus type conversion or implicit type acceptance. */
647 switch (type_call) {
648 case -enum_type_INTVAL:
649 if (type_sig == enum_class_Integer) { dist++; continue; }
650 if (type_sig == -enum_type_PMC ||
651 (type_sig >= enum_class_default && type_sig < enum_class_core_max)) {
652 ++dist;
653 type_call = enum_class_Integer;
654 }
655 break;
656 case -enum_type_FLOATVAL:
657 if (type_sig == enum_class_Float) { dist++; continue; }
658 if (type_sig == -enum_type_PMC ||
659 (type_sig >= enum_class_default && type_sig < enum_class_core_max)) {
660 ++dist;
661 type_call = enum_class_Float;
662 }
663 break;
664 case -enum_type_STRING:
665 if (type_sig == enum_class_String) { dist++; continue; }
666 if (type_sig == -enum_type_PMC ||
667 (type_sig >= enum_class_default && type_sig < enum_class_core_max)) {
668 ++dist;
669 type_call = enum_class_String;
670 }
671 break;
672 default:
673 break;
674 }
675
676 /*
677 * different native types are very different, except a PMC
678 * which matches any PMC
679 */
680 if (type_call <= 0 && type_sig == -enum_type_PMC) {
681 ++dist;
682 continue;
683 }
684
685 if ((type_sig <= 0 && type_sig != -enum_type_PMC) || type_call <= 0) {
686 dist = MMD_BIG_DISTANCE;
687 break;
688 }
689
690 /*
691 * now consider MRO of types the signature type has to be somewhere
692 * in the MRO of the type_call
693 */
694 mro = interp->vtables[type_call]->mro;
695 m = VTABLE_elements(interp, mro);
696
697 for (j = 0; j < m; ++j) {
698 PMC * const cl = VTABLE_get_pmc_keyed_int(interp, mro, j);
699
700 if (cl->vtable->base_type == type_sig)
701 break;
702 if (VTABLE_type(interp, cl) == type_sig)
703 break;
704
705 ++dist;
706 }
707
708 /*
709 * if the type wasn't in MRO check, if any PMC matches
710 * in that case use the distance + 1 (of an any PMC parent)
711 */
712 if (j == m && type_sig != -enum_type_PMC) {
713 dist = MMD_BIG_DISTANCE;
714 break;
715 }
716
717 ++dist;
718
719 #if MMD_DEBUG
720 {
721 STRING *s1, *s2;
722 if (type_sig < 0)
723 s1 = Parrot_dt_get_datatype_name(interp, -type_sig);
724 else
725 s1 = interp->vtables[type_sig]->whoami;
726
727 if (type_call < 0)
728 s2 = Parrot_dt_get_datatype_name(interp, -type_call);
729 else
730 s2 = interp->vtables[type_call]->whoami;
731
732 Parrot_io_eprintf(interp, "arg %d: dist %d sig %Ss arg %Ss\n",
733 i, dist, s1, s2);
734 }
735 #endif
736 }
737
738 return dist;
739 }
740
741 /*
742
743 =item C<static PMC * Parrot_mmd_sort_candidates(PARROT_INTERP, PMC *arg_tuple,
744 PMC *cl)>
745
746 Sort the candidate list C<cl> by Manhattan Distance, returning the best
747 candidate.
748
749 =cut
750
751 */
752
753 PARROT_CAN_RETURN_NULL
754 static PMC *
Parrot_mmd_sort_candidates(PARROT_INTERP,ARGIN (PMC * arg_tuple),ARGIN (PMC * cl))755 Parrot_mmd_sort_candidates(PARROT_INTERP, ARGIN(PMC *arg_tuple), ARGIN(PMC *cl))
756 {
757 ASSERT_ARGS(Parrot_mmd_sort_candidates)
758 PMC *best_candidate = PMCNULL;
759 INTVAL best_distance = MMD_BIG_DISTANCE;
760 const INTVAL n = VTABLE_elements(interp, cl);
761 INTVAL i;
762
763 for (i = 0; i < n; ++i) {
764 PMC * const pmc = VTABLE_get_pmc_keyed_int(interp, cl, i);
765 const INTVAL d = mmd_distance(interp, pmc, arg_tuple);
766 if (d < best_distance) {
767 best_candidate = pmc;
768 best_distance = d;
769 }
770 }
771
772 return best_candidate;
773 }
774
775 /*
776
777 =item C<static int Parrot_mmd_maybe_candidate(PARROT_INTERP, PMC *pmc, PMC *cl)>
778
779 If the candidate C<pmc> is a Sub PMC, push it on the candidate list and
780 return TRUE to stop further search.
781
782 If the candidate is a MultiSub remember all matching Subs and return FALSE
783 to continue searching outer scopes.
784
785 =cut
786
787 */
788
789 static int
Parrot_mmd_maybe_candidate(PARROT_INTERP,ARGIN (PMC * pmc),ARGIN (PMC * cl))790 Parrot_mmd_maybe_candidate(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *cl))
791 {
792 ASSERT_ARGS(Parrot_mmd_maybe_candidate)
793 STRING * const _sub = CONST_STRING(interp, "Sub");
794 STRING * const _multi_sub = CONST_STRING(interp, "MultiSub");
795
796 INTVAL i, n;
797
798 if (VTABLE_isa(interp, pmc, _sub)) {
799 /* a plain sub stops outer searches */
800 VTABLE_push_pmc(interp, cl, pmc);
801 return 1;
802 }
803
804 /* not a Sub or MultiSub - ignore */
805 if (!VTABLE_isa(interp, pmc, _multi_sub))
806 return 0;
807
808 /* ok we have a multi sub pmc, which is an array of candidates */
809 n = VTABLE_elements(interp, pmc);
810
811 for (i = 0; i < n; ++i) {
812 PMC * const multi_sub = VTABLE_get_pmc_keyed_int(interp, pmc, i);
813 VTABLE_push_pmc(interp, cl, multi_sub);
814 }
815
816 return 0;
817 }
818
819 /*
820
821 =item C<static void mmd_search_by_sig_obj(PARROT_INTERP, STRING *name, PMC
822 *sig_obj, PMC *candidates)>
823
824 Search the namespace of the first argument to the sub call for matching
825 candidates.
826
827 =cut
828
829 */
830
831 static void
mmd_search_by_sig_obj(PARROT_INTERP,ARGIN (STRING * name),ARGIN (PMC * sig_obj),ARGIN (PMC * candidates))832 mmd_search_by_sig_obj(PARROT_INTERP, ARGIN(STRING *name),
833 ARGIN(PMC *sig_obj), ARGIN(PMC *candidates))
834 {
835 ASSERT_ARGS(mmd_search_by_sig_obj)
836 PMC *first_arg = VTABLE_get_pmc_keyed_int(interp, sig_obj, 0);
837 PMC *ns, *multi_sub;
838
839 if (PMC_IS_NULL(first_arg))
840 return;
841
842 ns = VTABLE_get_namespace(interp, first_arg);
843
844 if (PMC_IS_NULL(ns))
845 return;
846
847 multi_sub = Parrot_ns_get_global(interp, ns, name);
848
849 if (PMC_IS_NULL(multi_sub))
850 return;
851
852 Parrot_mmd_maybe_candidate(interp, multi_sub, candidates);
853 }
854
855 /*
856
857 =item C<static void mmd_search_global(PARROT_INTERP, STRING *name, PMC *cl)>
858
859 Search the builtin namespace for matching candidates.
860
861 =cut
862
863 */
864
865 static void
mmd_search_global(PARROT_INTERP,ARGIN (STRING * name),ARGIN (PMC * cl))866 mmd_search_global(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *cl))
867 {
868 ASSERT_ARGS(mmd_search_global)
869 STRING * const multi_str = CONST_STRING(interp, "MULTI");
870 PMC * const ns = Parrot_ns_get_namespace_keyed_str(interp,
871 interp->root_namespace, multi_str);
872 PMC *multi_sub = Parrot_ns_get_global(interp, ns, name);
873
874 if (PMC_IS_NULL(multi_sub))
875 return;
876
877 Parrot_mmd_maybe_candidate(interp, multi_sub, cl);
878 }
879
880 /*
881
882 =item C<static void mmd_add_multi_global(PARROT_INTERP, STRING *sub_name, PMC
883 *sub_obj)>
884
885 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
886 stored in the global MULTI namespace.
887
888 =cut
889
890 */
891
892 static void
mmd_add_multi_global(PARROT_INTERP,ARGIN (STRING * sub_name),ARGIN (PMC * sub_obj))893 mmd_add_multi_global(PARROT_INTERP, ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
894 {
895 ASSERT_ARGS(mmd_add_multi_global)
896 STRING * const multi_str = CONST_STRING(interp, "MULTI");
897 PMC * const ns = Parrot_ns_make_namespace_keyed_str(interp,
898 interp->root_namespace, multi_str);
899 PMC *multi_sub = Parrot_ns_get_global(interp, ns, sub_name);
900
901 if (PMC_IS_NULL(multi_sub)) {
902 multi_sub = Parrot_pmc_new(interp, enum_class_MultiSub);
903 Parrot_ns_set_global(interp, ns, sub_name, multi_sub);
904 }
905
906 PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
907 VTABLE_push_pmc(interp, multi_sub, sub_obj);
908 }
909
910 /*
911
912 =item C<static void mmd_add_multi_to_namespace(PARROT_INTERP, STRING *ns_name,
913 STRING *sub_name, PMC *sub_obj)>
914
915 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
916 added as a method to a class.
917
918 =cut
919
920 */
921
922 static void
mmd_add_multi_to_namespace(PARROT_INTERP,ARGIN (STRING * ns_name),ARGIN (STRING * sub_name),ARGIN (PMC * sub_obj))923 mmd_add_multi_to_namespace(PARROT_INTERP, ARGIN(STRING *ns_name),
924 ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
925 {
926 ASSERT_ARGS(mmd_add_multi_to_namespace)
927 PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
928 interp->HLL_namespace,
929 Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
930 PMC * const ns = Parrot_ns_make_namespace_keyed_str(interp, hll_ns, ns_name);
931 PMC *multi_sub = Parrot_ns_get_global(interp, ns, sub_name);
932
933 if (PMC_IS_NULL(multi_sub)) {
934 multi_sub = Parrot_pmc_new(interp, enum_class_MultiSub);
935 Parrot_ns_set_global(interp, ns, sub_name, multi_sub);
936 }
937
938 PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
939 VTABLE_push_pmc(interp, multi_sub, sub_obj);
940 }
941
942 /*
943
944 =item C<void Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP, STRING *sub_name,
945 STRING *long_sig, PMC *sub_obj)>
946
947 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
948 stored in the global MULTI namespace.
949
950 =cut
951
952 */
953
954 PARROT_EXPORT
955 void
Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP,ARGIN (STRING * sub_name),ARGIN (STRING * long_sig),ARGIN (PMC * sub_obj))956 Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP,
957 ARGIN(STRING *sub_name), ARGIN(STRING *long_sig), ARGIN(PMC *sub_obj))
958 {
959 ASSERT_ARGS(Parrot_mmd_add_multi_from_long_sig)
960 Parrot_Sub_attributes *sub;
961 STRING *sub_str = CONST_STRING(interp, "Sub");
962 PMC *type_list = Parrot_str_split(interp, CONST_STRING(interp, ","), long_sig);
963 STRING *ns_name = VTABLE_get_string_keyed_int(interp, type_list, 0);
964
965 /* Attach a type tuple array to the sub for multi dispatch */
966 PMC *multi_sig = mmd_build_type_tuple_from_type_list(interp, type_list);
967
968 PARROT_GC_WRITE_BARRIER(interp, sub_obj);
969
970 if (sub_obj->vtable->base_type == enum_class_NativePCCMethod) {
971 SETATTR_NativePCCMethod_mmd_multi_sig(interp, sub_obj, multi_sig);
972 }
973 else if (sub_obj->vtable->base_type == enum_class_NCI) {
974 SETATTR_NCI_multi_sig(interp, sub_obj, multi_sig);
975 }
976 else if (VTABLE_isa(interp, sub_obj, sub_str)) {
977 PMC_get_sub(interp, sub_obj, sub);
978 sub->multi_signature = multi_sig;
979 }
980
981 mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
982 mmd_add_multi_global(interp, sub_name, sub_obj);
983 }
984
985 /*
986
987 =item C<void Parrot_mmd_add_multi_from_c_args(PARROT_INTERP, const char
988 *sub_name, const char *short_sig, const char *long_sig, funcptr_t
989 multi_func_ptr)>
990
991 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
992 stored in the specified namespace.
993
994 =cut
995
996 */
997
998 PARROT_EXPORT
999 void
Parrot_mmd_add_multi_from_c_args(PARROT_INTERP,ARGIN (const char * sub_name),ARGIN (const char * short_sig),ARGIN (const char * long_sig),ARGIN (funcptr_t multi_func_ptr))1000 Parrot_mmd_add_multi_from_c_args(PARROT_INTERP,
1001 ARGIN(const char *sub_name), ARGIN(const char *short_sig),
1002 ARGIN(const char *long_sig), ARGIN(funcptr_t multi_func_ptr))
1003 {
1004 ASSERT_ARGS(Parrot_mmd_add_multi_from_c_args)
1005 STRING *comma = CONST_STRING(interp, ",");
1006 STRING *sub_name_str = Parrot_str_new_constant(interp, sub_name);
1007 STRING *long_sig_str = Parrot_str_new_constant(interp, long_sig);
1008 STRING *short_sig_str = Parrot_str_new_constant(interp, short_sig);
1009 PMC *type_list = Parrot_str_split(interp, comma, long_sig_str);
1010 STRING *ns_name = VTABLE_get_string_keyed_int(interp, type_list, 0);
1011
1012 /* Create an NCI sub for the C function */
1013 PMC *sub_obj = Parrot_pmc_new(interp, enum_class_NCI);
1014 PMC *multi_sig = mmd_build_type_tuple_from_long_sig(interp,
1015 long_sig_str);
1016
1017 PARROT_GC_WRITE_BARRIER(interp, sub_obj);
1018
1019 VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig_str,
1020 F2DPTR(multi_func_ptr));
1021
1022 /* Attach a type tuple array to the NCI sub for multi dispatch */
1023 SETATTR_NCI_multi_sig(interp, sub_obj, multi_sig);
1024
1025 mmd_add_multi_to_namespace(interp, ns_name, sub_name_str, sub_obj);
1026 mmd_add_multi_global(interp, sub_name_str, sub_obj);
1027 }
1028
1029 /*
1030
1031 =item C<void Parrot_mmd_add_multi_list_from_c_args(PARROT_INTERP, const
1032 multi_func_list *mmd_info, INTVAL elements)>
1033
1034 Create a collection of multiple dispatch subs from a C structure of
1035 information. Iterate through the list of details passed in. For each entry
1036 create a MultiSub or add a variant to an existing MultiSub. MultiSubs are
1037 created in the global 'MULTI' namespace in the Parrot HLL.
1038
1039 Typically used to create all the multiple dispatch routines
1040 declared in a PMC from the PMC's class initialization function.
1041
1042 =cut
1043
1044 */
1045
1046 PARROT_EXPORT
1047 void
Parrot_mmd_add_multi_list_from_c_args(PARROT_INTERP,ARGIN (const multi_func_list * mmd_info),INTVAL elements)1048 Parrot_mmd_add_multi_list_from_c_args(PARROT_INTERP,
1049 ARGIN(const multi_func_list *mmd_info), INTVAL elements)
1050 {
1051 ASSERT_ARGS(Parrot_mmd_add_multi_list_from_c_args)
1052 INTVAL i;
1053 for (i = 0; i < elements; ++i) {
1054 funcptr_t func_ptr = mmd_info[i].func_ptr;
1055
1056 STRING *sub_name = mmd_info[i].multi_name;
1057 STRING *long_sig = mmd_info[i].full_sig;
1058 STRING *short_sig = mmd_info[i].short_sig;
1059 STRING *ns_name = mmd_info[i].ns_name;
1060
1061 /* Create an NCI sub for the C function */
1062 PMC *sub_obj = Parrot_pmc_new(interp, enum_class_NCI);
1063
1064 PARROT_GC_WRITE_BARRIER(interp, sub_obj);
1065
1066 VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig,
1067 F2DPTR(func_ptr));
1068
1069 /* Attach a type tuple array to the NCI sub for multi dispatch */
1070 SETATTR_NCI_long_signature(interp, sub_obj, long_sig);
1071
1072 mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
1073 mmd_add_multi_global(interp, sub_name, sub_obj);
1074 }
1075 }
1076
1077 /*
1078
1079 =item C<MMD_Cache * Parrot_mmd_cache_create(PARROT_INTERP)>
1080
1081 Creates and returns a new MMD cache.
1082
1083 =cut
1084
1085 */
1086
1087 PARROT_EXPORT
1088 PARROT_CANNOT_RETURN_NULL
1089 MMD_Cache *
Parrot_mmd_cache_create(PARROT_INTERP)1090 Parrot_mmd_cache_create(PARROT_INTERP)
1091 {
1092 ASSERT_ARGS(Parrot_mmd_cache_create)
1093 /* String hash. */
1094 PMC *cache = Parrot_pmc_new(interp, enum_class_Hash);
1095 return cache;
1096 }
1097
1098 /*
1099
1100 =item C<static STRING * mmd_cache_key_from_values(PARROT_INTERP, const char
1101 *name, PMC *values)>
1102
1103 Generates an MMD cache key from an array of values.
1104
1105 =cut
1106
1107 */
1108
1109 PARROT_WARN_UNUSED_RESULT
1110 PARROT_CAN_RETURN_NULL
1111 static STRING *
mmd_cache_key_from_values(PARROT_INTERP,ARGIN (const char * name),ARGIN (PMC * values))1112 mmd_cache_key_from_values(PARROT_INTERP, ARGIN(const char *name),
1113 ARGIN(PMC *values))
1114 {
1115 ASSERT_ARGS(mmd_cache_key_from_values)
1116 /* Build array of type IDs, which we'll then use as a string to key into
1117 * the hash. */
1118 const INTVAL num_values = VTABLE_elements(interp, values);
1119 const INTVAL name_len = name ? strlen(name) + 1: 0;
1120 const size_t id_size = num_values * sizeof (INTVAL) + name_len;
1121 INTVAL *type_ids = mem_gc_allocate_n_typed(interp, num_values + name_len, INTVAL);
1122 STRING *key;
1123 INTVAL i;
1124
1125 for (i = 0; i < num_values; ++i) {
1126 const INTVAL id = VTABLE_type(interp, VTABLE_get_pmc_keyed_int(interp, values, i));
1127 if (id == 0) {
1128 mem_gc_free(interp, type_ids);
1129 return NULL;
1130 }
1131
1132 type_ids[i] = id;
1133 }
1134
1135 if (name)
1136 strcpy((char *)(type_ids + num_values), name);
1137
1138 key = Parrot_str_new_init(interp, (char *)type_ids, id_size,
1139 Parrot_binary_encoding_ptr, 0);
1140 mem_gc_free(interp, type_ids);
1141
1142 return key;
1143 }
1144
1145 /*
1146
1147 =item C<PMC * Parrot_mmd_cache_lookup_by_values(PARROT_INTERP, MMD_Cache *cache,
1148 const char *name, PMC *values)>
1149
1150 Takes an array of values for the call and does a lookup in the MMD cache.
1151
1152 =cut
1153
1154 */
1155
1156 PARROT_EXPORT
1157 PARROT_WARN_UNUSED_RESULT
1158 PARROT_CAN_RETURN_NULL
1159 PMC *
Parrot_mmd_cache_lookup_by_values(PARROT_INTERP,ARGMOD (MMD_Cache * cache),ARGIN (const char * name),ARGIN (PMC * values))1160 Parrot_mmd_cache_lookup_by_values(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1161 ARGIN(const char *name), ARGIN(PMC *values))
1162 {
1163 ASSERT_ARGS(Parrot_mmd_cache_lookup_by_values)
1164 STRING * const key = mmd_cache_key_from_values(interp, name, values);
1165
1166 if (key)
1167 return VTABLE_get_pmc_keyed_str(interp, cache, key);
1168
1169 return PMCNULL;
1170 }
1171
1172 /*
1173
1174 =item C<void Parrot_mmd_cache_store_by_values(PARROT_INTERP, MMD_Cache *cache,
1175 const char *name, PMC *values, PMC *chosen)>
1176
1177 Takes an array of values for the call along with a chosen candidate and puts
1178 it into the cache.
1179
1180 =cut
1181
1182 */
1183
1184 PARROT_EXPORT
1185 void
Parrot_mmd_cache_store_by_values(PARROT_INTERP,ARGMOD (MMD_Cache * cache),ARGIN (const char * name),ARGIN (PMC * values),ARGIN (PMC * chosen))1186 Parrot_mmd_cache_store_by_values(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1187 ARGIN(const char *name), ARGIN(PMC *values), ARGIN(PMC *chosen))
1188 {
1189 ASSERT_ARGS(Parrot_mmd_cache_store_by_values)
1190 STRING * const key = mmd_cache_key_from_values(interp, name, values);
1191
1192 if (key)
1193 VTABLE_set_pmc_keyed_str(interp, cache, key, chosen);
1194 }
1195
1196 /*
1197
1198 =item C<static STRING * mmd_cache_key_from_types(PARROT_INTERP, const char
1199 *name, PMC *types)>
1200
1201 Generates an MMD cache key from an array of types.
1202
1203 =cut
1204
1205 */
1206
1207 PARROT_WARN_UNUSED_RESULT
1208 PARROT_CAN_RETURN_NULL
1209 static STRING *
mmd_cache_key_from_types(PARROT_INTERP,ARGIN (const char * name),ARGIN (PMC * types))1210 mmd_cache_key_from_types(PARROT_INTERP, ARGIN(const char *name),
1211 ARGIN(PMC *types))
1212 {
1213 ASSERT_ARGS(mmd_cache_key_from_types)
1214 /* Build array of type IDs, which we'll then use as a string to key into
1215 * the hash. */
1216 const INTVAL num_types = VTABLE_elements(interp, types);
1217 const INTVAL name_len = name ? strlen(name) + 1: 0;
1218 const size_t id_size = num_types * sizeof (INTVAL) + name_len;
1219 INTVAL * const type_ids = mem_gc_allocate_n_typed(interp, num_types + name_len, INTVAL);
1220
1221 STRING *key;
1222 INTVAL i;
1223
1224 for (i = 0; i < num_types; ++i) {
1225 const INTVAL id = VTABLE_get_integer_keyed_int(interp, types, i);
1226
1227 if (id == 0) {
1228 mem_gc_free(interp, type_ids);
1229 return NULL;
1230 }
1231
1232 type_ids[i] = id;
1233 }
1234
1235 if (name)
1236 strcpy((char *)(type_ids + num_types), name);
1237
1238 key = Parrot_str_new_init(interp, (char *)type_ids, id_size,
1239 Parrot_binary_encoding_ptr, 0);
1240
1241 mem_gc_free(interp, type_ids);
1242 return key;
1243 }
1244
1245 /*
1246
1247 =item C<PMC * Parrot_mmd_cache_lookup_by_types(PARROT_INTERP, MMD_Cache *cache,
1248 const char *name, PMC *types)>
1249
1250 Takes an array of types for the call and does a lookup in the MMD cache.
1251
1252 =cut
1253
1254 */
1255
1256 PARROT_EXPORT
1257 PARROT_WARN_UNUSED_RESULT
1258 PARROT_CAN_RETURN_NULL
1259 PMC *
Parrot_mmd_cache_lookup_by_types(PARROT_INTERP,ARGMOD (MMD_Cache * cache),ARGIN (const char * name),ARGIN (PMC * types))1260 Parrot_mmd_cache_lookup_by_types(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1261 ARGIN(const char *name), ARGIN(PMC *types))
1262 {
1263 ASSERT_ARGS(Parrot_mmd_cache_lookup_by_types)
1264 STRING * const key = mmd_cache_key_from_types(interp, name, types);
1265
1266 if (key)
1267 return VTABLE_get_pmc_keyed_str(interp, cache, key);
1268
1269 return PMCNULL;
1270 }
1271
1272 /*
1273
1274 =item C<void Parrot_mmd_cache_store_by_types(PARROT_INTERP, MMD_Cache *cache,
1275 const char *name, PMC *types, PMC *chosen)>
1276
1277 Takes an array of types for the call along with a chosen candidate and puts
1278 it into the cache. The name parameter is optional, and if the cache is already
1279 tied to an individual multi can be null.
1280
1281 =cut
1282
1283 */
1284
1285 PARROT_EXPORT
1286 void
Parrot_mmd_cache_store_by_types(PARROT_INTERP,ARGMOD (MMD_Cache * cache),ARGIN (const char * name),ARGIN (PMC * types),ARGIN (PMC * chosen))1287 Parrot_mmd_cache_store_by_types(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1288 ARGIN(const char *name), ARGIN(PMC *types), ARGIN(PMC *chosen))
1289 {
1290 ASSERT_ARGS(Parrot_mmd_cache_store_by_types)
1291 STRING * const key = mmd_cache_key_from_types(interp, name, types);
1292
1293 if (key)
1294 VTABLE_set_pmc_keyed_str(interp, cache, key, chosen);
1295 }
1296
1297 /*
1298
1299 =item C<void Parrot_mmd_cache_mark(PARROT_INTERP, MMD_Cache *cache)>
1300
1301 GC-marks an MMD cache.
1302
1303 =cut
1304
1305 */
1306
1307 PARROT_EXPORT
1308 void
Parrot_mmd_cache_mark(PARROT_INTERP,ARGMOD (MMD_Cache * cache))1309 Parrot_mmd_cache_mark(PARROT_INTERP, ARGMOD(MMD_Cache *cache))
1310 {
1311 ASSERT_ARGS(Parrot_mmd_cache_mark)
1312 /* As a small future optimization, note that we only *really* need to mark
1313 * keys - the candidates will be referenced outside the cache, provided it's
1314 * invalidated properly. */
1315 Parrot_gc_mark_PMC_alive(interp, cache);
1316 }
1317
1318 /*
1319
1320 =back
1321
1322 =head1 SEE ALSO
1323
1324 F<include/parrot/multidispatch.h>,
1325 L<http://design.perl6.org/S12.html>,
1326 L<http://dev.perl.org/perl6/doc/design/apo/A12.html>
1327
1328 =cut
1329
1330 */
1331
1332 /*
1333 * Local variables:
1334 * c-file-style: "parrot"
1335 * End:
1336 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
1337 */
1338