src/multidispatch.c

   1 /*
   2 Copyright (C) 2003-2010, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/multidispatch.c - Multimethod dispatch for binary opcode functions
   8
   9 =head1 SYNOPSIS
  10
  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.
  14
  15 =head1 DESCRIPTION
  16
  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).
  20
  21 =head2 API
  22
  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.
  29
  30 =head2 Remarks
  31
  32 =head2 Functions
  33
  34 =over 4
  35
  36 =cut
  37
  38 */
  39
  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"
  49
  50 /* HEADERIZER HFILE: include/parrot/multidispatch.h */
  51
  52 /* HEADERIZER BEGIN: static */
  53 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  54
  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);
  61
  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);
  70
  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);
  77
  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);
  84
  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);
  93
  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);
 102
 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);
 108
 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);
 115
 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);
 124
 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);
 131
 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);
 138
 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);
 145
 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);
 153
 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 */
 209
 210
 211 #define MMD_DEBUG 0
 212
 213
 214 /*
 215
 216 =item C<PMC* Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP, STRING *name, PMC
 217 *invoke_sig)>
 218
 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.
 223
 224 Currently this only looks in the global "MULTI" namespace.
 225
 226 =cut
 227
 228 */
 229
 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))
 235 {
 236     ASSERT_ARGS(Parrot_mmd_find_multi_from_sig_obj)
 237     PMC * const candidate_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
 238
 239     mmd_search_by_sig_obj(interp, name, invoke_sig, candidate_list);
 240     mmd_search_global(interp, name, candidate_list);
 241
 242     return Parrot_mmd_sort_manhattan_by_sig_pmc(interp, candidate_list, invoke_sig);
 243 }
 244
 245 /*
 246
 247 =item C<void Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP, const char
 248 *name, const char *sig, ...)>
 249
 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.
 253
 254 Return arguments must be passed as a reference to the PMC, string, number, or
 255 integer, so the result can be set.
 256
 257 =cut
 258
 259 */
 260
 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), ...)
 266 {
 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;
 271
 272     Parrot_pcc_split_signature_string(sig, &arg_sig, &ret_sig);
 273
 274     va_start(args, sig);
 275     call_obj = Parrot_pcc_build_call_from_varargs(interp, PMCNULL, arg_sig, &args);
 276
 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));
 280
 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);
 284
 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);
 288     }
 289
 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);
 294
 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
 301
 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);
 307 }
 308
 309
 310 /*
 311
 312 =item C<PMC * Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP, STRING *name,
 313 STRING *long_sig)>
 314
 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.
 317
 318 Currently only searches the global MULTI namespace.
 319
 320 =cut
 321
 322 */
 323
 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))
 330 {
 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);
 336
 337     if (PMC_IS_NULL(multi_sub)) {
 338         return PMCNULL;
 339     }
 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);
 343     }
 344 }
 345
 346
 347 /*
 348
 349 =item C<PMC * Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP, PMC
 350 *candidates, PMC *invoke_sig)>
 351
 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.
 355
 356 =cut
 357
 358 */
 359
 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))
 366 {
 367     ASSERT_ARGS(Parrot_mmd_sort_manhattan_by_sig_pmc)
 368     const INTVAL n = VTABLE_elements(interp, candidates);
 369
 370     if (!n)
 371         return PMCNULL;
 372
 373     return Parrot_mmd_sort_candidates(interp,
 374         VTABLE_get_pmc(interp, invoke_sig), candidates);
 375 }
 376
 377 /*
 378
 379 =item C<static PMC* mmd_build_type_tuple_from_type_list(PARROT_INTERP, PMC
 380 *type_list)>
 381
 382 Construct a FixedIntegerArray of type numbers from an array of
 383 type names. Used for multiple dispatch.
 384
 385 =cut
 386
 387 */
 388
 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))
 393 {
 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;
 399
 400     for (i = 0; i < param_count; ++i) {
 401         STRING *type_name = VTABLE_get_string_keyed_int(interp, type_list, i);
 402         INTVAL  type;
 403
 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);
 414
 415         VTABLE_set_integer_keyed_int(interp, multi_sig, i, type);
 416     }
 417
 418     return multi_sig;
 419 }
 420
 421
 422 /*
 423
 424 =item C<static PMC* mmd_build_type_tuple_from_long_sig(PARROT_INTERP, STRING
 425 *long_sig)>
 426
 427 Construct a FixedIntegerArray of type numbers from a comma-delimited string of
 428 type names. Used for multiple dispatch.
 429
 430 =cut
 431
 432 */
 433
 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))
 438 {
 439     ASSERT_ARGS(mmd_build_type_tuple_from_long_sig)
 440     PMC *type_list = Parrot_str_split(interp, CONST_STRING(interp, ","), long_sig);
 441
 442     return mmd_build_type_tuple_from_type_list(interp, type_list);
 443 }
 444
 445
 446 /*
 447
 448 =item C<PMC* Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, PMC
 449 *sig_obj)>
 450
 451 Construct a FixedIntegerArray of type numbers from the arguments of a Call
 452 Signature object. Used for multiple dispatch.
 453
 454 =cut
 455
 456 */
 457
 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))
 463 {
 464     ASSERT_ARGS(Parrot_mmd_build_type_tuple_from_sig_obj)
 465     return VTABLE_get_pmc(interp, sig_obj);
 466 }
 467
 468
 469 /*
 470
 471 =item C<static PMC* mmd_cvt_to_types(PARROT_INTERP, PMC *multi_sig)>
 472
 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.
 479
 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.
 482
 483 {{**DEPRECATE**}}
 484
 485 =cut
 486
 487 */
 488
 489 PARROT_WARN_UNUSED_RESULT
 490 PARROT_CAN_RETURN_NULL
 491 static PMC*
 492 mmd_cvt_to_types(PARROT_INTERP, ARGIN(PMC *multi_sig))
 493 {
 494     ASSERT_ARGS(mmd_cvt_to_types)
 495     PMC        *ar = PMCNULL;
 496     const INTVAL n = VTABLE_elements(interp, multi_sig);
 497     INTVAL       i;
 498
 499     for (i = 0; i < n; ++i) {
 500         PMC * const sig_elem = VTABLE_get_pmc_keyed_int(interp, multi_sig, i);
 501         INTVAL type;
 502
 503         if (sig_elem->vtable->base_type == enum_class_String) {
 504             STRING * const sig = VTABLE_get_string(interp, sig_elem);
 505
 506             if (!sig)
 507                 return PMCNULL;
 508
 509             type = Parrot_pmc_get_type_str(interp, sig);
 510
 511             if (type == enum_type_undef)
 512                 return PMCNULL;
 513         }
 514         else if (sig_elem->vtable->base_type == enum_class_Integer) {
 515             type = VTABLE_get_integer(interp, sig_elem);
 516         }
 517         else
 518             type = Parrot_pmc_get_type(interp, sig_elem);
 519
 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);
 523
 524         VTABLE_set_integer_keyed_int(interp, ar, i, type);
 525     }
 526
 527     return ar;
 528 }
 529
 530
 531 /*
 532
 533 =item C<static PMC * Parrot_mmd_get_cached_multi_sig(PARROT_INTERP, PMC
 534 *sub_pmc)>
 535
 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.
 539
 540 =cut
 541
 542 */
 543
 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))
 548 {
 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;
 553
 554         PMC_get_sub(interp, sub_pmc, sub);
 555         multi_sig = sub->multi_signature;
 556
 557         if (multi_sig->vtable->base_type == enum_class_FixedPMCArray) {
 558             PMC *converted_sig = mmd_cvt_to_types(interp, multi_sig);
 559
 560             if (PMC_IS_NULL(converted_sig))
 561                 return PMCNULL;
 562
 563             multi_sig = sub->multi_signature = converted_sig;
 564         }
 565
 566         return multi_sig;
 567     }
 568
 569     return PMCNULL;
 570 }
 571
 572
 573 #define MMD_BIG_DISTANCE 0x7fff
 574
 575 /*
 576
 577 =item C<static UINTVAL mmd_distance(PARROT_INTERP, PMC *pmc, PMC *arg_tuple)>
 578
 579 Create Manhattan Distance of sub C<pmc> against given argument types.
 580 0xffff is the maximum distance
 581
 582 =cut
 583
 584 */
 585
 586 static UINTVAL
 587 mmd_distance(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *arg_tuple))
 588 {
 589     ASSERT_ARGS(mmd_distance)
 590     PMC        *multi_sig, *mro;
 591     Parrot_Sub_attributes *sub;
 592     INTVAL      args, dist, i, j, n, m;
 593
 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;
 598
 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);
 602         }
 603     }
 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;
 608
 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);
 612         }
 613     }
 614     else {
 615         PMC_get_sub(interp, pmc, sub);
 616
 617         if (!sub->multi_signature)
 618             return 0; /* not a multi; no distance */
 619
 620         multi_sig = Parrot_mmd_get_cached_multi_sig(interp, pmc);
 621     }
 622
 623     if (PMC_IS_NULL(multi_sig))
 624         return MMD_BIG_DISTANCE;
 625
 626     n    = VTABLE_elements(interp, multi_sig);
 627     args = VTABLE_elements(interp, arg_tuple);
 628
 629     /*
 630      * arg_tuple may have more arguments - only the
 631      * n multi_sig invocants are counted
 632      */
 633     if (args < n)
 634         return MMD_BIG_DISTANCE;
 635
 636     dist = 0;
 637
 638     if (args > n)
 639         dist = PARROT_MMD_MAX_CLASS_DEPTH;
 640
 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;
 647
 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;
 661             }
 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;
 669             }
 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;
 677             }
 678             break;
 679           default:
 680             break;
 681         }
 682
 683         /*
 684          * different native types are very different, except a PMC
 685          * which matches any PMC
 686          */
 687         if (type_call <= 0 && type_sig == enum_type_PMC) {
 688             ++dist;
 689             continue;
 690         }
 691
 692         if ((type_sig <= 0 && type_sig != enum_type_PMC) || type_call <= 0) {
 693             dist = MMD_BIG_DISTANCE;
 694             break;
 695         }
 696
 697         /*
 698          * now consider MRO of types the signature type has to be somewhere
 699          * in the MRO of the type_call
 700          */
 701         mro = interp->vtables[type_call]->mro;
 702         m   = VTABLE_elements(interp, mro);
 703
 704         for (j = 0; j < m; ++j) {
 705             PMC * const cl = VTABLE_get_pmc_keyed_int(interp, mro, j);
 706
 707             if (cl->vtable->base_type == type_sig)
 708                 break;
 709             if (VTABLE_type(interp, cl) == type_sig)
 710                 break;
 711
 712             ++dist;
 713         }
 714
 715         /*
 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)
 718          */
 719         if (j == m && type_sig != enum_type_PMC) {
 720             dist = MMD_BIG_DISTANCE;
 721             break;
 722         }
 723
 724         ++dist;
 725
 726 #if MMD_DEBUG
 727         {
 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;
 733
 734             if (type_call < 0)
 735                 s2 = Parrot_get_datatype_name(interp, type_call);
 736             else
 737                 s2 = interp->vtables[type_call]->whoami;
 738
 739             Parrot_io_eprintf(interp, "arg %d: dist %d sig %Ss arg %Ss\n",
 740                 i, dist, s1, s2);
 741         }
 742 #endif
 743     }
 744
 745     return dist;
 746 }
 747
 748
 749 /*
 750
 751 =item C<static PMC * Parrot_mmd_sort_candidates(PARROT_INTERP, PMC *arg_tuple,
 752 PMC *cl)>
 753
 754 Sort the candidate list C<cl> by Manhattan Distance, returning the best
 755 candidate.
 756
 757 =cut
 758
 759 */
 760
 761 PARROT_CANNOT_RETURN_NULL
 762 static PMC *
 763 Parrot_mmd_sort_candidates(PARROT_INTERP, ARGIN(PMC *arg_tuple), ARGIN(PMC *cl))
 764 {
 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;
 770
 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;
 777         }
 778     }
 779
 780     return best_candidate;
 781 }
 782
 783
 784 /*
 785
 786 =item C<static int Parrot_mmd_maybe_candidate(PARROT_INTERP, PMC *pmc, PMC *cl)>
 787
 788 If the candidate C<pmc> is a Sub PMC, push it on the candidate list and
 789 return TRUE to stop further search.
 790
 791 If the candidate is a MultiSub remember all matching Subs and return FALSE
 792 to continue searching outer scopes.
 793
 794 =cut
 795
 796 */
 797
 798 static int
 799 Parrot_mmd_maybe_candidate(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *cl))
 800 {
 801     ASSERT_ARGS(Parrot_mmd_maybe_candidate)
 802     STRING * const _sub       = CONST_STRING(interp, "Sub");
 803     STRING * const _multi_sub = CONST_STRING(interp, "MultiSub");
 804
 805     INTVAL i, n;
 806
 807     if (VTABLE_isa(interp, pmc, _sub)) {
 808         /* a plain sub stops outer searches */
 809         VTABLE_push_pmc(interp, cl, pmc);
 810         return 1;
 811     }
 812
 813     /* not a Sub or MultiSub - ignore */
 814     if (!VTABLE_isa(interp, pmc, _multi_sub))
 815         return 0;
 816
 817     /* ok we have a multi sub pmc, which is an array of candidates */
 818     n = VTABLE_elements(interp, pmc);
 819
 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);
 823     }
 824
 825     return 0;
 826 }
 827
 828
 829 /*
 830
 831 =item C<static void mmd_search_by_sig_obj(PARROT_INTERP, STRING *name, PMC
 832 *sig_obj, PMC *candidates)>
 833
 834 Search the namespace of the first argument to the sub call for matching
 835 candidates.
 836
 837 =cut
 838
 839 */
 840
 841 static void
 842 mmd_search_by_sig_obj(PARROT_INTERP, ARGIN(STRING *name),
 843         ARGIN(PMC *sig_obj), ARGIN(PMC *candidates))
 844 {
 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;
 848
 849     if (PMC_IS_NULL(first_arg))
 850         return;
 851
 852     ns = VTABLE_get_namespace(interp, first_arg);
 853
 854     if (PMC_IS_NULL(ns))
 855         return;
 856
 857     multi_sub = Parrot_ns_get_global(interp, ns, name);
 858
 859     if (PMC_IS_NULL(multi_sub))
 860         return;
 861
 862     Parrot_mmd_maybe_candidate(interp, multi_sub, candidates);
 863 }
 864
 865
 866 /*
 867
 868 =item C<static void mmd_search_global(PARROT_INTERP, STRING *name, PMC *cl)>
 869
 870 Search the builtin namespace for matching candidates.
 871
 872 =cut
 873
 874 */
 875
 876 static void
 877 mmd_search_global(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *cl))
 878 {
 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);
 884
 885     if (PMC_IS_NULL(multi_sub))
 886         return;
 887
 888     Parrot_mmd_maybe_candidate(interp, multi_sub, cl);
 889 }
 890
 891
 892 /*
 893
 894 =item C<static void mmd_add_multi_global(PARROT_INTERP, STRING *sub_name, PMC
 895 *sub_obj)>
 896
 897 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
 898 stored in the global MULTI namespace.
 899
 900 =cut
 901
 902 */
 903
 904 static void
 905 mmd_add_multi_global(PARROT_INTERP, ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
 906 {
 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);
 912
 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);
 916     }
 917
 918     PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
 919     VTABLE_push_pmc(interp, multi_sub, sub_obj);
 920 }
 921
 922
 923 /*
 924
 925 =item C<static void mmd_add_multi_to_namespace(PARROT_INTERP, STRING *ns_name,
 926 STRING *sub_name, PMC *sub_obj)>
 927
 928 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
 929 added as a method to a class.
 930
 931 =cut
 932
 933 */
 934
 935 static void
 936 mmd_add_multi_to_namespace(PARROT_INTERP, ARGIN(STRING *ns_name),
 937             ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
 938 {
 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);
 945
 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);
 949     }
 950
 951     PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
 952     VTABLE_push_pmc(interp, multi_sub, sub_obj);
 953 }
 954
 955
 956 /*
 957
 958 =item C<void Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP, STRING *sub_name,
 959 STRING *long_sig, PMC *sub_obj)>
 960
 961 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
 962 stored in the global MULTI namespace.
 963
 964 =cut
 965
 966 */
 967
 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))
 972 {
 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);
 978
 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);
 981
 982     if (sub_obj->vtable->base_type == enum_class_NativePCCMethod) {
 983         SETATTR_NativePCCMethod_mmd_multi_sig(interp, sub_obj, multi_sig);
 984     }
 985     else if (sub_obj->vtable->base_type == enum_class_NCI) {
 986         SETATTR_NCI_multi_sig(interp, sub_obj, multi_sig);
 987     }
 988     else if (VTABLE_isa(interp, sub_obj, sub_str)) {
 989         PMC_get_sub(interp, sub_obj, sub);
 990         sub->multi_signature = multi_sig;
 991     }
 992
 993     mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
 994     mmd_add_multi_global(interp, sub_name, sub_obj);
 995 }
 996
 997
 998 /*
 999
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)>
1003
1004 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
1005 stored in the specified namespace.
1006
1007 =cut
1008
1009 */
1010
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))
1016 {
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);
1024
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);
1029
1030     VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig_str,
1031                                     F2DPTR(multi_func_ptr));
1032
1033     /* Attach a type tuple array to the NCI sub for multi dispatch */
1034     SETATTR_NCI_multi_sig(interp, sub_obj, multi_sig);
1035
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);
1038 }
1039
1040 /*
1041
1042 =item C<void Parrot_mmd_add_multi_list_from_c_args(PARROT_INTERP, const
1043 multi_func_list *mmd_info, INTVAL elements)>
1044
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.
1049
1050 Typically used to create all the multiple dispatch routines
1051 declared in a PMC from the PMC's class initialization function.
1052
1053 =cut
1054
1055 */
1056
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)
1061 {
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;
1066
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;
1071
1072         /* Create an NCI sub for the C function */
1073         PMC    *sub_obj       = Parrot_pmc_new_constant(interp, enum_class_NCI);
1074
1075         VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig,
1076                                      F2DPTR(func_ptr));
1077
1078         /* Attach a type tuple array to the NCI sub for multi dispatch */
1079         SETATTR_NCI_long_signature(interp, sub_obj, long_sig);
1080
1081         mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
1082         mmd_add_multi_global(interp, sub_name, sub_obj);
1083     }
1084 }
1085
1086
1087 /*
1088
1089 =item C<MMD_Cache * Parrot_mmd_cache_create(PARROT_INTERP)>
1090
1091 Creates and returns a new MMD cache.
1092
1093 =cut
1094
1095 */
1096
1097 PARROT_EXPORT
1098 PARROT_CANNOT_RETURN_NULL
1099 MMD_Cache *
1100 Parrot_mmd_cache_create(PARROT_INTERP)
1101 {
1102     ASSERT_ARGS(Parrot_mmd_cache_create)
1103     /* String hash. */
1104     Hash *cache = parrot_new_hash(interp);
1105     return cache;
1106 }
1107
1108
1109 /*
1110
1111 =item C<static STRING * mmd_cache_key_from_values(PARROT_INTERP, const char
1112 *name, PMC *values)>
1113
1114 Generates an MMD cache key from an array of values.
1115
1116 =cut
1117
1118 */
1119
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))
1125 {
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;
1135
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;
1141         }
1142
1143         type_ids[i] = id;
1144     }
1145
1146     if (name)
1147         strcpy((char *)(type_ids + num_values), name);
1148
1149     key = Parrot_str_new(interp, (char *)type_ids, id_size);
1150     mem_gc_free(interp, type_ids);
1151
1152     return key;
1153 }
1154
1155
1156 /*
1157
1158 =item C<PMC * Parrot_mmd_cache_lookup_by_values(PARROT_INTERP, MMD_Cache *cache,
1159 const char *name, PMC *values)>
1160
1161 Takes an array of values for the call and does a lookup in the MMD cache.
1162
1163 =cut
1164
1165 */
1166
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))
1173 {
1174     ASSERT_ARGS(Parrot_mmd_cache_lookup_by_values)
1175     STRING * const key = mmd_cache_key_from_values(interp, name, values);
1176
1177     if (key)
1178         return (PMC *)parrot_hash_get(interp, cache, key);
1179
1180     return PMCNULL;
1181 }
1182
1183
1184 /*
1185
1186 =item C<void Parrot_mmd_cache_store_by_values(PARROT_INTERP, MMD_Cache *cache,
1187 const char *name, PMC *values, PMC *chosen)>
1188
1189 Takes an array of values for the call along with a chosen candidate and puts
1190 it into the cache.
1191
1192 =cut
1193
1194 */
1195
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))
1200 {
1201     ASSERT_ARGS(Parrot_mmd_cache_store_by_values)
1202     STRING * const key = mmd_cache_key_from_values(interp, name, values);
1203
1204     if (key)
1205         parrot_hash_put(interp, cache, key, chosen);
1206 }
1207
1208
1209 /*
1210
1211 =item C<static STRING * mmd_cache_key_from_types(PARROT_INTERP, const char
1212 *name, PMC *types)>
1213
1214 Generates an MMD cache key from an array of types.
1215
1216 =cut
1217
1218 */
1219
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))
1225 {
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);
1233
1234     STRING *key;
1235     INTVAL  i;
1236
1237     for (i = 0; i < num_types; ++i) {
1238         const INTVAL id = VTABLE_get_integer_keyed_int(interp, types, i);
1239
1240         if (id == 0) {
1241             mem_gc_free(interp, type_ids);
1242             return NULL;
1243         }
1244
1245         type_ids[i] = id;
1246     }
1247
1248     if (name)
1249         strcpy((char *)(type_ids + num_types), name);
1250
1251     key = Parrot_str_new(interp, (char *)type_ids, id_size);
1252
1253     mem_gc_free(interp, type_ids);
1254     return key;
1255 }
1256
1257
1258 /*
1259
1260 =item C<PMC * Parrot_mmd_cache_lookup_by_types(PARROT_INTERP, MMD_Cache *cache,
1261 const char *name, PMC *types)>
1262
1263 Takes an array of types for the call and does a lookup in the MMD cache.
1264
1265 =cut
1266
1267 */
1268
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))
1275 {
1276     ASSERT_ARGS(Parrot_mmd_cache_lookup_by_types)
1277     const STRING * const key = mmd_cache_key_from_types(interp, name, types);
1278
1279     if (key)
1280         return (PMC *)parrot_hash_get(interp, cache, key);
1281
1282     return PMCNULL;
1283 }
1284
1285
1286 /*
1287
1288 =item C<void Parrot_mmd_cache_store_by_types(PARROT_INTERP, MMD_Cache *cache,
1289 const char *name, PMC *types, PMC *chosen)>
1290
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.
1294
1295 =cut
1296
1297 */
1298
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))
1303 {
1304     ASSERT_ARGS(Parrot_mmd_cache_store_by_types)
1305     STRING * const key = mmd_cache_key_from_types(interp, name, types);
1306
1307     if (key)
1308         parrot_hash_put(interp, cache, key, chosen);
1309 }
1310
1311
1312 /*
1313
1314 =item C<void Parrot_mmd_cache_mark(PARROT_INTERP, MMD_Cache *cache)>
1315
1316 GC-marks an MMD cache.
1317
1318 =cut
1319
1320 */
1321
1322 PARROT_EXPORT
1323 void
1324 Parrot_mmd_cache_mark(PARROT_INTERP, ARGMOD(MMD_Cache *cache))
1325 {
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);
1331 }
1332
1333
1334 /*
1335
1336 =item C<void Parrot_mmd_cache_destroy(PARROT_INTERP, MMD_Cache *cache)>
1337
1338 Destroys an MMD cache.
1339
1340 =cut
1341
1342 */
1343
1344 PARROT_EXPORT
1345 void
1346 Parrot_mmd_cache_destroy(PARROT_INTERP, ARGMOD(MMD_Cache *cache))
1347 {
1348     ASSERT_ARGS(Parrot_mmd_cache_destroy)
1349     parrot_hash_destroy(interp, cache);
1350 }
1351
1352
1353 /*
1354
1355 =back
1356
1357 =head1 SEE ALSO
1358
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>
1362
1363 =cut
1364
1365 */
1366
1367
1368 /*
1369  * Local variables:
1370  *   c-file-style: "parrot"
1371  * End:
1372  * vim: expandtab shiftwidth=4:
1373  */