diff options
| author | Gurusamy Sarathy <gsar@cpan.org> | 2000-02-15 17:42:06 +0000 |
|---|---|---|
| committer | Gurusamy Sarathy <gsar@cpan.org> | 2000-02-15 17:42:06 +0000 |
| commit | 345599ca7248bba771c8a9cadc2422a744a61ff2 (patch) | |
| tree | baffde66935102e9864c06feff9808dfa426fb9c /op.c | |
| parent | 827e134a90c4e2814fe47bdf310ed7e78fd7f61c (diff) | |
| download | perl-345599ca7248bba771c8a9cadc2422a744a61ff2.tar.gz | |
optimize pseudohash slice in array slice at compile time (from
John Tobey <jtobey@john-edwin-tobey.org>)
p4raw-id: //depot/perl@5104
Diffstat (limited to 'op.c')
| -rw-r--r-- | op.c | 56 |
1 files changed, 56 insertions, 0 deletions
@@ -6493,6 +6493,62 @@ Perl_peep(pTHX_ register OP *o) *svp = newSViv(ind); break; } + + case OP_HSLICE: { + UNOP *rop; + SV *lexname; + GV **fields; + SV **svp, **indsvp; + I32 ind; + char *key; + STRLEN keylen; + SVOP *first_key_op, *key_op; + + if ((o->op_private & (OPpLVAL_INTRO)) + /* I bet there's always a pushmark... */ + || ((LISTOP*)o)->op_first->op_sibling->op_type != OP_LIST) + /* hmmm, no optimization if list contains only one key. */ + break; + rop = (UNOP*)((LISTOP*)o)->op_last; + if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV) + break; + lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE); + if (!SvOBJECT(lexname)) + break; + fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE); + if (!fields || !GvHV(*fields)) + break; + /* Again guessing that the pushmark can be jumped over.... */ + first_key_op = (SVOP*)((LISTOP*)((LISTOP*)o)->op_first->op_sibling) + ->op_first->op_sibling; + /* Check that the key list contains only constants. */ + for (key_op = first_key_op; key_op; + key_op = (SVOP*)key_op->op_sibling) + if (key_op->op_type != OP_CONST) + break; + if (key_op) + break; + rop->op_type = OP_RV2AV; + rop->op_ppaddr = PL_ppaddr[OP_RV2AV]; + o->op_type = OP_ASLICE; + o->op_ppaddr = PL_ppaddr[OP_ASLICE]; + for (key_op = first_key_op; key_op; + key_op = (SVOP*)key_op->op_sibling) { + svp = cSVOPx_svp(key_op); + key = SvPV(*svp, keylen); + indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); + if (!indsvp) { + Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s", + key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname))); + } + ind = SvIV(*indsvp); + if (ind < 1) + Perl_croak(aTHX_ "Bad index while coercing array into hash"); + SvREFCNT_dec(*svp); + *svp = newSViv(ind); + } + break; + } case OP_RV2AV: case OP_RV2HV: |