Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Pull the Pair implementation into EclectusPair
  • Loading branch information
bschmalhofer committed Mar 22, 2009
1 parent e6eb077 commit 2347641
Show file tree
Hide file tree
Showing 6 changed files with 405 additions and 12 deletions.
5 changes: 4 additions & 1 deletion .gitignore
Expand Up @@ -36,4 +36,7 @@
/src/pmc/pmc_eclectusstring.h
/src/pmc/pmc_eclectusvector.h
/stst.out
/t/*.nqp
/t/scheme/*.nqp
/t/scheme/*.pir
*.nqp
*.pir
3 changes: 1 addition & 2 deletions build/templates/src/pmc/Makefile.in
Expand Up @@ -27,11 +27,10 @@ PMCS := \
eclectuscharacter \
eclectusemptylist \
eclectusfixnum \
eclectuspair \
eclectusstring \
eclectusvector

#eclectuspair \
PMC_SOURCES := \
eclectusboolean.pmc \
eclectuscharacter.pmc \
Expand Down
4 changes: 2 additions & 2 deletions driver_nqp.pir
Expand Up @@ -14,9 +14,9 @@

# The dynamics PMCs used by Eclectus are loaded
loadlib $P1, 'pair'
_dumper( 'p1', $P1 )
#_dumper( 'p1', $P1 )
loadlib $P1, 'eclectus_group'
_dumper( 'p1', $P1 )
#_dumper( 'p1', $P1 )

.end

Expand Down
321 changes: 315 additions & 6 deletions src/pmc/eclectuspair.pmc
Expand Up @@ -18,12 +18,261 @@ pair behavior.

*/

pmclass EclectusPair
extends Pair
dynpmc
group eclectus_group
hll Eclectus
{
pmclass EclectusPair dynpmc group eclectus_group hll Eclectus {
ATTR PMC *key;
ATTR PMC *value;

/*

=item C<void init()>

Initializes the instance.

=item C<PMC *instantiate(PMC *sig)>

Class method to construct an Integer according to passed arguments.

=cut

*/

VTABLE void init() {
PMC_data(SELF) = mem_allocate_zeroed_typed(Parrot_EclectusPair_attributes);
PObj_custom_mark_SET(SELF);
}

VTABLE PMC *instantiate(PMC *sig) {
return PMCNULL;

/* TODO -- really create this thing */
#if 0
PMC * const _class = REG_PMC(interp, 2);
Parrot_EclectusPair_attributes *pair = PARROT_ECLECTUSPAIR(SELF);
const int argcP = REG_INT(interp, 3);
const int argcS = REG_INT(interp, 2);

SELF = pmc_new(INTERP, _class->vtable->base_type);
if (argcS == 1 && argcP == 1) {
PObj_key_is_string_SET(SELF);
pair->key = REG_STR(interp, 5);
pair->value = REG_PMC(interp, 5);
}
else if (argcP == 2) {
pair->key = REG_PMC(interp, 5);
pair->value = REG_PMC(interp, 6);
}
else
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"wrong argument count for Pair creation");

return SELF;
#endif
}
/*

=item C<void mark()>

Marks the hash as live.

=cut

*/

VTABLE void mark() {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);

if (pair->key)
pobject_lives(INTERP, (PObj *)pair->key);

if (pair->value)
pobject_lives(INTERP, (PObj *)pair->value);
}

/*

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

=item C<PMC *get_pmc_keyed(PMC *key)>

=cut

*/

VTABLE PMC *get_pmc_keyed_str(STRING *key) {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);
/* check key ? */
return pair->value;
}

VTABLE PMC *get_pmc_keyed(PMC *key) {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);
/* check key ? */
return pair->value;
}

/*

=item C<void set_pmc_keyed(PMC *key, PMC *value)>

=item C<void set_pmc_keyed_str(STRING *key, PMC *value)>

Set key and value. The key can only set once.

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

Set the value of the Pair.

=cut

*/

VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);

if (pair->key)
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"attempt to set existing Pair key");


pair->key = key;
pair->value = value;
}


VTABLE void set_pmc_keyed_str(STRING *key, PMC *value) {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);
PMC *key_pmc;

if (pair->key)
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"attempt to set existing Pair key");


key_pmc = pmc_new(interp, enum_class_String);
VTABLE_set_string_native(interp, key_pmc, key);

pair->key = key_pmc;
pair->value = value;
}

VTABLE void assign_pmc(PMC *value) {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);
pair->value = value;
}

