To my surprise, I found a 'ctx' member in struct Parrot_sub. It
appears that this is only used for the "autoclose" feature, which AFAICS
is not documented. The only place it is mentioned is in four
t/op/lexicals.t cases (though it is also used in three t/pmc/exception.t
cases; see the patch). The 'package-scoped closure 6 - autoclose' test
(the next-to-last one in t/op/lexicals.t) implements this Perl 6
snippet:
sub f ($x) {
sub g () { print "$x\n" };
}
f(10);
g();
in the following curious way:
.sub '&f'
.param pmc x
.lex '$x', x
.end
.sub '&g' :outer('&f')
.local pmc x
x = find_lex '$x'
print x
print "\n"
.end
.sub '&main' :main :anon
'&f'(10)
'&g'()
.end
Note that &f doesn't explicitly create a closure. Through the magic of
"autoclose," &g becomes a valid closure merely by invoking &f, and &main
prints "10" as a result.
The very fact of having a 'ctx' member in struct Parrot_sub bothers
me, but I haven't figured out how to make it fail yet, so my case
against it is purely esthetic. It seems cleaner to create the closure
and define the sub explicitly:
.sub '&f'
.param pmc x
.lex '$x', x
.local pmc sub_g, closure_g
.const .Sub sub_g = "raw_&g"
closure_g = newclosure sub_g
store_global '&g', closure_g
.end
.sub 'raw_&g' :outer('&f')
.local pmc x
x = find_lex '$x'
print x
print "\n"
.end
This also seems more natural for compilers to generate, especially when
presented with a variation like this [1]:
sub f ($x) {
if $x > $too_big {
sub g () { print "$x is too big\n" };
}
else {
sub g () { print "$x\n" };
}
}
The explicit solution also leaves &g undefined if no "sub g () { ... }"
statement is ever executed.
So it looks like "autoclose" is a convenience for writing PIR by
hand, whereas I personally think it is cleaner to create closures
explicitly. The attached patch changes all the affected test cases to
do so, and disables the feature. Is there anyone who would like to
argue that I shouldn't apply it? And if so, would you be willing to
document it?
-- Bob Rogers
http://rgrjr.dyndns.org/
[1] But I wouldn't swear that this is valid Perl 6 -- syntactically or
semantically.
Index: src/pmc/closure.pmc
===================================================================
--- src/pmc/closure.pmc (revision 14848)
+++ src/pmc/closure.pmc (working copy)
@@ -92,46 +92,13 @@
outer_sub = sub->outer_sub;
if (sub->outer_ctx) {
/* during newclosure, outer's ctx was stored in
- * sub->outer_ctx
+ * sub->outer_ctx. we need to copy it into our ctx.
*/
- sub->ctx->outer_ctx = sub->outer_ctx;
+ CONTEXT(INTERP->ctx)->outer_ctx = sub->outer_ctx;
}
- else if ((PObj_get_FLAGS(outer_sub) & SUB_FLAG_IS_OUTER) &&
- PMC_sub(outer_sub)->ctx) {
- /* the sub was invoked earlier - it still has the context
- * due to the SUB_FLAG_IS_OUTER flag
- */
- sub->outer_ctx = sub->ctx->outer_ctx = PMC_sub(outer_sub)->ctx;
- }
else {
- /* closure is just invoked - located :outer's ctx */
- parrot_context_t *caller = sub->ctx->caller_ctx;
- while (caller) {
- if (caller->current_sub == outer_sub) {
- cont = caller->current_cont;
- cont->vtable =
- interpreter->vtables[enum_class_Continuation];
- sub->outer_ctx = sub->ctx->outer_ctx = caller;
- caller->ref_count++;
- return next;
- }
- caller = caller->caller_ctx;
- }
- if (!caller) {
- /* outer has never been invoked, we fake a subroutine call
- * which builds the LexPad and return immediately
- * this will usually just lead to a Null PMC access
- * exception
- */
- INTERP->current_cont = NEED_CONTINUATION;
- (void)VTABLE_invoke(INTERP, sub->outer_sub, next);
- caller = CONTEXT(INTERP->ctx);
- cont = caller->current_cont;
- cont->vtable = interpreter->vtables[enum_class_Continuation];
- sub->outer_ctx = sub->ctx->outer_ctx = caller;
- caller->ref_count++;
- (void)VTABLE_invoke(INTERP, cont, next);
- }
+ real_exception(interpreter, NULL, 1,
+ "Closure sub called without 'newclosure'.\n");
}
return next;
}
Index: src/pmc/sub.pmc
===================================================================
--- src/pmc/sub.pmc (revision 14848)
+++ src/pmc/sub.pmc (working copy)
@@ -275,10 +275,6 @@
* and copy set context variables
*/
PMC_cont(ccont)->from_ctx = context;
- /*
- * set context of the sub
- */
- sub->ctx = context;
if (PObj_get_FLAGS(SELF) & SUB_FLAG_IS_OUTER) {
/* don't destroy context */
ccont->vtable = interpreter->vtables[enum_class_Continuation];
Index: include/parrot/sub.h
===================================================================
--- include/parrot/sub.h (revision 14848)
+++ include/parrot/sub.h (working copy)
@@ -70,7 +70,7 @@
PMC *lex_info; /* LexInfo PMC */
PMC *outer_sub; /* :outer for closures */
PMC *eval_pmc; /* eval container / NULL */
- parrot_context_t *ctx; /* the context this sub is in */
+ parrot_context_t *broken_ctx; /* the context this sub is in */
/* - end common */
struct Parrot_Context *outer_ctx; /* outer context, if a closure */
Index: t/pmc/exception.t
===================================================================
--- t/pmc/exception.t (revision 14848)
+++ t/pmc/exception.t (working copy)
@@ -728,7 +728,8 @@
a = 42
print "main\n"
.const .Sub at_exit = "exit_handler"
- pushaction at_exit
+ $P0 = newclosure at_exit
+ pushaction $P0
.return()
.end
@@ -756,7 +757,8 @@
push_eh h
print "main\n"
.const .Sub at_exit = "exit_handler"
- pushaction at_exit
+ $P0 = newclosure at_exit
+ pushaction $P0
$P1 = new .Exception
throw $P1
print "never 1\n"
@@ -783,10 +785,12 @@
pir_output_is(<<'CODE', <<'OUTPUT', "exit_handler via exit exception");
.sub main :main
- .local pmc a
+ .local pmc a, exit_handler
.lex 'a', a
a = new .Integer
a = 42
+ .const .Sub exit_handler_sub = "exit_handler"
+ exit_handler = newclosure exit_handler_sub
push_eh handler
exit 0
handler:
Index: t/op/lexicals.t
===================================================================
--- t/op/lexicals.t (revision 14848)
+++ t/op/lexicals.t (working copy)
@@ -364,7 +364,9 @@
pir_output_is(<<'CODE', <<'OUTPUT', 'get_outer');
.sub "main"
- foo()
+ .const .Sub foo = "foo"
+ $P0 = newclosure foo
+ $P0()
.end
.sub foo :outer('main')
.include "interpinfo.pasm"
@@ -379,10 +381,14 @@
pir_output_is(<<'CODE', <<'OUTPUT', 'get_outer 2');
.sub "main"
- foo()
+ .const .Sub foo = "foo"
+ $P0 = newclosure foo
+ $P0()
.end
.sub foo :outer('main')
- bar()
+ .const .Sub bar = "bar"
+ $P0 = newclosure bar
+ $P0()
.end
.sub bar :outer('foo')
.include "interpinfo.pasm"
@@ -820,7 +826,9 @@
.lex '$x', $P0
$P0 = new .Integer
$P0 = 5
- anon_1()
+ .const .Sub $P1 = 'anon_1'
+ $P2 = newclosure $P1
+ $P2()
.end
.sub anon_1 :anon :outer(main)
@@ -839,11 +847,17 @@
pir_output_like(<<'CODE', <<'OUTPUT', 'get non existing');
.sub "main" :main
.lex 'a', $P0
- foo()
+ .local pmc sub_foo, closure_foo
+ .const .Sub sub_foo = "foo"
+ closure_foo = newclosure sub_foo
+ closure_foo()
.end
.sub foo :outer('main')
.lex 'b', $P0
- bar()
+ .local pmc sub_bar, closure_bar
+ .const .Sub sub_bar = "bar"
+ closure_bar = newclosure sub_bar
+ closure_bar()
.end
.sub bar :outer('foo')
.lex 'c', $P0
@@ -898,8 +912,11 @@
# f()
# print "$x\n"
.sub '&main' :main :anon
- .local pmc sx
+ .local pmc sx, sub_f, closure_f
.lex '$x', sx
+ .const .Sub sub_f = "raw_&f"
+ closure_f = newclosure sub_f
+ store_global '&f', closure_f
sx = new .Integer
sx = 33
'&f'()
@@ -915,7 +932,7 @@
print "\n"
.end
-.sub '&f' :outer('&main')
+.sub 'raw_&f' :outer('&main')
$P0 = find_lex '$x' # find_lex needed
inc $P0
.end
@@ -932,8 +949,12 @@
# g()
# print "$x\n"
.sub '&main' :main :anon
- .local pmc sx
+ .local pmc sx, sub_f, closure_f
.lex '$x', sx
+ .const .Sub sub_f = "raw_&f"
+ closure_f = newclosure sub_f
+ store_global '&f', closure_f
+
sx = new .Integer
sx = -32
'&g'()
@@ -950,12 +971,12 @@
.end
-.sub '&f' :outer('&main')
+.sub 'raw_&f' :outer('&main')
$P0 = find_lex '$x'
inc $P0
.end
-.sub '&g' :outer('&main') # :outer not needed - no find_lex
+.sub '&g' # :outer not needed - no find_lex
'&f'()
'&f'()
.end
@@ -974,11 +995,15 @@
.sub '&f'
.param pmc x
.lex '$x', x
+ .local pmc sub_g, closure_g
+ .const .Sub sub_g = "raw_&g"
+ closure_g = newclosure sub_g
+ store_global '&g', closure_g
$P0 = '&g'(x)
.return ($P0)
.end
-.sub '&g' :outer('&f')
+.sub 'raw_&g' :outer('&f')
.param pmc y
.lex '$y', y
.local pmc x
@@ -1023,7 +1048,7 @@
print "never\n"
.end
CODE
-/Null PMC access/
+/Closure sub called without 'newclosure'/
OUTPUT
pir_output_is(<<'CODE', <<'OUTPUT', 'package-scoped closure 5 - autoclose');
@@ -1035,9 +1060,13 @@
.sub '&f'
.param pmc x
.lex '$x', x
+ .local pmc sub_g, closure_g
+ .const .Sub sub_g = "raw_&g"
+ closure_g = newclosure sub_g
+ store_global '&g', closure_g
.end
-.sub '&g' :outer('&f')
+.sub 'raw_&g' :outer('&f')
.local pmc x
x = find_lex '$x'
print x
@@ -1062,9 +1091,13 @@
.sub '&f'
.param pmc x
.lex '$x', x
+ .local pmc sub_g, closure_g
+ .const .Sub sub_g = "raw_&g"
+ closure_g = newclosure sub_g
+ store_global '&g', closure_g
.end
-.sub '&g' :outer('&f')
+.sub 'raw_&g' :outer('&f')
.local pmc x
x = find_lex '$x'
print x
