cvsuser 04/06/18 08:15:00
Modified: classes perlstring.pmc slice.pmc
imcc pbc.c
include/parrot string_funcs.h
src key.c string.c
t/pmc iter.t
Log:
slices 9 - PerlHash ranges and S vars
Revision Changes Path
1.75 +2 -13 parrot/classes/perlstring.pmc
Index: perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -w -r1.74 -r1.75
--- perlstring.pmc 18 Jun 2004 13:44:24 -0000 1.74
+++ perlstring.pmc 18 Jun 2004 15:14:44 -0000 1.75
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlstring.pmc,v 1.74 2004/06/18 13:44:24 leo Exp $
+$Id: perlstring.pmc,v 1.75 2004/06/18 15:14:44 leo Exp $
=head1 NAME
@@ -599,18 +599,7 @@
void increment () {
STRING* s = PMC_str_val(SELF);
- INTVAL o;
- if (string_length(INTERP, s) != 1)
- internal_exception(1, "increment only for length=1 done");
- o = string_ord(INTERP, s, 0);
- if ((o >= 'A' && o < 'Z') ||
- (o >= 'a' && o < 'z')) {
- ++o;
- /* TODO increment in place */
- PMC_str_val(SELF) = string_chr(INTERP, o);
- return;
- }
- internal_exception(1, "increment out of range - unimplemented");
+ PMC_str_val(SELF) = string_increment(INTERP, s);
}
void decrement () {
1.5 +47 -17 parrot/classes/slice.pmc
Index: slice.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/slice.pmc,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- slice.pmc 18 Jun 2004 13:06:54 -0000 1.4
+++ slice.pmc 18 Jun 2004 15:14:44 -0000 1.5
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: slice.pmc,v 1.4 2004/06/18 13:06:54 leo Exp $
+$Id: slice.pmc,v 1.5 2004/06/18 15:14:44 leo Exp $
=head1 NAME
@@ -68,9 +68,14 @@
}
}
else {
+ if (PObj_get_FLAGS(range) & KEY_inf_slice_FLAG) {
+ internal_exception(1,
+ "unlimited slice range for hash not implemented");
+ }
+
/*
* string assumed
- * - no ranges yet, start at value
+ * start at value
*/
PMC_struct_val(self) = key_string(interpreter, range);
}
@@ -84,9 +89,10 @@
set_slice_next(Interp *interpreter, PMC *self, PMC *agg)
{
PMC* range = PMC_pmc_val(self);
- INTVAL cur, end;
if (key_type(interpreter, range) & KEY_integer_FLAG) {
+ INTVAL cur, end;
+
if ((PObj_get_FLAGS(range) &
(KEY_start_slice_FLAG|KEY_end_slice_FLAG)) ==
(KEY_start_slice_FLAG|KEY_end_slice_FLAG)) {
@@ -143,7 +149,7 @@
next_range:
range = PMC_pmc_val(self) = PMC_data(range);
- if (!PMC_pmc_val(self)) {
+ if (!range) {
/*
* this denotes the end of iteration
*/
@@ -157,6 +163,7 @@
}
}
else {
+ STRING *cur, *end;
/*
* string assumed
*/
@@ -164,18 +171,42 @@
(KEY_start_slice_FLAG|KEY_end_slice_FLAG)) ==
(KEY_start_slice_FLAG|KEY_end_slice_FLAG)) {
/*
- * only single values for now - no ranges
+ * only single values or limited ranges - no
+ * ..end or start.. range for hash
+ */
+ goto next_str_range;
+ }
+ if (PObj_get_FLAGS(range) & KEY_inf_slice_FLAG) {
+ internal_exception(1,
+ "unlimited slice range for hash not implemented");
+ }
+ if (PObj_get_FLAGS(range) & KEY_start_slice_FLAG) {
+ /*
+ * start ... end range
+ * end is in the next range in the Key chain
*/
+ PMC *end_range = PMC_data(range);
+ if (!end_range)
+ internal_exception(1, "No end range found");
+ cur = (STRING *)PMC_struct_val(self);
+ end = key_string(interpreter, end_range);
+ if (string_compare(interpreter, cur, end) < 0) {
+ cur = string_increment(interpreter, cur);
+ PMC_struct_val(self) = (void *)cur;
+ return;
+ }
+ /* skip end range */
+ PMC_pmc_val(self) = end_range;
+ range = end_range;
+ /* go on with next_range */
+ }
+next_str_range:
range = PMC_pmc_val(self) = PMC_data(range);
- if (!PMC_pmc_val(self))
+ if (!range)
PMC_int_val(self) = -1;
else
PMC_struct_val(self) = key_string(interpreter, range);
}
- else {
- internal_exception(1, "slices ranges for hash not implemented");
- }
- }
}
pmclass Slice need_ext extends Key {
@@ -215,7 +246,6 @@
INTVAL get_integer() {
INTVAL v = (INTVAL)PMC_struct_val(SELF);
- /* printf("Slice_get_integer %d\n", (int)v); */
return v;
}
1.82 +1 -1 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -w -r1.81 -r1.82
--- pbc.c 17 Jun 2004 12:04:42 -0000 1.81
+++ pbc.c 18 Jun 2004 15:14:47 -0000 1.82
@@ -680,7 +680,7 @@
if (r->set == 'I')
*pc++ = PARROT_ARG_I | slice_bits; /* register type */
else if (r->set == 'S')
- *pc++ = PARROT_ARG_S;
+ *pc++ = PARROT_ARG_S | slice_bits;
else
fatal(1, "build_key", "wrong register set\n");
/* don't emit mapped regs in key parts */
1.41 +2 -1 parrot/include/parrot/string_funcs.h
Index: string_funcs.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/string_funcs.h,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -w -r1.40 -r1.41
--- string_funcs.h 22 Apr 2004 08:55:06 -0000 1.40
+++ string_funcs.h 18 Jun 2004 15:14:52 -0000 1.41
@@ -1,7 +1,7 @@
/* string_funcs.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: string_funcs.h,v 1.40 2004/04/22 08:55:06 leo Exp $
+ * $Id: string_funcs.h,v 1.41 2004/06/18 15:14:52 leo Exp $
* Overview:
* This is the api header for the string subsystem
* Data Structure and Algorithms:
@@ -35,6 +35,7 @@
INTVAL string_compare(struct Parrot_Interp *, STRING *, STRING *);
INTVAL string_equal(struct Parrot_Interp *, STRING *, STRING *);
INTVAL string_bool(struct Parrot_Interp *, const STRING *);
+STRING *string_increment(struct Parrot_Interp *, const STRING *);
const char *Parrot_string_cstring(const STRING *);
/* Declarations of other functions */
1.49 +12 -9 parrot/src/key.c
Index: key.c
===================================================================
RCS file: /cvs/public/parrot/src/key.c,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -w -r1.48 -r1.49
--- key.c 17 Jun 2004 16:30:25 -0000 1.48
+++ key.c 18 Jun 2004 15:14:56 -0000 1.49
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: key.c,v 1.48 2004/06/17 16:30:25 leo Exp $
+$Id: key.c,v 1.49 2004/06/18 15:14:56 leo Exp $
=head1 NAME
@@ -141,6 +141,7 @@
PMC *key = pmc_new(interpreter, enum_class_Key);
PObj_get_FLAGS(key) |= KEY_pmc_FLAG;
+ internal_exception(1, "this is broken - see slice.pmc");
PMC_pmc_val(key) = value;
return key;
@@ -248,6 +249,11 @@
{
PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
PObj_get_FLAGS(key) |= KEY_pmc_FLAG;
+ /*
+ * XXX leo
+ * what for is this indirection?
+ */
+ internal_exception(1, "this is broken - see slice.pmc");
PMC_pmc_val(key) = value;
return;
@@ -321,8 +327,8 @@
case KEY_number_FLAG | KEY_register_FLAG:
return interpreter->num_reg.registers[PMC_int_val(key)];
case KEY_pmc_FLAG:
- return VTABLE_get_number(interpreter,
- PMC_pmc_val(key));
+ return VTABLE_get_number(interpreter, key);
+ /* PMC_pmc_val(key)); */
case KEY_pmc_FLAG | KEY_register_FLAG:
reg = interpreter->pmc_reg.registers[PMC_int_val(key)];
return VTABLE_get_number(interpreter, reg);
@@ -352,8 +358,8 @@
case KEY_string_FLAG | KEY_register_FLAG:
return interpreter->string_reg.registers[PMC_int_val(key)];
case KEY_pmc_FLAG:
- return VTABLE_get_string(interpreter,
- PMC_pmc_val(key));
+ return VTABLE_get_string(interpreter, key);
+ /* PMC_pmc_val(key)); */
case KEY_pmc_FLAG | KEY_register_FLAG:
reg = interpreter->pmc_reg.registers[PMC_int_val(key)];
return VTABLE_get_string(interpreter, reg);
@@ -379,13 +385,10 @@
key_pmc(Interp *interpreter, PMC *key)
{
switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
- case KEY_pmc_FLAG:
- return PMC_pmc_val(key);
case KEY_pmc_FLAG | KEY_register_FLAG:
return interpreter->pmc_reg.registers[PMC_int_val(key)];
default:
- internal_exception(INVALID_OPERATION, "Key not a PMC!\n");
- return 0;
+ return key; /* PMC_pmc_val(key); */
}
}
1.206 +29 -1 parrot/src/string.c
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/src/string.c,v
retrieving revision 1.205
retrieving revision 1.206
diff -u -w -r1.205 -r1.206
--- string.c 12 Jun 2004 13:19:22 -0000 1.205
+++ string.c 18 Jun 2004 15:14:56 -0000 1.206
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: string.c,v 1.205 2004/06/12 13:19:22 nicholas Exp $
+$Id: string.c,v 1.206 2004/06/18 15:14:56 leo Exp $
=head1 NAME
@@ -3178,6 +3178,34 @@
/*
+=item C<STRING *string_increment(struct Parrot_Interp *, const STRING *)>
+
+Perl5ish increment the string. Currently single char only.
+
+=cut
+
+*/
+
+STRING *
+string_increment(Interp *interpreter, const STRING *s)
+{
+ INTVAL o;
+
+ if (string_length(interpreter, s) != 1)
+ internal_exception(1, "increment only for length=1 done");
+ o = string_ord(interpreter, s, 0);
+ if ((o >= 'A' && o < 'Z') ||
+ (o >= 'a' && o < 'z')) {
+ ++o;
+ /* TODO increment in place */
+ return string_chr(interpreter, o);
+ }
+ internal_exception(1, "increment out of range - unimplemented");
+ return NULL;
+}
+
+/*
+
=back
=head1 SEE ALSO
1.18 +101 -2 parrot/t/pmc/iter.t
Index: iter.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/iter.t,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- iter.t 18 Jun 2004 12:06:06 -0000 1.17
+++ iter.t 18 Jun 2004 15:15:00 -0000 1.18
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: iter.t,v 1.17 2004/06/18 12:06:06 leo Exp $
+# $Id: iter.t,v 1.18 2004/06/18 15:15:00 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 26;
+use Parrot::Test tests => 29;
use Test::More qw(skip);
output_is(<<'CODE', <<'OUTPUT', "new iter");
@@ -883,3 +883,102 @@
500
ok
OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "slice iter range");
+ .include "iterator.pasm"
+ new P2, .PerlHash
+ set P2["a"], 10
+ set P2["b"], 20
+ set P2["c"], 30
+ set P2["d"], 40
+ set P2["e"], 50
+ slice P1, P2["a".. "c"]
+ set P1, .ITERATE_FROM_START
+iter_loop:
+ unless P1, iter_end
+ shift S1, P1
+ print S1
+ print "\n"
+ branch iter_loop
+iter_end:
+ print "ok\n"
+ end
+CODE
+10
+20
+30
+ok
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "slice iter range 2");
+ .include "iterator.pasm"
+ new P2, .PerlHash
+ set P2["a"], 10
+ set P2["b"], 20
+ set P2["c"], 30
+ set P2["d"], 40
+ set P2["e"], 50
+ set P2["A"], 11
+ set P2["B"], 21
+ set P2["C"], 31
+ set P2["D"], 41
+ set P2["E"], 51
+ slice P1, P2["a".. "c", 'C' .. 'E']
+ set P1, .ITERATE_FROM_START
+iter_loop:
+ unless P1, iter_end
+ shift S1, P1
+ print S1
+ print "\n"
+ branch iter_loop
+iter_end:
+ print "ok\n"
+ end
+CODE
+10
+20
+30
+31
+41
+51
+ok
+OUTPUT
+
+output_is(<<'CODE', <<OUTPUT, "slice iter range - vars");
+ .include "iterator.pasm"
+ new P2, .PerlHash
+ set P2["a"], 10
+ set P2["b"], 20
+ set P2["c"], 30
+ set P2["d"], 40
+ set P2["e"], 50
+ set P2["A"], 11
+ set P2["B"], 21
+ set P2["C"], 31
+ set P2["D"], 41
+ set P2["E"], 51
+ set S0, 'a'
+ set S1, 'c'
+ set S2, 'C'
+ set S3, 'E'
+ slice P1, P2[S0 .. S1, S2 .. S3, 'A']
+ set P1, .ITERATE_FROM_START
+iter_loop:
+ unless P1, iter_end
+ shift S10, P1
+ print S10
+ print "\n"
+ branch iter_loop
+iter_end:
+ print "ok\n"
+ end
+CODE
+10
+20
+30
+31
+41
+51
+11
+ok
+OUTPUT
