Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add preliminary support for hash iterators

Untested, as I accidentally installed a Perl without MULTIPLICITY,
and Blizkost hasn't been made clean for that yet.
  • Loading branch information...
commit ef6f0bee3a8ece69a1f7ced0a62856b00818735a 1 parent 9dfcf49
@sorear sorear authored
View
3  build/Makefile.in
@@ -41,7 +41,8 @@ PMC_DEPS = \
$(PMC_DIR)/p5sv.pmc \
$(PMC_DIR)/p5interpreter.pmc \
$(PMC_DIR)/p5namespace.pmc \
- $(PMC_DIR)/p5scalar.pmc
+ $(PMC_DIR)/p5scalar.pmc \
+ $(PMC_DIR)/p5hashiter.pmc
SOURCES = \
perl5.pir
View
2  build/src/pmc/Makefile.in
@@ -47,6 +47,7 @@ PMC_SOURCES = \
p5sv.pmc \
p5interpreter.pmc \
p5scalar.pmc \
+ p5hashiter.pmc \
p5namespace.pmc \
p5invocation.pmc
@@ -93,6 +94,7 @@ compile: generate
$(CC) $(CC_OUT)p5namespace$(O) $(INCLUDES) $(CFLAGS) p5namespace.c
$(CC) $(CC_OUT)p5interpreter$(O) $(INCLUDES) $(CFLAGS) p5interpreter.c
$(CC) $(CC_OUT)p5invocation$(O) $(INCLUDES) $(CFLAGS) p5invocation.c
+ $(CC) $(CC_OUT)p5hashiter$(O) $(INCLUDES) $(CFLAGS) p5hashiter.c
$(CC) $(CC_OUT)lib-$(BLIZKOST_GROUP)$(O) $(INCLUDES) $(CFLAGS) $(BLIZKOST_GROUP).c
$(CC) $(CC_OUT)bkmarshal$(O) $(INCLUDES) $(CFLAGS) bkmarshal.c
View
3  src/pmc/blizkost.h
@@ -60,6 +60,9 @@ does the necessary cruft to import both in the same file.
#include "pmc_p5namespace.h"
#include "pmc_p5sv.h"
#include "pmc_p5scalar.h"
+#include "pmc_p5hashiter.h"
+
+extern HE blizkost_EMPTY;
#include "bkmarshal.h"
View
99 src/pmc/p5hashiter.pmc
@@ -0,0 +1,99 @@
+/*
+Copyright (C) 2009, Jonathan Worthington and friends
+
+This file is distributed under the same terms as Parrot itself; see the
+file LICENSE in the source root for details.
+
+=head1 NAME
+
+src/pmc/p5hashiter.pmc - Perl 5 hash iterator
+
+=head1 DESCRIPTION
+
+This PMC wraps the Perl 5 hv_iter interface to provide an iterator object
+interface. Note that the serial iterations rule is still present.
+
+=cut
+
+*/
+
+#include "blizkost.h"
+
+HE blizkost_EMPTY; /*semipredicate*/
+
+static HE *
+force_current_he(PARROT_INTERP, PMC *hiter) {
+ HE *current_he;
+ PMC *hash, *p5i;
+ HV *hashsv;
+ PerlInterpreter *my_perl;
+
+ GETATTR_P5HashIter_current_he(interp, hiter, current_he);
+
+ if (current_he != &blizkost_EMPTY) {
+ return current_he;
+ }
+
+ GETATTR_P5HashIter_backing_hash(interp, hiter, hash);
+ GETATTR_P5SV_p5i(interp, hash, p5i);
+ GETATTR_P5Interpreter_my_perl(interp, p5i, my_perl);
+ GETATTR_P5SV_sv(interp, hash, hashsv);
+
+ current_he = hv_iternext(hashsv);
+
+ SETATTR_P5HashIter_current_he(interp, hiter, current_he);
+
+ return current_he;
+}
+
+/* extends Iterator - TT#1578 */
+pmclass P5HashIter no_ro group blizkost_group dynpmc auto_attrs {
+ ATTR PMC *backing_hash;
+ /* FIXME This encapsulation break sucks, but it's not trivially fixable
+ because pmc2c puts the attribute declarations into a header where
+ they are divorced from the local referencing environment, causing
+ errors down the line if we use the typedef. */
+ ATTR struct he *current_he;
+
+/*
+
+=item C<void mark()>
+
+Mark GC-ables.
+
+=cut
+
+*/
+ VTABLE void mark() {
+ PMC *backing_hash;
+ GET_ATTR_backing_hash(interp, SELF, backing_hash);
+ if (backing_hash)
+ Parrot_gc_mark_PObj_alive(interp, (PObj*)backing_hash);
+ }
+
+ VTABLE INTVAL get_bool() {
+ return force_current_he(INTERP, SELF) != NULL;
+ }
+
+ VTABLE PMC *shift_pmc() {
+ HE *current_he = force_current_he(INTERP, SELF);
+ SV *keysv;
+ PMC *p5i, *hash;
+ PerlInterpreter *my_perl;
+
+ if (current_he == NULL) {
+ Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_OUT_OF_BOUNDS,
+ "StopIteration");
+ }
+
+ SET_ATTR_current_he(INTERP, SELF, &blizkost_EMPTY);
+
+ GET_ATTR_backing_hash(INTERP, SELF, hash);
+ GETATTR_P5SV_p5i(INTERP, hash, p5i);
+ GETATTR_P5Interpreter_my_perl(INTERP, p5i, my_perl);
+
+ keysv = hv_iterkeysv(current_he);
+
+ return blizkost_wrap_sv(INTERP, p5i, keysv);
+ }
+}
View
53 src/pmc/p5scalar.pmc
@@ -155,6 +155,55 @@ Returns the string value of the SV.
}
}
+ VTABLE PMC *get_iter() {
+ PerlInterpreter *my_perl;
+ PMC *p5i, *elpmc;
+ SV *sv, *rsv, *element;
+ svtype type;
+
+ GET_ATTR_p5i(interp, SELF, p5i);
+ GETATTR_P5Interpreter_my_perl(interp, p5i, my_perl);
+ GET_ATTR_sv(interp, SELF, sv);
+
+ ENTER;
+ SAVETMPS;
+
+ SvGETMAGIC(sv);
+
+ if (!SvROK(sv))
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "non-reference value used as aggregate");
+
+ /* XXX handle overloading
+ problem: we don't necessarily know whether to use @{} or %{}
+ Austin suggests using whichever is overloaded, else @{} */
+ rsv = SvRV(sv);
+ type = SvTYPE(rsv);
+
+ if (type == SVt_PVHV) {
+ PMC *iter = Parrot_pmc_new_noinit(interp, pmc_type(interp,
+ string_from_literal(interp, "P5HashIter")));
+
+ hv_iterinit((HV*) rsv);
+
+ PObj_custom_mark_SET(iter);
+ /* XXX this is a cheat */
+ SETATTR_P5HashIter_backing_hash(interp, iter,
+ blizkost_wrap_sv(interp, p5i, (SV*)rsv));
+ SETATTR_P5HashIter_current_he(interp, iter, &blizkost_EMPTY);
+
+ FREETMPS;
+ LEAVE;
+ return iter;
+ } else {
+ FREETMPS;
+ LEAVE;
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_INVALID_OPERATION,
+ "non-hash reference used as aggregate");
+ }
+ }
/*
@@ -199,6 +248,7 @@ Attempts to invoke the target of a code reference.
PMC *ctx = CURRENT_CONTEXT(interp);
PMC *call_object = Parrot_pcc_get_signature(interp, ctx);
+ PMC *ret_object;
GET_ATTR_p5i(interp, SELF, p5i);
GETATTR_P5Interpreter_my_perl(interp, p5i, my_perl);
@@ -210,7 +260,8 @@ Attempts to invoke the target of a code reference.
blizkost_call_in(interp, p5i, invref, G_ARRAY, positional, named,
&results);
- Parrot_pcc_build_call_from_c_args(interp, call_object, "Pf", results);
+ ret_object = Parrot_pcc_build_call_from_c_args(interp, call_object,
+ "Pf", results);
return blizkost_return_from_invoke(interp, next);
}
Please sign in to comment.
Something went wrong with that request. Please try again.