/*
Copyright (C) 2004-2007, The Perl Foundation.
$Id: match.pmc 23493 2007-12-05 12:55:03Z paultcochrane $

=head1 NAME

src/dynpmc/match.pmc - Match object for rules

=head1 DESCRIPTION

This is a match object for holding hypothetical variables, the input string,
etc. It is used by the languages/regex rule compiler.

For now, it is really just proof-of-concept code, and I fully expect
anyone who reads this to hurl. Violently.

=head2 Functions

=over 4

=cut

*/

#include <assert.h>
#include "parrot/parrot.h"

extern int MatchRange_type_id;

static STRING* make_hash_key(Interp* interp, PMC * key)
{
    if (key == NULL) {
        real_exception(interp, NULL, OUT_OF_BOUNDS,
        "Cannot use NULL key for Match!");
        return NULL;
    }
    return key_string(interp, key);
}

static STRING* match_range(Interp* interp, PMC* self, PMC* range)
{
    STRING* input_key = const_string(interp, "!INPUT");
    Hash* hash = (Hash*) PMC_struct_val(self);
    HashBucket *b;
    STRING* input;
    int start, end;

    b = parrot_hash_get_bucket(interp, hash, input_key);
    if (!b) {
        real_exception(interp, NULL, 1, "Match: input string not set");
        return NULL;
    }

    input = VTABLE_get_string(interp, (PMC*) b->value);
    /* These could both be converted to grab UVal_int directly, but
     * I'll leave it like this for now because it'll test the vtable
     * members. */
    start = VTABLE_get_integer_keyed_int(interp, range, 0);
    end = VTABLE_get_integer_keyed_int(interp, range, 1);

    if (start == -2 || end == -2 || end < start - 1)
        return NULL;
    else
        return string_substr(interp, input, start, end - start + 1, NULL, 0);
}

static STRING* fetch_string(Interp* interp, PMC* matchobj, PMC* val)
{
    if (val->vtable->base_type == MatchRange_type_id) {
        return match_range(interp, matchobj, val);
    }
    else {
        return VTABLE_get_string(interp, val);
    }
}

static INTVAL fetch_integer(Interp* interp, PMC* matchobj, PMC* val)
{
    if (val->vtable->base_type == MatchRange_type_id) {
        STRING* valstr = match_range(interp, matchobj, val);
        return string_to_int(interp, valstr);
    }
    else {
        return VTABLE_get_integer(interp, val);
    }
}

pmclass Match extends Hash dynpmc group match_group {

/*

=item C<void class_init()>

Class initialization. Caches the type id of the MatchRange PMC,
because it will be used frequently here. Does not bother to call
Hash's class_init(), because everything it does looks like it only
needs to be done once.

=cut

*/

    void class_init() {
        /* class_init_code */
    }

/*

=item C<STRING *get_string_keyed_str(STRING *key)>

=cut

*/

    STRING* get_string_keyed_str(STRING* key) {
        Hash* hash = (Hash*) PMC_struct_val(SELF);
        HashBucket *b = parrot_hash_get_bucket(interp, hash, key);
        if (b == NULL) {
            /* RT#48170 Warning: use of uninitialized value */
            /* return VTABLE_get_string(interp, undef); */
            return NULL;
        }
        return fetch_string(interp, SELF, (PMC*) b->value);
    }

/*

=item C<STRING *get_string_keyed(PMC *key)>

Returns the string value for the element at C<*key>.

=cut

*/

    STRING* get_string_keyed(PMC* key) {
        PMC        *valpmc, *nextkey;
        STRING     *keystr;
        HashBucket *b;
        Hash       *hash = (Hash *)PMC_struct_val(SELF);
        void       *result;

        switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
            case KEY_integer_FLAG:
                /* called from iterator with an integer idx in key */
                /* BUG! This will iterate through the input string as
                 * well as all of the real values. */
                result = parrot_hash_get_idx(interp, hash, key);

                if (hash->key_type == Hash_key_type_int)
                    return string_from_int(interp, (INTVAL)result);

                return (STRING *)result;
            default:
                keystr = make_hash_key(interp, key);
        }

        b = parrot_hash_get_bucket(interp, hash, keystr);

        if (b == NULL)
            return SELF.get_string_keyed_str(keystr);

        nextkey = key_next(interp, key);
        valpmc  = (PMC *)b->value;

        if (!nextkey)
            return fetch_string(interp, SELF, valpmc);
        return VTABLE_get_string_keyed(interp, valpmc, nextkey);
    }

    INTVAL get_integer_keyed(PMC* key) {
        Hash       *hash = (Hash *)PMC_struct_val(SELF);
        STRING     *keystr;
        HashBucket *b;
        PMC        *valpmc, *nextkey;
        void       *result;

        switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
            case KEY_integer_FLAG:
                /* called from iterator with an integer idx in key
                 * check if we really have Hash_key_type_int */
                result = parrot_hash_get_idx(interp, hash, key);

                if (hash->key_type == Hash_key_type_int)
                    return (INTVAL)result;
                else
                    return string_to_int(interp, (STRING *)result);
            default:
                keystr = make_hash_key(interp, key);
        }
        b = parrot_hash_get_bucket(interp, hash, keystr);
        if (b == NULL) {
            /* RT#48170 Warning: use of uninitialized value */
            return 0;
        }

        nextkey = key_next(interp, key);
        valpmc  = (PMC *)b->value;

        if (!nextkey)
            return fetch_integer(interp, SELF, valpmc);
        return VTABLE_get_integer_keyed(interp, valpmc, nextkey);
    }

/*

=item C<INTVAL get_bool()>

Returns whether the match succeeded. Throws an exception if the match
has not completed yet.

=cut

*/
    INTVAL get_bool() {
        STRING* input_key = const_string(interp, "!RESULT");
        Hash* hash = (Hash*) PMC_struct_val(SELF);
        HashBucket *b;

        b = parrot_hash_get_bucket(interp, hash, input_key);
        if (!b) {
            real_exception(interp, NULL, 1,
                               "Match: cannot get status of incomplete match");
            return 0;
        }

        return VTABLE_get_integer(interp, (PMC*) b->value);
    }
}

/*

=back

=head1 SEE ALSO

F<docs/pdds/pdd08_keys.pod>.

=cut

*/

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