src/pmc/multisub.pmc

   1 /*
   2 Copyright (C) 2001-2007, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/multisub.pmc - A container for multi-dispatched subs
   8
   9 =head1 DESCRIPTION
  10
  11 This class inherits from ResizablePMCArray and provides an Array of
  12 Sub PMCs with the same short name, but different long names.
  13
  14 =head2 Functions
  15
  16 =over 4
  17
  18 =cut
  19
  20 */
  21
  22 #include "parrot/parrot.h"
  23
  24
  25 pmclass MultiSub extends ResizablePMCArray need_ext provides array {
  26
  27     void push_pmc(PMC *value) {
  28         STRING * const _sub = CONST_STRING(interp, "Sub");
  29         STRING * const _nci = CONST_STRING(interp, "NCI");
  30         if (!VTABLE_isa(interp, value, _sub) &&
  31             !VTABLE_isa(interp, value, _nci))
  32             real_exception(interp, NULL, E_TypeError,
  33                     "attempt to push non Sub PMC");
  34         SUPER(value);
  35     }
  36
  37     VTABLE void set_pmc_keyed_int(INTVAL key, PMC *value) {
  38         STRING *_sub = CONST_STRING(interp, "Sub");
  39         if (!VTABLE_isa(interp, value, _sub))
  40             real_exception(interp, NULL, E_TypeError,
  41                     "attempt to set non Sub PMC");
  42         SUPER(key, value);
  43     }
  44
  45     VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) {
  46         real_exception(interp, NULL, E_TypeError,
  47                 "attempt to set non Sub PMC");
  48     }
  49
  50     VTABLE void set_string_keyed_int(INTVAL key, STRING *value) {
  51         real_exception(interp, NULL, E_TypeError,
  52                 "attempt to set non Sub PMC");
  53     }
  54
  55     VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) {
  56         real_exception(interp, NULL, E_TypeError,
  57                 "attempt to set non Sub PMC");
  58     }
  59
  60     VTABLE opcode_t *invoke(void *next) {
  61         PMC * const list = Parrot_mmd_sort_candidate_list(interp, SELF);
  62         PMC *func;
  63
  64         if (PMC_IS_NULL(list))
  65             real_exception(INTERP, NULL, 1, "No applicable methods.\n");
  66
  67         func = VTABLE_get_pmc_keyed_int(interp, list, 0);
  68         return VTABLE_invoke(INTERP, func, next);
  69     }
  70 }
  71
  72 /*
  73
  74 =back
  75
  76 =head1 SEE ALSO
  77
  78 F<src/mmd.c>,
  79 F<$perl6/doc/trunk/design/apo/A12.pod>,
  80 F<$perl6/doc/trunk/design/syn/S12.pod>
  81
  82 =head1 HISTORY
  83
  84 Initial version                  - leo 14.03.2005
  85
  86 =cut
  87
  88 */
  89
  90 /*
  91  * Local variables:
  92  *   c-file-style: "parrot"
  93  * End:
  94  * vim: expandtab shiftwidth=4:
  95  */