cvsuser 04/07/10 04:40:55
Modified: classes perlhash.pmc
languages/python pie-thon.pl
src call_list.txt hash.c py_func.c
Log:
Pie-thon 46 - better attribute handling
Revision Changes Path
1.82 +68 -5 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -w -r1.81 -r1.82
--- perlhash.pmc 9 Jul 2004 16:38:56 -0000 1.81
+++ perlhash.pmc 10 Jul 2004 11:40:48 -0000 1.82
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlhash.pmc,v 1.81 2004/07/09 16:38:56 leo Exp $
+$Id: perlhash.pmc,v 1.82 2004/07/10 11:40:48 leo Exp $
=head1 NAME
@@ -44,7 +44,7 @@
return a != b;
}
-static void
+static PMC*
fromkeys(Interp *interpreter, PMC *self, PMC *keys, PMC *value)
{
INTVAL elems, dod_disabled, i;
@@ -111,6 +111,7 @@
Parrot_unblock_DOD(interpreter);
Parrot_unblock_GC(interpreter);
}
+ return self;
}
@@ -157,7 +158,7 @@
make_bufferlike_pool(INTERP, sizeof(struct _hash));
if (pass) {
enter_nci_method(INTERP, enum_class_PerlHash,
- F2DPTR(fromkeys), "fromkeys", "vIOPP");
+ F2DPTR(fromkeys), "fromkeys", "PIOPP");
}
}
/*
@@ -430,11 +431,55 @@
Returns a string representation of the hash, showing its class name and
memory address.
+For Python returns its repr.
+
=cut
*/
STRING* get_string () {
+ if (Interp_flags_TEST(interpreter, PARROT_PYTHON_MODE)) {
+ /* TODO use freeze */
+ PMC *iter = VTABLE_get_iter(INTERP, SELF);
+ STRING *res, *s;
+ INTVAL j, n;
+
+ res = string_from_cstring(INTERP, "{", 0);
+ n = VTABLE_elements(INTERP, SELF);
+ for (j = 0; j < n; ++j) {
+ STRING *key = VTABLE_shift_string(INTERP, iter);
+ int i,all_digit = 1;
+ PMC *val;
+
+ for (i = 0; i < (int)key->strlen; ++i) {
+ if (!isdigit(((char *)key->strstart)[i])) {
+ all_digit = 0;
+ break;
+ }
+ }
+ if (all_digit) {
+ res = string_append(INTERP, res, key, 0);
+ }
+ else {
+ res = string_append(INTERP, res,
+ const_string(INTERP, "'"), 0);
+ res = string_append(INTERP, res, key, 0);
+ res = string_append(INTERP, res,
+ const_string(INTERP, "'"), 0);
+ }
+ res = string_append(INTERP, res,
+ const_string(INTERP, ": "), 0);
+ val = SELF.get_pmc_keyed_str(key);
+ res = string_append(INTERP, res,
+ VTABLE_get_string(INTERP, val), 0);
+ if (j < n - 1)
+ res = string_append(INTERP, res,
+ const_string(INTERP, ", "), 0);
+ }
+ res = string_append(INTERP, res,
+ const_string(INTERP, "}"), 0);
+ return res;
+ }
return Parrot_sprintf_c(INTERP, "PerlHash[0x%x]", SELF);
}
@@ -840,14 +885,32 @@
The C<==> operation.
-Currently just returns false, C<*value> is ignored.
+Check if to hashes hold the same keys and values.
=cut
*/
INTVAL is_equal (PMC* value) {
+ PMC *iter = VTABLE_get_iter(INTERP, SELF);
+ INTVAL j, n;
+
+ if (value->vtable->base_type != enum_class_PerlHash)
+ return 0;
+ n = SELF.elements();
+ if (VTABLE_elements(INTERP, value) != n)
return 0;
+ for (j = 0; j < n; ++j) {
+ STRING *key = VTABLE_shift_string(INTERP, iter);
+ PMC *item1, *item2;
+ if (!VTABLE_exists_keyed_str(INTERP, value, key))
+ return 0;
+ item1 = SELF.get_pmc_keyed_str(key);
+ item2 = VTABLE_get_pmc_keyed_str(INTERP, value, key);
+ if (!mmd_dispatch_i_pp(INTERP, item1, item2, MMD_EQ))
+ return 0;
+ }
+ return 1;
}
/*
1.29 +56 -9 parrot/languages/python/pie-thon.pl
Index: pie-thon.pl
===================================================================
RCS file: /cvs/public/parrot/languages/python/pie-thon.pl,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -w -r1.28 -r1.29
--- pie-thon.pl 10 Jul 2004 09:02:29 -0000 1.28
+++ pie-thon.pl 10 Jul 2004 11:40:52 -0000 1.29
@@ -915,6 +915,14 @@
push @stack, [-1, $p, 'I'];
}
+sub ret_val {
+ my $a = shift;
+ my %rets = (
+ '__repr__' => 'S',
+ );
+ return $rets{$a} if defined $rets{$a};
+ return 'P';
+}
sub CALL_FUNCTION
{
@@ -966,6 +974,7 @@
my $args = join ', ', @args;
my $t;
$func = $tos->[1];
+ # create argument tuple
if ($builtins{$name} && $builtins{$name} eq 'v') {
my $ar = temp('P');
print <<"EOC";
@@ -987,9 +996,17 @@
$t = $func $args $cmt
EOC
}
- elsif ($name =~/^obj (\w+) attr (\w+)/) { # convert to meth call syntax
+ elsif ($name =~/^obj (\S+) attr (\w+)/) { # convert to meth call syntax
+ my ($obj, $attr) = ($1, $2);
+ my $ret_type = ret_val($attr);
+ my $ret_string = "";
+ if ($ret_type ne 'None') {
+ $t = temp($ret_type);
+ $ret_string = "$t = ";
+ }
print <<EOC;
- $1."$2"($args) $cmt
+ P2 = $1
+ $ret_string$func($args) $cmt
EOC
}
else {
@@ -1076,7 +1093,10 @@
sub BUILD_TUPLE
{
- my ($n, $c, $cmt) = @_;
+ my ($n, $c, $cmt, $type) = @_;
+ # TODO iter for FixedPMCArray
+ # $type = "FixedPMCArray" unless defined $type;
+ $type = "PerlArray";
my ($opcode, $rest) = ($code[$code_l]->[2],$code[$code_l]->[4]);
if ($opcode eq 'UNPACK_SEQUENCE') {
$code_l++;
@@ -1092,7 +1112,8 @@
}
my $ar = temp('P');
print <<EOC;
- $ar = new PerlArray $cmt
+ $ar = new $type $cmt
+ $ar = $n
EOC
for (my $i = $n-1; $i >= 0; $i--) {
my $p = pop @stack;
@@ -1105,7 +1126,7 @@
sub BUILD_LIST
{
- BUILD_TUPLE(@_)
+ BUILD_TUPLE(@_,"PerlArray")
}
sub BUILD_MAP
{
@@ -1114,7 +1135,7 @@
print <<EOC;
$ar = new PerlHash $cmt
EOC
- push @stack, [-1, $ar, 'P'];
+ push @stack, ["hash", $ar, 'P'];
}
sub RAISE_VARARGS
{
@@ -1240,8 +1261,17 @@
my $w = pop @stack;
my $v = pop @stack;
my $x = pop @stack;
+ my $key = $x->[1];
+ if ($v->[0] eq 'hash') {
+ if ($key =~ /^\d+$/) {
+ $key = qq!"$key"!;
+ }
+ elsif ($v->[2] eq 'I') {
+ # ok ?
+ }
+ }
print <<EOC
- $v->[1]\[$x->[1]\] = $w->[1] $cmt
+ $v->[1]\[$key\] = $w->[1] $cmt
EOC
}
@@ -1310,10 +1340,27 @@
my ($n, $c, $cmt) = @_;
my $tos = pop @stack; # object
my $attr = temp('P');
+ my $obj = promote $tos;
+ my $o;
+ if ($builtins{$obj}) { # postponed LOAD_ like dict
+ $o = temp('P');
+ my $args = "";
+ if ($builtins{$obj} eq 'v') {
+ my $arg = temp('P');
+ print <<EOC;
+ $arg = new FixedPMCArray
+EOC
+ $args = $arg;
+ }
+ print <<EOC;
+ $o = $obj($args) # postponed LOAD_
+EOC
+ $obj = $o;
+ }
print <<EOC;
- $attr = getattribute $tos->[1], "$c" $cmt
+ $attr = getattribute $obj, "$c" $cmt
EOC
- push @stack, ["obj $tos->[1] attr $c", $attr, 'P'];
+ push @stack, ["obj $obj attr $c", $attr, 'P'];
}
sub Slice
1.40 +1 -1 parrot/src/call_list.txt
Index: call_list.txt
===================================================================
RCS file: /cvs/public/parrot/src/call_list.txt,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -w -r1.39 -r1.40
--- call_list.txt 8 Jul 2004 16:11:44 -0000 1.39
+++ call_list.txt 10 Jul 2004 11:40:55 -0000 1.40
@@ -201,7 +201,7 @@
P Ii
# PerlHash fromkeys
-v IOPP
+P IOPP
# Oddball ones for postgres
p ptiLTLLi
1.83 +5 -2 parrot/src/hash.c
Index: hash.c
===================================================================
RCS file: /cvs/public/parrot/src/hash.c,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -w -r1.82 -r1.83
--- hash.c 23 Apr 2004 09:21:12 -0000 1.82
+++ hash.c 10 Jul 2004 11:40:55 -0000 1.83
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: hash.c,v 1.82 2004/04/23 09:21:12 jrieks Exp $
+$Id: hash.c,v 1.83 2004/07/10 11:40:55 leo Exp $
=head1 NAME
@@ -626,6 +626,9 @@
hash->entry_type = val_type;
hash->key_type = hkey_type;
hash->value_size = val_size; /* extra size */
+ if (Interp_flags_TEST(interpreter, PARROT_PYTHON_MODE))
+ hash->seed = 3793;
+ else
hash->seed = (size_t) Parrot_uint_rand(0);
/* PObj_report_SET(&hash->buffer); */
1.16 +6 -3 parrot/src/py_func.c
Index: py_func.c
===================================================================
RCS file: /cvs/public/parrot/src/py_func.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- py_func.c 10 Jul 2004 08:59:37 -0000 1.15
+++ py_func.c 10 Jul 2004 11:40:55 -0000 1.16
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-$Id: py_func.c,v 1.15 2004/07/10 08:59:37 leo Exp $
+$Id: py_func.c,v 1.16 2004/07/10 11:40:55 leo Exp $
=head1 NAME
@@ -63,13 +63,14 @@
static PMC *
dict_from_tuple_array(Interp *interpreter, PMC *ar)
{
- INTVAL i;
+ INTVAL i, el;
PMC *dict;
/*
* ar is an array of tuples which are key/value pairs
*/
dict = pmc_new(interpreter, enum_class_PerlHash);
- for (i = 0; i < VTABLE_elements(interpreter, ar); ++i) {
+ el = VTABLE_elements(interpreter, ar);
+ for (i = 0; i < el; ++i) {
PMC *tupl = VTABLE_get_pmc_keyed_int(interpreter, ar, i);
PMC *key, *value;
INTVAL n = VTABLE_elements(interpreter, tupl);
@@ -104,6 +105,7 @@
switch (arg->vtable->base_type) {
case enum_class_PerlHash:
return arg;
+ case enum_class_FixedPMCArray: /* sequence from BUILD_TUPLE */
case enum_class_PerlArray: /* sequence from BUILD_LIST */
return dict_from_tuple_array(interpreter, arg);
default:
@@ -131,6 +133,7 @@
arg = VTABLE_get_pmc_keyed_int(interpreter, argv, 0);
iter = NULL;
switch (arg->vtable->base_type) {
+ case enum_class_FixedPMCArray: /* sequence from BUILD_TUPLE */
case enum_class_PerlArray: /* sequence from BUILD_LIST */
/* TODO return copy */
return arg;
