/*
Copyright (C) 2001-2003, The Perl Foundation.
$Id: tcllist.pmc 16418 2007-01-05 04:07:21Z mdiep $

=head1 NAME

pmc/tcllist.pmc - Tcl List

=head1 DESCRIPTION

These are the vtable functions for the TclList base class

=head2 Methods

=over 4

=cut

*/

#include "parrot/parrot.h"

/* cache of classes referenced */

static INTVAL dynpmc_TclInt;

pmclass TclList
    dynpmc
    need_ext
    extends ResizablePMCArray
    does    array
    group   tcl_group
    hll     Tcl
    maps    Array
{

/*

=item C<void class_init()>

Class initialization. Caches the type id of various PMCs.

=cut

*/

    void class_init() {
        if (pass) {
            dynpmc_TclInt = pmc_type(INTERP,
                string_from_const_cstring(INTERP, "TclInt", 0));
        }
    }

/*

=item C<STRING *get_string()>

Returns the list as a string

=cut

*/

    STRING* get_string () {
        PMC *listToString, *namespace;
        STRING *_tcl_namespace, *sub, *value;

        _tcl_namespace = string_from_const_cstring(INTERP, "_tcl", 4);
        sub            = string_from_const_cstring(INTERP, "__listToString",14);

        namespace = INTERP->root_namespace;
        namespace = VTABLE_get_pmc_keyed_str(INTERP, namespace, _tcl_namespace);
        listToString = VTABLE_get_pmc_keyed_str(INTERP, namespace, sub);

        CONTEXT(INTERP->ctx)->constants =
          PMC_sub(listToString)->seg->const_table->constants;
        value        = Parrot_runops_fromc_args
                         (INTERP, listToString, "SP", SELF);
        return value;
    }

/*

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

An alias to assign_pmc to make other things happy before set_pmc is removed.

=cut

*/

    void set_pmc (PMC *other) {
        VTABLE_assign_pmc(INTERP, SELF, other);
    }

/*

=item C<void assign_pmc(PMC *other)>

Copy the contents of other to self.

=back

=cut

*/

    void assign_pmc (PMC *other) {
        STRING *array  = string_from_const_cstring(INTERP, "array", 5);
        STRING *string = string_from_const_cstring(INTERP, "String", 6);
        STRING *undef  = string_from_const_cstring(INTERP, "Undef", 5);

        if (VTABLE_does(INTERP, other, array))
        {
            INTVAL size;
            INTVAL i;

            size = VTABLE_elements(INTERP,other);
            DYNSELF.set_integer_native(size);
            for(i = 0; i < size; i++) {
                PMC* elem = VTABLE_get_pmc_keyed_int(INTERP, other, i);
                DYNSELF.set_pmc_keyed_int(i, elem);
            }
        }
        else if (VTABLE_isa(INTERP, other, string))
        {
            STRING *v = VTABLE_get_string(INTERP, other);
            pmc_reuse(INTERP, SELF, other->vtable->base_type, 0);
            DYNSELF.set_string_native(v);
        }
        else if (VTABLE_isa(INTERP, other, undef))
        {
            pmc_reuse(INTERP, SELF, other->vtable->base_type, 0);
        }
        else
        {
            real_exception(INTERP, NULL, E_TypeError,
                           "unable to assign self to this type");
        }
    }

}

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