cvsuser 04/07/04 03:41:10
Modified: classes bigint.pmc perlnum.pmc perlscalar.pmc
languages/python pie-thon.pl
languages/python/t/basic 03_types.t
src trace.c
Log:
Pie-thon 14 - complex PMC fixes; number formatting
Revision Changes Path
1.6 +2 -2 parrot/classes/bigint.pmc
Index: bigint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/bigint.pmc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- bigint.pmc 3 Jul 2004 20:21:59 -0000 1.5
+++ bigint.pmc 4 Jul 2004 10:41:00 -0000 1.6
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: bigint.pmc,v 1.5 2004/07/03 20:21:59 leo Exp $
+$Id: bigint.pmc,v 1.6 2004/07/04 10:41:00 leo Exp $
=head1 NAME
@@ -471,7 +471,7 @@
=item C<void absolute()>
-Sets C<dest> to the absolute value of SELF.0).
+Sets C<dest> to the absolute value of SELF.
=cut
1.59 +16 -15 parrot/classes/perlnum.pmc
Index: perlnum.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlnum.pmc,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -w -r1.58 -r1.59
--- perlnum.pmc 3 Jul 2004 19:50:13 -0000 1.58
+++ perlnum.pmc 4 Jul 2004 10:41:00 -0000 1.59
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlnum.pmc,v 1.58 2004/07/03 19:50:13 leo Exp $
+$Id: perlnum.pmc,v 1.59 2004/07/04 10:41:00 leo Exp $
=head1 NAME
@@ -77,21 +77,21 @@
*/
STRING* get_string () {
- char* buff = mem_sys_allocate(80);
- STRING* s;
- char* pos = buff;
-
- if (signbit(PMC_num_val(SELF)))
- *pos++ = '-';
-#ifdef HAS_SNPRINTF
- snprintf(pos,80,FLOATVAL_FMT,fabs(PMC_num_val(SELF)));
-#else
- sprintf(pos,FLOATVAL_FMT,fabs(PMC_num_val(SELF))); /* XXX buffer overflow!
*/
-#endif
- s = string_make(INTERP,buff,strlen(buff),"iso-8859-1",0);
- mem_sys_free(buff);
+ double d = (double) PMC_num_val(SELF);
+ const char *sign = "-";
+ if (!signbit(PMC_num_val(SELF)))
+ sign = "";
+ d = fabs(d);
+ if (Interp_flags_TEST(INTERP, PARROT_PYTHON_MODE)) {
+ /* XXX make a Python format string */
+ STRING *s = Parrot_sprintf_c(interpreter, "%s%.12g", sign, d);
+ if (string_str_index(interpreter, s,
+ const_string(interpreter, "."), 0) == -1)
+ string_append(INTERP, s, const_string(INTERP, ".0"), 0);
return s;
}
+ return Parrot_sprintf_c(interpreter, "%s" FLOATVAL_FMT, sign, d);
+ }
/*
@@ -138,6 +138,7 @@
PMC_num_val(SELF) = value;
/* don't mess around with - 0 */
if (value == vali && (vali || !Parrot_signbit(value)))
+ if (!Interp_flags_TEST(INTERP, PARROT_PYTHON_MODE))
DYNSELF.set_integer_native(vali);
}
1.13 +2 -2 parrot/classes/perlscalar.pmc
Index: perlscalar.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlscalar.pmc,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- perlscalar.pmc 26 Jun 2004 14:06:13 -0000 1.12
+++ perlscalar.pmc 4 Jul 2004 10:41:00 -0000 1.13
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlscalar.pmc,v 1.12 2004/06/26 14:06:13 leo Exp $
+$Id: perlscalar.pmc,v 1.13 2004/07/04 10:41:00 leo Exp $
=head1 NAME
@@ -55,7 +55,7 @@
SELF->vtable = Parrot_base_vtables[type];
return;
}
- if (type == enum_class_BigInt) {
+ if (type == enum_class_BigInt || type == enum_class_Complex) {
PMC_str_val(SELF) = NULL;
SELF->vtable = Parrot_base_vtables[type];
DYNSELF.init();
1.6 +51 -6 parrot/languages/python/pie-thon.pl
Index: pie-thon.pl
===================================================================
RCS file: /cvs/public/parrot/languages/python/pie-thon.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- pie-thon.pl 3 Jul 2004 20:21:56 -0000 1.5
+++ pie-thon.pl 4 Jul 2004 10:41:05 -0000 1.6
@@ -174,21 +174,43 @@
"\$$t" . ++$temp;
}
+sub is_num {
+ my $c = $_[0];
+ my ($pointfloat, $expfloat, $frac, $exp);
+ $exp = qr/[eE][-+]?\d+/;
+ $frac = qr/\.\d+/;
+ $pointfloat = qr/(?:(?:\d+)?$frac)|\d+\./o;
+ $expfloat = qr/(?:\d+|$pointfloat)$exp/o;
+ return 1 if ($c =~ /$pointfloat|$expfloat/o);
+ return 0;
+}
+
+sub is_imag {
+ my $c = $_[0];
+ return 1 if ($c =~ /^[+-]?\d+[jJ]$/);
+ return 1 if ($c =~ s/[jJ]$// && is_num($c));
+ return 0;
+}
+
sub typ {
my $c = $_[0];
my $t = 'P';
- if ($c =~ /^-?\d+$/) { # int
+ if ($c =~ /^[+-]?\d+$/) { # int
$t = 'I';
}
- elsif ($c =~ /^\d+L$/) { # bigint
+ elsif ($c =~ /^\d+[lL]$/) { # bigint XXX
$t = 'B';
}
elsif ($c =~ /^'.*'$/) { # string
- $t = 'B';
+ $t = 'S';
+ }
+ elsif (is_num($c)) { # num
+ $t = 'N';
}
$t;
}
+
sub promote {
my $v = $_[0];
my $n = $v->[1];
@@ -204,13 +226,27 @@
sub LOAD_CONST {
my ($n, $c, $cmt) = @_;
- if ($c =~ /^[_a-zA-Z]/ && !$names{$c}) {
+ if ($c =~ /^[_a-zA-Z]/ && !$names{$c}) { # True, False ...
print <<EOC;
.local pmc $c $cmt
$c = new .$c
EOC
$names{$c} = 1;
}
+ elsif (typ($c) eq 'P') {
+ my $typ = $DEFVAR;
+ if (is_imag($c)) {
+ $typ = '.Complex';
+ $c = qq!"$c"!;
+ }
+ my $pmc = temp('P');
+ print <<EOC;
+ $pmc = new $typ $cmt
+ $pmc = $c
+EOC
+ push @stack, [$n, $pmc, 'P'];
+ return;
+ }
else {
print <<EOC;
$cmt
@@ -233,10 +269,12 @@
else {
$globals{$c} = 1;
$names{$c} = 1;
+ my $typ = $DEFVAR;
+ my $const = $tos->[1];
print <<"EOC";
.local pmc $c $cmt
- $c = new $DEFVAR
- $c = $tos->[1]
+ $c = new $typ
+ $c = $const
global "$c" = $c
EOC
}
@@ -276,6 +314,13 @@
sub LOAD_NAME() {
my ($n, $c, $cmt) = @_;
+ if (is_builtin($c)) {
+ print <<EOC;
+ # builtin $c $cmt
+EOC
+ push @stack, [-1, $c, 'F'];
+ return;
+ }
if ($globals{$c}) {
print <<"EOC";
# $c = global "$c" $cmt
1.3 +15 -2 parrot/languages/python/t/basic/03_types.t
Index: 03_types.t
===================================================================
RCS file: /cvs/public/parrot/languages/python/t/basic/03_types.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- 03_types.t 3 Jul 2004 20:22:03 -0000 1.2
+++ 03_types.t 4 Jul 2004 10:41:07 -0000 1.3
@@ -1,9 +1,9 @@
-# $Id: 03_types.t,v 1.2 2004/07/03 20:22:03 leo Exp $
+# $Id: 03_types.t,v 1.3 2004/07/04 10:41:07 leo Exp $
use strict;
use lib '../../lib';
-use Parrot::Test tests => 1;
+use Parrot::Test tests => 3;
sub test {
language_output_is('python', $_[0], '', $_[1]);
@@ -18,3 +18,16 @@
CODE
+test(<<'CODE', 'complex');
+if __name__ == '__main__':
+ i=-10j
+ print abs(i)
+CODE
+
+test(<<'CODE', 'complex add c + i');
+if __name__ == '__main__':
+ i=-10j
+ print abs(i)
+ i=-3j + 4
+ print abs(i)
+CODE
1.58 +6 -1 parrot/src/trace.c
Index: trace.c
===================================================================
RCS file: /cvs/public/parrot/src/trace.c,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -w -r1.57 -r1.58
--- trace.c 1 Jul 2004 13:45:33 -0000 1.57
+++ trace.c 4 Jul 2004 10:41:10 -0000 1.58
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: trace.c,v 1.57 2004/07/01 13:45:33 leo Exp $
+$Id: trace.c,v 1.58 2004/07/04 10:41:10 leo Exp $
=head1 NAME
@@ -56,6 +56,11 @@
mem_sys_free(escaped);
}
}
+ else if (pmc->vtable->base_type == enum_class_Complex) {
+ STRING *s = VTABLE_get_string(interpreter, pmc);
+ PIO_eprintf(interpreter, "Complex=PMC(%#p: (%Ss)",
+ pmc, s);
+ }
else if (pmc->vtable->base_type == enum_class_PerlUndef
|| pmc->vtable->base_type == enum_class_PerlInt
|| pmc->vtable->base_type == enum_class_PerlNum) {
