cvsuser 03/07/05 05:17:24
Modified: classes iterator.pmc perlhash.pmc
. hash.c
t/pmc iter.t
Log:
hash iter: buggy initial try
Revision Changes Path
1.4 +9 -2 parrot/classes/iterator.pmc
Index: iterator.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/iterator.pmc,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- iterator.pmc 6 Jun 2003 15:14:59 -0000 1.3
+++ iterator.pmc 5 Jul 2003 12:17:20 -0000 1.4
@@ -1,7 +1,7 @@
/* Iterator.pmc
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: iterator.pmc,v 1.3 2003/06/06 15:14:59 leo Exp $
+ * $Id: iterator.pmc,v 1.4 2003/07/05 12:17:20 leo Exp $
* Overview:
* These are the vtable functions for the Iterator base class
* Data Structure and Algorithms:
@@ -103,7 +103,8 @@
}
STRING* get_string_keyed (PMC* key) {
- return (STRING*)0;
+ return VTABLE_get_string_keyed(INTERP,
+ (PMC *)PMC_data(SELF), key);
}
STRING* get_string_keyed_int (INTVAL* key) {
@@ -356,6 +357,12 @@
}
STRING* shift_string () {
+ PMC *key = SELF->cache.struct_val;
+ PMC *agg = PMC_data(SELF);
+ STRING * ret = VTABLE_shift_string_keyed(INTERP, agg, key);
+ SELF->cache.struct_val =
+ VTABLE_nextkey_keyed(INTERP, agg, key, 1);
+ return ret;
return (STRING*)0;
}
1.40 +36 -1 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -w -r1.39 -r1.40
--- perlhash.pmc 6 Jun 2003 15:14:59 -0000 1.39
+++ perlhash.pmc 5 Jul 2003 12:17:20 -0000 1.40
@@ -1,7 +1,7 @@
/* perlhash.pmc
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: perlhash.pmc,v 1.39 2003/06/06 15:14:59 leo Exp $
+ * $Id: perlhash.pmc,v 1.40 2003/07/05 12:17:20 leo Exp $
* Overview:
* These are the vtable functions for the PerlHash base class
* Data Structure and Algorithms:
@@ -17,6 +17,7 @@
#define INT2KEY(i,k) ((k) ? key_new_integer((i), *(k)) : NULL)
static PMC* undef = NULL;
+STRING * hash_get_idx(Interp *interpreter, HASH *hash, INTVAL idx);
static STRING* make_hash_key(Interp* interpreter, PMC * key)
{
@@ -335,5 +336,39 @@
else
VTABLE_delete_keyed(INTERP, he->val.pmc_val,
key);
+ }
+
+ PMC* nextkey_keyed (PMC* key, INTVAL what) {
+ PMC *ret = key;
+
+ INTVAL n = SELF.elements();
+ PObj_get_FLAGS(ret) &= ~KEY_type_FLAGS;
+ PObj_get_FLAGS(ret) |= KEY_integer_FLAG;
+ switch (what) {
+ case 0: /* reset key, iterate from start */
+ ret->cache.int_val = 0;
+ break;
+ case 1: /* next key */
+ if (ret->cache.int_val < n)
+ ++ret->cache.int_val;
+ break;
+ case 2: /* prev key */
+ if (ret->cache.int_val >= 0)
+ --ret->cache.int_val;
+ break;
+ case 3: /* reset key, iterate from end */
+ ret->cache.int_val = n - 1;
+ break;
+ }
+ return ret;
+ }
+
+ /* used by iterator.pmc:
+ * return hash key for an integer idx in key
+ */
+ STRING* shift_string_keyed(PMC *key) {
+ INTVAL idx = key_integer(INTERP, key);
+ HASH * h = (HASH *)PMC_data(SELF);
+ return hash_get_idx(INTERP, h, idx);
}
}
1.39 +23 -1 parrot/hash.c
Index: hash.c
===================================================================
RCS file: /cvs/public/parrot/hash.c,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -w -r1.38 -r1.39
--- hash.c 6 Jun 2003 14:00:53 -0000 1.38
+++ hash.c 5 Jul 2003 12:17:22 -0000 1.39
@@ -1,7 +1,7 @@
/* hash.c
* Copyright: (When this is determined...it will go here)
* CVS Info
- * $Id: hash.c,v 1.38 2003/06/06 14:00:53 leo Exp $
+ * $Id: hash.c,v 1.39 2003/07/05 12:17:22 leo Exp $
* Overview:
* Data Structure and Algorithms:
* A hashtable contains an array of bucket indexes. Buckets
@@ -41,6 +41,8 @@
* buckets indexed by hash(KEY) mod hash_size */
const HashIndex NULLHashIndex = (HashIndex)-1;
+STRING * hash_get_idx(Interp *interpreter, HASH *hash, INTVAL idx);
+
/* Is there a way to portably add inlining hints anymore? */
#define FIXME_INLINE
@@ -335,6 +337,26 @@
HashIndex *table = (HashIndex *)hash->buffer.bufstart;
BucketIndex chain = table[hashval & hash->max_chain];
return find_bucket(interpreter, hash, chain, key);
+}
+
+/* given a zero based idx return a hash key
+ * FIXME: this is suboptimal
+ */
+STRING *
+hash_get_idx(Interp *interpreter, HASH *hash, INTVAL idx)
+{
+ HashIndex i;
+ INTVAL n = 0;
+ for (i = 0; i <= hash->max_chain; i++) {
+ BucketIndex bi = lookupBucketIndex(hash, i);
+ while (bi != NULLBucketIndex) {
+ HASHBUCKET *b = getBucket(hash, bi);
+ if (n++ == idx)
+ return b->key;
+ bi = b->next;
+ }
+ }
+ return NULL;
}
HASH_ENTRY *
1.3 +93 -1 parrot/t/pmc/iter.t
Index: iter.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/iter.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- iter.t 20 May 2003 07:24:31 -0000 1.2
+++ iter.t 5 Jul 2003 12:17:24 -0000 1.3
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 4;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "new iter");
new P2, .PerlArray
@@ -87,3 +87,95 @@
ok 12
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "hash iter 1");
+ new P0, .PerlHash # empty Hash
+ new P2, .PerlHash # Hash with 2 elements
+ set P2["ab"], 100
+ set P2["xy"], "value"
+ set I0, P2
+ new P1, .Iterator, P2
+ print "ok 1\n"
+ set I1, P1
+ eq I0, I1, ok2 # iter.length() == hash.length()
+ print "not "
+ok2: print "ok 2\n"
+ new P1, .Iterator, P0
+ set P1, 0 # reset PIter
+ print "ok 3\n"
+ unless P1, ok4 # if(iter) == false on empty
+ print "not "
+ok4: print "ok 4\n"
+ new P1, .Iterator, P2
+ set P1, 0 # reset PIter
+ if P1, ok5 # if(iter) == true on non empty
+ print "not "
+ok5: print "ok 5\n"
+ # now iterate over P2
+ # while (P1) { key = shift(P1) }
+ unless P1, nok6
+ shift S3, P1 # get hash.key
+ eq S3, "ab", ok6
+ eq S3, "xy", ok6
+nok6: print " not "
+ok6: print "ok 6\n"
+ unless P1, nok7
+ shift S3, P1
+ eq S3, "ab", ok7
+ eq S3, "xy", ok7
+nok7: print "not "
+ok7: print "ok 7\n"
+ unless P1, ok8 # if(iter) == false after last
+ print "not "
+ok8: print "ok 8\n"
+ end
+
+CODE
+ok 1
+ok 2
+ok 3
+ok 4
+ok 5
+ok 6
+ok 7
+ok 8
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "hash iter 2");
+ new P0, .PerlHash # Hash for iteration
+ new P2, .PerlHash # for test
+
+ set I0, 65
+ set I1, 35
+ set I10, I1
+fill:
+ chr S0, I0
+ set P0[S0], I0
+ dec I1
+ inc I0
+ if I1, fill
+
+ new P1, .Iterator, P0
+ set I0, P1
+ eq I0, I10, ok1
+ print "not "
+ok1:
+ print "ok 1\n"
+ set P1, 0
+get:
+ unless P1, done
+ shift S3, P1 # get hash.key
+ set I0, P0[S3] # and value
+ set P2[S3], I0
+ branch get
+
+done:
+ set I0, P2
+ eq I0, I10, ok2
+ print "not "
+ok2:
+ print "ok 2\n"
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
