key.pmc

/*
Copyright (C) 2001-2014, Parrot Foundation.

=head1 NAME

src/pmc/key.pmc - Key PMC

=head1 DESCRIPTION

These are the vtable functions for the Key PMC class.

=head2 Methods

=over 4

=cut

*/

/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* HEADERIZER END: static */

pmclass Key auto_attrs {
    ATTR PMC      *next_key; /* Sometimes it's the next key, sometimes it's
                                not.  The Key code is like that. */
    ATTR INTVAL    int_key;  /* int value of this key, or something magical if
                                it's a hash iterator key */
    ATTR STRING   *str_key;  /* STRING value of this key, if any */
                             /* Theoretically there'd also be a pmc_key here,
                              * but that code looks broken and unneeded. */


/*

=item C<void init()>

Initializes the key.

=cut

*/

    VTABLE void init() {
        PObj_custom_mark_SET(SELF);
    }

/*

=item C<PMC *clone()>

Creates and returns a clone of the key.

=cut

*/

    VTABLE PMC *clone() :no_wb {
        PMC * const dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
        PMC *dkey        = dest;
        PMC *key         = SELF;

        for (; key ;) {
            switch (KEY_get_FLAGS(key)) {
              case KEY_integer_FLAG:
              case KEY_integer_FLAG | KEY_register_FLAG:
                Parrot_key_set_integer(INTERP, dkey, Parrot_key_integer(INTERP, key));
                break;
              case KEY_string_FLAG:
              case KEY_string_FLAG | KEY_register_FLAG:
                Parrot_key_set_string(INTERP, dkey, VTABLE_get_string(INTERP, key));
                break;
              case KEY_pmc_FLAG:
              case KEY_pmc_FLAG | KEY_register_FLAG:
                Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
                        "Key.clone of pmc is broken - see TT #1683");
              default:
                Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
                                            "Key: Unknown Key type %d", KEY_get_FLAGS(SELF));
                break;
            }

            key = Parrot_key_next(INTERP, key);

            if (key) {
                PMC * const p = Parrot_key_new(INTERP);
                Parrot_key_append(INTERP, dkey, p);
                dkey = p;
            }
        }

        return dest;
    }

/*

=item C<void mark()>

Marks the key as live.

=cut

*/

    VTABLE void mark() :no_wb {
        Parrot_key_mark(INTERP, SELF);
    }

/*

=item C<INTVAL get_integer()>

Returns the integer value of the key.

=cut

*/

    VTABLE INTVAL get_integer() :no_wb {
        return Parrot_key_integer(INTERP, SELF);
    }

/*

=item C<STRING *get_string()>

Returns the Parrot string value of the key.

=cut

*/

    VTABLE STRING *get_string() :no_wb {
        /* Parrot_key_string() is only useful if this PMC has a key type */
        if (KEY_get_FLAGS(SELF)) {
            return Parrot_key_string(INTERP, SELF);
        }

        return CONST_STRING(INTERP, "");
    }

/*

=item C<PMC *get_pmc()>

Returns the PMC value of the key.

=cut

*/

    VTABLE PMC *get_pmc() :no_wb {
        return Parrot_key_pmc(INTERP, SELF);
    }

/*

=item C<void set_integer_native(INTVAL value)>

=cut

*/

    VTABLE void set_integer_native(INTVAL value) {
        Parrot_key_set_integer(INTERP, SELF, value);
    }

/*

=item C<void set_string_native(STRING *value)>


=cut

*/

    VTABLE void set_string_native(STRING *value) {
        Parrot_key_set_string(INTERP, SELF, value);
    }

/*

=item C<void set_pmc(PMC *value)>

Sets the value of the key to C<*value>.

=cut

*/

    VTABLE void set_pmc(PMC *value) :no_wb {
        UNUSED(SELF)
        UNUSED(value)
        Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_UNIMPLEMENTED,
                "Key.set_pmc is broken - see GH #499");
    }

/*

=item C<void push_pmc(PMC *value)>

Appends C<*value> to the key.

=cut

*/

    void push_pmc(PMC *value) {
        if (value->vtable->base_type != enum_class_Key)
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_INVALID_OPERATION,
                "Can only push another Key onto a Key PMC.");

        Parrot_key_append(INTERP, SELF, value);
    }

/*

=item C<PMC *shift_pmc()>

Returns the next key.

Actually doesn't remove the entry but might be useful to traverse a key
chain.

=cut

*/

    VTABLE PMC *shift_pmc() :no_wb {
        PMC *next_key;

        GET_ATTR_next_key(INTERP, SELF, next_key);

        return next_key;
    }

