lexinfo.pmc

/*
Copyright (C) 2005, 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"
#include <assert.h>
#include "pmc_hash.h"

static size_t
key_hash_STRING(Interp *interp, void *value, size_t seed)
{
    STRING *s = value;

    if (s->hashval) {
        return s->hashval;
    }

    return string_hash(interp, s, seed);
}
/*
 * 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 does 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() {
        if (pass == 1) {
            /* there is no pmclass const_pmc flag yet */
            interp->vtables[entry]->flags |= VTABLE_IS_CONST_PMC_FLAG;
        }

    }
    void init() {
        real_exception(INTERP, NULL, INVALID_OPERATION,
                "don't create me like this");
    }

    void init_pmc(PMC* sub) {
        assert(PObj_constant_TEST(SELF));
        PMC_pmc_val(SELF) = sub;
        parrot_new_pmc_hash_x(INTERP, SELF,
            enum_hash_int,
            Hash_key_type_STRING,
            (hash_comp_fn)string_equal,     /* STRING compare */
            key_hash_STRING);    /*        hash */
    }

/*

=item C<METHOD 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 void declare_lex_preg(STRING* name, INTVAL preg) {
        parrot_hash_put(INTERP, PMC_struct_val(SELF), name, (void*)preg);
    }

    INTVAL elements() {
        return parrot_hash_size(INTERP, 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

*/

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

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

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

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

            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 = PMC_struct_val(SELF);
            hash->entries = elems;
        }
        else {
            SUPER(info);
        }
    }
}


/*

=back

=head1 SEE ALSO

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

=cut

*/

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