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_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_CANNOT_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
 210 #define MMD_DEBUG 0
 211
 212
 213 /*
 214
 215 =item C<PMC* Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP, STRING *name, PMC
 216 *invoke_sig)>
 217
 218 Collect a list of possible candidates for a given sub name and call signature.
 219 Rank the possible candidates by Manhattan Distance, and return the best
 220 matching candidate. The candidate list is cached in the CallSignature object,
 221 to allow for iterating through it.
 222
 223 Currently this only looks in the global "MULTI" namespace.
 224
 225 =cut
 226
 227 */
 228
 229 PARROT_EXPORT
 230 PARROT_WARN_UNUSED_RESULT
 231 PARROT_CANNOT_RETURN_NULL
 232 PMC*
 233 Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *invoke_sig))
 234 {
 235     ASSERT_ARGS(Parrot_mmd_find_multi_from_sig_obj)
 236     PMC * const candidate_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
 237
 238     mmd_search_by_sig_obj(interp, name, invoke_sig, candidate_list);
 239     mmd_search_global(interp, name, candidate_list);
 240
 241     return Parrot_mmd_sort_manhattan_by_sig_pmc(interp, candidate_list, invoke_sig);
 242 }
 243
 244 /*
 245
 246 =item C<void Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP, const char
 247 *name, const char *sig, ...)>
 248
 249 Dispatches to a MultiSub from a variable-sized list of C arguments. The
 250 multiple dispatch system will figure out which sub should be called based on
 251 the types of the arguments passed in.
 252
 253 Return arguments must be passed as a reference to the PMC, string, number, or
 254 integer, so the result can be set.
 255
 256 =cut
 257
 258 */
 259
 260 PARROT_EXPORT
 261 PARROT_CAN_RETURN_NULL
 262 void
 263 Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP,
 264         ARGIN(const char *name), ARGIN(const char *sig), ...)
 265 {
 266     ASSERT_ARGS(Parrot_mmd_multi_dispatch_from_c_args)
 267     PMC *call_obj, *sub;
 268     va_list args;
 269     const char *arg_sig, *ret_sig;
 270
 271     Parrot_pcc_split_signature_string(sig, &arg_sig, &ret_sig);
 272
 273     va_start(args, sig);
 274     call_obj = Parrot_pcc_build_call_from_varargs(interp, PMCNULL, arg_sig, &args);
 275
 276     /* Check the cache. */
 277     sub = Parrot_mmd_cache_lookup_by_types(interp, interp->op_mmd_cache, name,
 278             VTABLE_get_pmc(interp, call_obj));
 279
 280     if (PMC_IS_NULL(sub)) {
 281         sub = Parrot_mmd_find_multi_from_sig_obj(interp,
 282             Parrot_str_new_constant(interp, name), call_obj);
 283
 284         if (!PMC_IS_NULL(sub))
 285             Parrot_mmd_cache_store_by_types(interp, interp->op_mmd_cache, name,
 286                     VTABLE_get_pmc(interp, call_obj), sub);
 287     }
 288
 289     if (PMC_IS_NULL(sub))
 290         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_METHOD_NOT_FOUND,
 291                 "Multiple Dispatch: No suitable candidate found for '%s',"
 292                 " with signature '%s'", name, sig);
 293
 294 #if MMD_DEBUG
 295     Parrot_io_eprintf(interp, "candidate found for '%s', with signature '%s'\n",
 296         name, sig);
 297     Parrot_io_eprintf(interp, "type of candidate found: %Ss\n",
 298             VTABLE_name(interp, sub));
 299 #endif
 300
 301     Parrot_pcc_invoke_from_sig_object(interp, sub, call_obj);
 302     call_obj = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
 303     Parrot_pcc_fill_params_from_varargs(interp, call_obj, ret_sig, &args,
 304             PARROT_ERRORS_RESULT_COUNT_FLAG);
 305     va_end(args);
 306 }
 307
 308
 309 /*
 310
 311 =item C<PMC * Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP, STRING *name,
 312 STRING *long_sig)>
 313
 314 Find the best candidate multi for a given sub name and signature. The signature
 315 is a string containing a comma-delimited list of type names.
 316
 317 Currently only searches the global MULTI namespace.
 318
 319 =cut
 320
 321 */
 322
 323 PARROT_EXPORT
 324 PARROT_CAN_RETURN_NULL
 325 PARROT_WARN_UNUSED_RESULT
 326 PMC *
 327 Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP, ARGIN(STRING *name),
 328         ARGIN(STRING *long_sig))
 329 {
 330     ASSERT_ARGS(Parrot_mmd_find_multi_from_long_sig)
 331     STRING * const multi_str = CONST_STRING(interp, "MULTI");
 332     PMC    * const ns        = Parrot_make_namespace_keyed_str(interp,
 333                                     interp->root_namespace, multi_str);
 334     PMC    * const multi_sub = Parrot_get_global(interp, ns, name);
 335
 336     if (PMC_IS_NULL(multi_sub)) {
 337         return PMCNULL;
 338     }
 339     else {
 340         PMC * const type_tuple = mmd_build_type_tuple_from_long_sig(interp, long_sig);
 341         return Parrot_mmd_sort_candidates(interp, type_tuple, multi_sub);
 342     }
 343 }
 344
 345
 346 /*
 347
 348 =item C<PMC * Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP, PMC
 349 *candidates, PMC *invoke_sig)>
 350
 351 Given an array PMC (usually a MultiSub) and a CallSignature PMC, sorts the mmd
 352 candidates by their manhattan distance to the signature args and returns the
 353 best one.
 354
 355 =cut
 356
 357 */
 358
 359 PARROT_EXPORT
 360 PARROT_CAN_RETURN_NULL
 361 PARROT_WARN_UNUSED_RESULT
 362 PMC *
 363 Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP, ARGIN(PMC *candidates),
 364         ARGIN(PMC *invoke_sig))
 365 {
 366     ASSERT_ARGS(Parrot_mmd_sort_manhattan_by_sig_pmc)
 367     const INTVAL n = VTABLE_elements(interp, candidates);
 368
 369     if (!n)
 370         return PMCNULL;
 371
 372     return Parrot_mmd_sort_candidates(interp,
 373         VTABLE_get_pmc(interp, invoke_sig), candidates);
 374 }
 375
 376 /*
 377
 378 =item C<static PMC* mmd_build_type_tuple_from_type_list(PARROT_INTERP, PMC
 379 *type_list)>
 380
 381 Construct a FixedIntegerArray of type numbers from an array of
 382 type names. Used for multiple dispatch.
 383
 384 =cut
 385
 386 */
 387
 388 PARROT_CANNOT_RETURN_NULL
 389 PARROT_WARN_UNUSED_RESULT
 390 static PMC*
 391 mmd_build_type_tuple_from_type_list(PARROT_INTERP, ARGIN(PMC *type_list))
 392 {
 393     ASSERT_ARGS(mmd_build_type_tuple_from_type_list)
 394     INTVAL param_count = VTABLE_elements(interp, type_list);
 395     PMC   *multi_sig   = Parrot_pmc_new_constant_init_int(interp,
 396             enum_class_FixedIntegerArray, param_count);
 397     INTVAL i;
 398
 399     for (i = 0; i < param_count; ++i) {
 400         STRING *type_name = VTABLE_get_string_keyed_int(interp, type_list, i);
 401         INTVAL  type;
 402
 403         if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "DEFAULT")))
 404             type = enum_type_PMC;
 405         else if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "STRING")))
 406             type = enum_type_STRING;
 407         else if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "INTVAL")))
 408             type = enum_type_INTVAL;
 409         else if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "FLOATVAL")))
 410             type = enum_type_FLOATVAL;
 411         else
 412             type = Parrot_pmc_get_type_str(interp, type_name);
 413
 414         VTABLE_set_integer_keyed_int(interp, multi_sig, i, type);
 415     }
 416
 417     return multi_sig;
 418 }
 419
 420
 421 /*
 422
 423 =item C<static PMC* mmd_build_type_tuple_from_long_sig(PARROT_INTERP, STRING
 424 *long_sig)>
 425
 426 Construct a FixedIntegerArray of type numbers from a comma-delimited string of
 427 type names. Used for multiple dispatch.
 428
 429 =cut
 430
 431 */
 432
 433 PARROT_CANNOT_RETURN_NULL
 434 PARROT_WARN_UNUSED_RESULT
 435 static PMC*
 436 mmd_build_type_tuple_from_long_sig(PARROT_INTERP, ARGIN(STRING *long_sig))
 437 {
 438     ASSERT_ARGS(mmd_build_type_tuple_from_long_sig)
 439     PMC *type_list = Parrot_str_split(interp, CONST_STRING(interp, ","), long_sig);
 440
 441     return mmd_build_type_tuple_from_type_list(interp, type_list);
 442 }
 443
 444
 445 /*
 446
 447 =item C<PMC* Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, PMC
 448 *sig_obj)>
 449
 450 Construct a FixedIntegerArray of type numbers from the arguments of a Call
 451 Signature object. Used for multiple dispatch.
 452
 453 =cut
 454
 455 */
 456
 457 PARROT_EXPORT
 458 PARROT_CANNOT_RETURN_NULL
 459 PARROT_WARN_UNUSED_RESULT
 460 PMC*
 461 Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, ARGIN(PMC *sig_obj))
 462 {
 463     ASSERT_ARGS(Parrot_mmd_build_type_tuple_from_sig_obj)
 464     return VTABLE_get_pmc(interp, sig_obj);
 465 }
 466
 467
 468 /*
 469
 470 =item C<static PMC* mmd_cvt_to_types(PARROT_INTERP, PMC *multi_sig)>
 471
 472 Given a ResizablePMCArray PMC containing some form of type identifier (either
 473 the string name of a class or a PMC representing the type), resolves all type
 474 references to type IDs, if possible.  If that's not possible, returns PMCNULL.
 475 In that case you can't dispatch to the multi variant with this type signature,
 476 as Parrot doesn't yet know about the respective types requested -- you have to
 477 register them first.
 478
 479 Otherwise, returns a ResizableIntegerArray PMC full of type IDs representing
 480 the signature of a multi variant to which you may be able to dispatch.
 481
 482 {{**DEPRECATE**}}
 483
 484 =cut
 485
 486 */
 487
 488 PARROT_WARN_UNUSED_RESULT
 489 PARROT_CAN_RETURN_NULL
 490 static PMC*
 491 mmd_cvt_to_types(PARROT_INTERP, ARGIN(PMC *multi_sig))
 492 {
 493     ASSERT_ARGS(mmd_cvt_to_types)
 494     PMC        *ar = PMCNULL;
 495     const INTVAL n = VTABLE_elements(interp, multi_sig);
 496     INTVAL       i;
 497
 498     for (i = 0; i < n; ++i) {
 499         PMC * const sig_elem = VTABLE_get_pmc_keyed_int(interp, multi_sig, i);
 500         INTVAL type;
 501
 502         if (sig_elem->vtable->base_type == enum_class_String) {
 503             STRING * const sig = VTABLE_get_string(interp, sig_elem);
 504
 505             if (!sig)
 506                 return PMCNULL;
 507
 508             type = Parrot_pmc_get_type_str(interp, sig);
 509
 510             if (type == enum_type_undef)
 511                 return PMCNULL;
 512         }
 513         else if (sig_elem->vtable->base_type == enum_class_Integer) {
 514             type = VTABLE_get_integer(interp, sig_elem);
 515         }
 516         else
 517             type = Parrot_pmc_get_type(interp, sig_elem);
 518
 519         /* create destination PMC only as necessary */
 520         if (PMC_IS_NULL(ar))
 521             ar = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
 522
 523         VTABLE_set_integer_keyed_int(interp, ar, i, type);
 524     }
 525
 526     return ar;
 527 }
 528
 529
 530 /*
 531
 532 =item C<static PMC * Parrot_mmd_get_cached_multi_sig(PARROT_INTERP, PMC
 533 *sub_pmc)>
 534
 535 Get the cached multisig of the given sub, if one exists. The cached signature
 536 might be in different formats, so put it into a type tuple like the rest of the
 537 MMD system expects.
 538
 539 =cut
 540
 541 */
 542
 543 PARROT_WARN_UNUSED_RESULT
 544 PARROT_CAN_RETURN_NULL
 545 static PMC *
 546 Parrot_mmd_get_cached_multi_sig(PARROT_INTERP, ARGIN(PMC *sub_pmc))
 547 {
 548     ASSERT_ARGS(Parrot_mmd_get_cached_multi_sig)
 549     if (VTABLE_isa(interp, sub_pmc, CONST_STRING(interp, "Sub"))) {
 550         Parrot_Sub_attributes *sub;
 551         PMC                   *multi_sig;
 552
 553         PMC_get_sub(interp, sub_pmc, sub);
 554         multi_sig = sub->multi_signature;
 555
 556         if (multi_sig->vtable->base_type == enum_class_FixedPMCArray) {
 557             PMC *converted_sig = mmd_cvt_to_types(interp, multi_sig);
 558
 559             if (PMC_IS_NULL(converted_sig))
 560                 return PMCNULL;
 561
 562             multi_sig = sub->multi_signature = converted_sig;
 563         }
 564
 565         return multi_sig;
 566     }
 567
 568     return PMCNULL;
 569 }
 570
 571
 572 #define MMD_BIG_DISTANCE 0x7fff
 573
 574 /*
 575
 576 =item C<static UINTVAL mmd_distance(PARROT_INTERP, PMC *pmc, PMC *arg_tuple)>
 577
 578 Create Manhattan Distance of sub C<pmc> against given argument types.
 579 0xffff is the maximum distance
 580
 581 =cut
 582
 583 */
 584
 585 static UINTVAL
 586 mmd_distance(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *arg_tuple))
 587 {
 588     ASSERT_ARGS(mmd_distance)
 589     PMC        *multi_sig, *mro;
 590     Parrot_Sub_attributes *sub;
 591     INTVAL      args, dist, i, j, n, m;
 592
 593     /* has to be a builtin multi method */
 594     if (pmc->vtable->base_type == enum_class_NCI) {
 595         GETATTR_NCI_multi_sig(interp, pmc, multi_sig);
 596         if (PMC_IS_NULL(multi_sig)) {
 597             STRING *long_sig;
 598
 599             GETATTR_NCI_long_signature(interp, pmc, long_sig);
 600             multi_sig = mmd_build_type_tuple_from_long_sig(interp, long_sig);
 601             SETATTR_NCI_multi_sig(interp, pmc, multi_sig);
 602         }
 603     }
 604     else {
 605         /* not a multi; no distance */
 606         PMC_get_sub(interp, pmc, sub);
 607         if (!sub->multi_signature)
 608             return 0;
 609
 610         multi_sig = Parrot_mmd_get_cached_multi_sig(interp, pmc);
 611     }
 612
 613     if (PMC_IS_NULL(multi_sig))
 614         return MMD_BIG_DISTANCE;
 615
 616     n    = VTABLE_elements(interp, multi_sig);
 617     args = VTABLE_elements(interp, arg_tuple);
 618
 619     /*
 620      * arg_tuple may have more arguments - only the
 621      * n multi_sig invocants are counted
 622      */
 623     if (args < n)
 624         return MMD_BIG_DISTANCE;
 625
 626     dist = 0;
 627
 628     if (args > n)
 629         dist = PARROT_MMD_MAX_CLASS_DEPTH;
 630
 631     /* now go through args */
 632     for (i = 0; i < n; ++i) {
 633         const INTVAL type_sig  = VTABLE_get_integer_keyed_int(interp, multi_sig, i);
 634         INTVAL type_call = VTABLE_get_integer_keyed_int(interp, arg_tuple, i);
 635         if (type_sig == type_call)
 636             continue;
 637
 638         /* promote primitives to their PMC equivalents, as PCC will autobox
 639          * them. If it's a direct autobox, int->Integer, str->String, or
 640          * num->Num, the distance is 1 and we move to the next arg. If it's
 641          * autoboxing to "any" PMC type, we increment the distance and continue
 642          * weighing other things. A direct autobox should be cheaper than an
 643          * autobox plus type conversion or implicit type acceptance. */
 644         switch (type_call) {
 645           case enum_type_INTVAL:
 646             if (type_sig == enum_class_Integer) { dist++; continue; }
 647             if (type_sig == enum_type_PMC ||
 648                 (type_sig >= enum_class_default && type_sig < enum_class_core_max)) {
 649                 ++dist;
 650                 type_call = enum_class_Integer;
 651             }
 652             break;
 653           case enum_type_FLOATVAL:
 654             if (type_sig == enum_class_Float)   { dist++; continue; }
 655             if (type_sig == enum_type_PMC ||
 656                 (type_sig >= enum_class_default && type_sig < enum_class_core_max)) {
 657                 ++dist;
 658                 type_call = enum_class_Float;
 659             }
 660             break;
 661           case enum_type_STRING:
 662             if (type_sig == enum_class_String)  { dist++; continue; }
 663             if (type_sig == enum_type_PMC ||
 664                 (type_sig >= enum_class_default && type_sig < enum_class_core_max)) {
 665                 ++dist;
 666                 type_call = enum_class_String;
 667             }
 668             break;
 669           default:
 670             break;
 671         }
 672
 673         /*
 674          * different native types are very different, except a PMC
 675          * which matches any PMC
 676          */
 677         if (type_call <= 0 && type_sig == enum_type_PMC) {
 678             ++dist;
 679             continue;
 680         }
 681
 682         if ((type_sig <= 0 && type_sig != enum_type_PMC) || type_call <= 0) {
 683             dist = MMD_BIG_DISTANCE;
 684             break;
 685         }
 686
 687         /*
 688          * now consider MRO of types the signature type has to be somewhere
 689          * in the MRO of the type_call
 690          */
 691         mro = interp->vtables[type_call]->mro;
 692         m   = VTABLE_elements(interp, mro);
 693
 694         for (j = 0; j < m; ++j) {
 695             PMC * const cl = VTABLE_get_pmc_keyed_int(interp, mro, j);
 696
 697             if (cl->vtable->base_type == type_sig)
 698                 break;
 699             if (VTABLE_type(interp, cl) == type_sig)
 700                 break;
 701
 702             ++dist;
 703         }
 704
 705         /*
 706          * if the type wasn't in MRO check, if any PMC matches
 707          * in that case use the distance + 1 (of an any PMC parent)
 708          */
 709         if (j == m && type_sig != enum_type_PMC) {
 710             dist = MMD_BIG_DISTANCE;
 711             break;
 712         }
 713
 714         ++dist;
 715
 716 #if MMD_DEBUG
 717         {
 718             STRING *s1, *s2;
 719             if (type_sig < 0)
 720                 s1 = Parrot_get_datatype_name(interp, type_sig);
 721             else
 722                 s1 = interp->vtables[type_sig]->whoami;
 723
 724             if (type_call < 0)
 725                 s2 = Parrot_get_datatype_name(interp, type_call);
 726             else
 727                 s2 = interp->vtables[type_call]->whoami;
 728
 729             Parrot_io_eprintf(interp, "arg %d: dist %d sig %Ss arg %Ss\n",
 730                 i, dist, s1, s2);
 731         }
 732 #endif
 733     }
 734
 735     return dist;
 736 }
 737
 738
 739 /*
 740
 741 =item C<static PMC * Parrot_mmd_sort_candidates(PARROT_INTERP, PMC *arg_tuple,
 742 PMC *cl)>
 743
 744 Sort the candidate list C<cl> by Manhattan Distance, returning the best
 745 candidate.
 746
 747 =cut
 748
 749 */
 750
 751 PARROT_CANNOT_RETURN_NULL
 752 static PMC *
 753 Parrot_mmd_sort_candidates(PARROT_INTERP, ARGIN(PMC *arg_tuple), ARGIN(PMC *cl))
 754 {
 755     ASSERT_ARGS(Parrot_mmd_sort_candidates)
 756     PMC         *best_candidate = PMCNULL;
 757     INTVAL       best_distance  = MMD_BIG_DISTANCE;
 758     const INTVAL n              = VTABLE_elements(interp, cl);
 759     INTVAL       i;
 760
 761     for (i = 0; i < n; ++i) {
 762         PMC * const  pmc = VTABLE_get_pmc_keyed_int(interp, cl, i);
 763         const INTVAL d   = mmd_distance(interp, pmc, arg_tuple);
 764         if (d < best_distance) {
 765             best_candidate = pmc;
 766             best_distance  = d;
 767         }
 768     }
 769
 770     return best_candidate;
 771 }
 772
 773
 774 /*
 775
 776 =item C<static int Parrot_mmd_maybe_candidate(PARROT_INTERP, PMC *pmc, PMC *cl)>
 777
 778 If the candidate C<pmc> is a Sub PMC, push it on the candidate list and
 779 return TRUE to stop further search.
 780
 781 If the candidate is a MultiSub remember all matching Subs and return FALSE
 782 to continue searching outer scopes.
 783
 784 =cut
 785
 786 */
 787
 788 static int
 789 Parrot_mmd_maybe_candidate(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *cl))
 790 {
 791     ASSERT_ARGS(Parrot_mmd_maybe_candidate)
 792     STRING * const _sub       = CONST_STRING(interp, "Sub");
 793     STRING * const _multi_sub = CONST_STRING(interp, "MultiSub");
 794
 795     INTVAL i, n;
 796
 797     if (VTABLE_isa(interp, pmc, _sub)) {
 798         /* a plain sub stops outer searches */
 799         VTABLE_push_pmc(interp, cl, pmc);
 800         return 1;
 801     }
 802
 803     /* not a Sub or MultiSub - ignore */
 804     if (!VTABLE_isa(interp, pmc, _multi_sub))
 805         return 0;
 806
 807     /* ok we have a multi sub pmc, which is an array of candidates */
 808     n = VTABLE_elements(interp, pmc);
 809
 810     for (i = 0; i < n; ++i) {
 811         PMC * const multi_sub = VTABLE_get_pmc_keyed_int(interp, pmc, i);
 812         VTABLE_push_pmc(interp, cl, multi_sub);
 813     }
 814
 815     return 0;
 816 }
 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
 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_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
 858 =item C<static void mmd_search_global(PARROT_INTERP, STRING *name, PMC *cl)>
 859
 860 Search the builtin namespace for matching candidates.
 861
 862 =cut
 863
 864 */
 865
 866 static void
 867 mmd_search_global(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *cl))
 868 {
 869     ASSERT_ARGS(mmd_search_global)
 870     STRING * const multi_str = CONST_STRING(interp, "MULTI");
 871     PMC    * const ns        = Parrot_get_namespace_keyed_str(interp,
 872                                     interp->root_namespace, multi_str);
 873     PMC           *multi_sub = Parrot_get_global(interp, ns, name);
 874
 875     if (PMC_IS_NULL(multi_sub))
 876         return;
 877
 878     Parrot_mmd_maybe_candidate(interp, multi_sub, cl);
 879 }
 880
 881
 882 /*
 883
 884 =item C<static void mmd_add_multi_global(PARROT_INTERP, STRING *sub_name, PMC
 885 *sub_obj)>
 886
 887 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
 888 stored in the global MULTI namespace.
 889
 890 =cut
 891
 892 */
 893
 894 static void
 895 mmd_add_multi_global(PARROT_INTERP, ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
 896 {
 897     ASSERT_ARGS(mmd_add_multi_global)
 898     STRING * const multi_str = CONST_STRING(interp, "MULTI");
 899     PMC    * const ns        = Parrot_make_namespace_keyed_str(interp,
 900                                     interp->root_namespace, multi_str);
 901     PMC           *multi_sub = Parrot_get_global(interp, ns, sub_name);
 902
 903     if (PMC_IS_NULL(multi_sub)) {
 904         multi_sub = Parrot_pmc_new_constant(interp, enum_class_MultiSub);
 905         Parrot_set_global(interp, ns, sub_name, multi_sub);
 906     }
 907
 908     PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
 909     VTABLE_push_pmc(interp, multi_sub, sub_obj);
 910 }
 911
 912
 913 /*
 914
 915 =item C<static void mmd_add_multi_to_namespace(PARROT_INTERP, STRING *ns_name,
 916 STRING *sub_name, PMC *sub_obj)>
 917
 918 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
 919 added as a method to a class.
 920
 921 =cut
 922
 923 */
 924
 925 static void
 926 mmd_add_multi_to_namespace(PARROT_INTERP, ARGIN(STRING *ns_name),
 927             ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
 928 {
 929     ASSERT_ARGS(mmd_add_multi_to_namespace)
 930     PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
 931                         interp->HLL_namespace,
 932                         Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
 933     PMC * const ns     = Parrot_make_namespace_keyed_str(interp, hll_ns, ns_name);
 934     PMC        *multi_sub = Parrot_get_global(interp, ns, sub_name);
 935
 936     if (PMC_IS_NULL(multi_sub)) {
 937         multi_sub = Parrot_pmc_new_constant(interp, enum_class_MultiSub);
 938         Parrot_set_global(interp, ns, sub_name, multi_sub);
 939     }
 940
 941     PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
 942     VTABLE_push_pmc(interp, multi_sub, sub_obj);
 943 }
 944
 945
 946 /*
 947
 948 =item C<void Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP, STRING *sub_name,
 949 STRING *long_sig, PMC *sub_obj)>
 950
 951 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
 952 stored in the global MULTI namespace.
 953
 954 =cut
 955
 956 */
 957
 958 PARROT_EXPORT
 959 void
 960 Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP,
 961         ARGIN(STRING *sub_name), ARGIN(STRING *long_sig), ARGIN(PMC *sub_obj))
 962 {
 963     ASSERT_ARGS(Parrot_mmd_add_multi_from_long_sig)
 964     Parrot_Sub_attributes *sub;
 965     STRING     *sub_str     = CONST_STRING(interp, "Sub");
 966     STRING     *closure_str = CONST_STRING(interp, "Closure");
 967     PMC        *type_list   = Parrot_str_split(interp, CONST_STRING(interp, ","), long_sig);
 968     STRING     *ns_name     = VTABLE_get_string_keyed_int(interp, type_list, 0);
 969
 970     /* Attach a type tuple array to the sub for multi dispatch */
 971     PMC    *multi_sig = mmd_build_type_tuple_from_type_list(interp, type_list);
 972
 973     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          ||  VTABLE_isa(interp, sub_obj, closure_str)) {
 978         PMC_get_sub(interp, sub_obj, sub);
 979         sub->multi_signature = multi_sig;
 980     }
 981
 982     mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
 983     mmd_add_multi_global(interp, sub_name, sub_obj);
 984 }
 985
 986
 987 /*
 988
 989 =item C<void Parrot_mmd_add_multi_from_c_args(PARROT_INTERP, const char
 990 *sub_name, const char *short_sig, const char *long_sig, funcptr_t
 991 multi_func_ptr)>
 992
 993 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
 994 stored in the specified namespace.
 995
 996 =cut
 997
 998 */
 999
