lexinfo.pmc

/*
Copyright (C) 2008, The Perl Foundation.
$Id$

=head1 NAME

src/pmc/lexinfo.pmc - LexInfo PMC

=head1 DESCRIPTION

These are the vtable functions for the lexinfo PMC.

=head2 Functions

=over 4

=cut

*/

#include "parrot/parrot.h"

/* included manually to prevent breaking C++ builds -- see RT #56534*/
#include "pmc_hash.h"

/*
 * LexInfo contains a constant Hash with constant string
 * keys and integer indices - no marking and no pmc_ext
 * needed (except for freeze/thaw
 */

pmclass LexInfo need_ext provides hash no_ro {

/*

=item C<void class_init()>

Manipulate vtable->flags so that constant PMCs are created.
If your inherited LexInfo is not so constant, then don't
do that and provide a mark() method and set the custom_mark flag.

=item C<init_pmc(PMC *sub)>

Initialize the LexInfo PMC and remember the associate
subroutine.

=cut

*/

    void class_init() {

        /* there is no pmclass const_pmc flag yet */
        if (pass == 1)
            interp->vtables[entry]->flags |= VTABLE_IS_CONST_PMC_FLAG;

    }

    VTABLE void init() {
        Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
                "Cannot create a LexInfo PMC without an initializer");
    }

    VTABLE void init_pmc(PMC *sub) {
        PARROT_ASSERT(PObj_constant_TEST(SELF));
        PMC_pmc_val(SELF) = sub;

        parrot_new_pmc_hash_x(INTERP, SELF,
            (PARROT_DATA_TYPE)enum_hash_int,
            Hash_key_type_STRING,
            (hash_comp_fn)string_equal,     /* STRING compare */
            (hash_hash_key_fn)string_hash); /*        hash    */

        PObj_active_destroy_SET(SELF);
    }

/*

=item C<void destroy()>

Frees any malloced memory held by this PMC.

=cut

*/

    void destroy() {
        if (PMC_struct_val(SELF))
            parrot_hash_destroy(INTERP, (Hash *)PMC_struct_val(SELF));
    }

/*

=item C<void declare_lex_preg(STRING *name, INTVAL preg)>

Declare a lexical variable that is an alias for a PMC register.  The PIR
compiler calls this method in response to a ".lex STRING, PREG" directive.

=item C<INTVAL elements()>

Returns the number of elements in the LexInfo hash.

=cut

*/

    METHOD declare_lex_preg(STRING *name, INTVAL preg) {
        parrot_hash_put(INTERP, (Hash*)PMC_struct_val(SELF), name, (void*)preg);
    }

    VTABLE INTVAL elements() {
        return parrot_hash_size(INTERP, (Hash *)PMC_struct_val(SELF));
    }

/*

=item C<void visit(visit_info *info)>

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

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

Freeze/thaw interface used during freeze/thaw of the Sub PMC.
The implementation of the Hash PMC is called.

=cut

*/

    VTABLE void visit(visit_info *info) {
        Parrot_Hash_visit(INTERP, SELF, info);
    }

    VTABLE void freeze(visit_info *info) {
        Parrot_Hash_freeze(INTERP, SELF, info);
    }

    VTABLE void thaw(visit_info *info) {
        IMAGE_IO * const io = info->image_io;

        if (info->extra_flags == EXTRA_IS_NULL) {
            const INTVAL elems  = VTABLE_shift_integer(INTERP, io);
            const INTVAL k_type = VTABLE_shift_integer(INTERP, io);
            const INTVAL v_type = VTABLE_shift_integer(INTERP, io);
            Hash        *hash;

            UNUSED(k_type);
            UNUSED(v_type);

            PARROT_ASSERT(v_type == enum_hash_int);
            /* TODO make a better interface for hash creation
             * TODO create hash with needed types in the first place
             */

            SELF.init_pmc(NULL);
            hash          = (Hash *)PMC_struct_val(SELF);
            hash->entries = elems;
        }
        else {
            SUPER(info);
        }
    }
}


/*

=back

=head1 SEE ALSO

F<docs/pdds/pdd20_lexical_vars.pod>, F<src/classes/lexpad.pmc>.

=cut

*/

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