/*

=back

=head2 Iterator Interface

=over 4

=item C<PMC *get_pmc_keyed(PMC *key)>

Returns the key itself.

=cut

*/

    VTABLE PMC *get_pmc_keyed(PMC *key) :no_wb {
        UNUSED(INTERP)
        UNUSED(SELF)
        return key;
    }

/*

=item C<void freeze(PMC *info)>

Archives the Key.

=item C<void thaw(PMC *info)>

Unarchives the Key.

=item C<void thawfinish(PMC *info)>

Called after the Key has been thawed: convert last PMC_NULL key to NULL.

=cut

*/

    void freeze(PMC *info) :no_wb {
        int size;
        PMC *k;

        for (size = 0, k = SELF; k; size++)
            GET_ATTR_next_key(interp, k, k);

        VTABLE_push_integer(INTERP, info, size);

        for (k = SELF; k;) {
            const INTVAL flags = KEY_get_FLAGS(k);
            VTABLE_push_integer(INTERP, info, flags);

            switch (flags) {
              case KEY_integer_FLAG | KEY_register_FLAG:
              case KEY_string_FLAG  | KEY_register_FLAG:
              case KEY_pmc_FLAG     | KEY_register_FLAG:
              case KEY_integer_FLAG:
                {
                    INTVAL i;
                    GET_ATTR_int_key(INTERP, k, i);
                    VTABLE_push_integer(INTERP, info, i);
                }
                break;

              case KEY_string_FLAG:
                {
                    STRING *s;
                    GET_ATTR_str_key(INTERP, k, s);
                    VTABLE_push_string(INTERP, info, s);
                }
                break;

              default:
                Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_KEY_NOT_FOUND,
                        "Unsupported key type in Key.freeze");
                break;
            }

            GET_ATTR_next_key(interp, k, k);
        }
    }

    void thaw(PMC *info) {
        int  size;
        PMC *k = SELF;

        PObj_custom_mark_SET(SELF);

        for (size = VTABLE_shift_integer(INTERP, info); size; size--) {
            const INTVAL flags  = VTABLE_shift_integer(INTERP, info) & KEY_type_FLAGS;

            PObj_get_FLAGS(k) |= flags;

            /* get contents */
            switch (flags) {
              case KEY_integer_FLAG | KEY_register_FLAG:
              case KEY_string_FLAG  | KEY_register_FLAG:
              case KEY_pmc_FLAG     | KEY_register_FLAG:
              case KEY_integer_FLAG:
                SET_ATTR_int_key(INTERP, k, VTABLE_shift_integer(INTERP, info));
                break;

              case KEY_string_FLAG:
                VTABLE_set_string_native(INTERP, k, VTABLE_shift_string(INTERP, info));
                break;

              default:
                Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_KEY_NOT_FOUND,
                        "Unsupported key type in Key.thaw");
                break;
            }

            if (size == 1) {
                SET_ATTR_next_key(INTERP, k, NULL);
            }
            else {
                SET_ATTR_next_key(INTERP, k, Parrot_pmc_new(INTERP, enum_class_Key));
                GET_ATTR_next_key(INTERP, k, k);
            }
        }
    }

    VTABLE void thawfinish(PMC *info) {
        UNUSED(info)
        PMC *key = SELF;

        while (1) {
            PMC *next;
            GET_ATTR_next_key(INTERP, key, next);

            if (PMC_IS_NULL(next)) {
                SET_ATTR_next_key(INTERP, key, NULL);
                break;
            }

            key = next;
        }
    }

    VTABLE STRING* get_repr() :no_wb {
        return Parrot_key_set_to_string(INTERP, SELF);
    }

/*

=item C<set_register(reg_no, type)>

Set key to hold particular register.

=cut

*/
    METHOD set_register(INTVAL reg_no, INTVAL reg_type) {
        Parrot_key_set_register(INTERP, SELF, reg_no, reg_type);
    }

