4 # ast type info is generally still implicit
5 # the combined madness calls are actually losing type information
6 # brace madprops tend to be too low in the tree
7 # could use about 18 more refactorings...
8 # lots of unused cruft left around from previous refactorings
23 my $filename = $options{'input'} or die;
24 $deinterpolate = $options{'deinterpolate'};
25 my $YAML = $options{'YAML'};
27 local $SIG{__DIE__} = sub {
29 $e =~ s/\n$/\n [NODE $filename line $::prevstate->{line}]/ if $::prevstate;
35 my $p1 = XML::Parser->new(Style => 'Objects', Pkg => 'PLXML');
36 $p1->setHandlers('Char' => sub { warn "Chars $_[1]" if $_[1] =~ /\S/; });
38 # First slurp XML into tree of objects.
40 my $root = $p1->parsefile($filename);
42 # Now turn XML tree into something more like an AST.
44 PLXML::prepreproc($root->[0]);
45 my $ast = P5AST->new('Kids' => [$root->[0]->ast()]);
50 return YAML::Syck::Dump($ast);
53 # Finally, walk AST to produce new program.
55 my $text = $ast->p5text(); # returns encoded, must output raw
61 $::curenc = 1; # start in iso-8859-1, sigh...
63 $::H = "HeredocHere000";
82 'o' => 'p5::operator',
83 '~' => 'p5::operator',
98 'a' => 'p5::operator',
99 'A' => 'p5::operator',
100 'd' => 'p5::declarator',
105 'q' => 'p5::openquote',
106 'Q' => 'p5::closequote',
110 's' => 'p5::declarator',
111 # 'V' => 'p5::version',
116 $Data::Dumper::Indent = 1;
117 $Data::Dumper::Quotekeys = 0;
120 my $text = Dumper(@_);
121 # doesn't scale well, alas
122 1 while $text =~ s/(.*)^([^\n]*)bless\( \{\n(.*?)^(\s*\}), '([^']*)' \)([^\n]*)/$1$2$5 {\n$3$4$6 # $5/ms;
123 $text =~ s/PLXML:://g;
125 my ($package, $filename, $line) = caller;
126 my $subroutine = (caller(1))[3];
127 $text =~ s/\n?\z/, called from $subroutine, line $line\n/;
147 warn xdolist($indent,"LIST",@_);
150 my $type = ref $_[0];
152 warn xdoitem($indent,$type,@_);
155 warn xdoitem($indent,"ITEM",@_);
163 my $in = ' ' x ($indent * 2);
165 $result .= "$in<$tag>\n" if defined $tag;
167 my $itt = ref $it || "ITEM";
169 $result .= xdoitem($indent+1,$itt,$it);
171 $result .= "$in</$tag>\n" if defined $tag;
179 my $in = ' ' x ($indent * 2);
180 my $result = "$in<$tag>\n";
181 my @keys = sort keys %$hash;
184 $longest = length($k) if length($k) > $longest;
189 $K = $$hash{$k}, next if $k eq 'Kids';
190 my $sp = ' ' x ($longest - length($k));
191 if (ref $$hash{$k}) {
192 $tmp = xdoitem($indent+1,"kv",$$hash{$k});
193 $tmp =~ s!^ *<kv>\n *</kv>!$in <kv/>!;
196 $tmp = xdoitem($indent+1,"kv",$$hash{$k});
198 $k =~ s/([\t\n'"<>&])/$xmlrepl{$1}/g;
199 $tmp =~ s/<kv/<kv k='$k'$sp/ or
200 $tmp =~ s/^(.*)$/$in <kv k='$k'>\n$in $1$in <\/kv>\n/s;
204 $result .= xdolist($indent, undef, @$K);
206 $result .= "$in</$tag>\n";
213 my $in = ' ' x ($indent * 2);
216 $item =~ s/([\t\n'"<>&])/$xmlrepl{$1}/g;
217 return "$in<$tag>$item</$tag>\n";
219 (my $newtag = $r) =~ s/::/:/g;
221 if ($t =~ /\bARRAY\b/) {
223 return xdolist($indent,$tag,@{$item});
226 return "$in<$tag />\n";
229 if ($t =~ /\bHASH\b/) {
230 return xdohash($indent,$tag,$item);
233 return "$in<$newtag>$$item</$newtag>\n";
236 return "$in<$newtag type='$r'/>\n";
250 tdolist($indent,"LIST",@_);
253 my $type = ref $_[0];
255 tdoitem($indent,$type,@_);
258 tdoitem($indent,"ITEM",@_);
266 my $tag = shift || "ARRAY";
267 my $in = ' ' x ($indent * 2);
271 my $itt = ref $it || "ITEM";
272 print STDERR $in," ";
273 tdoitem($indent+1,$itt,$it);
287 my $in = ' ' x ($indent * 2);
289 print STDERR "$tag => {\n";
291 my @keys = sort keys %$hash;
294 $longest = length($k) if length($k) > $longest;
298 my $sp = ' ' x ($longest - length($k));
299 print STDERR "$in $k$sp => ";
300 tdoitem($indent+1,"",$$hash{$k});
302 print STDERR " # Kids";
306 print STDERR "$in} # $tag";
313 if (not defined $item) {
314 print STDERR "UNDEF";
317 # my $in = ' ' x ($indent * 2);
320 $item =~ s/([\t\n"])/$trepl{$1}/g;
321 print STDERR "\"$item\"";
326 my $str = $$item{uni};
327 my $enc = $enc[$$item{enc}] . ' ';
328 $enc =~ s/iso-8859-1 //;
329 $str =~ s/([\t\n"])/$trepl{$1}/g;
330 print STDERR "$r $enc\"$str\"";
332 elsif ($t =~ /\bARRAY\b/) {
333 tdolist($indent,$tag,@{$item});
335 elsif ($t =~ /\bHASH\b/) {
336 tdohash($indent,$tag,$item);
339 print STDERR "$r type='$r'";
346 if (not exists $enc{$encname}) {
348 return $enc{$encname} = $#enc;
350 return $enc{$encname};
362 die "Too many args to new" if @_;
363 die "Attempt to bless non-text $text" if ref $text;
364 return bless( { uni => $text,
369 sub uni { my $self = shift; $$self{uni}; } # internal stuff all in utf8
373 my $enc = $enc[$$self{enc} || 0];
374 return encode($enc, $$self{uni});
377 package p5::closequote; BEGIN { @p5::closequote::ISA = 'p5::punct'; }
378 package p5::closer; BEGIN { @p5::closer::ISA = 'p5::punct'; }
379 package p5::declarator; BEGIN { @p5::declarator::ISA = 'p5::token'; }
380 package p5::junk; BEGIN { @p5::junk::ISA = 'p5::text'; }
381 package p5::label; BEGIN { @p5::label::ISA = 'p5::token'; }
382 #package p5::name; BEGIN { @p5::name::ISA = 'p5::token'; }
383 package p5::opener; BEGIN { @p5::opener::ISA = 'p5::punct'; }
384 package p5::openquote; BEGIN { @p5::openquote::ISA = 'p5::punct'; }
385 package p5::operator; BEGIN { @p5::operator::ISA = 'p5::token'; }
386 package p5::punct; BEGIN { @p5::punct::ISA = 'p5::token'; }
387 package p5::remod; BEGIN { @p5::remod::ISA = 'p5::token'; }
388 package p5::sigil; BEGIN { @p5::sigil::ISA = 'p5::punct'; }
389 package p5::token; BEGIN { @p5::token::ISA = 'p5::text'; }
390 #package p5::version; BEGIN { @p5::version::ISA = 'p5::token'; }
392 ################################################################
393 # Routines to turn XML tree into an AST. Mostly this amounts to hoisting
394 # misplaced nodes and flattening various things into lists.
399 ::x("AUTOLOAD $PLXML::AUTOLOAD", @_);
400 return "[[[ $PLXML::AUTOLOAD ]]]";
405 my $kids = $$self{Kids};
409 for ($i = 0; $i < @$kids; $i++) {
410 if (ref $kids->[$i] eq "PLXML::madprops") {
411 $self->{mp} = splice(@$kids, $i, 1)->hash($self,@_);
416 prepreproc($kids->[$i], $self, @_);
424 if (ref $self eq 'PLXML::op_null' and $$self{was}) {
425 return "PLXML::op_$$self{was}"->key();
434 my $t = ref $self || $self;
435 $t = "PLXML::op_$$self{was}" if $t eq 'PLXML::op_null' and $$self{was};
436 $t =~ s/PLXML/P5AST/ or die "Bad type: $t";
442 my @keys = split(' ', shift);
444 for my $key (@keys) {
445 my $madprop = $self->{mp}{$key};
446 next unless defined $madprop;
447 if (ref $madprop eq 'PLXML::mad_op') {
449 push @vals, $madprop->blockast($self, @_);
452 push @vals, $madprop->ast($self, @_);
457 if ($white = $self->{mp}{"_$key"}) {
458 push @vals, p5::junk->new($white);
460 my $type = $madtype{$key} || "p5::token";
461 push @vals, $type->new($madprop);
462 if ($white = $self->{mp}{"#$key"}) {
463 push @vals, p5::junk->new($white);
478 for my $kid (@{$$self{Kids}}) {
479 push @newkids, $kid->ast($self, @_);
481 return $self->newtype->new(Kids => [uc $self->key(), "(", @newkids, ")"]);
486 my $desc = $self->desc();
487 if ($desc =~ /\((.*?)\)/) {
491 return " <<" . $self->key() . ">> ";
500 package PLXML::Characters;
502 sub ast { die "oops" }
503 sub pair { die "oops" }
505 package PLXML::madprops;
518 # We need to guarantee key uniqueness at this point.
519 for my $kid (@{$$self{Kids}}) {
520 my ($k,$v) = $kid->pair($self, @_);
522 if ($k =~ /^[_#]$/) { # rekey whitespace according to preceding entry
523 $k .= $lastthing; # (which is actually the token the whitespace is before)
526 $k .= 'x' while exists $hash{$k};
531 $hash{FIRST} = $firstthing;
532 $hash{LAST} = $lastthing;
536 package PLXML::mad_op;
540 my $key = $$self{key};
546 $self->prepreproc(@_);
548 for my $kid (@{$$self{Kids}}) {
549 push @vals, $kid->ast($self, @_);
555 return P5AST::op_list->new(Kids => [@vals]);
561 $self->prepreproc(@_);
563 for my $kid (@{$$self{Kids}}) {
564 push @vals, $kid->blockast($self, @_);
570 return P5AST::op_lineseq->new(Kids => [@vals]);
574 package PLXML::mad_pv;
578 my $key = $$self{key};
579 my $val = $$self{val};
580 $val =~ s/STUPIDXML\(#x(\w+)\)/chr(hex $1)/eg;
584 package PLXML::mad_sv;
588 my $key = $$self{key};
589 my $val = $$self{val};
590 $val =~ s/STUPIDXML\(#x(\w+)\)/chr(hex $1)/eg;
594 package PLXML::baseop;
601 push @retval, $self->madness('M ox');
602 for my $kid (@{$$self{Kids}}) {
603 push @newkids, $kid->ast($self, @_);
606 push @retval, uc $self->key(), "(", @newkids , ")";
609 push @retval, $self->madness('o ( )');
611 return $self->newtype->new(Kids => [@retval]);
614 package PLXML::baseop_unop;
618 my @newkids = $self->madness('d M ox o (');
620 if (exists $$self{Kids}) {
621 my $arg = $$self{Kids}[0];
622 push @newkids, $arg->ast($self, @_) if defined $arg;
624 push @newkids, $self->madness(')');
626 return $self->newtype()->new(Kids => [@newkids]);
629 package PLXML::binop;
635 push @newkids, $self->madness('M ox');
637 my $left = $$self{Kids}[0];
638 push @newkids, $left->ast($self, @_);
640 push @newkids, $self->madness('o');
642 my $right = $$self{Kids}[1];
643 if (defined $right) {
644 push @newkids, $right->ast($self, @_);
647 return $self->newtype->new(Kids => [@newkids]);
652 package PLXML::filestatop;
657 my @newkids = $self->madness('o (');
659 if (@{$$self{Kids}}) {
660 for my $kid (@{$$self{Kids}}) {
661 push @newkids, $kid->ast($self, @_);
665 push @newkids, $self->madness('O');
667 push @newkids, $self->madness(')');
669 return $self->newtype->new(Kids => [@newkids]);
672 package PLXML::listop;
680 if (@before = $self->madness('M')) {
681 push @before, $self->madness('ox'); # o is the function name
683 if (@retval = $self->madness('X')) {
684 push @before, $self->madness('o x');
685 return P5AST::listop->new(Kids => [@before,@retval]);
688 push @retval, $self->madness('o ( [ {');
691 for my $kid (@{$$self{Kids}}) {
692 next if ref $kid eq 'PLXML::op_pushmark';
693 next if ref $kid eq 'PLXML::op_null' and
694 defined $$kid{was} and $$kid{was} eq 'pushmark';
695 push @newkids, $kid->ast($self, @_);
701 push @retval, $self->madness('S');
703 push @retval, @newkids;
705 push @retval, $self->madness('} ] )');
706 return $self->newtype->new(Kids => [@before,@retval,@after]);
709 package PLXML::logop;
715 push @newkids, $self->madness('o (');
716 for my $kid (@{$$self{Kids}}) {
717 push @newkids, $kid->ast($self, @_);
719 push @newkids, $self->madness(')');
720 return $self->newtype->new(Kids => [@newkids]);
725 package PLXML::loopexop;
729 my @newkids = $self->madness('o (');
731 if ($$self{mp}{L} or not $$self{flags} =~ /\bSPECIAL\b/) {
732 my @label = $self->madness('L');
734 push @newkids, @label;
737 my $arg = $$self{Kids}[0];
738 push @newkids, $arg->ast($self, @_) if defined $arg;
741 push @newkids, $self->madness(')');
743 return $self->newtype->new(Kids => [@newkids]);
747 package PLXML::padop;
749 package PLXML::padop_svop;
756 return P5AST::pmop->new(Kids => []) unless exists $$self{flags};
758 my $bits = $self->fetchbits($$self{flags},@_);
761 if ($bits->{binding}) {
762 push @newkids, $bits->{binding};
763 push @newkids, $self->madness('~');
765 if (exists $bits->{regcomp} and $bits->{regcomp}) {
766 my @front = $self->madness('q');
767 my @back = $self->madness('Q');
768 push @newkids, @front, $bits->{regcomp}, @back,
771 elsif ($$self{mp}{q}) {
772 push @newkids, $self->madness('q = Q m');
774 elsif ($$self{mp}{X}) {
775 push @newkids, $self->madness('X m');
778 push @newkids, $self->madness('e m');
781 return $self->newtype->new(Kids => [@newkids]);
787 for my $key (grep {!/^Kids/} keys %$pmop) {
788 $bits->{$key} = $pmop->{$key};
791 # Have to delete all the fake evals of the repl. This is a pain...
792 if (@{$$pmop{Kids}}) {
793 my $really = $$pmop{Kids}[0]{Kids}[0];
794 if (ref $really eq 'PLXML::op_substcont') {
795 $really = $$really{Kids}[0];
797 while ((ref $really) =~ /^PLXML::op_.*(null|entereval)/) {
798 if (exists $$really{was}) {
799 $bits->{repl} = $really->ast(@_);
802 $really = $$really{Kids}[0];
804 if (ref $really eq 'PLXML::op_scope' and
805 @{$$really{Kids}} == 1 and
806 ref $$really{Kids}[0] eq 'PLXML::op_null' and
807 not @{$$really{Kids}[0]{Kids}})
812 if (ref $really eq 'PLXML::op_leave' and
813 @{$$really{Kids}} == 2 and
814 ref $$really{Kids}[1] eq 'PLXML::op_null' and
815 not @{$$really{Kids}[1]{Kids}})
820 if ((ref $really) =~ /^PLXML::op_(scope|leave)/) {
821 # should be at inner do {...} here, so skip that fakery too
822 $bits->{repl} = $really->newtype->new(Kids => [$really->PLXML::op_lineseq::lineseq(@_)]);
823 # but retrieve the whitespace before fake '}'
824 if ($$really{mp}{'_}'}) {
825 push(@{$bits->{repl}->{Kids}}, p5::junk->new($$really{mp}{'_}'}));
828 else { # something else, padsv probably
829 $bits->{repl} = $really->ast(@_);
836 my $flags = shift || '';
838 my @kids = @{$$self{Kids}};
841 my $arg = shift @kids;
842 innerpmop($arg,\%bits, $self, @_);
843 if ($flags =~ /STACKED/) {
845 $bits{binding} = $arg->ast($self, @_);
847 if ($bits{when} ne "COMP" and @kids) {
849 $bits{regcomp} = $arg->ast($self, @_);
851 if (not exists $bits{repl} and @kids) {
853 $bits{repl} = $arg->ast($self, @_);
859 package PLXML::pvop_svop;
865 my @newkids = $self->madness('o (');
867 if (exists $$self{Kids}) {
868 my $arg = $$self{Kids}[0];
869 push @newkids, $arg->ast($self, @_) if defined $arg;
871 push @newkids, $self->madness(')');
873 return $self->newtype->new(Kids => [@newkids]);
877 package PLXML::Characters;
878 package PLXML::madprops;
879 package PLXML::mad_op;
880 package PLXML::mad_pv;
881 package PLXML::baseop;
882 package PLXML::baseop_unop;
883 package PLXML::binop;
885 package PLXML::filestatop;
886 package PLXML::listop;
887 package PLXML::logop;
889 package PLXML::loopexop;
890 package PLXML::padop;
891 package PLXML::padop_svop;
893 package PLXML::pvop_svop;
895 package PLXML::op_null;
897 # Null nodes typed by first madprop.
903 'p' => sub { # peg for #! line, etc.
906 push @newkids, $self->madness('p px');
908 return P5AST::peg->new(Kids => [@newkids])
910 '(' => sub { # extra parens around the whole thing
913 push @newkids, $self->madness('dx d o (');
914 for my $kid (@{$$self{Kids}}) {
915 push @newkids, $kid->ast($self, @_);
917 push @newkids, $self->madness(')');
918 return P5AST::parens->new(Kids => [@newkids])
920 '~' => sub { # binding operator
923 push @newkids, $$self{Kids}[0]->ast($self,@_);
924 push @newkids, $self->madness('~');
925 push @newkids, $$self{Kids}[1]->ast($self,@_);
926 return P5AST::bindop->new(Kids => [@newkids])
928 ';' => sub { # null statements/blocks
931 push @newkids, $self->madness('{ ; }');
933 return P5AST::nothing->new(Kids => [@newkids])
935 'I' => sub { # if or unless statement keyword
938 push @newkids, $self->madness('L I (');
940 for my $kid (@{$$self{Kids}}) {
941 push @subkids, $kid->ast($self, @_);
943 die "oops in op_null->new" unless @subkids == 1;
944 my $newself = $subkids[0];
945 @subkids = @{$$newself{Kids}};
947 unshift @{$subkids[0]{Kids}}, @newkids;
948 push @{$subkids[0]{Kids}}, $self->madness(')');
949 return bless($newself, 'P5AST::condstate');
954 my @module = $self->madness('U');
955 my @args = $self->madness('A');
956 my $module = $module[-1]{Kids}[-1];
957 if ($module->uni eq 'bytes') {
958 $::curenc = Nomad::encnum('iso-8859-1');
960 elsif ($module->uni eq 'utf8') {
961 if ($$self{mp}{o} eq 'no') {
962 $::curenc = Nomad::encnum('iso-8859-1');
965 $::curenc = Nomad::encnum('utf-8');
968 elsif ($module->uni eq 'encoding') {
969 if ($$self{mp}{o} eq 'no') {
970 $::curenc = Nomad::encnum('iso-8859-1');
973 $::curenc = Nomad::encnum(eval $args[0]->p5text); # XXX bletch
976 # (Surrounding {} ends up here if use is only thing in block.)
977 push @newkids, $self->madness('{ o');
978 push @newkids, @module;
979 push @newkids, $self->madness('V');
980 push @newkids, @args;
981 push @newkids, $self->madness('S ; }');
983 return P5AST::use->new(Kids => [@newkids])
985 '?' => sub { # ternary
989 my @condkids = @{$$self{Kids}[0]{Kids}};
991 push @newkids, $condkids[0]->ast($self,@_), $self->madness('?');
992 push @newkids, $condkids[1]->ast($self,@_), $self->madness(':');
993 push @newkids, $condkids[2]->ast($self,@_);
994 return P5AST::ternary->new(Kids => [@newkids])
996 '&' => sub { # subroutine
999 push @newkids, $self->madness('d n s a : { & } ;');
1001 return P5AST::sub->new(Kids => [@newkids])
1003 'i' => sub { # modifier if
1006 push @newkids, $self->madness('i');
1007 my $cond = $$self{Kids}[0];
1009 for my $kid (@{$$cond{Kids}}) {
1010 push @subkids, $kid->ast($self, @_);
1012 push @newkids, shift @subkids;
1013 unshift @newkids, @subkids;
1014 return P5AST::condmod->new(Kids => [@newkids])
1016 'P' => sub { # package declaration
1019 push @newkids, $self->madness('o');
1020 push @newkids, $self->madness('P');
1021 push @newkids, $self->madness(';');
1023 return P5AST::package->new(Kids => [@newkids])
1025 'F' => sub { # format
1027 my @newkids = $self->madness('F n b');
1029 return P5AST::format->new(Kids => [@newkids])
1031 'x' => sub { # qw literal
1033 return P5AST::qwliteral->new(Kids => [$self->madness('x')])
1035 'q' => sub { # random quote
1037 return P5AST::quote->new(Kids => [$self->madness('q = Q')])
1039 'X' => sub { # random literal
1041 return P5AST::token->new(Kids => [$self->madness('X')])
1043 ':' => sub { # attr list
1045 return P5AST::attrlist->new(Kids => [$self->madness(':')])
1047 ',' => sub { # "unary ," so to speak
1050 push @newkids, $self->madness(',');
1051 push @newkids, $$self{Kids}[0]->ast($self,@_);
1052 return P5AST::listelem->new(Kids => [@newkids])
1054 'C' => sub { # constant conditional
1057 push @newkids, $$self{Kids}[0]->ast($self,@_);
1058 my @folded = $self->madness('C');
1060 my @t = $self->madness('t');
1061 my @e = $self->madness('e');
1063 return P5AST::op_cond_expr->new(
1065 $self->madness('I ('),
1067 $self->madness(') ?'),
1068 P5AST::op_cond_expr->new(Kids => [@newkids]),
1069 $self->madness(':'),
1074 return P5AST::op_cond_expr->new(
1076 $self->madness('I ('),
1078 $self->madness(') ?'),
1080 $self->madness(':'),
1085 return P5AST::op_null->new(Kids => [@newkids])
1087 '+' => sub { # unary +
1090 push @newkids, $self->madness('+');
1091 push @newkids, $$self{Kids}[0]->ast($self,@_);
1092 return P5AST::preplus->new(Kids => [@newkids])
1094 'D' => sub { # do block
1097 push @newkids, $self->madness('D');
1098 push @newkids, $$self{Kids}[0]->ast($self,@_);
1099 return P5AST::doblock->new(Kids => [@newkids])
1101 '3' => sub { # C-style for loop
1106 my (undef, $init, $lineseq) = @{$$self{Kids}[0]{Kids}};
1107 my (undef, $leaveloop) = @{$$lineseq{Kids}};
1108 my (undef, $null) = @{$$leaveloop{Kids}};
1114 if (exists $$null{was} and $$null{was} eq 'and') {
1115 ($lineseq2) = @{$$null{Kids}};
1118 ($and) = @{$$null{Kids}};
1119 ($cond, $lineseq2) = @{$$and{Kids}};
1121 if ($$lineseq2{mp}{'{'}) {
1125 ($block, $cont) = @{$$lineseq2{Kids}};
1128 push @newkids, $self->madness('L 3 (');
1129 push @newkids, $init->ast($self,@_);
1130 push @newkids, $self->madness('1');
1131 if (defined $cond) {
1132 push @newkids, $cond->ast($self,@_);
1134 elsif (defined $null) {
1135 push @newkids, $null->madness('1');
1137 push @newkids, $self->madness('2');
1138 if (defined $cont) {
1139 push @newkids, $cont->ast($self,@_);
1141 push @newkids, $self->madness(')');
1142 push @newkids, $block->blockast($self,@_);
1144 return P5AST::cfor->new(Kids => [@newkids])
1146 'o' => sub { # random useless operator
1149 push @newkids, $self->madness('o');
1150 my $kind = $newkids[-1] || '';
1151 $kind = $kind->uni if ref $kind;
1153 for my $kid (@{$$self{Kids}}) {
1154 push @subkids, $kid->ast($self, @_);
1156 if ($kind eq '=') { # stealth readline
1157 unshift(@newkids, shift(@subkids));
1158 push(@newkids, @subkids);
1159 return P5AST::op_aassign->new(Kids => [@newkids])
1162 my $newself = $subkids[0];
1163 splice(@{$newself->{Kids}}, 1, 0,
1164 $self->madness('ox ('),
1174 # Null nodes are an untyped mess inside Perl. Instead of fixing it there,
1175 # we derive an effective type either from the "was" field or the first madprop.
1176 # (The individual routines select the actual new type.)
1180 my $was = $$self{was} || 'peg';
1181 my $mad = $$self{mp}{FIRST} || "unknown";
1183 # First try for a "was".
1184 my $meth = "PLXML::op_${was}::astnull";
1185 if (exists &{$meth}) {
1186 return $self->$meth(@_);
1189 # Look at first madprop.
1190 if (exists $astmad{$mad}) {
1191 return $astmad{$mad}->($self);
1193 warn "No mad $mad" unless $mad eq 'unknown';
1195 # Do something generic.
1197 for my $kid (@{$$self{Kids}}) {
1198 push @newkids, $kid->ast($self, @_);
1200 return $self->newtype->new(Kids => [@newkids]);
1206 local $::curenc = $::curenc;
1207 return $self->madness('{ ; }');
1210 package PLXML::op_stub;
1214 return $self->newtype->new(Kids => [$self->madness(', x ( ) q = Q')]);
1217 package PLXML::op_scalar;
1222 my @pre = $self->madness('o q');
1224 if ($op->uni =~ /^<</) {
1226 my $opstub = bless { start => $op }, 'P5AST::heredoc';
1227 push @newkids, $opstub;
1228 push @newkids, $self->madness('(');
1230 my @kids = @{$$self{Kids}};
1233 for my $kid (@kids) {
1234 next if ref $kid eq 'PLXML::op_pushmark';
1235 next if ref $kid eq 'PLXML::op_null' and
1236 defined $$kid{was} and $$kid{was} eq 'pushmark';
1237 push @divert, $kid->ast($self, @_);
1239 $opstub->{doc} = P5AST::op_list->new(Kids => [@divert]);
1240 $opstub->{end} = ($self->madness('Q'))[-1];
1242 push @newkids, $self->madness(')');
1244 return $self->newtype->new(Kids => [@pre,@newkids]);
1246 return $self->PLXML::baseop_unop::ast();
1249 package PLXML::op_pushmark;
1253 package PLXML::op_wantarray;
1254 package PLXML::op_const;
1259 return unless $$self{mp};
1260 push @newkids, $self->madness('q = Q X : f O ( )');
1261 return P5AST::op_const->new(Kids => [@newkids]);
1266 return unless %{$$self{mp}};
1271 my @args = $self->madness('f');
1274 elsif (exists $self->{mp}{q}) {
1275 push @args, $self->madness('d q');
1276 if ($args[-1]->uni =~ /^<</) {
1277 my $opstub = bless { start => pop(@args) }, 'P5AST::heredoc';
1278 $opstub->{doc} = P5AST::op_const->new(Kids => [$self->madness('=')]);
1279 $opstub->{end} = ($self->madness('Q'))[-1];
1280 push @args, $opstub;
1283 push @args, $self->madness('= Q');
1286 elsif (exists $self->{mp}{X}) {
1287 push @before, $self->madness('d'); # was local $[ probably
1288 if (not $$self{mp}{O}) {
1289 push @before, $self->madness('o'); # was unary
1291 my @X = $self->madness(': X');
1292 if (exists $$self{private} and $$self{private} =~ /BARE/) {
1293 return $self->newtype->new(Kids => [@X]);
1298 $self->madness('x'),
1300 if ($$self{mp}{O}) {
1301 push @args, $self->madness('o O');
1304 elsif (exists $self->{mp}{O}) {
1305 push @args, $self->madness('O');
1307 elsif ($$self{private} =~ /\bBARE\b/) {
1308 @args = ($$self{PV});
1310 elsif (exists $$self{mp}{o}) {
1311 @args = $self->madness('o');
1313 elsif (exists $$self{PV}) {
1314 @args = ('"', $$self{PV}, '"');
1316 elsif (exists $$self{NV}) {
1319 elsif (exists $$self{IV}) {
1323 @args = $self->SUPER::text(@_);
1325 return $self->newtype->new(Kids => [@before, @args]);
1329 package PLXML::op_gvsv;
1335 for my $attr (qw/gv GV flags/) {
1336 if (exists $$self{$attr}) {
1337 push @args, $attr, $$self{$attr};
1340 push @retval, @args;
1341 push @retval, $self->madness('X');
1342 return $self->newtype->new(Kids => [@retval]);
1345 package PLXML::op_gv;
1350 push @newkids, $self->madness('X K');
1352 return $self->newtype->new(Kids => [@newkids]);
1355 package PLXML::op_gelem;
1360 local $::curstate; # in case there are statements in subscript
1361 local $::curenc = $::curenc;
1363 push @newkids, $self->madness('dx d');
1364 for my $kid (@{$$self{Kids}}) {
1365 push @newkids, $kid->ast($self, @_);
1367 splice @newkids, -1, 0, $self->madness('o {');
1368 push @newkids, $self->madness('}');
1370 return $self->newtype->new(Kids => [@newkids]);
1373 package PLXML::op_padsv;
1378 push @args, $self->madness('dx d ( $ )');
1380 return $self->newtype->new(Kids => [@args]);
1383 package PLXML::op_padav;
1385 sub astnull { ast(@_) }
1390 push @retval, $self->madness('dx d (');
1391 push @retval, $self->madness('$ @');
1392 push @retval, $self->madness(') o O');
1393 return $self->newtype->new(Kids => [@retval]);
1396 package PLXML::op_padhv;
1398 sub astnull { ast(@_) }
1403 push @retval, $self->madness('dx d (');
1404 push @retval, $self->madness('$ @ %');
1405 push @retval, $self->madness(') o O');
1406 return $self->newtype->new(Kids => [@retval]);
1409 package PLXML::op_padany;
1411 package PLXML::op_pushre;
1415 if ($$self{mp}{q}) {
1416 return $self->madness('q = Q m');
1418 if ($$self{mp}{X}) {
1419 return $self->madness('X m');
1421 if ($$self{mp}{e}) {
1422 return $self->madness('e m');
1424 return $$self{Kids}[1]->ast($self,@_), $self->madness('m');
1427 package PLXML::op_rv2gv;
1433 push @newkids, $self->madness('dx d ( * $');
1434 push @newkids, $$self{Kids}[0]->ast();
1435 push @newkids, $self->madness(')');
1436 return $self->newtype->new(Kids => [@newkids]);
1439 package PLXML::op_rv2sv;
1443 return P5AST::op_rv2sv->new(Kids => [$self->madness('O o dx d ( $ ) : a')]);
1450 push @newkids, $self->madness('dx d ( $');
1451 if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
1452 push @newkids, $$self{Kids}[0]->ast();
1454 push @newkids, $self->madness(') : a');
1455 return $self->newtype->new(Kids => [@newkids]);
1458 package PLXML::op_av2arylen;
1464 push @newkids, $$self{Kids}[0]->madness('l');
1465 push @newkids, $$self{Kids}[0]->ast();
1466 return $self->newtype->new(Kids => [@newkids]);
1469 package PLXML::op_rv2cv;
1474 push @newkids, $self->madness('X');
1475 return @newkids if @newkids;
1476 if (exists $$self{mp}{'&'}) {
1477 push @newkids, $self->madness('&');
1478 if (@{$$self{Kids}}) {
1479 push @newkids, $$self{Kids}[0]->ast(@_);
1483 push @newkids, $$self{Kids}[0]->ast(@_);
1485 return P5AST::op_rv2cv->new(Kids => [@newkids]);
1492 push @newkids, $self->madness('&');
1493 if (@{$$self{Kids}}) {
1494 push @newkids, $$self{Kids}[0]->ast();
1496 return $self->newtype->new(Kids => [@newkids]);
1499 package PLXML::op_anoncode;
1503 my $arg = $$self{Kids}[0];
1504 local $::curstate; # hide nested statements in sub
1505 local $::curenc = $::curenc;
1507 return $arg->ast(@_);
1509 return ';'; # XXX literal ; should come through somewhere
1512 package PLXML::op_prototype;
1513 package PLXML::op_refgen;
1517 my @newkids = $self->madness('o s a');
1519 if (exists $$self{Kids}) {
1520 my $arg = $$self{Kids}[0];
1521 push @newkids, $arg->ast($self, @_) if defined $arg;
1524 my $res = $self->newtype->new(Kids => [@newkids]);
1528 package PLXML::op_srefgen;
1533 if ($$self{mp}{FIRST} eq '{') {
1534 local $::curstate; # this is officially a block, so hide it
1535 local $::curenc = $::curenc;
1536 push @newkids, $self->madness('{');
1537 for my $kid (@{$$self{Kids}}) {
1538 push @newkids, $kid->ast($self, @_);
1540 push @newkids, $self->madness('; }');
1541 return P5AST::op_stringify->new(Kids => [@newkids]);
1544 push @newkids, $self->madness('o [');
1545 for my $kid (@{$$self{Kids}}) {
1546 push @newkids, $kid->ast($self, @_);
1548 push @newkids, $self->madness(']');
1549 return P5AST::op_stringify->new(Kids => [@newkids]);
1553 package PLXML::op_ref;
1554 package PLXML::op_bless;
1555 package PLXML::op_backtick;
1560 if (exists $self->{mp}{q}) {
1561 push @args, $self->madness('q');
1562 if ($args[-1]->uni =~ /^<</) {
1563 my $opstub = bless { start => $args[-1] }, 'P5AST::heredoc';
1564 $args[-1] = $opstub;
1565 $opstub->{doc} = P5AST::op_const->new(Kids => [$self->madness('=')]);
1566 $opstub->{end} = ($self->madness('Q'))[-1];
1569 push @args, $self->madness('= Q');
1572 return $self->newtype->new(Kids => [@args]);
1575 package PLXML::op_glob;
1579 my @retval = $self->madness('o q = Q');
1580 if (not @retval or $retval[-1]->uni eq 'glob') {
1581 push @retval, $self->madness('(');
1582 push @retval, $$self{Kids}[0]->ast($self,@_);
1583 push @retval, $self->madness(')');
1585 return P5AST::op_glob->new(Kids => [@retval]);
1588 package PLXML::op_readline;
1593 if (exists $$self{mp}{q}) {
1594 @retval = $self->madness('q = Q');
1596 elsif (exists $$self{mp}{X}) {
1597 @retval = $self->madness('X');
1599 return P5AST::op_readline->new(Kids => [@retval]);
1609 if (exists $$self{mp}{q}) {
1610 @args = $self->madness('q = Q');
1612 elsif (exists $$self{mp}{X}) {
1613 @args = $self->madness('X');
1615 elsif (exists $$self{GV}) {
1618 elsif (@{$$self{Kids}}) {
1619 @args = $self->PLXML::unop::ast(@_);
1622 @args = $self->SUPER::text(@_);
1624 return $self->newtype->new(Kids => [@retval,@args]);
1628 package PLXML::op_rcatline;
1629 package PLXML::op_regcmaybe;
1630 package PLXML::op_regcreset;
1631 package PLXML::op_regcomp;
1635 $self->PLXML::unop::ast(@_);
1638 package PLXML::op_match;
1642 my $retval = $self->SUPER::ast(@_);
1644 if (not $p5re = $retval->p5text()) {
1645 $retval = $self->newtype->new(Kids => [$self->madness('X q = Q m')]);
1646 $p5re = $retval->p5text();
1648 if ($deinterpolate) {
1649 $retval->{P5re} = P5re::qrparse($p5re);
1654 package PLXML::op_qr;
1659 if (exists $$self{flags}) {
1660 $retval = $self->SUPER::ast(@_);
1663 $retval = $self->newtype->new(Kids => [$self->madness('X q = Q m')]);
1665 if ($deinterpolate) {
1666 my $p5re = $retval->p5text();
1667 $retval->{P5re} = P5re::qrparse($p5re);
1672 package PLXML::op_subst;
1677 my $bits = $self->fetchbits($$self{flags},@_);
1680 if ($bits->{binding}) {
1681 push @newkids, $bits->{binding};
1682 push @newkids, $self->madness('~');
1684 my $X = p5::token->new($$self{mp}{X});
1685 my @lfirst = $self->madness('q');
1686 my @llast = $self->madness('Q');
1689 $self->madness('E'), # XXX s/b e probably
1691 my @rfirst = $self->madness('z');
1692 my @rlast = $self->madness('Z');
1693 my @mods = $self->madness('m');
1694 if ($rfirst[-1]->uni ne $llast[-1]->uni) {
1695 push @newkids, @rfirst;
1698 push @newkids, $bits->{repl}, @rlast, @mods;
1700 my $retval = $self->newtype->new(Kids => [@newkids]);
1701 if ($deinterpolate) {
1702 my $p5re = $retval->p5text();
1703 $retval->{P5re} = P5re::qrparse($p5re);
1708 package PLXML::op_substcont;
1709 package PLXML::op_trans;
1714 # my $bits = $self->fetchbits($$self{flags},@_);
1717 my @lfirst = $self->madness('q');
1718 my @llast = $self->madness('Q');
1721 $self->madness('E'),
1723 my @rfirst = $self->madness('z');
1724 my @repl = $self->madness('R');
1725 my @rlast = $self->madness('Z');
1726 my @mods = $self->madness('m');
1727 if ($rfirst[-1]->uni ne $llast[-1]->uni) {
1728 push @newkids, @rfirst;
1731 push @newkids, @repl, @rlast, @mods;
1733 my $res = $self->newtype->new(Kids => [@newkids]);
1737 package PLXML::op_sassign;
1743 my $right = $$self{Kids}[1];
1744 eval { push @newkids, $right->ast($self, @_); };
1746 push @newkids, $self->madness('o');
1748 my $left = $$self{Kids}[0];
1749 push @newkids, $left->ast($self, @_);
1751 return $self->newtype->new(Kids => [@newkids]);
1754 package PLXML::op_aassign;
1756 sub astnull { ast(@_) }
1762 my $right = $$self{Kids}[1];
1763 push @newkids, $right->ast($self, @_);
1765 push @newkids, $self->madness('o');
1767 my $left = $$self{Kids}[0];
1768 push @newkids, $left->ast($self, @_);
1770 return $self->newtype->new(Kids => [@newkids]);
1773 package PLXML::op_chop;
1774 package PLXML::op_schop;
1775 package PLXML::op_chomp;
1776 package PLXML::op_schomp;
1777 package PLXML::op_defined;
1778 package PLXML::op_undef;
1779 package PLXML::op_study;
1780 package PLXML::op_pos;
1781 package PLXML::op_preinc;
1785 if ($$self{targ}) { # stealth post inc or dec
1786 return $self->PLXML::op_postinc::ast(@_);
1788 return $self->SUPER::ast(@_);
1791 package PLXML::op_i_preinc;
1793 sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
1795 package PLXML::op_predec;
1797 sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
1799 package PLXML::op_i_predec;
1801 sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
1803 package PLXML::op_postinc;
1809 if (exists $$self{Kids}) {
1810 my $arg = $$self{Kids}[0];
1811 push @newkids, $arg->ast($self, @_) if defined $arg;
1813 push @newkids, $self->madness('o');
1815 my $res = $self->newtype->new(Kids => [@newkids]);
1819 package PLXML::op_i_postinc;
1821 sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
1823 package PLXML::op_postdec;
1825 sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
1827 package PLXML::op_i_postdec;
1829 sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
1831 package PLXML::op_pow;
1832 package PLXML::op_multiply;
1833 package PLXML::op_i_multiply;
1834 package PLXML::op_divide;
1835 package PLXML::op_i_divide;
1836 package PLXML::op_modulo;
1837 package PLXML::op_i_modulo;
1838 package PLXML::op_repeat;
1842 return $self->SUPER::ast(@_)
1843 unless exists $$self{private} and $$self{private} =~ /DOLIST/;
1845 my $newself = $$self{Kids}[0]->ast($self,@_);
1846 splice @{$newself->{Kids}}, -1, 0, $self->madness('o');
1848 return bless $newself, $self->newtype; # rebless the op_null
1851 package PLXML::op_add;
1852 package PLXML::op_i_add;
1853 package PLXML::op_subtract;
1854 package PLXML::op_i_subtract;
1855 package PLXML::op_concat;
1862 if (@before = $self->madness('M')) {
1863 push @before, $self->madness('ox'); # o is the .
1866 my $left = $$self{Kids}[0];
1867 push @newkids, $left->ast($self, @_);
1869 push @newkids, $self->madness('o');
1871 my $right = $$self{Kids}[1];
1872 push @newkids, $right->ast($self, @_);
1873 return P5AST::op_concat->new(Kids => [@newkids]);
1882 if (@before = $self->madness('M')) {
1883 push @before, $self->madness('ox'); # o is the .
1886 my $left = $$self{Kids}[0];
1887 push @newkids, $left->ast($self, @_);
1889 push @newkids, $self->madness('o');
1891 my $right = $$self{Kids}[1];
1892 push @newkids, $right->ast($self, @_);
1894 return $self->newtype->new(Kids => [@before, @newkids, @after]);
1897 package PLXML::op_stringify;
1906 my @front = $self->madness('q (');
1907 my @back = $self->madness(') Q');
1908 my @M = $self->madness('M');
1910 push @newkids, $M[0], $self->madness('o');
1912 push @newkids, @front;
1913 for my $kid (@{$$self{Kids}}) {
1914 push @newkids, $kid->ast($self, @_);
1916 push @newkids, @back;
1917 return P5AST::op_stringify->new(Kids => [@newkids]);
1920 package PLXML::op_left_shift;
1921 package PLXML::op_right_shift;
1922 package PLXML::op_lt;
1923 package PLXML::op_i_lt;
1924 package PLXML::op_gt;
1925 package PLXML::op_i_gt;
1926 package PLXML::op_le;
1927 package PLXML::op_i_le;
1928 package PLXML::op_ge;
1929 package PLXML::op_i_ge;
1930 package PLXML::op_eq;
1931 package PLXML::op_i_eq;
1932 package PLXML::op_ne;
1933 package PLXML::op_i_ne;
1934 package PLXML::op_ncmp;
1935 package PLXML::op_i_ncmp;
1936 package PLXML::op_slt;
1937 package PLXML::op_sgt;
1938 package PLXML::op_sle;
1939 package PLXML::op_sge;
1940 package PLXML::op_seq;
1941 package PLXML::op_sne;
1942 package PLXML::op_scmp;
1943 package PLXML::op_bit_and;
1944 package PLXML::op_bit_xor;
1945 package PLXML::op_bit_or;
1946 package PLXML::op_negate;
1947 package PLXML::op_i_negate;
1948 package PLXML::op_not;
1952 my @newkids = $self->madness('o (');
1954 if (@newkids and $newkids[-1]->uni eq '!~') {
1959 if (exists $$self{Kids}) {
1960 my $arg = $$self{Kids}[0];
1961 push @newkids, $arg->ast($self, @_) if defined $arg;
1964 splice @{$newkids[-1][0]{Kids}}, -2, 0, @swap; # XXX WAG
1966 push @newkids, $self->madness(')');
1968 my $res = $self->newtype->new(Kids => [@newkids]);
1972 package PLXML::op_complement;
1973 package PLXML::op_atan2;
1974 package PLXML::op_sin;
1975 package PLXML::op_cos;
1976 package PLXML::op_rand;
1977 package PLXML::op_srand;
1978 package PLXML::op_exp;
1979 package PLXML::op_log;
1980 package PLXML::op_sqrt;
1981 package PLXML::op_int;
1982 package PLXML::op_hex;
1983 package PLXML::op_oct;
1984 package PLXML::op_abs;
1985 package PLXML::op_length;
1986 package PLXML::op_substr;
1987 package PLXML::op_vec;
1988 package PLXML::op_index;
1989 package PLXML::op_rindex;
1990 package PLXML::op_sprintf;
1991 package PLXML::op_formline;
1992 package PLXML::op_ord;
1993 package PLXML::op_chr;
1994 package PLXML::op_crypt;
1995 package PLXML::op_ucfirst;
1999 return $self->PLXML::listop::ast(@_);
2002 package PLXML::op_lcfirst;
2006 return $self->PLXML::listop::ast(@_);
2009 package PLXML::op_uc;
2013 return $self->PLXML::listop::ast(@_);
2016 package PLXML::op_lc;
2020 return $self->PLXML::listop::ast(@_);
2023 package PLXML::op_quotemeta;
2027 return $self->PLXML::listop::ast(@_);
2030 package PLXML::op_rv2av;
2034 return P5AST::op_rv2av->new(Kids => [$self->madness('$ @')]);
2040 if (ref $$self{Kids}[0] eq 'PLXML::op_const' and $$self{mp}{'O'}) {
2041 return $self->madness('O');
2045 push @before, $self->madness('dx d (');
2048 push @newkids, $self->madness('$ @ K');
2049 if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
2050 push @newkids, $$self{Kids}[0]->ast();
2053 push @after, $self->madness(') a');
2054 return $self->newtype->new(Kids => [@before, @newkids, @after]);
2057 package PLXML::op_aelemfast;
2061 return $self->madness('$');
2064 package PLXML::op_aelem;
2069 push @newkids, $self->madness('dx d');
2070 for my $kid (@{$$self{Kids}}) {
2071 push @newkids, $kid->ast($self, @_);
2073 splice @newkids, -1, 0, $self->madness('a [');
2074 push @newkids, $self->madness(']');
2075 return P5AST::op_aelem->new(Kids => [@newkids]);
2081 my @before = $self->madness('dx d');
2083 for my $kid (@{$$self{Kids}}) {
2084 push @newkids, $kid->ast(@_);
2086 splice @newkids, -1, 0, $self->madness('a [');
2087 push @newkids, $self->madness(']');
2089 return $self->newtype->new(Kids => [@before, @newkids]);
2092 package PLXML::op_aslice;
2097 push @newkids, $self->madness('[');
2098 for my $kid (@{$$self{Kids}}) {
2099 push @newkids, $kid->ast(@_);
2101 unshift @newkids, pop @newkids;
2102 unshift @newkids, $self->madness('dx d');
2103 push @newkids, $self->madness(']');
2104 return P5AST::op_aslice->new(Kids => [@newkids]);
2111 push @newkids, $self->madness('[');
2112 for my $kid (@{$$self{Kids}}) {
2113 push @newkids, $kid->ast(@_);
2115 unshift @newkids, pop @newkids;
2116 unshift @newkids, $self->madness('dx d');
2117 push @newkids, $self->madness(']');
2119 return $self->newtype->new(Kids => [@newkids]);
2122 package PLXML::op_each;
2123 package PLXML::op_values;
2124 package PLXML::op_keys;
2125 package PLXML::op_delete;
2126 package PLXML::op_exists;
2127 package PLXML::op_rv2hv;
2131 return P5AST::op_rv2hv->new(Kids => [$self->madness('$')]);
2138 push @before, $self->madness('dx d (');
2141 push @newkids, $self->madness('$ @ % K');
2142 if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
2143 push @newkids, $$self{Kids}[0]->ast();
2146 push @after, $self->madness(') a');
2147 return $self->newtype->new(Kids => [@before, @newkids, @after]);
2150 package PLXML::op_helem;
2154 local $::curstate; # hash subscript potentially a lineseq
2155 local $::curenc = $::curenc;
2158 push @newkids, $self->madness('dx d');
2159 for my $kid (@{$$self{Kids}}) {
2160 push @newkids, $kid->ast($self, @_);
2162 splice @newkids, -1, 0, $self->madness('a {');
2163 push @newkids, $self->madness('}');
2164 return P5AST::op_helem->new(Kids => [@newkids]);
2169 local $::curstate; # hash subscript potentially a lineseq
2170 local $::curenc = $::curenc;
2172 my @before = $self->madness('dx d');
2174 for my $kid (@{$$self{Kids}}) {
2175 push @newkids, $kid->ast($self, @_);
2177 splice @newkids, -1, 0, $self->madness('a {');
2178 push @newkids, $self->madness('}');
2180 return $self->newtype->new(Kids => [@before, @newkids]);
2184 package PLXML::op_hslice;
2189 push @newkids, $self->madness('{');
2190 for my $kid (@{$$self{Kids}}) {
2191 push @newkids, $kid->ast(@_);
2193 unshift @newkids, pop @newkids;
2194 unshift @newkids, $self->madness('dx d');
2195 push @newkids, $self->madness('}');
2196 return P5AST::op_hslice->new(Kids => [@newkids]);
2203 push @newkids, $self->madness('{');
2204 for my $kid (@{$$self{Kids}}) {
2205 push @newkids, $kid->ast(@_);
2207 unshift @newkids, pop @newkids;
2208 unshift @newkids, $self->madness('dx d');
2209 push @newkids, $self->madness('}');
2211 return $self->newtype->new(Kids => [@newkids]);
2214 package PLXML::op_unpack;
2215 package PLXML::op_pack;
2216 package PLXML::op_split;
2220 my $results = $self->SUPER::ast(@_);
2221 if (my @dest = $self->madness('R')) {
2222 return PLXML::op_aassign->newtype->new(Kids => [@dest, $self->madness('ox'), $results]);
2227 package PLXML::op_join;
2228 package PLXML::op_list;
2235 if (@retval = $self->madness('X')) {
2236 push @before, $self->madness('x o');
2237 return @before,@retval;
2239 my @kids = @{$$self{Kids}};
2240 for my $kid (@kids) {
2241 next if ref $kid eq 'PLXML::op_pushmark';
2242 next if ref $kid eq 'PLXML::op_null' and
2243 defined $$kid{was} and $$kid{was} eq 'pushmark';
2244 push @newkids, $kid->ast($self, @_);
2248 my @newnewkids = ();
2249 push @newnewkids, $self->madness('dx d (');
2250 push @newnewkids, @newkids;
2251 push @newnewkids, $self->madness(') :');
2252 return P5AST::op_list->new(Kids => [@newnewkids]);
2260 if (@retval = $self->madness('X')) {
2261 push @before, $self->madness('o');
2262 return $self->newtype->new(Kids => [@before,@retval]);
2264 push @retval, $self->madness('dx d (');
2267 for my $kid (@{$$self{Kids}}) {
2268 push @newkids, $kid->ast($self, @_);
2271 my @newnewkids = ();
2272 push @newnewkids, @newkids;
2273 @newkids = @newnewkids;
2274 push @retval, @newkids;
2275 push @retval, $self->madness(') :');
2276 return $self->newtype->new(Kids => [@retval]);
2279 package PLXML::op_lslice;
2285 if ($$self{mp}{q}) {
2286 push @newkids, $self->madness('q = Q');
2288 elsif ($$self{mp}{x}) {
2289 push @newkids, $self->madness('x');
2292 push @newkids, $self->madness('(');
2293 my $list = $$self{Kids}[1];
2294 push @newkids, $list->ast($self, @_);
2295 push @newkids, $self->madness(')');
2298 push @newkids, $self->madness('[');
2300 my $slice = $$self{Kids}[0];
2301 push @newkids, $slice->ast($self, @_);
2302 push @newkids, $self->madness(']');
2304 return $self->newtype->new(Kids => [@newkids]);
2307 package PLXML::op_anonlist;
2308 package PLXML::op_anonhash;
2309 package PLXML::op_splice;
2310 package PLXML::op_push;
2311 package PLXML::op_pop;
2312 package PLXML::op_shift;
2313 package PLXML::op_unshift;
2314 package PLXML::op_sort;
2315 package PLXML::op_reverse;
2319 $self->PLXML::listop::ast(@_);
2322 package PLXML::op_grepstart;
2323 package PLXML::op_grepwhile;
2324 package PLXML::op_mapstart;
2325 package PLXML::op_mapwhile;
2326 package PLXML::op_range;
2330 return $self->PLXML::binop::ast(@_);
2333 package PLXML::op_flip;
2334 package PLXML::op_flop;
2335 package PLXML::op_and;
2340 my @first = $self->madness('1');
2341 my @second = $self->madness('2');
2342 my @stuff = $$self{Kids}[0]->ast();
2343 if (my @I = $self->madness('I')) {
2346 push @newkids, $self->madness('(');
2347 push @newkids, @stuff;
2348 push @newkids, $self->madness(')');
2349 push @newkids, @second;
2353 push @newkids, $self->madness('(');
2354 push @newkids, @first;
2355 push @newkids, $self->madness(')');
2356 push @newkids, @stuff;
2359 elsif (my @i = $self->madness('i')) {
2361 push @newkids, @second;
2363 push @newkids, @stuff;
2366 push @newkids, @stuff;
2368 push @newkids, @first;
2371 elsif (my @o = $self->madness('o')) {
2373 push @newkids, @stuff;
2375 push @newkids, @second;
2378 push @newkids, @first;
2380 push @newkids, @stuff;
2383 return P5AST::op_and->new(Kids => [@newkids]);
2386 package PLXML::op_or;
2391 my @first = $self->madness('1');
2392 my @second = $self->madness('2');
2393 my @i = $self->madness('i');
2394 my @stuff = $$self{Kids}[0]->ast();
2397 push @newkids, @second;
2398 push @newkids, $self->madness('i');
2399 push @newkids, @stuff;
2402 push @newkids, @stuff;
2403 push @newkids, $self->madness('o');
2404 push @newkids, @second;
2409 push @newkids, @stuff;
2410 push @newkids, $self->madness('i');
2411 push @newkids, @first;
2414 push @newkids, @first;
2415 push @newkids, $self->madness('o');
2416 push @newkids, @stuff;
2419 return "P5AST::op_$$self{was}"->new(Kids => [@newkids]);
2423 package PLXML::op_xor;
2424 package PLXML::op_cond_expr;
2425 package PLXML::op_andassign;
2426 package PLXML::op_orassign;
2427 package PLXML::op_method;
2428 package PLXML::op_entersub;
2433 if ($$self{mp}{q}) {
2434 return $self->madness('q = Q');
2436 if ($$self{mp}{X}) { # <FH> override?
2437 return $self->madness('X');
2439 if ($$self{mp}{A}) {
2440 return $self->astmethod(@_);
2442 if ($$self{mp}{a}) {
2443 return $self->astarrow(@_);
2449 my @kids = @{$$self{Kids}};
2450 if (@kids == 1 and ref $kids[0] eq 'PLXML::op_null' and $kids[0]{was} =~ /list/) {
2451 @kids = @{$kids[0]{Kids}};
2453 my $dest = pop @kids;
2454 my @dest = $dest->ast($self, @_);
2456 if (ref($dest) =~ /method/) {
2457 my $invocant = shift @kids;
2458 $invocant = shift @kids if ref($invocant) eq 'PLXML::op_pushmark';
2459 my @invocant = $invocant->ast($self, @_);
2460 push @retval, @dest;
2461 push @retval, @invocant;
2463 elsif (exists $$self{mp}{o} and $$self{mp}{o} eq 'do') {
2464 push @retval, $self->madness('o');
2465 push @retval, @dest;
2468 push @retval, $self->madness('o');
2469 push @retval, @dest;
2472 my $kid = shift(@kids);
2473 push @newkids, $kid->ast($self, @_);
2476 push @retval, $self->madness('(');
2477 push @retval, @newkids;
2478 push @retval, $self->madness(')');
2479 return $self->newtype->new(Kids => [@retval]);
2486 for my $kid (@{$$self{Kids}}) {
2487 next if ref $kid eq 'PLXML::op_pushmark';
2488 next if ref $kid eq 'PLXML::op_null' and
2489 defined $$kid{was} and $$kid{was} eq 'pushmark';
2493 if ($$self{flags} =~ /\bSTACKED\b/) {
2494 push @invocant, shift(@kids)->ast($self, @_);
2496 for my $kid (@kids) {
2497 push @newkids, $kid->ast($self, @_);
2499 my $dest = pop(@newkids);
2500 if (ref $dest eq 'PLXML::op_rv2cv' and $$self{flags} =~ /\bMOD\b/) {
2501 $dest = pop(@newkids);
2505 push @retval, @invocant;
2506 push @retval, $self->madness('A');
2507 push @retval, $dest;
2508 push @retval, $self->madness('(');
2509 push @retval, @newkids;
2510 push @retval, $self->madness(')');
2511 return $self->newtype->new(Kids => [@retval]);
2518 my @kids = @{$$self{Kids}};
2519 if (@kids == 1 and ref $kids[0] eq 'PLXML::op_null' and $kids[0]{was} =~ /list/) {
2520 @kids = @{$kids[0]{Kids}};
2523 my $kid = shift(@kids);
2524 push @newkids, $kid->ast($self, @_);
2526 my @dest = $kids[0]->ast($self, @_);
2528 push @retval, @dest;
2529 push @retval, $self->madness('a');
2530 push @retval, $self->madness('(');
2531 push @retval, @newkids;
2532 push @retval, $self->madness(')');
2533 return $self->newtype->new(Kids => [@retval]);
2536 package PLXML::op_leavesub;
2540 if (ref $$self{Kids}[0] eq "PLXML::op_null") {
2541 return $$self{Kids}[0]->ast(@_);
2543 return $$self{Kids}[0]->blockast($self, @_);
2546 package PLXML::op_leavesublv;
2551 return $$self{Kids}[0]->blockast($self, @_);
2554 package PLXML::op_caller;
2555 package PLXML::op_warn;
2556 package PLXML::op_die;
2557 package PLXML::op_reset;
2558 package PLXML::op_lineseq;
2562 my @kids = @{$$self{Kids}};
2563 local $::curstate = 0; # (probably redundant, but that's okay)
2564 local $::prevstate = 0;
2565 local $::curenc = $::curenc;
2570 my $kid = shift @kids;
2571 my $thing = $kid->ast($self, @_);
2572 next unless defined $thing;
2573 if ($::curstate ne $::prevstate) {
2575 push @newstuff, $::prevstate->madness(';');
2576 push @{$newprev->{Kids}}, @newstuff if $newprev;
2579 $::prevstate = $::curstate;
2581 push @retval, $thing;
2583 elsif ($::prevstate) {
2584 push @newstuff, $thing;
2587 push @retval, $thing;
2591 push @newstuff, $::prevstate->madness(';');
2592 push @{$newprev->{Kids}}, @newstuff if $newprev;
2604 push @retval, $self->madness('{');
2606 my @newkids = $self->PLXML::op_lineseq::lineseq(@_);
2607 push @retval, @newkids;
2609 push @retval, $self->madness('; }');
2610 return $self->newtype->new(Kids => [@retval]);
2613 package PLXML::op_nextstate;
2615 sub newtype { return "P5AST::statement" }
2620 push @newkids, $self->madness('L');
2621 $::curstate = $self;
2622 return P5AST::statement->new(Kids => [@newkids]);
2629 push @newkids, $self->madness('L');
2630 $::curstate = $self;
2631 return $self->newtype->new(Kids => [@newkids]);
2635 package PLXML::op_dbstate;
2636 package PLXML::op_unstack;
2637 package PLXML::op_enter;
2641 package PLXML::op_leave;
2650 my $mad = $$self{mp}{FIRST} || "unknown";
2656 push @tmpkids, $self->{Kids};
2657 my $anddo = $$self{Kids}[-1]{Kids}[0]{Kids};
2658 eval { push @newkids, $anddo->[1]->ast($self,@_); };
2659 push @newkids, "[[[NOANDDO]]]" if $@;
2660 push @newkids, $self->madness('w');
2661 push @newkids, $anddo->[0]->ast($self,@_);
2663 return $self->newtype->new(Kids => [@newkids]);
2667 push @retval, $self->madness('o {');
2669 my @newkids = $self->PLXML::op_lineseq::lineseq(@_);
2670 push @retval, @newkids;
2671 push @retval, $self->madness(q/; }/);
2672 my $retval = $self->newtype->new(Kids => [@retval]);
2674 if ($$self{mp}{C}) {
2677 push @before, $self->madness('I ( C )');
2678 if ($$self{mp}{t}) {
2679 push @before, $self->madness('t');
2681 elsif ($$self{mp}{e}) {
2682 push @after, $self->madness('e');
2684 return P5AST::op_cond->new(Kids => [@before, $retval, @after]);
2691 package PLXML::op_scope;
2698 push @newkids, $self->madness('o');
2700 push @newkids, $self->madness('{');
2701 push @newkids, $self->PLXML::op_lineseq::lineseq(@_);
2702 push @newkids, $self->madness('; }');
2704 my @folded = $self->madness('C');
2706 my @t = $self->madness('t');
2707 my @e = $self->madness('e');
2709 return $self->newtype->new(
2711 $self->madness('I ('),
2713 $self->madness(')'),
2714 $self->newtype->new(Kids => [@newkids]),
2719 return $self->newtype->new(
2721 $self->madness('I ('),
2723 $self->madness(')'),
2725 $self->newtype->new(Kids => [@newkids])
2729 return $self->newtype->new(Kids => [@newkids]);
2732 package PLXML::op_enteriter;
2736 my (undef,$range,$var) = @{$self->{Kids}};
2738 push @retval, $self->madness('v');
2739 if (!@retval and defined $var) {
2740 push @retval, $var->ast($self,@_);
2745 if (ref $range eq 'PLXML::op_null' and $$self{flags} =~ /STACKED/) {
2746 my (undef,$min,$max) = @{$range->{Kids}};
2747 push @retval, $min->ast($self,@_);
2749 if (exists $$range{mp}{O}) { # deeply buried .. operator
2750 PLXML::prepreproc($$range{mp}{O});
2752 $$range{mp}{'O'}{Kids}[0]{Kids}[0]{Kids}[0]{Kids}[0]->madness('o')
2755 push @retval, '..'; # XXX missing whitespace
2757 push @retval, $max->ast($self,@_);
2761 push @retval, $range->ast($self,@_);
2763 return $self->newtype->new(Kids => [@retval]);
2766 package PLXML::op_iter;
2767 package PLXML::op_enterloop;
2772 package PLXML::op_leaveloop;
2779 my $enterloop = $$self{Kids}[0];
2780 my $nextthing = $$self{Kids}[1];
2782 if ($$self{mp}{W}) {
2783 push @retval, $self->madness('L');
2784 push @newkids, $self->madness('W d');
2786 if (ref $enterloop eq 'PLXML::op_enteriter') {
2787 my ($var,@rest) = @{$enterloop->ast($self,@_)->{Kids}};
2788 push @newkids, $var if $var;
2789 push @newkids, $self->madness('q ( x = Q');
2790 push @newkids, @rest;
2793 push @newkids, $self->madness('(');
2794 push @newkids, $enterloop->ast($self,@_);
2799 if (ref $nextthing eq 'PLXML::op_null') {
2800 if ($$nextthing{mp}{'1'}) {
2801 push @newkids, $nextthing->madness('1');
2802 push @newkids, $self->madness(')');
2803 push @newkids, $$nextthing{Kids}[0]->blockast($self,@_);
2805 elsif ($$nextthing{mp}{'2'}) {
2806 push @newkids, $$nextthing{Kids}[0]->ast($self,@_);
2807 push @newkids, $self->madness(')');
2808 push @newkids, $$nextthing{mp}{'2'}->blockast($self,@_);
2810 elsif ($$nextthing{mp}{'U'}) {
2811 push @newkids, $nextthing->ast($self,@_);
2814 # bypass the op_null
2815 $andor = $nextthing->{Kids}[0];
2817 push @newkids, $$andor{Kids}[0]->ast($self, @_);
2819 push @newkids, $self->madness(')');
2821 push @newkids, $$andor{Kids}[1]->blockast($self, @_);
2826 $andor = $nextthing;
2827 push @newkids, $nextthing->madness('O');
2828 push @newkids, $self->madness(')');
2829 push @newkids, $nextthing->blockast($self, @_);
2831 if ($$self{mp}{w}) {
2832 push @newkids, $self->madness('w');
2833 push @newkids, $enterloop->ast($self,@_);
2836 push @retval, @newkids;
2838 return $self->newtype->new(Kids => [@retval]);
2841 package PLXML::op_return;
2842 package PLXML::op_last;
2843 package PLXML::op_next;
2844 package PLXML::op_redo;
2845 package PLXML::op_dump;
2846 package PLXML::op_goto;
2847 package PLXML::op_exit;
2848 package PLXML::op_open;
2849 package PLXML::op_close;
2850 package PLXML::op_pipe_op;
2851 package PLXML::op_fileno;
2852 package PLXML::op_umask;
2853 package PLXML::op_binmode;
2854 package PLXML::op_tie;
2855 package PLXML::op_untie;
2856 package PLXML::op_tied;
2857 package PLXML::op_dbmopen;
2858 package PLXML::op_dbmclose;
2859 package PLXML::op_sselect;
2860 package PLXML::op_select;
2861 package PLXML::op_getc;
2862 package PLXML::op_read;
2863 package PLXML::op_enterwrite;
2864 package PLXML::op_leavewrite;
2865 package PLXML::op_prtf;
2866 package PLXML::op_print;
2867 package PLXML::op_sysopen;
2868 package PLXML::op_sysseek;
2869 package PLXML::op_sysread;
2870 package PLXML::op_syswrite;
2871 package PLXML::op_send;
2872 package PLXML::op_recv;
2873 package PLXML::op_eof;
2874 package PLXML::op_tell;
2875 package PLXML::op_seek;
2876 package PLXML::op_truncate;
2877 package PLXML::op_fcntl;
2878 package PLXML::op_ioctl;
2879 package PLXML::op_flock;
2880 package PLXML::op_socket;
2881 package PLXML::op_sockpair;
2882 package PLXML::op_bind;
2883 package PLXML::op_connect;
2884 package PLXML::op_listen;
2885 package PLXML::op_accept;
2886 package PLXML::op_shutdown;
2887 package PLXML::op_gsockopt;
2888 package PLXML::op_ssockopt;
2889 package PLXML::op_getsockname;
2890 package PLXML::op_getpeername;
2891 package PLXML::op_lstat;
2892 package PLXML::op_stat;
2893 package PLXML::op_ftrread;
2894 package PLXML::op_ftrwrite;
2895 package PLXML::op_ftrexec;
2896 package PLXML::op_fteread;
2897 package PLXML::op_ftewrite;
2898 package PLXML::op_fteexec;
2899 package PLXML::op_ftis;
2900 package PLXML::op_fteowned;
2901 package PLXML::op_ftrowned;
2902 package PLXML::op_ftzero;
2903 package PLXML::op_ftsize;
2904 package PLXML::op_ftmtime;
2905 package PLXML::op_ftatime;
2906 package PLXML::op_ftctime;
2907 package PLXML::op_ftsock;
2908 package PLXML::op_ftchr;
2909 package PLXML::op_ftblk;
2910 package PLXML::op_ftfile;
2911 package PLXML::op_ftdir;
2912 package PLXML::op_ftpipe;
2913 package PLXML::op_ftlink;
2914 package PLXML::op_ftsuid;
2915 package PLXML::op_ftsgid;
2916 package PLXML::op_ftsvtx;
2917 package PLXML::op_fttty;
2918 package PLXML::op_fttext;
2919 package PLXML::op_ftbinary;
2920 package PLXML::op_chdir;
2921 package PLXML::op_chown;
2922 package PLXML::op_chroot;
2923 package PLXML::op_unlink;
2924 package PLXML::op_chmod;
2925 package PLXML::op_utime;
2926 package PLXML::op_rename;
2927 package PLXML::op_link;
2928 package PLXML::op_symlink;
2929 package PLXML::op_readlink;
2930 package PLXML::op_mkdir;
2931 package PLXML::op_rmdir;
2932 package PLXML::op_open_dir;
2933 package PLXML::op_readdir;
2934 package PLXML::op_telldir;
2935 package PLXML::op_seekdir;
2936 package PLXML::op_rewinddir;
2937 package PLXML::op_closedir;
2938 package PLXML::op_fork;
2939 package PLXML::op_wait;
2940 package PLXML::op_waitpid;
2941 package PLXML::op_system;
2942 package PLXML::op_exec;
2943 package PLXML::op_kill;
2944 package PLXML::op_getppid;
2945 package PLXML::op_getpgrp;
2946 package PLXML::op_setpgrp;
2947 package PLXML::op_getpriority;
2948 package PLXML::op_setpriority;
2949 package PLXML::op_time;
2950 package PLXML::op_tms;
2951 package PLXML::op_localtime;
2952 package PLXML::op_gmtime;
2953 package PLXML::op_alarm;
2954 package PLXML::op_sleep;
2955 package PLXML::op_shmget;
2956 package PLXML::op_shmctl;
2957 package PLXML::op_shmread;
2958 package PLXML::op_shmwrite;
2959 package PLXML::op_msgget;
2960 package PLXML::op_msgctl;
2961 package PLXML::op_msgsnd;
2962 package PLXML::op_msgrcv;
2963 package PLXML::op_semget;
2964 package PLXML::op_semctl;
2965 package PLXML::op_semop;
2966 package PLXML::op_require;
2967 package PLXML::op_dofile;
2968 package PLXML::op_entereval;
2972 local $::curstate; # eval {} has own statement sequence
2973 return $self->SUPER::ast(@_);
2976 package PLXML::op_leaveeval;
2977 package PLXML::op_entertry;
2978 package PLXML::op_leavetry;
2983 return $self->PLXML::op_leave::ast(@_);
2986 package PLXML::op_ghbyname;
2987 package PLXML::op_ghbyaddr;
2988 package PLXML::op_ghostent;
2989 package PLXML::op_gnbyname;
2990 package PLXML::op_gnbyaddr;
2991 package PLXML::op_gnetent;
2992 package PLXML::op_gpbyname;
2993 package PLXML::op_gpbynumber;
2994 package PLXML::op_gprotoent;
2995 package PLXML::op_gsbyname;
2996 package PLXML::op_gsbyport;
2997 package PLXML::op_gservent;
2998 package PLXML::op_shostent;
2999 package PLXML::op_snetent;
3000 package PLXML::op_sprotoent;
3001 package PLXML::op_sservent;
3002 package PLXML::op_ehostent;
3003 package PLXML::op_enetent;
3004 package PLXML::op_eprotoent;
3005 package PLXML::op_eservent;
3006 package PLXML::op_gpwnam;
3007 package PLXML::op_gpwuid;
3008 package PLXML::op_gpwent;
3009 package PLXML::op_spwent;
3010 package PLXML::op_epwent;
3011 package PLXML::op_ggrnam;
3012 package PLXML::op_ggrgid;
3013 package PLXML::op_ggrent;
3014 package PLXML::op_sgrent;
3015 package PLXML::op_egrent;
3016 package PLXML::op_getlogin;
3017 package PLXML::op_syscall;
3018 package PLXML::op_lock;
3019 package PLXML::op_threadsv;
3020 package PLXML::op_setstate;
3021 package PLXML::op_method_named;
3025 return $self->madness('O');
3028 package PLXML::op_dor;
3032 $self->PLXML::op_or::astnull(@_);
3035 package PLXML::op_dorassign;
3036 package PLXML::op_custom;