src/multidispatch.c

   1 /*
   2 Copyright (C) 2003-2009, 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_context.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 INTVAL distance_cmp(SHIM_INTERP, INTVAL a, INTVAL b);
  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 static int mmd_search_local(PARROT_INTERP,
 133     ARGIN(STRING *name),
 134     ARGIN(PMC *candidates))
 135         __attribute__nonnull__(1)
 136         __attribute__nonnull__(2)
 137         __attribute__nonnull__(3);
 138
 139 PARROT_WARN_UNUSED_RESULT
 140 PARROT_CAN_RETURN_NULL
 141 static PMC * Parrot_mmd_get_cached_multi_sig(PARROT_INTERP,
 142     ARGIN(PMC *sub_pmc))
 143         __attribute__nonnull__(1)
 144         __attribute__nonnull__(2);
 145
 146 static int Parrot_mmd_maybe_candidate(PARROT_INTERP,
 147     ARGIN(PMC *pmc),
 148     ARGIN(PMC *cl))
 149         __attribute__nonnull__(1)
 150         __attribute__nonnull__(2)
 151         __attribute__nonnull__(3);
 152
 153 PARROT_CANNOT_RETURN_NULL
 154 PARROT_WARN_UNUSED_RESULT
 155 static PMC* Parrot_mmd_search_scopes(PARROT_INTERP, ARGIN(STRING *meth))
 156         __attribute__nonnull__(1)
 157         __attribute__nonnull__(2);
 158
 159 PARROT_CANNOT_RETURN_NULL
 160 static PMC * Parrot_mmd_sort_candidates(PARROT_INTERP,
 161     ARGIN(PMC *arg_tuple),
 162     ARGIN(PMC *cl))
 163         __attribute__nonnull__(1)
 164         __attribute__nonnull__(2)
 165         __attribute__nonnull__(3);
 166
 167 #define ASSERT_ARGS_distance_cmp __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 168 #define ASSERT_ARGS_mmd_add_multi_global __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 169        PARROT_ASSERT_ARG(interp) \
 170     , PARROT_ASSERT_ARG(sub_name) \
 171     , PARROT_ASSERT_ARG(sub_obj))
 172 #define ASSERT_ARGS_mmd_add_multi_to_namespace __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 173        PARROT_ASSERT_ARG(interp) \
 174     , PARROT_ASSERT_ARG(ns_name) \
 175     , PARROT_ASSERT_ARG(sub_name) \
 176     , PARROT_ASSERT_ARG(sub_obj))
 177 #define ASSERT_ARGS_mmd_build_type_tuple_from_long_sig \
 178      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 179        PARROT_ASSERT_ARG(interp) \
 180     , PARROT_ASSERT_ARG(long_sig))
 181 #define ASSERT_ARGS_mmd_build_type_tuple_from_type_list \
 182      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 183        PARROT_ASSERT_ARG(interp) \
 184     , PARROT_ASSERT_ARG(type_list))
 185 #define ASSERT_ARGS_mmd_cache_key_from_types __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 186        PARROT_ASSERT_ARG(interp) \
 187     , PARROT_ASSERT_ARG(name) \
 188     , PARROT_ASSERT_ARG(types))
 189 #define ASSERT_ARGS_mmd_cache_key_from_values __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 190        PARROT_ASSERT_ARG(interp) \
 191     , PARROT_ASSERT_ARG(name) \
 192     , PARROT_ASSERT_ARG(values))
 193 #define ASSERT_ARGS_mmd_cvt_to_types __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 194        PARROT_ASSERT_ARG(interp) \
 195     , PARROT_ASSERT_ARG(multi_sig))
 196 #define ASSERT_ARGS_mmd_distance __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 197        PARROT_ASSERT_ARG(interp) \
 198     , PARROT_ASSERT_ARG(pmc) \
 199     , PARROT_ASSERT_ARG(arg_tuple))
 200 #define ASSERT_ARGS_mmd_search_by_sig_obj __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 201        PARROT_ASSERT_ARG(interp) \
 202     , PARROT_ASSERT_ARG(name) \
 203     , PARROT_ASSERT_ARG(sig_obj) \
 204     , PARROT_ASSERT_ARG(candidates))
 205 #define ASSERT_ARGS_mmd_search_global __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 206        PARROT_ASSERT_ARG(interp) \
 207     , PARROT_ASSERT_ARG(name) \
 208     , PARROT_ASSERT_ARG(cl))
 209 #define ASSERT_ARGS_mmd_search_local __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 210        PARROT_ASSERT_ARG(interp) \
 211     , PARROT_ASSERT_ARG(name) \
 212     , PARROT_ASSERT_ARG(candidates))
 213 #define ASSERT_ARGS_Parrot_mmd_get_cached_multi_sig \
 214      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 215        PARROT_ASSERT_ARG(interp) \
 216     , PARROT_ASSERT_ARG(sub_pmc))
 217 #define ASSERT_ARGS_Parrot_mmd_maybe_candidate __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 218        PARROT_ASSERT_ARG(interp) \
 219     , PARROT_ASSERT_ARG(pmc) \
 220     , PARROT_ASSERT_ARG(cl))
 221 #define ASSERT_ARGS_Parrot_mmd_search_scopes __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 222        PARROT_ASSERT_ARG(interp) \
 223     , PARROT_ASSERT_ARG(meth))
 224 #define ASSERT_ARGS_Parrot_mmd_sort_candidates __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 225        PARROT_ASSERT_ARG(interp) \
 226     , PARROT_ASSERT_ARG(arg_tuple) \
 227     , PARROT_ASSERT_ARG(cl))
 228 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 229 /* HEADERIZER END: static */
 230
 231
 232 #define MMD_DEBUG 0
 233
 234
 235 /*
 236
 237 =item C<PMC* Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP, STRING *name, PMC
 238 *invoke_sig)>
 239
 240 Collect a list of possible candidates for a given sub name and call signature.
 241 Rank the possible candidates by Manhattan Distance, and return the best
 242 matching candidate. The candidate list is cached in the CallSignature object,
 243 to allow for iterating through it.
 244
 245 Currently this only looks in the global "MULTI" namespace.
 246
 247 =cut
 248
 249 */
 250
 251 PARROT_EXPORT
 252 PARROT_WARN_UNUSED_RESULT
 253 PARROT_CANNOT_RETURN_NULL
 254 PMC*
 255 Parrot_mmd_find_multi_from_sig_obj(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *invoke_sig))
 256 {
 257     ASSERT_ARGS(Parrot_mmd_find_multi_from_sig_obj)
 258     PMC * const candidate_list = pmc_new(interp, enum_class_ResizablePMCArray);
 259
 260     mmd_search_by_sig_obj(interp, name, invoke_sig, candidate_list);
 261     mmd_search_global(interp, name, candidate_list);
 262
 263     return Parrot_mmd_sort_manhattan_by_sig_pmc(interp, candidate_list, invoke_sig);
 264 }
 265
 266 /*
 267
 268 =item C<void Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP, const char
 269 *name, const char *sig, ...)>
 270
 271 Dispatches to a MultiSub from a variable-sized list of C arguments. The
 272 multiple dispatch system will figure out which sub should be called based on
 273 the types of the arguments passed in.
 274
 275 Return arguments must be passed as a reference to the PMC, string, number, or
 276 integer, so the result can be set.
 277
 278 =cut
 279
 280 */
 281
 282 PARROT_EXPORT
 283 PARROT_CAN_RETURN_NULL
 284 void
 285 Parrot_mmd_multi_dispatch_from_c_args(PARROT_INTERP,
 286         ARGIN(const char *name), ARGIN(const char *sig), ...)
 287 {
 288     ASSERT_ARGS(Parrot_mmd_multi_dispatch_from_c_args)
 289     PMC *sig_object, *sub;
 290
 291     va_list args;
 292     va_start(args, sig);
 293     sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, sig, args);
 294     va_end(args);
 295
 296     /* Check the cache. */
 297     sub = Parrot_mmd_cache_lookup_by_types(interp, interp->op_mmd_cache, name,
 298             VTABLE_get_pmc(interp, sig_object));
 299
 300     if (PMC_IS_NULL(sub)) {
 301         sub = Parrot_mmd_find_multi_from_sig_obj(interp,
 302             Parrot_str_new_constant(interp, name), sig_object);
 303
 304         if (!PMC_IS_NULL(sub))
 305             Parrot_mmd_cache_store_by_types(interp, interp->op_mmd_cache, name,
 306                     VTABLE_get_pmc(interp, sig_object), sub);
 307     }
 308
 309     if (PMC_IS_NULL(sub))
 310         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_METHOD_NOT_FOUND,
 311                 "Multiple Dispatch: No suitable candidate found for '%s',"
 312                 " with signature '%s'", name, sig);
 313
 314 #if MMD_DEBUG
 315     Parrot_io_eprintf(interp, "candidate found for '%s', with signature '%s'\n",
 316         name, sig);
 317     Parrot_io_eprintf(interp, "type of candidate found: %Ss\n",
 318             VTABLE_name(interp, sub));
 319 #endif
 320
 321     Parrot_pcc_invoke_from_sig_object(interp, sub, sig_object);
 322 }
 323
 324
 325 /*
 326
 327 =item C<PMC * Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP, STRING *name,
 328 STRING *long_sig)>
 329
 330 Find the best candidate multi for a given sub name and signature. The signature
 331 is a string containing a comma-delimited list of type names.
 332
 333 Currently only searches the global MULTI namespace.
 334
 335 =cut
 336
 337 */
 338
 339 PARROT_EXPORT
 340 PARROT_CAN_RETURN_NULL
 341 PARROT_WARN_UNUSED_RESULT
 342 PMC *
 343 Parrot_mmd_find_multi_from_long_sig(PARROT_INTERP, ARGIN(STRING *name),
 344         ARGIN(STRING *long_sig))
 345 {
 346     ASSERT_ARGS(Parrot_mmd_find_multi_from_long_sig)
 347     STRING * const multi_str = CONST_STRING(interp, "MULTI");
 348     PMC    * const ns        = Parrot_make_namespace_keyed_str(interp,
 349                                     interp->root_namespace, multi_str);
 350     PMC    * const multi_sub = Parrot_get_global(interp, ns, name);
 351
 352     if (PMC_IS_NULL(multi_sub)) {
 353         return PMCNULL;
 354     }
 355     else {
 356         PMC * const type_tuple = mmd_build_type_tuple_from_long_sig(interp, long_sig);
 357         return Parrot_mmd_sort_candidates(interp, type_tuple, multi_sub);
 358     }
 359 }
 360
 361
 362 /*
 363
 364 =item C<PMC * Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP, PMC
 365 *candidates, PMC *invoke_sig)>
 366
 367 Given an array PMC (usually a MultiSub) and a CallSignature PMC, sorts the mmd
 368 candidates by their manhattan distance to the signature args and returns the
 369 best one.
 370
 371 =cut
 372
 373 */
 374
 375 PARROT_EXPORT
 376 PARROT_CAN_RETURN_NULL
 377 PARROT_WARN_UNUSED_RESULT
 378 PMC *
 379 Parrot_mmd_sort_manhattan_by_sig_pmc(PARROT_INTERP, ARGIN(PMC *candidates),
 380         ARGIN(PMC *invoke_sig))
 381 {
 382     ASSERT_ARGS(Parrot_mmd_sort_manhattan_by_sig_pmc)
 383     const INTVAL n = VTABLE_elements(interp, candidates);
 384
 385     if (!n)
 386         return PMCNULL;
 387
 388     return Parrot_mmd_sort_candidates(interp,
 389         VTABLE_get_pmc(interp, invoke_sig), candidates);
 390 }
 391
 392
 393
 394 /*
 395
 396 =item C<static INTVAL distance_cmp(PARROT_INTERP, INTVAL a, INTVAL b)>
 397
 398 Compare distance values C<a> and C<b>. Return 1 if C<a> is larger, -1 if
 399 C<b> is.
 400
 401 =cut
 402
 403 */
 404
 405 static INTVAL
 406 distance_cmp(SHIM_INTERP, INTVAL a, INTVAL b)
 407 {
 408     ASSERT_ARGS(distance_cmp)
 409     short da = (short)(a & 0xffff);
 410     short db = (short)(b & 0xffff);
 411
 412     /* sort first by distance */
 413     if (da > db)
 414         return 1;
 415
 416     if (da < db)
 417         return -1;
 418
 419     /* end then by index in candidate list */
 420     da = (short)(a >> 16);
 421     db = (short)(b >> 16);
 422
 423     return da > db ? 1 : da < db ? -1 : 0;
 424 }
 425
 426
 427 /*
 428
 429 =item C<static PMC* mmd_build_type_tuple_from_type_list(PARROT_INTERP, PMC
 430 *type_list)>
 431
 432 Construct a FixedIntegerArray of type numbers from an array of
 433 type names. Used for multiple dispatch.
 434
 435 =cut
 436
 437 */
 438
 439 PARROT_CANNOT_RETURN_NULL
 440 PARROT_WARN_UNUSED_RESULT
 441 static PMC*
 442 mmd_build_type_tuple_from_type_list(PARROT_INTERP, ARGIN(PMC *type_list))
 443 {
 444     ASSERT_ARGS(mmd_build_type_tuple_from_type_list)
 445     PMC   *multi_sig   = constant_pmc_new(interp, enum_class_FixedIntegerArray);
 446     INTVAL param_count = VTABLE_elements(interp, type_list);
 447     INTVAL i;
 448
 449     VTABLE_set_integer_native(interp, multi_sig, param_count);
 450
 451     for (i = 0; i < param_count; i++) {
 452         STRING *type_name = VTABLE_get_string_keyed_int(interp, type_list, i);
 453         INTVAL  type;
 454
 455         if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "DEFAULT")))
 456             type = enum_type_PMC;
 457         else if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "STRING")))
 458             type = enum_type_STRING;
 459         else if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "INTVAL")))
 460             type = enum_type_INTVAL;
 461         else if (Parrot_str_equal(interp, type_name, CONST_STRING(interp, "FLOATVAL")))
 462             type = enum_type_FLOATVAL;
 463         else
 464             type = pmc_type(interp, type_name);
 465
 466         VTABLE_set_integer_keyed_int(interp, multi_sig, i, type);
 467     }
 468
 469     return multi_sig;
 470 }
 471
 472
 473 /*
 474
 475 =item C<static PMC* mmd_build_type_tuple_from_long_sig(PARROT_INTERP, STRING
 476 *long_sig)>
 477
 478 Construct a FixedIntegerArray of type numbers from a comma-delimited string of
 479 type names. Used for multiple dispatch.
 480
 481 =cut
 482
 483 */
 484
 485 PARROT_CANNOT_RETURN_NULL
 486 PARROT_WARN_UNUSED_RESULT
 487 static PMC*
 488 mmd_build_type_tuple_from_long_sig(PARROT_INTERP, ARGIN(STRING *long_sig))
 489 {
 490     ASSERT_ARGS(mmd_build_type_tuple_from_long_sig)
 491     PMC *type_list = Parrot_str_split(interp, CONST_STRING(interp, ","), long_sig);
 492
 493     return mmd_build_type_tuple_from_type_list(interp, type_list);
 494 }
 495
 496
 497 /*
 498
 499 =item C<PMC* Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, PMC
 500 *sig_obj)>
 501
 502 Construct a FixedIntegerArray of type numbers from the arguments of a Call
 503 Signature object. Used for multiple dispatch.
 504
 505 =cut
 506
 507 */
 508
 509 PARROT_EXPORT
 510 PARROT_CANNOT_RETURN_NULL
 511 PARROT_WARN_UNUSED_RESULT
 512 PMC*
 513 Parrot_mmd_build_type_tuple_from_sig_obj(PARROT_INTERP, ARGIN(PMC *sig_obj))
 514 {
 515     ASSERT_ARGS(Parrot_mmd_build_type_tuple_from_sig_obj)
 516     PMC * const  type_tuple = pmc_new(interp, enum_class_ResizableIntegerArray);
 517     STRING      *string_sig = VTABLE_get_string(interp, sig_obj);
 518     INTVAL       tuple_size = 0;
 519     INTVAL       args_ended = 0;
 520     INTVAL       i, seen_invocant = 0;
 521     INTVAL       sig_len;
 522
 523     if (STRING_IS_NULL(string_sig)) {
 524             Parrot_ex_throw_from_c_args(interp, NULL, 1,
 525                     "Call has no signature, unable to dispatch.\n");
 526     }
 527
 528     sig_len = Parrot_str_byte_length(interp, string_sig);
 529
 530     for (i = 0; i < sig_len; ++i) {
 531         INTVAL type = Parrot_str_indexed(interp, string_sig, i + seen_invocant);
 532         if (args_ended)
 533             break;
 534
 535         /* Regular arguments just set the value */
 536         switch (type) {
 537             case 'I':
 538                 VTABLE_set_integer_keyed_int(interp, type_tuple,
 539                         i, enum_type_INTVAL);
 540                 break;
 541             case 'N':
 542                 VTABLE_set_integer_keyed_int(interp, type_tuple,
 543                         i, enum_type_FLOATVAL);
 544                 break;
 545             case 'S':
 546                 {
 547                     INTVAL type_lookahead = Parrot_str_indexed(interp, string_sig, (i + 1));
 548                     if (type_lookahead == 'n') {
 549                         args_ended = 1;
 550                         break;
 551                     }
 552                     VTABLE_set_integer_keyed_int(interp, type_tuple,
 553                             i, enum_type_STRING);
 554                     break;
 555                 }
 556             case 'P':
 557             {
 558                 INTVAL type_lookahead = Parrot_str_indexed(interp, string_sig, (i + 1));
 559                 if (type_lookahead == 'i') {
 560                     if (i != 0)
 561                         Parrot_ex_throw_from_c_args(interp, NULL,
 562                             EXCEPTION_INVALID_OPERATION,
 563                             "Multiple Dispatch: only the first argument can be an invocant");
 564                     seen_invocant = 1;
 565                 }
 566                 else if (type_lookahead == 'f') {
 567                     args_ended = 1;
 568                     break;
 569                 }
 570                 else {
 571                     PMC *pmc_arg = VTABLE_get_pmc_keyed_int(interp, sig_obj, i);
 572                     if (PMC_IS_NULL(pmc_arg))
 573                         VTABLE_set_integer_keyed_int(interp, type_tuple,
 574                                 i, enum_type_PMC);
 575                     else
 576                         VTABLE_set_integer_keyed_int(interp, type_tuple, i,
 577                                 VTABLE_type(interp, pmc_arg));
 578                 }
 579
 580                 break;
 581             }
 582             case '-':
 583                 args_ended = 1;
 584                 break;
 585             default:
 586                 Parrot_ex_throw_from_c_args(interp, NULL,
 587                     EXCEPTION_INVALID_OPERATION,
 588                     "Multiple Dispatch: invalid argument type %c!", type);
 589         }
 590     }
 591
 592     return type_tuple;
 593 }
 594
 595
 596 /*
 597
 598 =item C<static PMC* mmd_cvt_to_types(PARROT_INTERP, PMC *multi_sig)>
 599
 600 Given a ResizablePMCArray PMC containing some form of type identifier (either
 601 the string name of a class or a PMC representing the type), resolves all type
 602 references to type IDs, if possible.  If that's not possible, returns PMCNULL.
 603 In that case you can't dispatch to the multi variant with this type signature,
 604 as Parrot doesn't yet know about the respective types requested -- you have to
 605 register them first.
 606
 607 Otherwise, returns a ResizableIntegerArray PMC full of type IDs representing
 608 the signature of a multi variant to which you may be able to dispatch.
 609
 610 {{**DEPRECATE**}}
 611
 612 =cut
 613
 614 */
 615
 616 PARROT_WARN_UNUSED_RESULT
 617 PARROT_CAN_RETURN_NULL
 618 static PMC*
 619 mmd_cvt_to_types(PARROT_INTERP, ARGIN(PMC *multi_sig))
 620 {
 621     ASSERT_ARGS(mmd_cvt_to_types)
 622     PMC        *ar = PMCNULL;
 623     const INTVAL n = VTABLE_elements(interp, multi_sig);
 624     INTVAL       i;
 625
 626     for (i = 0; i < n; ++i) {
 627         PMC * const sig_elem = VTABLE_get_pmc_keyed_int(interp, multi_sig, i);
 628         INTVAL type;
 629
 630         if (sig_elem->vtable->base_type == enum_class_String) {
 631             STRING * const sig = VTABLE_get_string(interp, sig_elem);
 632
 633             if (!sig)
 634                 return PMCNULL;
 635
 636             type = pmc_type(interp, sig);
 637
 638             if (type == enum_type_undef)
 639                 return PMCNULL;
 640         }
 641         else if (sig_elem->vtable->base_type == enum_class_Integer) {
 642             type = VTABLE_get_integer(interp, sig_elem);
 643         }
 644         else
 645             type = pmc_type_p(interp, sig_elem);
 646
 647         /* create destination PMC only as necessary */
 648         if (PMC_IS_NULL(ar)) {
 649             ar = pmc_new(interp, enum_class_FixedIntegerArray);
 650             VTABLE_set_integer_native(interp, ar, n);
 651         }
 652
 653         VTABLE_set_integer_keyed_int(interp, ar, i, type);
 654     }
 655
 656     return ar;
 657 }
 658
 659
 660 /*
 661
 662 =item C<static PMC * Parrot_mmd_get_cached_multi_sig(PARROT_INTERP, PMC
 663 *sub_pmc)>
 664
 665 Get the cached multisig of the given sub, if one exists. The cached signature
 666 might be in different formats, so put it into a type tuple like the rest of the
 667 MMD system expects.
 668
 669 =cut
 670
 671 */
 672
 673 PARROT_WARN_UNUSED_RESULT
 674 PARROT_CAN_RETURN_NULL
 675 static PMC *
 676 Parrot_mmd_get_cached_multi_sig(PARROT_INTERP, ARGIN(PMC *sub_pmc))
 677 {
 678     ASSERT_ARGS(Parrot_mmd_get_cached_multi_sig)
 679     if (VTABLE_isa(interp, sub_pmc, CONST_STRING(interp, "Sub"))) {
 680         Parrot_Sub_attributes *sub;
 681         PMC                   *multi_sig;
 682
 683         PMC_get_sub(interp, sub_pmc, sub);
 684         multi_sig = sub->multi_signature;
 685
 686         if (multi_sig->vtable->base_type == enum_class_FixedPMCArray) {
 687             PMC *converted_sig = mmd_cvt_to_types(interp, multi_sig);
 688
 689             if (PMC_IS_NULL(converted_sig))
 690                 return PMCNULL;
 691
 692             multi_sig = sub->multi_signature = converted_sig;
 693         }
 694
 695         return multi_sig;
 696     }
 697
 698     return PMCNULL;
 699 }
 700
 701
 702 #define MMD_BIG_DISTANCE 0x7fff
 703
 704 /*
 705
 706 =item C<static UINTVAL mmd_distance(PARROT_INTERP, PMC *pmc, PMC *arg_tuple)>
 707
 708 Create Manhattan Distance of sub C<pmc> against given argument types.
 709 0xffff is the maximum distance
 710
 711 =cut
 712
 713 */
 714
 715 static UINTVAL
 716 mmd_distance(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *arg_tuple))
 717 {
 718     ASSERT_ARGS(mmd_distance)
 719     PMC        *multi_sig, *mro;
 720     Parrot_Sub_attributes *sub;
 721     INTVAL      args, dist, i, j, n, m;
 722
 723     /* has to be a builtin multi method */
 724     if (pmc->vtable->base_type == enum_class_NCI) {
 725         GETATTR_NCI_multi_sig(interp, pmc, multi_sig);
 726         if (PMC_IS_NULL(multi_sig)) {
 727             STRING *long_sig;
 728
 729             GETATTR_NCI_long_signature(interp, pmc, long_sig);
 730             multi_sig = mmd_build_type_tuple_from_long_sig(interp, long_sig);
 731             SETATTR_NCI_multi_sig(interp, pmc, multi_sig);
 732         }
 733     }
 734     else {
 735         /* not a multi; no distance */
 736         PMC_get_sub(interp, pmc, sub);
 737         if (!sub->multi_signature)
 738             return 0;
 739
 740         multi_sig = Parrot_mmd_get_cached_multi_sig(interp, pmc);
 741     }
 742
 743     if (PMC_IS_NULL(multi_sig))
 744         return MMD_BIG_DISTANCE;
 745
 746     n    = VTABLE_elements(interp, multi_sig);
 747     args = VTABLE_elements(interp, arg_tuple);
 748
 749     /*
 750      * arg_tuple may have more arguments - only the
 751      * n multi_sig invocants are counted
 752      */
 753     if (args < n)
 754         return MMD_BIG_DISTANCE;
 755
 756     dist = 0;
 757
 758     if (args > n)
 759         dist = PARROT_MMD_MAX_CLASS_DEPTH;
 760
 761     /* now go through args */
 762     for (i = 0; i < n; ++i) {
 763         const INTVAL type_sig  = VTABLE_get_integer_keyed_int(interp, multi_sig, i);
 764         const INTVAL type_call = VTABLE_get_integer_keyed_int(interp, arg_tuple, i);
 765         if (type_sig == type_call)
 766             continue;
 767
 768         /* promote primitives to their PMC equivalents, as PCC will autobox
 769          * the distance penalty makes primitive variants look cheaper */
 770         switch (type_call) {
 771             case enum_type_INTVAL:
 772                 if (type_sig == enum_class_Integer) { dist++; continue; }
 773                 break;
 774             case enum_type_FLOATVAL:
 775                 if (type_sig == enum_class_Float)   { dist++; continue; }
 776                 break;
 777             case enum_type_STRING:
 778                 if (type_sig == enum_class_String)  { dist++; continue; }
 779                 break;
 780             default:
 781                 break;
 782         }
 783
 784         /*
 785          * different native types are very different, except a PMC
 786          * which matches any PMC
 787          */
 788         if (type_call <= 0 && type_sig == enum_type_PMC) {
 789             dist++;
 790             continue;
 791         }
 792
 793         if ((type_sig <= 0 && type_sig != enum_type_PMC) || type_call <= 0) {
 794             dist = MMD_BIG_DISTANCE;
 795             break;
 796         }
 797
 798         /*
 799          * now consider MRO of types the signature type has to be somewhere
 800          * in the MRO of the type_call
 801          */
 802         mro = interp->vtables[type_call]->mro;
 803         m   = VTABLE_elements(interp, mro);
 804
 805         for (j = 0; j < m; ++j) {
 806             PMC * const cl = VTABLE_get_pmc_keyed_int(interp, mro, j);
 807
 808             if (cl->vtable->base_type == type_sig)
 809                 break;
 810             if (VTABLE_type(interp, cl) == type_sig)
 811                 break;
 812
 813             ++dist;
 814         }
 815
 816         /*
 817          * if the type wasn't in MRO check, if any PMC matches
 818          * in that case use the distance + 1 (of an any PMC parent)
 819          */
 820         if (j == m && type_sig != enum_type_PMC) {
 821             dist = MMD_BIG_DISTANCE;
 822             break;
 823         }
 824
 825         ++dist;
 826
 827 #if MMD_DEBUG
 828         {
 829             STRING *s1, *s2;
 830             if (type_sig < 0)
 831                 s1 = Parrot_get_datatype_name(interp, type_sig);
 832             else
 833                 s1 = interp->vtables[type_sig]->whoami;
 834
 835             if (type_call < 0)
 836                 s2 = Parrot_get_datatype_name(interp, type_call);
 837             else
 838                 s2 = interp->vtables[type_call]->whoami;
 839
 840             Parrot_io_eprintf(interp, "arg %d: dist %d sig %Ss arg %Ss\n",
 841                 i, dist, s1, s2);
 842         }
 843 #endif
 844     }
 845
 846     return dist;
 847 }
 848
 849
 850 /*
 851
 852 =item C<static PMC * Parrot_mmd_sort_candidates(PARROT_INTERP, PMC *arg_tuple,
 853 PMC *cl)>
 854
 855 Sort the candidate list C<cl> by Manhattan Distance, returning the best
 856 candidate.
 857
 858 =cut
 859
 860 */
 861
 862 PARROT_CANNOT_RETURN_NULL
 863 static PMC *
 864 Parrot_mmd_sort_candidates(PARROT_INTERP, ARGIN(PMC *arg_tuple), ARGIN(PMC *cl))
 865 {
 866     ASSERT_ARGS(Parrot_mmd_sort_candidates)
 867     PMC         *best_candidate = PMCNULL;
 868     INTVAL       best_distance  = MMD_BIG_DISTANCE;
 869     const INTVAL n              = VTABLE_elements(interp, cl);
 870     INTVAL       i;
 871
 872     for (i = 0; i < n; ++i) {
 873         PMC * const  pmc = VTABLE_get_pmc_keyed_int(interp, cl, i);
 874         const INTVAL d   = mmd_distance(interp, pmc, arg_tuple);
 875         if (d < best_distance) {
 876             best_candidate = pmc;
 877             best_distance  = d;
 878         }
 879     }
 880
 881     return best_candidate;
 882 }
 883
 884
 885 /*
 886
 887 =item C<static PMC* Parrot_mmd_search_scopes(PARROT_INTERP, STRING *meth)>
 888
 889 Search all scopes for MMD candidates matching the arguments given in
 890 C<arg_tuple>.
 891
 892 =cut
 893
 894 */
 895
 896 PARROT_CANNOT_RETURN_NULL
 897 PARROT_WARN_UNUSED_RESULT
 898 static PMC*
 899 Parrot_mmd_search_scopes(PARROT_INTERP, ARGIN(STRING *meth))
 900 {
 901     ASSERT_ARGS(Parrot_mmd_search_scopes)
 902     PMC * const candidates = pmc_new(interp, enum_class_ResizablePMCArray);
 903     const int stop         = mmd_search_local(interp, meth, candidates);
 904
 905     if (!stop)
 906         mmd_search_global(interp, meth, candidates);
 907
 908     return candidates;
 909 }
 910
 911
 912 /*
 913
 914 =item C<static int Parrot_mmd_maybe_candidate(PARROT_INTERP, PMC *pmc, PMC *cl)>
 915
 916 If the candidate C<pmc> is a Sub PMC, push it on the candidate list and
 917 return TRUE to stop further search.
 918
 919 If the candidate is a MultiSub remember all matching Subs and return FALSE
 920 to continue searching outer scopes.
 921
 922 =cut
 923
 924 */
 925
 926 static int
 927 Parrot_mmd_maybe_candidate(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *cl))
 928 {
 929     ASSERT_ARGS(Parrot_mmd_maybe_candidate)
 930     STRING * const _sub       = CONST_STRING(interp, "Sub");
 931     STRING * const _multi_sub = CONST_STRING(interp, "MultiSub");
 932
 933     INTVAL i, n;
 934
 935     if (VTABLE_isa(interp, pmc, _sub)) {
 936         /* a plain sub stops outer searches */
 937         /* RT #45959 check arity of sub */
 938
 939         VTABLE_push_pmc(interp, cl, pmc);
 940         return 1;
 941     }
 942
 943     /* not a Sub or MultiSub - ignore */
 944     if (!VTABLE_isa(interp, pmc, _multi_sub))
 945         return 0;
 946
 947     /* ok we have a multi sub pmc, which is an array of candidates */
 948     n = VTABLE_elements(interp, pmc);
 949
 950     for (i = 0; i < n; ++i) {
 951         PMC * const multi_sub = VTABLE_get_pmc_keyed_int(interp, pmc, i);
 952         VTABLE_push_pmc(interp, cl, multi_sub);
 953     }
 954
 955     return 0;
 956 }
 957
 958
 959 /*
 960
 961 =item C<static int mmd_search_local(PARROT_INTERP, STRING *name, PMC
 962 *candidates)>
 963
 964 Search the current package namespace for matching candidates. Return
 965 TRUE if the MMD search should stop.
 966
 967 =cut
 968
 969 */
 970
 971 static int
 972 mmd_search_local(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *candidates))
 973 {
 974     ASSERT_ARGS(mmd_search_local)
 975     PMC * const multi_sub = Parrot_find_global_cur(interp, name);
 976
 977     return multi_sub && Parrot_mmd_maybe_candidate(interp, multi_sub, candidates);
 978 }
 979
 980
 981 /*
 982
 983 =item C<static void mmd_search_by_sig_obj(PARROT_INTERP, STRING *name, PMC
 984 *sig_obj, PMC *candidates)>
 985
 986 Search the namespace of the first argument to the sub call for matching
 987 candidates.
 988
 989 =cut
 990
 991 */
 992
 993 static void
 994 mmd_search_by_sig_obj(PARROT_INTERP, ARGIN(STRING *name),
 995         ARGIN(PMC *sig_obj), ARGIN(PMC *candidates))
 996 {
 997     ASSERT_ARGS(mmd_search_by_sig_obj)
 998     PMC *first_arg = VTABLE_get_pmc_keyed_int(interp, sig_obj, 0);
 999     PMC *ns, *multi_sub;
1000
1001     if (PMC_IS_NULL(first_arg))
1002         return;
1003
1004     ns = VTABLE_get_namespace(interp, first_arg);
1005
1006     if (PMC_IS_NULL(ns))
1007         return;
1008
1009     multi_sub = Parrot_get_global(interp, ns, name);
1010
1011     if (PMC_IS_NULL(multi_sub))
1012         return;
1013
1014     Parrot_mmd_maybe_candidate(interp, multi_sub, candidates);
1015 }
1016
1017
1018 /*
1019
1020 =item C<static void mmd_search_global(PARROT_INTERP, STRING *name, PMC *cl)>
1021
1022 Search the builtin namespace for matching candidates.
1023
1024 =cut
1025
1026 */
1027
1028 static void
1029 mmd_search_global(PARROT_INTERP, ARGIN(STRING *name), ARGIN(PMC *cl))
1030 {
1031     ASSERT_ARGS(mmd_search_global)
1032     STRING * const multi_str = CONST_STRING(interp, "MULTI");
1033     PMC    * const ns        = Parrot_get_namespace_keyed_str(interp,
1034                                     interp->root_namespace, multi_str);
1035     PMC           *multi_sub = Parrot_get_global(interp, ns, name);
1036
1037     if (PMC_IS_NULL(multi_sub))
1038         return;
1039
1040     Parrot_mmd_maybe_candidate(interp, multi_sub, cl);
1041 }
1042
1043
1044 /*
1045
1046 =item C<static void mmd_add_multi_global(PARROT_INTERP, STRING *sub_name, PMC
1047 *sub_obj)>
1048
1049 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
1050 stored in the global MULTI namespace.
1051
1052 =cut
1053
1054 */
1055
1056 static void
1057 mmd_add_multi_global(PARROT_INTERP, ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
1058 {
1059     ASSERT_ARGS(mmd_add_multi_global)
1060     STRING * const multi_str = CONST_STRING(interp, "MULTI");
1061     PMC    * const ns        = Parrot_make_namespace_keyed_str(interp,
1062                                     interp->root_namespace, multi_str);
1063     PMC           *multi_sub = Parrot_get_global(interp, ns, sub_name);
1064
1065     if (PMC_IS_NULL(multi_sub)) {
1066         multi_sub = constant_pmc_new(interp, enum_class_MultiSub);
1067         Parrot_set_global(interp, ns, sub_name, multi_sub);
1068     }
1069
1070     PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
1071     VTABLE_push_pmc(interp, multi_sub, sub_obj);
1072 }
1073
1074
1075 /*
1076
1077 =item C<static void mmd_add_multi_to_namespace(PARROT_INTERP, STRING *ns_name,
1078 STRING *sub_name, PMC *sub_obj)>
1079
1080 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
1081 added as a method to a class.
1082
1083 =cut
1084
1085 */
1086
1087 static void
1088 mmd_add_multi_to_namespace(PARROT_INTERP, ARGIN(STRING *ns_name),
1089             ARGIN(STRING *sub_name), ARGIN(PMC *sub_obj))
1090 {
1091     ASSERT_ARGS(mmd_add_multi_to_namespace)
1092     PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
1093                         interp->HLL_namespace,
1094                         Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
1095     PMC * const ns     = Parrot_make_namespace_keyed_str(interp, hll_ns, ns_name);
1096     PMC        *multi_sub = Parrot_get_global(interp, ns, sub_name);
1097
1098     if (PMC_IS_NULL(multi_sub)) {
1099         multi_sub = constant_pmc_new(interp, enum_class_MultiSub);
1100         Parrot_set_global(interp, ns, sub_name, multi_sub);
1101     }
1102
1103     PARROT_ASSERT(multi_sub->vtable->base_type == enum_class_MultiSub);
1104     VTABLE_push_pmc(interp, multi_sub, sub_obj);
1105 }
1106
1107
1108 /*
1109
1110 =item C<void Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP, STRING *sub_name,
1111 STRING *long_sig, PMC *sub_obj)>
1112
1113 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
1114 stored in the global MULTI namespace.
1115
1116 =cut
1117
1118 */
1119
1120 PARROT_EXPORT
1121 void
1122 Parrot_mmd_add_multi_from_long_sig(PARROT_INTERP,
1123         ARGIN(STRING *sub_name), ARGIN(STRING *long_sig), ARGIN(PMC *sub_obj))
1124 {
1125     ASSERT_ARGS(Parrot_mmd_add_multi_from_long_sig)
1126     Parrot_Sub_attributes *sub;
1127     STRING     *sub_str     = CONST_STRING(interp, "Sub");
1128     STRING     *closure_str = CONST_STRING(interp, "Closure");
1129     PMC        *type_list   = Parrot_str_split(interp, CONST_STRING(interp, ","), long_sig);
1130     STRING     *ns_name     = VTABLE_get_string_keyed_int(interp, type_list, 0);
1131
1132     /* Attach a type tuple array to the sub for multi dispatch */
1133     PMC    *multi_sig = mmd_build_type_tuple_from_type_list(interp, type_list);
1134
1135     if (sub_obj->vtable->base_type == enum_class_NCI) {
1136         SETATTR_NCI_multi_sig(interp, sub_obj, multi_sig);
1137     }
1138     else if (VTABLE_isa(interp, sub_obj, sub_str)
1139          ||  VTABLE_isa(interp, sub_obj, closure_str)) {
1140         PMC_get_sub(interp, sub_obj, sub);
1141         sub->multi_signature = multi_sig;
1142     }
1143
1144     mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
1145     mmd_add_multi_global(interp, sub_name, sub_obj);
1146 }
1147
1148
1149 /*
1150
1151 =item C<void Parrot_mmd_add_multi_from_c_args(PARROT_INTERP, const char
1152 *sub_name, const char *short_sig, const char *long_sig, funcptr_t
1153 multi_func_ptr)>
1154
1155 Create a MultiSub, or add a variant to an existing MultiSub. The MultiSub is
1156 stored in the specified namespace.
1157
1158 =cut
1159
1160 */
1161
1162 PARROT_EXPORT
1163 void
1164 Parrot_mmd_add_multi_from_c_args(PARROT_INTERP,
1165         ARGIN(const char *sub_name), ARGIN(const char *short_sig),
1166         ARGIN(const char *long_sig), ARGIN(funcptr_t multi_func_ptr))
1167 {
1168     ASSERT_ARGS(Parrot_mmd_add_multi_from_c_args)
1169     STRING *comma         = CONST_STRING(interp, ",");
1170     STRING *sub_name_str  = Parrot_str_new_constant(interp, sub_name);
1171     STRING *long_sig_str  = Parrot_str_new_constant(interp, long_sig);
1172     STRING *short_sig_str = Parrot_str_new_constant(interp, short_sig);
1173     PMC    *type_list     = Parrot_str_split(interp, comma, long_sig_str);
1174     STRING *ns_name       = VTABLE_get_string_keyed_int(interp, type_list, 0);
1175
1176     /* Create an NCI sub for the C function */
1177     PMC    *sub_obj       = constant_pmc_new(interp, enum_class_NCI);
1178     PMC    *multi_sig     = mmd_build_type_tuple_from_long_sig(interp,
1179                                 long_sig_str);
1180
1181     VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig_str,
1182                                     F2DPTR(multi_func_ptr));
1183
1184     /* Attach a type tuple array to the NCI sub for multi dispatch */
1185     SETATTR_NCI_multi_sig(interp, sub_obj, multi_sig);
1186
1187     mmd_add_multi_to_namespace(interp, ns_name, sub_name_str, sub_obj);
1188     mmd_add_multi_global(interp, sub_name_str, sub_obj);
1189 }
1190
1191 /*
1192
1193 =item C<void Parrot_mmd_add_multi_list_from_c_args(PARROT_INTERP, const
1194 multi_func_list *mmd_info, INTVAL elements)>
1195
1196 Create a collection of multiple dispatch subs from a C structure of
1197 information. Iterate through the list of details passed in. For each entry
1198 create a MultiSub or add a variant to an existing MultiSub. MultiSubs are
1199 created in the global 'MULTI' namespace in the Parrot HLL.
1200
1201 Typically used to create all the multiple dispatch routines
1202 declared in a PMC from the PMC's class initialization function.
1203
1204 =cut
1205
1206 */
1207
1208 PARROT_EXPORT
1209 void
1210 Parrot_mmd_add_multi_list_from_c_args(PARROT_INTERP,
1211         ARGIN(const multi_func_list *mmd_info), INTVAL elements)
1212 {
1213     ASSERT_ARGS(Parrot_mmd_add_multi_list_from_c_args)
1214     INTVAL i;
1215     for (i = 0; i < elements; ++i) {
1216         funcptr_t func_ptr  = mmd_info[i].func_ptr;
1217
1218         STRING   *sub_name  = mmd_info[i].multi_name;
1219         STRING   *long_sig  = mmd_info[i].full_sig;
1220         STRING   *short_sig = mmd_info[i].short_sig;
1221         STRING   *ns_name   = mmd_info[i].ns_name;
1222
1223         /* Create an NCI sub for the C function */
1224         PMC    *sub_obj       = constant_pmc_new(interp, enum_class_NCI);
1225
1226         VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig,
1227                                      F2DPTR(func_ptr));
1228
1229         /* Attach a type tuple array to the NCI sub for multi dispatch */
1230         SETATTR_NCI_long_signature(interp, sub_obj, long_sig);
1231
1232         mmd_add_multi_to_namespace(interp, ns_name, sub_name, sub_obj);
1233         mmd_add_multi_global(interp, sub_name, sub_obj);
1234     }
1235 }
1236
1237
1238 /*
1239
1240 =item C<MMD_Cache * Parrot_mmd_cache_create(PARROT_INTERP)>
1241
1242 Creates and returns a new MMD cache.
1243
1244 =cut
1245
1246 */
1247
1248 PARROT_EXPORT
1249 PARROT_CANNOT_RETURN_NULL
1250 MMD_Cache *
1251 Parrot_mmd_cache_create(PARROT_INTERP)
1252 {
1253     ASSERT_ARGS(Parrot_mmd_cache_create)
1254     /* String hash. */
1255     Hash *cache = parrot_new_hash(interp);
1256     return cache;
1257 }
1258
1259
1260 /*
1261
1262 =item C<static STRING * mmd_cache_key_from_values(PARROT_INTERP, const char
1263 *name, PMC *values)>
1264
1265 Generates an MMD cache key from an array of values.
1266
1267 =cut
1268
1269 */
1270
1271 PARROT_WARN_UNUSED_RESULT
1272 PARROT_CAN_RETURN_NULL
1273 static STRING *
1274 mmd_cache_key_from_values(PARROT_INTERP, ARGIN(const char *name),
1275     ARGIN(PMC *values))
1276 {
1277     ASSERT_ARGS(mmd_cache_key_from_values)
1278     /* Build array of type IDs, which we'll then use as a string to key into
1279      * the hash. */
1280     const INTVAL num_values = VTABLE_elements(interp, values);
1281     const INTVAL name_len   = name ? strlen(name) + 1: 0;
1282     const size_t id_size    = num_values * sizeof (INTVAL) + name_len;
1283     INTVAL *type_ids        = (INTVAL *)mem_sys_allocate(id_size);
1284     STRING *key;
1285     INTVAL  i;
1286
1287     for (i = 0; i < num_values; i++) {
1288         const INTVAL id = VTABLE_type(interp, VTABLE_get_pmc_keyed_int(interp, values, i));
1289         if (id == 0) {
1290             mem_sys_free(type_ids);
1291             return NULL;
1292         }
1293
1294         type_ids[i] = id;
1295     }
1296
1297     if (name)
1298         strcpy((char *)(type_ids + num_values), name);
1299
1300     key = Parrot_str_new(interp, (char *)type_ids, id_size);
1301     mem_sys_free(type_ids);
1302
1303     return key;
1304 }
1305
1306
1307 /*
1308
1309 =item C<PMC * Parrot_mmd_cache_lookup_by_values(PARROT_INTERP, MMD_Cache *cache,
1310 const char *name, PMC *values)>
1311
1312 Takes an array of values for the call and does a lookup in the MMD cache.
1313
1314 =cut
1315
1316 */
1317
1318 PARROT_EXPORT
1319 PARROT_WARN_UNUSED_RESULT
1320 PARROT_CAN_RETURN_NULL
1321 PMC *
1322 Parrot_mmd_cache_lookup_by_values(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1323     ARGIN(const char *name), ARGIN(PMC *values))
1324 {
1325     ASSERT_ARGS(Parrot_mmd_cache_lookup_by_values)
1326     STRING * const key = mmd_cache_key_from_values(interp, name, values);
1327
1328     if (key)
1329         return (PMC *)parrot_hash_get(interp, cache, key);
1330
1331     return PMCNULL;
1332 }
1333
1334
1335 /*
1336
1337 =item C<void Parrot_mmd_cache_store_by_values(PARROT_INTERP, MMD_Cache *cache,
1338 const char *name, PMC *values, PMC *chosen)>
1339
1340 Takes an array of values for the call along with a chosen candidate and puts
1341 it into the cache.
1342
1343 =cut
1344
1345 */
1346
1347 PARROT_EXPORT
1348 void
1349 Parrot_mmd_cache_store_by_values(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1350     ARGIN(const char *name), ARGIN(PMC *values), ARGIN(PMC *chosen))
1351 {
1352     ASSERT_ARGS(Parrot_mmd_cache_store_by_values)
1353     STRING * const key = mmd_cache_key_from_values(interp, name, values);
1354
1355     if (key)
1356         parrot_hash_put(interp, cache, key, chosen);
1357 }
1358
1359
1360 /*
1361
1362 =item C<static STRING * mmd_cache_key_from_types(PARROT_INTERP, const char
1363 *name, PMC *types)>
1364
1365 Generates an MMD cache key from an array of types.
1366
1367 =cut
1368
1369 */
1370
1371 PARROT_WARN_UNUSED_RESULT
1372 PARROT_CAN_RETURN_NULL
1373 static STRING *
1374 mmd_cache_key_from_types(PARROT_INTERP, ARGIN(const char *name),
1375     ARGIN(PMC *types))
1376 {
1377     ASSERT_ARGS(mmd_cache_key_from_types)
1378     /* Build array of type IDs, which we'll then use as a string to key into
1379      * the hash. */
1380     const INTVAL num_types  = VTABLE_elements(interp, types);
1381     const INTVAL name_len   = name ? strlen(name) + 1: 0;
1382     const size_t id_size    = num_types * sizeof (INTVAL) + name_len;
1383     INTVAL * const type_ids = (INTVAL *)mem_sys_allocate(id_size);
1384
1385     STRING *key;
1386     INTVAL  i;
1387
1388     for (i = 0; i < num_types; i++) {
1389         const INTVAL id = VTABLE_get_integer_keyed_int(interp, types, i);
1390
1391         if (id == 0) {
1392             mem_sys_free(type_ids);
1393             return NULL;
1394         }
1395
1396         type_ids[i] = id;
1397     }
1398
1399     if (name)
1400         strcpy((char *)(type_ids + num_types), name);
1401
1402     key = Parrot_str_new(interp, (char *)type_ids, id_size);
1403
1404     mem_sys_free(type_ids);
1405     return key;
1406 }
1407
1408
1409 /*
1410
1411 =item C<PMC * Parrot_mmd_cache_lookup_by_types(PARROT_INTERP, MMD_Cache *cache,
1412 const char *name, PMC *types)>
1413
1414 Takes an array of types for the call and does a lookup in the MMD cache.
1415
1416 =cut
1417
1418 */
1419
1420 PARROT_EXPORT
1421 PARROT_WARN_UNUSED_RESULT
1422 PARROT_CAN_RETURN_NULL
1423 PMC *
1424 Parrot_mmd_cache_lookup_by_types(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1425     ARGIN(const char *name), ARGIN(PMC *types))
1426 {
1427     ASSERT_ARGS(Parrot_mmd_cache_lookup_by_types)
1428     const STRING * const key = mmd_cache_key_from_types(interp, name, types);
1429
1430     if (key)
1431         return (PMC *)parrot_hash_get(interp, cache, key);
1432
1433     return PMCNULL;
1434 }
1435
1436
1437 /*
1438
1439 =item C<void Parrot_mmd_cache_store_by_types(PARROT_INTERP, MMD_Cache *cache,
1440 const char *name, PMC *types, PMC *chosen)>
1441
1442 Takes an array of types for the call along with a chosen candidate and puts
1443 it into the cache. The name parameter is optional, and if the cache is already
1444 tied to an individual multi can be null.
1445
1446 =cut
1447
1448 */
1449
1450 PARROT_EXPORT
1451 void
1452 Parrot_mmd_cache_store_by_types(PARROT_INTERP, ARGMOD(MMD_Cache *cache),
1453     ARGIN(const char *name), ARGIN(PMC *types), ARGIN(PMC *chosen))
1454 {
1455     ASSERT_ARGS(Parrot_mmd_cache_store_by_types)
1456     STRING * const key = mmd_cache_key_from_types(interp, name, types);
1457
1458     if (key)
1459         parrot_hash_put(interp, cache, key, chosen);
1460 }
1461
1462
1463 /*
1464
1465 =item C<void Parrot_mmd_cache_mark(PARROT_INTERP, MMD_Cache *cache)>
1466
1467 GC-marks an MMD cache.
1468
1469 =cut
1470
1471 */
1472
1473 PARROT_EXPORT
1474 void
1475 Parrot_mmd_cache_mark(PARROT_INTERP, ARGMOD(MMD_Cache *cache))
1476 {
1477     ASSERT_ARGS(Parrot_mmd_cache_mark)
1478     /* As a small future optimization, note that we only *really* need to mark
1479     * keys - the candidates will be referenced outside the cache, provided it's
1480     * invalidated properly. */
1481     parrot_mark_hash(interp, cache);
1482 }
1483
1484
1485 /*
1486
1487 =item C<void Parrot_mmd_cache_destroy(PARROT_INTERP, MMD_Cache *cache)>
1488
1489 Destroys an MMD cache.
1490
1491 =cut
1492
1493 */
1494
1495 PARROT_EXPORT
1496 void
1497 Parrot_mmd_cache_destroy(PARROT_INTERP, ARGMOD(MMD_Cache *cache))
1498 {
1499     ASSERT_ARGS(Parrot_mmd_cache_destroy)
1500     parrot_hash_destroy(interp, cache);
1501 }
1502
1503
1504 /*
1505
1506 =back
1507
1508 =head1 SEE ALSO
1509
1510 F<include/parrot/multidispatch.h>,
1511 F<http://svn.perl.org/perl6/doc/trunk/design/apo/A12.pod>,
1512 F<http://svn.perl.org/perl6/doc/trunk/design/syn/S12.pod>
1513
1514 =cut
1515
1516 */
1517
1518
1519 /*
1520  * Local variables:
1521  *   c-file-style: "parrot"
1522  * End:
1523  * vim: expandtab shiftwidth=4:
1524  */