/*

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

Sets this pair to hold the value of another.

=cut

*/

void set_pmc(PMC *pair) {
if (pair->vtable->base_type == SELF->vtable->base_type) {
Parrot_EclectusPair_attributes * const from = PARROT_ECLECTUSPAIR(SELF);
Parrot_EclectusPair_attributes * const to = PARROT_ECLECTUSPAIR(SELF);

to->key = from->key;
to->value = from->value;
}
else
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"Can only set a pair to another pair.");
}

/*

=item C<INTVAL is_equal(PMC *value)>

The C<==> operation.

Check if two Pairs hold the same keys and values.

=cut

*/

VTABLE INTVAL is_equal(PMC *value) {
Parrot_EclectusPair_attributes * const from = PARROT_ECLECTUSPAIR(SELF);
Parrot_EclectusPair_attributes * const to = PARROT_ECLECTUSPAIR(SELF);
PMC *p1, *p2;
PMC *k1, *k2;
INTVAL result;

if (value->vtable->base_type != SELF->vtable->base_type)
return 0;

k1 = from->key;
k2 = to->key;

Parrot_mmd_multi_dispatch_from_c_args(INTERP, "is_equal",
"PP->I", k1, k2, &result);
if (!result)
return 0;

p1 = from->value;
p2 = to->value;

if (!p1 && !p2)
return 1;
else
return 0;
}

/*

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

Used during archiving to visit the elements in the pair.

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

Used to archive the Pair.

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

Used to unarchive the Pair.

=cut

*/

VTABLE void visit(visit_info *info) {
PMC **pos;
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);
IMAGE_IO * const io = info->image_io;
DPOINTER ** const temp_pos = (DPOINTER **)pair->key;
info->thaw_ptr = (PMC **)temp_pos;
(info->visit_pmc_now)(INTERP, (PMC *)temp_pos, info);

pos = &pair->value;
info->thaw_ptr = pos;

(info->visit_pmc_now)(INTERP, *pos, info);

SUPER(info);
}

VTABLE void freeze(visit_info *info) {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);
IMAGE_IO * const io = info->image_io;
SUPER(info);
VTABLE_push_pmc(INTERP, io, pair->key);
VTABLE_push_pmc(INTERP, io, pair->value);
}

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

SUPER(info);

pair->key = VTABLE_shift_pmc(interp, io);
pair->value = VTABLE_shift_pmc(interp, io);
}

STRING* get_string() {
return const_string(INTERP, "()");
Expand All @@ -33,6 +282,66 @@ pmclass EclectusPair
INTVAL get_bool() {
return 1;
}
/*

=back

=head2 Methods

=over 4

=item C<METHOD key()>

Return the key of the pair.

=cut

*/

METHOD key() {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);
PMC *key = pair->key;

RETURN(PMC *key);
}

/*

=item C<METHOD value()>

Return the value of the pair.

=cut

*/

METHOD value() {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);
PMC * const value = pair->value;
RETURN(PMC *value);
}

/*

=item C<METHOD kv()>

Return a tuple of (key, value) for the pair.

=cut

*/

METHOD kv() {
Parrot_EclectusPair_attributes * const pair = PARROT_ECLECTUSPAIR(SELF);
PMC * const t = pmc_new(INTERP,
Parrot_get_ctx_HLL_type(INTERP, enum_class_FixedPMCArray));

VTABLE_set_integer_native(INTERP, t, 2);
VTABLE_set_pmc_keyed_int(INTERP, t, 0, pair->key);

VTABLE_set_pmc_keyed_int(INTERP, t, 1, pair->value);
RETURN(PMC *t);
}
}

/*
Expand Down
2 changes: 1 addition & 1 deletion t/harness
Expand Up @@ -66,7 +66,7 @@ $verbosity ||= 0;
return [ "$path_to_parrot/parrot$PConfig{exe}", $test_file ] if $test_file =~ m!t/pmc/.*[.]t$!;

# the directory t/scheme contains only test scripts written in scheme
if ( $test_file =~ m!t/in_php/.*[.]t$! ) {
if ( $test_file =~ m!t/scheme/.*[.]t$! ) {
if ($^O eq 'MSWin32') {
return [ 'csi', '-R', 'alexpander', '-i', '-k', 'none', '-I', 'riaxpander',
'-e', '(load "chicken/prelude.scm")', '-s', $test_file ];
Expand Down

0 comments on commit 2347641

Please sign in to comment.