1000 PARROT_EXPORT
1001 void
1002 Parrot_mmd_add_multi_from_c_args(PARROT_INTERP,
1003         ARGIN(const char *sub_name), ARGIN(const char *short_sig),
1004         ARGIN(const char *long_sig), ARGIN(funcptr_t multi_func_ptr))
1005 {
1006     ASSERT_ARGS(Parrot_mmd_add_multi_from_c_args)
1007     STRING *comma         = CONST_STRING(interp, ",");
1008     STRING *sub_name_str  = Parrot_str_new_constant(interp, sub_name);
1009     STRING *long_sig_str  = Parrot_str_new_constant(interp, long_sig);
1010     STRING *short_sig_str = Parrot_str_new_constant(interp, short_sig);
1011     PMC    *type_list     = Parrot_str_split(interp, comma, long_sig_str);
1012     STRING *ns_name       = VTABLE_get_string_keyed_int(interp, type_list, 0);
1013
1014     /* Create an NCI sub for the C function */
1015     PMC    *sub_obj       = Parrot_pmc_new_constant(interp, enum_class_NCI);
1016     PMC    *multi_sig     = mmd_build_type_tuple_from_long_sig(interp,
1017                                 long_sig_str);
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
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_constant(interp, enum_class_NCI);
1063
1064         VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig,
1065                                      F2DPTR(func_ptr));
1066
1067         /* Attach a type tuple array to the NCI sub for multi dispatch */
1068         SETATTR_NCI_long_signature(interp, sub_obj, long_sig);
1069
1070         mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
1071         mmd_add_multi_global(interp, sub_name, sub_obj);
1072     }
1073 }
1074
1075
1076 /*
1077
1078 =item C<MMD_Cache * Parrot_mmd_cache_create(PARROT_INTERP)>
1079
1080 Creates and returns a new MMD cache.
1081
1082 =cut
1083
1084 */
1085
1086 PARROT_EXPORT
1087 PARROT_CANNOT_RETURN_NULL
1088 MMD_Cache *
1089 Parrot_mmd_cache_create(PARROT_INTERP)
1090 {
1091     ASSERT_ARGS(Parrot_mmd_cache_create)
1092     /* String hash. */
1093     Hash *cache = parrot_new_hash(interp);
1094     return cache;
1095 }
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 *
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(interp, (char *)type_ids, id_size);
1139     mem_gc_free(interp, type_ids);
1140
1141     return key;
1142 }
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 *
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 (PMC *)parrot_hash_get(interp, cache, key);
1168
1169     return PMCNULL;
1170 }
1171
1172
1173 /*
1174
1175 =item C<void Parrot_mmd_cache_store_by_values(PARROT_INTERP, MMD_Cache *cache,
1176 const char *name, PMC *values, PMC *chosen)>
1177
1178 Takes an array of values for the call along with a chosen candidate and puts
1179 it into the cache.
1180
1181 =cut
1182
1183 */
1184
1185 PARROT_EXPORT
1186 void
1187 Parrot_mmd_cache_store_by_values(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1188     ARGIN(const char *name), ARGIN(PMC *values), ARGIN(PMC *chosen))
1189 {
1190     ASSERT_ARGS(Parrot_mmd_cache_store_by_values)
1191     STRING * const key = mmd_cache_key_from_values(interp, name, values);
1192
1193     if (key)
1194         parrot_hash_put(interp, cache, key, chosen);
1195 }
1196
1197
1198 /*
1199
1200 =item C<static STRING * mmd_cache_key_from_types(PARROT_INTERP, const char
1201 *name, PMC *types)>
1202
1203 Generates an MMD cache key from an array of types.
1204
1205 =cut
1206
1207 */
1208
1209 PARROT_WARN_UNUSED_RESULT
1210 PARROT_CAN_RETURN_NULL
1211 static STRING *
1212 mmd_cache_key_from_types(PARROT_INTERP, ARGIN(const char *name),
1213     ARGIN(PMC *types))
1214 {
1215     ASSERT_ARGS(mmd_cache_key_from_types)
1216     /* Build array of type IDs, which we'll then use as a string to key into
1217      * the hash. */
1218     const INTVAL num_types  = VTABLE_elements(interp, types);
1219     const INTVAL name_len   = name ? strlen(name) + 1: 0;
1220     const size_t id_size    = num_types * sizeof (INTVAL) + name_len;
1221     INTVAL * const type_ids = mem_gc_allocate_n_typed(interp, num_types + name_len, INTVAL);
1222
1223     STRING *key;
1224     INTVAL  i;
1225
1226     for (i = 0; i < num_types; ++i) {
1227         const INTVAL id = VTABLE_get_integer_keyed_int(interp, types, i);
1228
1229         if (id == 0) {
1230             mem_gc_free(interp, type_ids);
1231             return NULL;
1232         }
1233
1234         type_ids[i] = id;
1235     }
1236
1237     if (name)
1238         strcpy((char *)(type_ids + num_types), name);
1239
1240     key = Parrot_str_new(interp, (char *)type_ids, id_size);
1241
1242     mem_gc_free(interp, type_ids);
1243     return key;
1244 }
1245
1246
1247 /*
1248
1249 =item C<PMC * Parrot_mmd_cache_lookup_by_types(PARROT_INTERP, MMD_Cache *cache,
1250 const char *name, PMC *types)>
1251
1252 Takes an array of types for the call and does a lookup in the MMD cache.
1253
1254 =cut
1255
1256 */
1257
1258 PARROT_EXPORT
1259 PARROT_WARN_UNUSED_RESULT
1260 PARROT_CAN_RETURN_NULL
1261 PMC *
1262 Parrot_mmd_cache_lookup_by_types(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1263     ARGIN(const char *name), ARGIN(PMC *types))
1264 {
1265     ASSERT_ARGS(Parrot_mmd_cache_lookup_by_types)
1266     const STRING * const key = mmd_cache_key_from_types(interp, name, types);
1267
1268     if (key)
1269         return (PMC *)parrot_hash_get(interp, cache, key);
1270
1271     return PMCNULL;
1272 }
1273
1274
1275 /*
1276
1277 =item C<void Parrot_mmd_cache_store_by_types(PARROT_INTERP, MMD_Cache *cache,
1278 const char *name, PMC *types, PMC *chosen)>
1279
1280 Takes an array of types for the call along with a chosen candidate and puts
1281 it into the cache. The name parameter is optional, and if the cache is already
1282 tied to an individual multi can be null.
1283
1284 =cut
1285
1286 */
1287
1288 PARROT_EXPORT
1289 void
1290 Parrot_mmd_cache_store_by_types(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1291     ARGIN(const char *name), ARGIN(PMC *types), ARGIN(PMC *chosen))
1292 {
1293     ASSERT_ARGS(Parrot_mmd_cache_store_by_types)
1294     STRING * const key = mmd_cache_key_from_types(interp, name, types);
1295
1296     if (key)
1297         parrot_hash_put(interp, cache, key, chosen);
1298 }
1299
1300
1301 /*
1302
1303 =item C<void Parrot_mmd_cache_mark(PARROT_INTERP, MMD_Cache *cache)>
1304
1305 GC-marks an MMD cache.
1306
1307 =cut
1308
1309 */
1310
1311 PARROT_EXPORT
1312 void
1313 Parrot_mmd_cache_mark(PARROT_INTERP, ARGMOD(MMD_Cache *cache))
1314 {
1315     ASSERT_ARGS(Parrot_mmd_cache_mark)
1316     /* As a small future optimization, note that we only *really* need to mark
1317     * keys - the candidates will be referenced outside the cache, provided it's
1318     * invalidated properly. */
1319     parrot_mark_hash(interp, cache);
1320 }
1321
1322
1323 /*
1324
1325 =item C<void Parrot_mmd_cache_destroy(PARROT_INTERP, MMD_Cache *cache)>
1326
1327 Destroys an MMD cache.
1328
1329 =cut
1330
1331 */
1332
1333 PARROT_EXPORT
1334 void
1335 Parrot_mmd_cache_destroy(PARROT_INTERP, ARGMOD(MMD_Cache *cache))
1336 {
1337     ASSERT_ARGS(Parrot_mmd_cache_destroy)
1338     parrot_hash_destroy(interp, cache);
1339 }
1340
1341
1342 /*
1343
1344 =back
1345
1346 =head1 SEE ALSO
1347
1348 F<include/parrot/multidispatch.h>,
1349 F<http://svn.perl.org/perl6/doc/trunk/design/apo/A12.pod>,
1350 F<http://svn.perl.org/perl6/doc/trunk/design/syn/S12.pod>
1351
1352 =cut
1353
1354 */
1355
1356
1357 /*
1358  * Local variables:
1359  *   c-file-style: "parrot"
1360  * End:
1361  * vim: expandtab shiftwidth=4:
1362  */