Front page | perl.perl5.porters |
Postings from January 2001
Re: `Final' lvsub patch: arrays and hashes
Thread Previous
|
Thread Next
From:
Stephen McCamant
Date:
January 4, 2001 23:08
Subject:
Re: `Final' lvsub patch: arrays and hashes
Message ID:
14933.24347.495481.478191@soda.csua.berkeley.edu
>>>>> "SC" == Simon Cozens <simon@cozens.net> writes:
SC> What I would suggest as the way forward is that Stephen grabs
SC> bleadperl, applies these two patches to his tree, does the mod()
SC> hack, changes LVRET to check his flag instead of "PL_op->op_next
SC> && ...", and then produces a consolidated patch against bleadperl
SC> which makes the whole thing work.
Well, I wrote part of the mod() hack and added a flag, but I don't
think that one could yet say that `the whole thing works'. Some notes,
in no particular order:
* Your method of checking the context stack didn't work for me (it
segfaulted several of the lib/* tests, in fact; did you run them?),
since you can't be sure that the context on top of the stack is a
sub context (you might be returning out of the middle of a loop,
say). The simplest fix seemed to be to use dopoptosub(), though this
required moving the test into a function in pp_ctl.c
* I've decided that my idea of turning on both the private flag and
OPf_MOD (or OPf_REF) won't work because the op might have OPf_MOD
for some other reason, so it might need to be an lvalue even if the
sub isn't being used as an lvalue; for instance,
sub f :lvalue { @a = (1,2); }
* Checking for real syntactic lvalue-ness significantly narrows the
range of what subs can be lvalues. Roughly, you can only return foo
from an lvalue sub if `foo = bar' would be legal. This doesn't seem
to me like a very onerous restriction from the point of view of real
applications of lvalue subs (not that I have any experience with
that), but it's a big change from the way lvalue subs currently seem
to be perceived by the code's authors; for instance it breaks about
half of t/pragma/sub_lval.t. It has lots of examples like
sub f1 :lvalue {shift}; f($x) = 7; print "$x\n"
sub f2 :lvalue {$_[0]}; f($x) = 7; print "$x\n"
which sort of do what you want if you think of f as being a
do-nothing `identity' function, but that line of thought doesn't
help with
sub f3 :lvalue {$_[0] + 0}; f($x) = 7; print "$x\n"
because that `identity' function happens to have an implementation
that makes a new SV. I don't think we should allow `shift(@x) = 5',
and I don't think we should allow `sub f :lvalue {shift @x}'
either, since I consider the fact that it works an implementation
detail. (f2 is okay since you can say $_[0] = 7 just fine). And do
we really need to wait until you try an assignment at runtime to
complain about
sub pi :lvalue { 3.1415926535 } ?
* What should
sub f :lvalue {@a}; f() = "foo\n"; print "@a";
do? Probably not what it does in my current version, which is cause
a segfault in sv_setsv(). If f is returning an array, the only
sensible kind of assignment you can do to it is an array
assignment. The nicest thing would be for it to figure out what I
meant and act as if I said `(f()) = "foo\n"', but I'm not sure how
the information would propagate to achieve that. If I were designing
this from scratch, I think I'd say sub assignments are always list
assignments (I never was fond of the $x= vs. ($x)= distinction
anyway), but it may be too late for that. The best fix I can think
of at the moment is for the rv2av to croak if it isn't in list
context (more runtime checks, yay!).
SC> That would be really really cool.
The following patch (just a progress report, not intended to go in) is
against 8327; it doesn't include the doc change or the changes to
sub_lval.t:
--- perl-current/pp.h Sun Dec 31 18:02:31 2000
+++ perl+lval/pp.h Thu Jan 4 22:32:03 2001
@@ -380,3 +380,10 @@
SvREFCNT_dec(tmpRef); \
SvRV(rv)=AMG_CALLun(rv,copy); \
} } STMT_END
+
+/*
+=for apidoc mU||LVRET
+True if the next operation will cause a return from an lvalue subroutine
+
+*/
+#define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && Perl_is_lvalue_sub())
--- perl-current/op.h Thu Jan 4 12:54:19 2001
+++ perl+lval/op.h Thu Jan 4 22:21:44 2001
@@ -157,6 +157,8 @@
#define OPpLVAL_DEFER 16 /* Defer creation of array/hash elem */
/* OP_RV2?V, OP_GVSV only */
#define OPpOUR_INTRO 16 /* Defer creation of array/hash elem */
+ /* OP_RV2[AH]V, OP_PAD[AH]V, OP_[AH]ELEM */
+#define OPpMAYBE_LVSUB 8 /* We might be an lvalue to return */
/* for OP_RV2?V, lower bits carry hints (currently only HINT_STRICT_REFS) */
/* Private for OPs with TARGLEX */
--- perl-current/op.c Thu Jan 4 12:54:19 2001
+++ perl+lval/op.c Thu Jan 4 23:23:08 2001
@@ -1528,6 +1528,8 @@
PL_modcount = 10000;
return o; /* Treat \(@foo) like ordinary list. */
}
+ if (type == OP_LEAVESUBLV)
+ o->op_private |= OPpMAYBE_LVSUB;
/* FALL THROUGH */
case OP_RV2GV:
if (scalar_mod_type(o, type))
@@ -1565,6 +1567,8 @@
return o; /* Treat \(@foo) like ordinary list. */
if (scalar_mod_type(o, type))
goto nomod;
+ if (type == OP_LEAVESUBLV)
+ o->op_private |= OPpMAYBE_LVSUB;
/* FALL THROUGH */
case OP_PADSV:
PL_modcount++;
@@ -1606,12 +1610,15 @@
if (type == OP_ENTERSUB &&
!(o->op_private & (OPpLVAL_INTRO | OPpDEREF)))
o->op_private |= OPpLVAL_DEFER;
+ if (type == OP_LEAVESUBLV)
+ o->op_private |= OPpMAYBE_LVSUB;
PL_modcount++;
break;
case OP_SCOPE:
case OP_LEAVE:
case OP_ENTER:
+ case OP_LINESEQ:
if (o->op_flags & OPf_KIDS)
mod(cLISTOPo->op_last, type);
break;
@@ -1631,7 +1638,8 @@
mod(kid, type);
break;
}
- o->op_flags |= OPf_MOD;
+ if (type != OP_LEAVESUBLV)
+ o->op_flags |= OPf_MOD;
if (type == OP_AASSIGN || type == OP_SASSIGN)
o->op_flags |= OPf_SPECIAL|OPf_REF;
@@ -1640,7 +1648,8 @@
o->op_flags &= ~OPf_SPECIAL;
PL_hints |= HINT_BLOCK_SCOPE;
}
- else if (type != OP_GREPSTART && type != OP_ENTERSUB)
+ else if (type != OP_GREPSTART && type != OP_ENTERSUB
+ && type != OP_LEAVESUBLV)
o->op_flags |= OPf_REF;
return o;
}
@@ -4661,7 +4670,8 @@
av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
if (CvLVALUE(cv)) {
- CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block));
+ CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
+ mod(scalarseq(block), OP_LEAVESUBLV));
}
else {
CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
@@ -6652,7 +6662,7 @@
(PL_op = pop->op_next) &&
pop->op_next->op_type == OP_AELEM &&
!(pop->op_next->op_private &
- (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) &&
+ (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
(i = SvIV(((SVOP*)pop)->op_sv) - PL_compiling.cop_arybase)
<= 255 &&
i >= 0)
@@ -6878,32 +6888,6 @@
}
o->op_seq = PL_op_seqmax++;
break;
-
- case OP_RETURN:
- if (o->op_next && o->op_next->op_type != OP_LEAVESUBLV) {
- o->op_seq = PL_op_seqmax++;
- break;
- }
- /* FALL THROUGH */
-
- case OP_LEAVESUBLV:
- if (last_composite) {
- OP *r = last_composite;
-
- while (r->op_sibling)
- r = r->op_sibling;
- if (r->op_next == o
- || (r->op_next->op_type == OP_LIST
- && r->op_next->op_next == o))
- {
- if (last_composite->op_type == OP_RV2AV)
- yyerror("Lvalue subs returning arrays not implemented yet");
- else
- yyerror("Lvalue subs returning hashes not implemented yet");
- ;
- }
- }
- /* FALL THROUGH */
default:
o->op_seq = PL_op_seqmax++;
--- perl-current/pp_ctl.c Sun Dec 31 18:02:31 2000
+++ perl+lval/pp_ctl.c Thu Jan 4 22:00:24 2001
@@ -1240,6 +1240,20 @@
}
}
+I32
+Perl_is_lvalue_sub(pTHX)
+{
+ I32 cxix;
+
+ cxix = dopoptosub(cxstack_ix);
+ assert(cxix >= 0); /* We should only be called from inside subs */
+
+ if (cxstack[cxix].blk_sub.lval && CvLVALUE(cxstack[cxix].blk_sub.cv))
+ return cxstack[cxix].blk_sub.lval;
+ else
+ return 0;
+}
+
STATIC I32
S_dopoptosub(pTHX_ I32 startingblock)
{
--- perl-current/embed.pl Sat Dec 30 11:16:25 2000
+++ perl+lval/embed.pl Thu Jan 4 22:01:21 2001
@@ -1593,6 +1593,7 @@
p |bool |io_close |IO* io|bool not_implicit
p |OP* |invert |OP* cmd
dp |bool |is_gv_magical |char *name|STRLEN len|U32 flags
+p |I32 |is_lvalue_sub
Ap |bool |is_uni_alnum |U32 c
Ap |bool |is_uni_alnumc |U32 c
Ap |bool |is_uni_idfirst |U32 c
--- perl-current/pp_hot.c Thu Jan 4 09:43:59 2001
+++ perl+lval/pp_hot.c Thu Jan 4 22:39:46 2001
@@ -668,7 +668,7 @@
av = GvAVn(gv);
if (PL_op->op_private & OPpLVAL_INTRO)
av = save_ary(gv);
- if (PL_op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF || LVRET) {
SETs((SV*)av);
RETURN;
}
@@ -772,7 +772,7 @@
hv = GvHVn(gv);
if (PL_op->op_private & OPpLVAL_INTRO)
hv = save_hash(gv);
- if (PL_op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF || LVRET) {
SETs((SV*)hv);
RETURN;
}
@@ -1532,7 +1532,7 @@
SV **svp;
SV *keysv = POPs;
HV *hv = (HV*)POPs;
- U32 lval = PL_op->op_flags & OPf_MOD;
+ U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
@@ -2785,7 +2785,7 @@
SV* elemsv = POPs;
IV elem = SvIV(elemsv);
AV* av = (AV*)POPs;
- U32 lval = PL_op->op_flags & OPf_MOD;
+ U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
SV *sv;
--- perl-current/pp.c Thu Jan 4 18:49:42 2001
+++ perl+lval/pp.c Thu Jan 4 20:49:58 2001
@@ -111,7 +111,7 @@
if (PL_op->op_private & OPpLVAL_INTRO)
SAVECLEARSV(PL_curpad[PL_op->op_targ]);
EXTEND(SP, 1);
- if (PL_op->op_flags & OPf_REF) {
+ if (PL_op->op_flags & OPf_REF || LVRET) {
PUSHs(TARG);
RETURN;
}
@@ -147,7 +147,7 @@
XPUSHs(TARG);
if (PL_op->op_private & OPpLVAL_INTRO)
SAVECLEARSV(PL_curpad[PL_op->op_targ]);
- if (PL_op->op_flags & OPf_REF)
+ if (PL_op->op_flags & OPf_REF || LVRET)
RETURN;
gimme = GIMME_V;
if (gimme == G_ARRAY) {
-- Stephen `yes, I do name all my functions f' McCamant
Thread Previous
|
Thread Next