/*

=item C<INTVAL elements()>

=item C<INTVAL get_integer_keyed_int(INTVAL n)>

=item C<STRING *get_string_keyed_int(INTVAL n)>

=item C<PMC *get_pmc_keyed_init(INTVAL n)>

Aggregate interface.

=cut

*/

    VTABLE INTVAL elements() :no_wb {
        INTVAL n = 0;
        UNUSED(INTERP)
        for (; SELF; SELF = PARROT_KEY(SELF)->next_key)
            n++;
        return n;
    }

    VTABLE INTVAL get_integer_keyed_int(INTVAL n) :no_wb {
        for (; SELF && n; SELF = PARROT_KEY(SELF)->next_key, n--);
        if (n)
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
                    "Key access out of bounds");
        return Parrot_key_integer(INTERP, SELF);
    }

    VTABLE STRING *get_string_keyed_int(INTVAL n) :no_wb {
        for (; SELF && n; SELF = PARROT_KEY(SELF)->next_key, n--);
        if (n)
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
                    "Key access out of bounds");
        return Parrot_key_string(INTERP, SELF);
    }

    VTABLE PMC *get_pmc_keyed_int(INTVAL n) :no_wb {
        for (; SELF && n; SELF = PARROT_KEY(SELF)->next_key, n--);
        if (n)
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_OUT_OF_BOUNDS,
                    "Key access out of bounds");
        return Parrot_key_pmc(INTERP, SELF);
    }

    METHOD make_register_key(STRING * set, INTVAL idx) {
        INTVAL first_char = Parrot_str_indexed(INTERP, set, 0);
        KEY_flags key_type;
        switch (first_char) {
            case 'S':
                key_type = KEY_string_FLAG;
                break;
            case 'I':
                key_type = KEY_integer_FLAG;
                break;
            case 'P':
                key_type = KEY_pmc_FLAG;
                break;
            default:
              Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_NULL_REG_ACCESS,
                    "Key: Unknown register set %Ss", set);
        }
        Parrot_key_set_register(INTERP, SELF, idx, (INTVAL)key_type);
    }

    METHOD is_register_reference() :no_wb {
        INTVAL is_reg_ref = KEY_register_TEST(SELF) ? 1 : 0;
        RETURN(INTVAL is_reg_ref);
    }

    METHOD get_register_idx() :no_wb {
        if (!KEY_register_TEST(SELF))
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_KEY_NOT_FOUND,
                "Key: Key is not a register reference");
        else {
            const INTVAL idx = Parrot_key_integer(INTERP, SELF);
            RETURN(INTVAL idx);
        }
    }

    METHOD get_register_contents(PMC *ctx :optional, INTVAL has_ctx :opt_flag) :no_wb {
        INTVAL int_key;
        if (!KEY_register_TEST(SELF))
            Parrot_ex_throw_from_c_noargs(INTERP, EXCEPTION_KEY_NOT_FOUND,
                "Key: Key is not a register reference");

        GETATTR_Key_int_key(interp, SELF, int_key);
        if (!has_ctx || PMC_IS_NULL(ctx)) {
            switch (KEY_get_FLAGS(SELF)) {
                case KEY_string_FLAG | KEY_register_FLAG: {
                    STRING * const str_val =  REG_STR(interp, int_key);
                    RETURN(STRING *str_val);
                }
                case KEY_pmc_FLAG | KEY_register_FLAG: {
                    PMC * const pmc_val = REG_PMC(interp, int_key);
                    RETURN(PMC *pmc_val);
                }
                case KEY_integer_FLAG | KEY_register_FLAG: {
                    const INTVAL int_val = REG_INT(interp, int_key);
                    RETURN(INTVAL int_val);
                }
                default:
                    Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_KEY_NOT_FOUND,
                        "Key: Unknown Key type %d", KEY_get_FLAGS(SELF));
            }
        }
        else {
            switch (KEY_get_FLAGS(SELF)) {
                case KEY_string_FLAG | KEY_register_FLAG: {
                    STRING * const str_val =  *Parrot_pcc_get_STRING_reg(INTERP, ctx, int_key);
                    RETURN(STRING *str_val);
                }
                case KEY_pmc_FLAG | KEY_register_FLAG: {
                    PMC * const pmc_val = *Parrot_pcc_get_PMC_reg(INTERP, ctx, int_key);
                    RETURN(PMC *pmc_val);
                }
                case KEY_integer_FLAG | KEY_register_FLAG: {
                    const INTVAL int_val = *Parrot_pcc_get_INTVAL_reg(INTERP, ctx, int_key);
                    RETURN(INTVAL int_val);
                }
                default:
                    Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_KEY_NOT_FOUND,
                        "Key: Unknown Key type %d", KEY_get_FLAGS(SELF));
            }
        }

    }

    /* returns integer, values taken from PCC */
    METHOD get_type() :no_wb {
        INTVAL ret = 0;
        switch (KEY_get_FLAGS(SELF)) {
#if 0
            case KEY_integer_FLAG:
            case KEY_integer_FLAG | KEY_register_FLAG:
                ret = 0;
                break;
#endif
            case KEY_string_FLAG:
            case KEY_string_FLAG | KEY_register_FLAG:
                ret = 1;
                break;
            case KEY_pmc_FLAG:
            case KEY_pmc_FLAG | KEY_register_FLAG:
                ret = 2;
                break;
            default:
                break;
        }

        RETURN(INTVAL ret);
    }
}

/*

=back

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4 cinoptions='\:2=2' :
 */