/*
Copyright (C) 2004, The Perl Foundation.
$Id: match.pmc 16599 2007-01-13 21:47:06Z particle $

=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* interpreter, PMC * key)
{
    if (key == NULL) {
        internal_exception(OUT_OF_BOUNDS,
        "Cannot use NULL key for Match!");
        return NULL;
    }
    return key_string(interpreter, 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) {
        internal_exception(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) {
            /* XXX 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;
        STRING* keystr;
        HashBucket *b;
        Hash *hash = PMC_struct_val(SELF);
        PMC* nextkey;

        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. */
                if (hash->key_type == Hash_key_type_int) {
                    INTVAL i = (INTVAL)parrot_hash_get_idx(INTERP, hash, key);
                    return string_from_int(INTERP, i);
                }
                return parrot_hash_get_idx(INTERP, hash, key);
            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 = b->value;
        if (!nextkey)
            return fetch_string(INTERP, SELF, valpmc);
        return VTABLE_get_string_keyed(INTERP, valpmc, nextkey);
    }

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

        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
                 */
                if (hash->key_type == Hash_key_type_int) {
                    return (INTVAL)parrot_hash_get_idx(INTERP, hash, key);
                }
                else {
                    STRING *s = parrot_hash_get_idx(INTERP, hash, key);
                    return string_to_int(INTERP, s);
                }
            default:
                keystr = make_hash_key(INTERP, key);
        }
        b = parrot_hash_get_bucket(INTERP, hash, keystr);
        if (b == NULL) {
            /* XXX Warning: use of uninitialized value */
            return 0;
        }
        nextkey = key_next(INTERP, key);
        valpmc = 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) {
            internal_exception(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:
 */
