Disable slurping assigned of split when PL_madskills
[perl.git] / mad / Nomad.pm
1 package Nomad;
2
3 # Suboptimal things:
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
9
10 use strict;
11 use warnings;
12 use Carp;
13
14 use P5AST;
15 use P5re;
16
17 my $deinterpolate;
18
19 sub xml_to_p5 {
20     my %options = @_;
21
22
23     my $filename = $options{'input'} or die;
24     $deinterpolate = $options{'deinterpolate'};
25     my $YAML = $options{'YAML'};
26
27     local $SIG{__DIE__} = sub {
28         my $e = shift;
29         $e =~ s/\n$/\n    [NODE $filename line $::prevstate->{line}]/ if $::prevstate;
30         confess $e;
31     };
32
33     # parse file
34     use XML::Parser;
35     my $p1 = XML::Parser->new(Style => 'Objects', Pkg => 'PLXML');
36     $p1->setHandlers('Char' => sub { warn "Chars $_[1]" if $_[1] =~ /\S/; });
37
38     # First slurp XML into tree of objects.
39
40     my $root = $p1->parsefile($filename);
41
42     # Now turn XML tree into something more like an AST.
43
44     PLXML::prepreproc($root->[0]);
45     my $ast = P5AST->new('Kids' => [$root->[0]->ast()]);
46     #::t($ast);
47
48     if ($YAML) {
49         require YAML::Syck;
50         return YAML::Syck::Dump($ast);
51     }
52
53     # Finally, walk AST to produce new program.
54
55     my $text = $ast->p5text();  # returns encoded, must output raw
56     return $text;
57 }
58
59 $::curstate = 0;
60 $::prevstate = 0;
61 $::curenc = 1;          # start in iso-8859-1, sigh...
62
63 $::H = "HeredocHere000";
64 %::H = ();
65
66 my @enc = (
67     'utf-8',
68     'iso-8859-1',
69 );
70
71 my %enc = (
72     'utf-8' => 0,
73     'iso-8859-1' => 1,
74 );
75
76 my %madtype = (
77     '$' => 'p5::sigil',
78     '@' => 'p5::sigil',
79     '%' => 'p5::sigil',
80     '&' => 'p5::sigil',
81     '*' => 'p5::sigil',
82     'o' => 'p5::operator',
83     '~' => 'p5::operator',
84     '+' => 'p5::punct',
85     '?' => 'p5::punct',
86     ':' => 'p5::punct',
87     ',' => 'p5::punct',
88     ';' => 'p5::punct',
89     '#' => 'p5::punct',
90     '(' => 'p5::opener',
91     ')' => 'p5::closer',
92     '[' => 'p5::opener',
93     ']' => 'p5::closer',
94     '{' => 'p5::opener',
95     '}' => 'p5::closer',
96     '1' => 'p5::punct',
97     '2' => 'p5::punct',
98     'a' => 'p5::operator',
99     'A' => 'p5::operator',
100     'd' => 'p5::declarator',
101     'E' => 'p5::text',
102     'L' => 'p5::label',
103     'm' => 'p5::remod',
104 #    'n' => 'p5::name',
105     'q' => 'p5::openquote',
106     'Q' => 'p5::closequote',
107     '=' => 'p5::text',
108     'R' => 'p5::text',
109     's' => 'p5::text',
110     's' => 'p5::declarator',
111 #    'V' => 'p5::version',
112     'X' => 'p5::token',
113 );
114
115 use Data::Dumper;
116 $Data::Dumper::Indent = 1;
117 $Data::Dumper::Quotekeys = 0;
118
119 sub d {
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;
124     if ($text) {
125         my ($package, $filename, $line) = caller;
126         my $subroutine = (caller(1))[3];
127         $text =~ s/\n?\z/, called from $subroutine, line $line\n/;
128         warn $text;
129     }
130 };
131
132 {
133
134     my %xmlrepl = (
135         '&' => '&',
136         "'" => ''',
137         '"' => '&dquo;',
138         '<' => '&lt;',
139         '>' => '&gt;',
140         "\n" => '&#10;',
141         "\t" => '&#9;',
142     );
143
144     sub x {
145         my $indent = 0;
146         if (@_ > 1) {
147             warn xdolist($indent,"LIST",@_);
148         }
149         else {
150             my $type = ref $_[0];
151             if ($type) {
152                 warn xdoitem($indent,$type,@_);
153             }
154             else {
155                 warn xdoitem($indent,"ITEM",@_);
156             }
157         }
158     }
159
160     sub xdolist {
161         my $indent = shift;
162         my $tag = shift;
163         my $in = ' ' x ($indent * 2);
164         my $result;
165         $result .= "$in<$tag>\n" if defined $tag;
166         for my $it (@_) {
167             my $itt = ref $it || "ITEM";
168             $itt =~ s/::/:/g;
169             $result .= xdoitem($indent+1,$itt,$it);
170         }
171         $result .= "$in</$tag>\n" if defined $tag;
172         return $result;
173     }
174
175     sub xdohash {
176         my $indent = shift;
177         my $tag = shift;
178         my $hash = shift;
179         my $in = ' ' x ($indent * 2);
180         my $result = "$in<$tag>\n";
181         my @keys = sort keys %$hash;
182         my $longest = 0;
183         for my $k (@keys) {
184             $longest = length($k) if length($k) > $longest;
185         }
186         my $K;
187         for my $k (@keys) {
188             my $tmp;
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/>!;
194             }
195             else {
196                 $tmp = xdoitem($indent+1,"kv",$$hash{$k});
197             }
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;
201             $result .= $tmp;
202         }
203         if ($K and @$K) {
204             $result .= xdolist($indent, undef, @$K);
205         }
206         $result .= "$in</$tag>\n";
207     }
208
209     sub xdoitem {
210         my $indent = shift;
211         my $tag = shift;
212         my $item = shift;
213         my $in = ' ' x ($indent * 2);
214         my $r = ref $item;
215         if (not $r) {
216             $item =~ s/([\t\n'"<>&])/$xmlrepl{$1}/g;
217             return "$in<$tag>$item</$tag>\n";
218         }
219         (my $newtag = $r) =~ s/::/:/g;
220         my $t = "$item";
221         if ($t =~ /\bARRAY\b/) {
222             if (@{$item}) {
223                 return xdolist($indent,$tag,@{$item});
224             }
225             else {
226                 return "$in<$tag />\n";
227             }
228         }
229         if ($t =~ /\bHASH\b/) {
230             return xdohash($indent,$tag,$item);
231         }
232         if ($r =~ /^p5::/) {
233             return "$in<$newtag>$$item</$newtag>\n";
234         }
235         else {
236             return "$in<$newtag type='$r'/>\n";
237         }
238     }
239
240     my %trepl = (
241         "'" => '\\\'',
242         '"' => '\\"',
243         "\n" => '\\n',
244         "\t" => '\\t',
245     );
246
247     sub t {
248         my $indent = 0;
249         if (@_ > 1) {
250             tdolist($indent,"LIST",@_);
251         }
252         else {
253             my $type = ref $_[0];
254             if ($type) {
255                 tdoitem($indent,$type,@_);
256             }
257             else {
258                 tdoitem($indent,"ITEM",@_);
259             }
260         }
261         print STDERR "\n";
262     }
263
264     sub tdolist {
265         my $indent = shift;
266         my $tag = shift || "ARRAY";
267         my $in = ' ' x ($indent * 2);
268         if (@_) {
269             print STDERR "[\n";
270             for my $it (@_) {
271                 my $itt = ref $it || "ITEM";
272                 print STDERR $in,"  ";
273                 tdoitem($indent+1,$itt,$it);
274                 print STDERR "\n";
275             }
276             print STDERR "$in]";
277         }
278         else {
279             print STDERR "[]";
280         }
281     }
282
283     sub tdohash {
284         my $indent = shift;
285         my $tag = shift;
286         my $hash = shift;
287         my $in = ' ' x ($indent * 2);
288
289         print STDERR "$tag => {\n";
290
291         my @keys = sort keys %$hash;
292         my $longest = 0;
293         for my $k (@keys) {
294             $longest = length($k) if length($k) > $longest;
295         }
296         my $K;
297         for my $k (@keys) {
298             my $sp = ' ' x ($longest - length($k));
299             print STDERR "$in  $k$sp => ";
300             tdoitem($indent+1,"",$$hash{$k});
301             if ($k eq 'Kids') {
302                 print STDERR " # Kids";
303             }
304             print STDERR "\n";
305         }
306         print STDERR "$in} # $tag";
307     }
308
309     sub tdoitem {
310         my $indent = shift;
311         my $tag = shift;
312         my $item = shift;
313         if (not defined $item) {
314             print STDERR "UNDEF";
315             return;
316         }
317 #       my $in = ' ' x ($indent * 2);
318         my $r = ref $item;
319         if (not $r) {
320             $item =~ s/([\t\n"])/$trepl{$1}/g;
321             print STDERR "\"$item\"";
322             return;
323         }
324         my $t = "$item";
325         if ($r =~ /^p5::/) {
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\"";
331         }
332         elsif ($t =~ /\bARRAY\b/) {
333             tdolist($indent,$tag,@{$item});
334         }
335         elsif ($t =~ /\bHASH\b/) {
336             tdohash($indent,$tag,$item);
337         }
338         else {
339             print STDERR "$r type='$r'";
340         }
341     }
342 }
343
344 sub encnum {
345     my $encname = shift;
346     if (not exists $enc{$encname}) {
347         push @enc, $encname;
348         return $enc{$encname} = $#enc;
349     }
350     return $enc{$encname};
351 }
352
353 use PLXML;
354
355 package p5::text;
356
357 use Encode;
358
359 sub new {
360     my $class = shift;
361     my $text = shift;
362     die "Too many args to new" if @_;
363     die "Attempt to bless non-text $text" if ref $text;
364     return bless( { uni => $text,
365                     enc => $::curenc,
366                   }, $class);
367 }
368
369 sub uni { my $self = shift; $$self{uni}; }      # internal stuff all in utf8
370
371 sub enc {
372     my $self = shift;
373     my $enc = $enc[$$self{enc} || 0];
374     return encode($enc, $$self{uni});
375 }
376
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'; }
391
392 ################################################################
393 # Routines to turn XML tree into an AST.  Mostly this amounts to hoisting
394 # misplaced nodes and flattening various things into lists.
395
396 package PLXML;
397
398 sub AUTOLOAD {
399     ::x("AUTOLOAD $PLXML::AUTOLOAD", @_);
400     return "[[[ $PLXML::AUTOLOAD ]]]";
401 }
402
403 sub prepreproc {
404     my $self = shift;
405     my $kids = $$self{Kids};
406     $self->{mp} = {};
407     if (defined $kids) {
408         my $i;
409         for ($i = 0; $i < @$kids; $i++) {
410             if (ref $kids->[$i] eq "PLXML::madprops") {
411                 $self->{mp} = splice(@$kids, $i, 1)->hash($self,@_);
412                 $i--;
413                 next;
414             }
415             else {
416                 prepreproc($kids->[$i], $self, @_);
417             }
418         }
419     }
420 }
421
422 sub preproc {
423     my $self = shift;
424     if (ref $self eq 'PLXML::op_null' and $$self{was}) {
425         return "PLXML::op_$$self{was}"->key();
426     }
427     else {
428         return $self->key();
429     }
430 }
431
432 sub newtype {
433     my $self = shift;
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";
437     return $t;
438 }
439
440 sub madness {
441     my $self = shift;
442     my @keys = split(' ', shift);
443     my @vals = ();
444     for my $key (@keys) {
445         my $madprop = $self->{mp}{$key};
446         next unless defined $madprop;
447         if (ref $madprop eq 'PLXML::mad_op') {
448             if ($key eq 'b') {
449                 push @vals, $madprop->blockast($self, @_);
450             }
451             else {
452                 push @vals, $madprop->ast($self, @_);
453             }
454             next;
455         }
456         my $white;
457         if ($white = $self->{mp}{"_$key"}) {
458             push @vals, p5::junk->new($white);
459         }
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);
464         }
465     }
466     @vals;
467 }
468
469 sub blockast {
470     my $self = shift;
471     $self->ast(@_);
472 }
473
474 sub ast {
475     my $self = shift;
476
477     my @newkids;
478     for my $kid (@{$$self{Kids}}) {
479         push @newkids, $kid->ast($self, @_);
480     }
481     return $self->newtype->new(Kids => [uc $self->key(), "(", @newkids, ")"]);
482 }
483
484 sub op {
485     my $self = shift;
486     my $desc = $self->desc();
487     if ($desc =~ /\((.*?)\)/) {
488         return $1;
489     }
490     else {
491         return " <<" . $self->key() . ">> ";
492     }
493 }
494
495 sub mp {
496     my $self = shift;
497     return $self->{mp};
498 }
499
500 package PLXML::Characters;
501
502 sub ast { die "oops" }
503 sub pair { die "oops" }
504
505 package PLXML::madprops;
506
507 sub ast {
508     die "oops madprops";
509 }
510
511 sub hash {
512     my $self = shift;
513     my @pairs;
514     my %hash = ();
515     my $firstthing = '';
516     my $lastthing = '';
517     
518     # We need to guarantee key uniqueness at this point.
519     for my $kid (@{$$self{Kids}}) {
520         my ($k,$v) = $kid->pair($self, @_);
521         $firstthing ||= $k;
522         if ($k =~ /^[_#]$/) {   # rekey whitespace according to preceding entry
523             $k .= $lastthing;   # (which is actually the token the whitespace is before)
524         }
525         else {
526             $k .= 'x' while exists $hash{$k};
527             $lastthing = $k;
528         }
529         $hash{$k} = $v;
530     }
531     $hash{FIRST} = $firstthing;
532     $hash{LAST} = $lastthing;
533     return \%hash;
534 }
535
536 package PLXML::mad_op;
537
538 sub pair {
539     my $self = shift;
540     my $key = $$self{key};
541     return $key,$self;
542 }
543
544 sub ast {
545     my $self = shift;
546     $self->prepreproc(@_);
547     my @vals;
548     for my $kid (@{$$self{Kids}}) {
549         push @vals, $kid->ast($self, @_);
550     }
551     if (@vals == 1) {
552         return @vals;
553     }
554     else {
555         return P5AST::op_list->new(Kids => [@vals]);
556     }
557 }
558
559 sub blockast {
560     my $self = shift;
561     $self->prepreproc(@_);
562     my @vals;
563     for my $kid (@{$$self{Kids}}) {
564         push @vals, $kid->blockast($self, @_);
565     }
566     if (@vals == 1) {
567         return @vals;
568     }
569     else {
570         return P5AST::op_lineseq->new(Kids => [@vals]);
571     }
572 }
573
574 package PLXML::mad_pv;
575
576 sub pair {
577     my $self = shift;
578     my $key = $$self{key};
579     my $val = $$self{val};
580     $val =~ s/STUPIDXML\(#x(\w+)\)/chr(hex $1)/eg;
581     return $key,$val;
582 }
583
584 package PLXML::mad_sv;
585
586 sub pair {
587     my $self = shift;
588     my $key = $$self{key};
589     my $val = $$self{val};
590     $val =~ s/STUPIDXML\(#x(\w+)\)/chr(hex $1)/eg;
591     return $key,$val;
592 }
593
594 package PLXML::baseop;
595
596 sub ast {
597     my $self = shift;
598
599     my @retval;
600     my @newkids;
601     for my $kid (@{$$self{Kids}}) {
602         push @newkids, $kid->ast($self, @_);
603     }
604     if (@newkids) {
605         push @retval, uc $self->key(), "(", @newkids , ")";
606     }
607     else {
608         push @retval, $self->madness('o ( )');
609     }
610     return $self->newtype->new(Kids => [@retval]);
611 }
612
613 package PLXML::baseop_unop;
614
615 sub ast {
616     my $self = shift;
617     my @newkids = $self->madness('d o (');
618
619     if (exists $$self{Kids}) {
620         my $arg = $$self{Kids}[0];
621         push @newkids, $arg->ast($self, @_) if defined $arg;
622     }
623     push @newkids, $self->madness(')');
624
625     return $self->newtype()->new(Kids => [@newkids]);
626 }
627
628 package PLXML::binop;
629
630 sub ast {
631     my $self = shift;
632     my @newkids;
633
634     my $left = $$self{Kids}[0];
635     push @newkids, $left->ast($self, @_);
636
637     push @newkids, $self->madness('o');
638
639     my $right = $$self{Kids}[1];
640     if (defined $right) {
641         push @newkids, $right->ast($self, @_);
642     }
643
644     return $self->newtype->new(Kids => [@newkids]);
645 }
646
647 package PLXML::cop;
648
649 package PLXML::filestatop;
650
651 sub ast {
652     my $self = shift;
653
654     my @newkids = $self->madness('o (');
655
656     if (@{$$self{Kids}}) {
657         for my $kid (@{$$self{Kids}}) {
658             push @newkids, $kid->ast($self, @_);
659         }
660     }
661     if ($$self{mp}{O}) {
662         push @newkids, $self->madness('O');
663     }
664     push @newkids, $self->madness(')');
665
666     return $self->newtype->new(Kids => [@newkids]);
667 }
668
669 package PLXML::listop;
670
671 sub ast {
672     my $self = shift;
673
674     my @retval;
675     my @after;
676     if (@retval = $self->madness('X')) {
677         my @before, $self->madness('o x');
678         return P5AST::listop->new(Kids => [@before,@retval]);
679     }
680
681     push @retval, $self->madness('o ( [ {');
682
683     my @newkids;
684     for my $kid (@{$$self{Kids}}) {
685         next if ref $kid eq 'PLXML::op_pushmark';
686         next if ref $kid eq 'PLXML::op_null' and
687                 defined $$kid{was} and $$kid{was} eq 'pushmark';
688         push @newkids, $kid->ast($self, @_);
689     }
690
691     my $x = "";
692
693     if ($$self{mp}{S}) {
694         push @retval, $self->madness('S');
695     }
696     push @retval, @newkids;
697
698     push @retval, $self->madness('} ] )');
699     return $self->newtype->new(Kids => [@retval,@after]);
700 }
701
702 package PLXML::logop;
703
704 sub ast {
705     my $self = shift;
706
707     my @newkids;
708     push @newkids, $self->madness('o (');
709     for my $kid (@{$$self{Kids}}) {
710         push @newkids, $kid->ast($self, @_);
711     }
712     push @newkids, $self->madness(')');
713     return $self->newtype->new(Kids => [@newkids]);
714 }
715
716 package PLXML::loop;
717
718 package PLXML::loopexop;
719
720 sub ast {
721     my $self = shift;
722     my @newkids = $self->madness('o (');
723
724     if ($$self{mp}{L} or not $$self{flags} =~ /\bSPECIAL\b/) {
725         my @label = $self->madness('L');
726         if (@label) {
727             push @newkids, @label;
728         }
729         else {
730             my $arg = $$self{Kids}[0];
731             push @newkids, $arg->ast($self, @_) if defined $arg;
732         }
733     }
734     push @newkids, $self->madness(')');
735
736     return $self->newtype->new(Kids => [@newkids]);
737 }
738
739
740 package PLXML::padop;
741
742 package PLXML::padop_svop;
743
744 package PLXML::pmop;
745
746 sub ast {
747     my $self = shift;
748
749     return P5AST::pmop->new(Kids => []) unless exists $$self{flags};
750
751     my $bits = $self->fetchbits($$self{flags},@_);
752
753     my @newkids;
754     if ($bits->{binding}) {
755         push @newkids, $bits->{binding};
756         push @newkids, $self->madness('~');
757     }
758     if (exists $bits->{regcomp} and $bits->{regcomp}) {
759         my @front = $self->madness('q');
760         my @back = $self->madness('Q');
761         push @newkids, @front, $bits->{regcomp}, @back,
762                 $self->madness('m');
763     }
764     elsif ($$self{mp}{q}) {
765         push @newkids, $self->madness('q = Q m');
766     }
767     elsif ($$self{mp}{X}) {
768         push @newkids, $self->madness('X m');
769     }
770     else {
771         push @newkids, $self->madness('e m');
772     }
773
774     return $self->newtype->new(Kids => [@newkids]);
775 }
776
777 sub innerpmop {
778     my $pmop = shift;
779     my $bits = shift;
780     for my $key (grep {!/^Kids/} keys %$pmop) {
781         $bits->{$key} = $pmop->{$key};
782     }
783
784     # Have to delete all the fake evals of the repl.  This is a pain...
785     if (@{$$pmop{Kids}}) {
786         my $really = $$pmop{Kids}[0]{Kids}[0];
787         if (ref $really eq 'PLXML::op_substcont') {
788             $really = $$really{Kids}[0];
789         }
790         while ((ref $really) =~ /^PLXML::op_.*(null|entereval)/) {
791             if (exists $$really{was}) {
792                 $bits->{repl} = $really->ast(@_);
793                 return;
794             }
795             $really = $$really{Kids}[0];
796         }
797         if (ref $really eq 'PLXML::op_scope' and
798             @{$$really{Kids}} == 1 and
799             ref $$really{Kids}[0] eq 'PLXML::op_null' and
800             not @{$$really{Kids}[0]{Kids}})
801         {
802             $bits->{repl} = '';
803             return;
804         }
805         if (ref $really eq 'PLXML::op_leave' and
806             @{$$really{Kids}} == 2 and
807             ref $$really{Kids}[1] eq 'PLXML::op_null' and
808             not @{$$really{Kids}[1]{Kids}})
809         {
810             $bits->{repl} = '';
811             return;
812         }
813         if ((ref $really) =~ /^PLXML::op_(scope|leave)/) {
814             # should be at inner do {...} here, so skip that fakery too
815             $bits->{repl} = $really->newtype->new(Kids => [$really->PLXML::op_lineseq::lineseq(@_)]);
816             # but retrieve the whitespace before fake '}'
817             if ($$really{mp}{'_}'}) {
818                 push(@{$bits->{repl}->{Kids}}, p5::junk->new($$really{mp}{'_}'}));
819             }
820         }
821         else {  # something else, padsv probably
822             $bits->{repl} = $really->ast(@_);
823         }
824     }
825 }
826
827 sub fetchbits {
828     my $self = shift;
829     my $flags = shift || '';
830     my %bits = %$self;
831     my @kids = @{$$self{Kids}};
832     if (@kids) {
833         delete $bits{Kids};
834         my $arg = shift @kids;
835         innerpmop($arg,\%bits, $self, @_);
836         if ($flags =~ /STACKED/) {
837             $arg = shift @kids;
838             $bits{binding} = $arg->ast($self, @_);
839         }
840         if ($bits{when} ne "COMP" and @kids) {
841             $arg = pop @kids;
842             $bits{regcomp} = $arg->ast($self, @_);
843         }
844         if (not exists $bits{repl} and @kids) {
845             $arg = shift @kids;
846             $bits{repl} = $arg->ast($self, @_);
847         }
848     }
849     return \%bits;
850 }
851
852 package PLXML::pvop_svop;
853
854 package PLXML::unop;
855
856 sub ast {
857     my $self = shift;
858     my @newkids = $self->madness('o (');
859
860     if (exists $$self{Kids}) {
861         my $arg = $$self{Kids}[0];
862         push @newkids, $arg->ast($self, @_) if defined $arg;
863     }
864     push @newkids, $self->madness(')');
865
866     return $self->newtype->new(Kids => [@newkids]);
867 }
868
869 package PLXML;
870 package PLXML::Characters;
871 package PLXML::madprops;
872 package PLXML::mad_op;
873 package PLXML::mad_pv;
874 package PLXML::baseop;
875 package PLXML::baseop_unop;
876 package PLXML::binop;
877 package PLXML::cop;
878 package PLXML::filestatop;
879 package PLXML::listop;
880 package PLXML::logop;
881 package PLXML::loop;
882 package PLXML::loopexop;
883 package PLXML::padop;
884 package PLXML::padop_svop;
885 package PLXML::pmop;
886 package PLXML::pvop_svop;
887 package PLXML::unop;
888 package PLXML::op_null;
889
890 # Null nodes typed by first madprop.
891
892 my %astmad;
893
894 BEGIN {
895     %astmad = (
896         'p' => sub {            # peg for #! line, etc.
897             my $self = shift;
898             my @newkids;
899             push @newkids, $self->madness('p px');
900             $::curstate = 0;
901             return P5AST::peg->new(Kids => [@newkids])
902         },
903         '(' => sub {            # extra parens around the whole thing
904             my $self = shift;
905             my @newkids;
906             push @newkids, $self->madness('dx d o (');
907             for my $kid (@{$$self{Kids}}) {
908                 push @newkids, $kid->ast($self, @_);
909             }
910             push @newkids, $self->madness(')');
911             return P5AST::parens->new(Kids => [@newkids])
912         },
913         '~' => sub {                            # binding operator
914             my $self = shift;
915             my @newkids;
916             push @newkids, $$self{Kids}[0]->ast($self,@_);
917             push @newkids, $self->madness('~');
918             push @newkids, $$self{Kids}[1]->ast($self,@_);
919             return P5AST::bindop->new(Kids => [@newkids])
920         },
921         ';' => sub {            # null statements/blocks
922             my $self = shift;
923             my @newkids;
924             push @newkids, $self->madness('{ ; }');
925             $::curstate = 0;
926             return P5AST::nothing->new(Kids => [@newkids])
927         },
928         'I' => sub {            # if or unless statement keyword
929             my $self = shift;
930             my @newkids;
931             push @newkids, $self->madness('L I (');
932             my @subkids;
933             for my $kid (@{$$self{Kids}}) {
934                 push @subkids, $kid->ast($self, @_);
935             }
936             die "oops in op_null->new" unless @subkids == 1;
937             my $newself = $subkids[0];
938             @subkids = @{$$newself{Kids}};
939             
940             unshift @{$subkids[0]{Kids}}, @newkids;
941             push @{$subkids[0]{Kids}}, $self->madness(')');
942             return bless($newself, 'P5AST::condstate');
943         },
944         'U' => sub {                    # use
945             my $self = shift;
946             my @newkids;
947             my @module = $self->madness('U');
948             my @args = $self->madness('A');
949             my $module = $module[-1]{Kids}[-1];
950             if ($module->uni eq 'bytes') {
951                 $::curenc = Nomad::encnum('iso-8859-1');
952             }
953             elsif ($module->uni eq 'utf8') {
954                 if ($$self{mp}{o} eq 'no') {
955                     $::curenc = Nomad::encnum('iso-8859-1');
956                 }
957                 else {
958                     $::curenc = Nomad::encnum('utf-8');
959                 }
960             }
961             elsif ($module->uni eq 'encoding') {
962                 if ($$self{mp}{o} eq 'no') {
963                     $::curenc = Nomad::encnum('iso-8859-1');
964                 }
965                 else {
966                     $::curenc = Nomad::encnum(eval $args[0]->p5text); # XXX bletch
967                 }
968             }
969             # (Surrounding {} ends up here if use is only thing in block.)
970             push @newkids, $self->madness('{ o');
971             push @newkids, @module;
972             push @newkids, $self->madness('V');
973             push @newkids, @args;
974             push @newkids, $self->madness('S ; }');
975             $::curstate = 0;
976             return P5AST::use->new(Kids => [@newkids])
977         },
978         '?' => sub {                    # ternary
979             my $self = shift;
980             my @newkids;
981             my @subkids;
982             my @condkids = @{$$self{Kids}[0]{Kids}};
983             
984             push @newkids, $condkids[0]->ast($self,@_), $self->madness('?');
985             push @newkids, $condkids[1]->ast($self,@_), $self->madness(':');
986             push @newkids, $condkids[2]->ast($self,@_);
987             return P5AST::ternary->new(Kids => [@newkids])
988         },
989         '&' => sub {                    # subroutine
990             my $self = shift;
991             my @newkids;
992             push @newkids, $self->madness('d n s a : { & } ;');
993             $::curstate = 0;
994             return P5AST::sub->new(Kids => [@newkids])
995         },
996         'i' => sub {                    # modifier if
997             my $self = shift;
998             my @newkids;
999             push @newkids, $self->madness('i');
1000             my $cond = $$self{Kids}[0];
1001             my @subkids;
1002             for my $kid (@{$$cond{Kids}}) {
1003                 push @subkids, $kid->ast($self, @_);
1004             }
1005             push @newkids, shift @subkids;
1006             unshift @newkids, @subkids;
1007             return P5AST::condmod->new(Kids => [@newkids])
1008         },
1009         'P' => sub {                            # package declaration
1010             my $self = shift;
1011             my @newkids;
1012             push @newkids, $self->madness('o');
1013             push @newkids, $self->madness('P');
1014             push @newkids, $self->madness(';');
1015             $::curstate = 0;
1016             return P5AST::package->new(Kids => [@newkids])
1017         },
1018         'F' => sub {                            # format
1019             my $self = shift;
1020             my @newkids = $self->madness('F n b');
1021             $::curstate = 0;
1022             return P5AST::format->new(Kids => [@newkids])
1023         },
1024         'x' => sub {                            # qw literal
1025             my $self = shift;
1026             return P5AST::qwliteral->new(Kids => [$self->madness('x')])
1027         },
1028         'q' => sub {                            # random quote
1029             my $self = shift;
1030             return P5AST::quote->new(Kids => [$self->madness('q = Q')])
1031         },
1032         'X' => sub {                            # random literal
1033             my $self = shift;
1034             return P5AST::token->new(Kids => [$self->madness('X')])
1035         },
1036         ':' => sub {                            # attr list
1037             my $self = shift;
1038             return P5AST::attrlist->new(Kids => [$self->madness(':')])
1039         },
1040         ',' => sub {                            # "unary ," so to speak
1041             my $self = shift;
1042             my @newkids;
1043             push @newkids, $self->madness(',');
1044             push @newkids, $$self{Kids}[0]->ast($self,@_);
1045             return P5AST::listelem->new(Kids => [@newkids])
1046         },
1047         'C' => sub {                            # constant conditional
1048             my $self = shift;
1049             my @newkids;
1050             push @newkids, $$self{Kids}[0]->ast($self,@_);
1051             my @folded = $self->madness('C');
1052             if (@folded) {
1053                 my @t = $self->madness('t');
1054                 my @e = $self->madness('e');
1055                 if (@e) {
1056                     return P5AST::op_cond_expr->new(
1057                         Kids => [
1058                             $self->madness('I ('),
1059                             @folded,
1060                             $self->madness(') ?'),
1061                             P5AST::op_cond_expr->new(Kids => [@newkids]),
1062                             $self->madness(':'),
1063                             @e
1064                         ] );
1065                 }
1066                 else {
1067                     return P5AST::op_cond_expr->new(
1068                         Kids => [
1069                             $self->madness('I ('),
1070                             @folded,
1071                             $self->madness(') ?'),
1072                             @t,
1073                             $self->madness(':'),
1074                             @newkids
1075                         ] );
1076                 }
1077             }
1078             return P5AST::op_null->new(Kids => [@newkids])
1079         },
1080         '+' => sub {                            # unary +
1081             my $self = shift;
1082             my @newkids;
1083             push @newkids, $self->madness('+');
1084             push @newkids, $$self{Kids}[0]->ast($self,@_);
1085             return P5AST::preplus->new(Kids => [@newkids])
1086         },
1087         'D' => sub {                            # do block
1088             my $self = shift;
1089             my @newkids;
1090             push @newkids, $self->madness('D');
1091             push @newkids, $$self{Kids}[0]->ast($self,@_);
1092             return P5AST::doblock->new(Kids => [@newkids])
1093         },
1094         '3' => sub {                            # C-style for loop
1095             my $self = shift;
1096             my @newkids;
1097
1098             # What a mess!
1099             my (undef, $init, $lineseq) = @{$$self{Kids}[0]{Kids}};
1100             my (undef, $leaveloop) = @{$$lineseq{Kids}};
1101             my (undef, $null) = @{$$leaveloop{Kids}};
1102             my $and;
1103             my $cond;
1104             my $lineseq2;
1105             my $block;
1106             my $cont;
1107             if (exists $$null{was} and $$null{was} eq 'and') {
1108                 ($lineseq2) = @{$$null{Kids}};
1109             }
1110             else {
1111                 ($and) = @{$$null{Kids}};
1112                 ($cond, $lineseq2) = @{$$and{Kids}};
1113             }
1114             if ($$lineseq2{mp}{'{'}) {
1115                 $block = $lineseq2;
1116             }
1117             else {
1118                 ($block, $cont) = @{$$lineseq2{Kids}};
1119             }
1120
1121             push @newkids, $self->madness('L 3 (');
1122             push @newkids, $init->ast($self,@_);
1123             push @newkids, $self->madness('1');
1124             if (defined $cond) {
1125                 push @newkids, $cond->ast($self,@_);
1126             }
1127             elsif (defined $null) {
1128                 push @newkids, $null->madness('1');
1129             }
1130             push @newkids, $self->madness('2');
1131             if (defined $cont) {
1132                 push @newkids, $cont->ast($self,@_);
1133             }
1134             push @newkids, $self->madness(')');
1135             push @newkids, $block->blockast($self,@_);
1136             $::curstate = 0;
1137             return P5AST::cfor->new(Kids => [@newkids])
1138         },
1139         'o' => sub {                    # random useless operator
1140             my $self = shift;
1141             my @newkids;
1142             push @newkids, $self->madness('o');
1143             my $kind = $newkids[-1] || '';
1144             $kind = $kind->uni if ref $kind;
1145             my @subkids;
1146             for my $kid (@{$$self{Kids}}) {
1147                 push @subkids, $kid->ast($self, @_);
1148             }
1149             if ($kind eq '=') { # stealth readline
1150                 unshift(@newkids, shift(@subkids));
1151                 push(@newkids, @subkids);
1152                 return P5AST::op_aassign->new(Kids => [@newkids])
1153             }
1154             else {
1155                 my $newself = $subkids[0];
1156                 splice(@{$newself->{Kids}}, 1, 0,
1157                             $self->madness('ox ('),
1158                             @newkids,
1159                             $self->madness(')')
1160                 );
1161                 return $newself;
1162             }
1163         },
1164     );
1165 }
1166
1167 # Null nodes are an untyped mess inside Perl.  Instead of fixing it there,
1168 # we derive an effective type either from the "was" field or the first madprop.
1169 # (The individual routines select the actual new type.)
1170
1171 sub ast {
1172     my $self = shift;
1173     my $was = $$self{was} || 'peg';
1174     my $mad = $$self{mp}{FIRST} || "unknown";
1175
1176     # First try for a "was".
1177     my $meth = "PLXML::op_${was}::astnull";
1178     if (exists &{$meth}) {
1179         return $self->$meth(@_);
1180     }
1181
1182     # Look at first madprop.
1183     if (exists $astmad{$mad}) {
1184         return $astmad{$mad}->($self);
1185     }
1186     warn "No mad $mad" unless $mad eq 'unknown';
1187
1188     # Do something generic.
1189     my @newkids;
1190     for my $kid (@{$$self{Kids}}) {
1191         push @newkids, $kid->ast($self, @_);
1192     }
1193     return $self->newtype->new(Kids => [@newkids]);
1194 }
1195
1196 sub blockast {
1197     my $self = shift;
1198     local $::curstate;
1199     local $::curenc = $::curenc;
1200     return $self->madness('{ ; }');
1201 }
1202
1203 package PLXML::op_stub;
1204
1205 sub ast {
1206     my $self = shift;
1207     return $self->newtype->new(Kids => [$self->madness(', x ( ) q = Q')]);
1208 }
1209
1210 package PLXML::op_scalar;
1211
1212 sub ast {
1213     my $self = shift;
1214
1215     my @pre = $self->madness('o q');
1216     my $op = pop @pre;
1217     if ($op->uni =~ /^<</) {
1218         my @newkids;
1219         my $opstub = bless { start => $op }, 'P5AST::heredoc';
1220         push @newkids, $opstub;
1221         push @newkids, $self->madness('(');
1222
1223         my @kids = @{$$self{Kids}};
1224
1225         my @divert;
1226         for my $kid (@kids) {
1227             next if ref $kid eq 'PLXML::op_pushmark';
1228             next if ref $kid eq 'PLXML::op_null' and
1229                     defined $$kid{was} and $$kid{was} eq 'pushmark';
1230             push @divert, $kid->ast($self, @_);
1231         }
1232         $opstub->{doc} = P5AST::op_list->new(Kids => [@divert]);
1233         $opstub->{end} = ($self->madness('Q'))[-1];
1234
1235         push @newkids, $self->madness(')');
1236
1237         return $self->newtype->new(Kids => [@pre,@newkids]);
1238     }
1239     return $self->PLXML::baseop_unop::ast();
1240 }
1241
1242 package PLXML::op_pushmark;
1243
1244 sub ast { () }
1245
1246 package PLXML::op_wantarray;
1247 package PLXML::op_const;
1248
1249 sub astnull {
1250     my $self = shift;
1251     my @newkids;
1252     return unless $$self{mp};
1253     push @newkids, $self->madness('q = Q X : f O ( )');
1254     return P5AST::op_const->new(Kids => [@newkids]);
1255 }
1256
1257 sub ast {
1258     my $self = shift;
1259     return unless %{$$self{mp}};
1260
1261     my @before;
1262
1263     my $const;
1264     my @args = $self->madness('f');
1265     if (@args) {
1266     }
1267     elsif (exists $self->{mp}{q}) {
1268         push @args, $self->madness('d q');
1269         if ($args[-1]->uni =~ /^<</) {
1270             my $opstub = bless { start => pop(@args) }, 'P5AST::heredoc';
1271             $opstub->{doc} = P5AST::op_const->new(Kids => [$self->madness('=')]);
1272             $opstub->{end} = ($self->madness('Q'))[-1];
1273             push @args, $opstub;
1274         }
1275         else {
1276             push @args, $self->madness('= Q');
1277         }
1278     }
1279     elsif (exists $self->{mp}{X}) {
1280         push @before, $self->madness('d');      # was local $[ probably
1281         if (not $$self{mp}{O}) {
1282             push @before, $self->madness('o');  # was unary
1283         }
1284         my @X = $self->madness(': X');
1285         if (exists $$self{private} and $$self{private} =~ /BARE/) {
1286             return $self->newtype->new(Kids => [@X]);
1287         }
1288         my $X = pop @X;
1289         push @before, @X;
1290         @args = (
1291             $self->madness('x'),
1292             $X);
1293         if ($$self{mp}{O}) {
1294             push @args, $self->madness('o O');
1295         }
1296     }
1297     elsif (exists $self->{mp}{O}) {
1298         push @args, $self->madness('O');
1299     }
1300     elsif ($$self{private} =~ /\bBARE\b/) {
1301         @args = ($$self{PV});
1302     }
1303     elsif (exists $$self{mp}{o}) {
1304         @args = $self->madness('o');
1305     }
1306     elsif (exists $$self{PV}) {
1307         @args = ('"', $$self{PV}, '"');
1308     }
1309     elsif (exists $$self{NV}) {
1310         @args = $$self{NV};
1311     }
1312     elsif (exists $$self{IV}) {
1313         @args = $$self{IV};
1314     }
1315     else {
1316         @args = $self->SUPER::text(@_);
1317     }
1318     return $self->newtype->new(Kids => [@before, @args]);
1319 }
1320
1321
1322 package PLXML::op_gvsv;
1323
1324 sub ast {
1325     my $self = shift;
1326     my @args;
1327     my @retval;
1328     for my $attr (qw/gv GV flags/) {
1329         if (exists $$self{$attr}) {
1330             push @args, $attr, $$self{$attr};
1331         }
1332     }
1333     push @retval, @args;
1334     push @retval, $self->madness('X');
1335     return $self->newtype->new(Kids => [@retval]);
1336 }
1337
1338 package PLXML::op_gv;
1339
1340 sub ast {
1341     my $self = shift;
1342     my @newkids;
1343     push @newkids, $self->madness('X K');
1344
1345     return $self->newtype->new(Kids => [@newkids]);
1346 }
1347
1348 package PLXML::op_gelem;
1349
1350 sub ast {
1351     my $self = shift;
1352
1353     local $::curstate;  # in case there are statements in subscript
1354     local $::curenc = $::curenc;
1355     my @newkids;
1356     push @newkids, $self->madness('dx d');
1357     for my $kid (@{$$self{Kids}}) {
1358         push @newkids, $kid->ast($self, @_);
1359     }
1360     splice @newkids, -1, 0, $self->madness('o {');
1361     push @newkids, $self->madness('}');
1362
1363     return $self->newtype->new(Kids => [@newkids]);
1364 }
1365
1366 package PLXML::op_padsv;
1367
1368 sub ast {
1369     my $self = shift;
1370     my @args;
1371     push @args, $self->madness('dx d ( $ )');
1372
1373     return $self->newtype->new(Kids => [@args]);
1374 }
1375
1376 package PLXML::op_padav;
1377
1378 sub astnull { ast(@_) }
1379
1380 sub ast {
1381     my $self = shift;
1382     my @retval;
1383     push @retval, $self->madness('dx d (');
1384     push @retval, $self->madness('$ @');
1385     push @retval, $self->madness(') o O');
1386     return $self->newtype->new(Kids => [@retval]);
1387 }
1388
1389 package PLXML::op_padhv;
1390
1391 sub astnull { ast(@_) }
1392
1393 sub ast {
1394     my $self = shift;
1395     my @retval;
1396     push @retval, $self->madness('dx d (');
1397     push @retval, $self->madness('$ @ %');
1398     push @retval, $self->madness(') o O');
1399     return $self->newtype->new(Kids => [@retval]);
1400 }
1401
1402 package PLXML::op_padany;
1403
1404 package PLXML::op_pushre;
1405
1406 sub ast {
1407     my $self = shift;
1408     if ($$self{mp}{q}) {
1409         return $self->madness('q = Q m');
1410     }
1411     if ($$self{mp}{X}) {
1412         return $self->madness('X m');
1413     }
1414     if ($$self{mp}{e}) {
1415         return $self->madness('e m');
1416     }
1417     return $$self{Kids}[1]->ast($self,@_), $self->madness('m');
1418 }
1419
1420 package PLXML::op_rv2gv;
1421
1422 sub ast {
1423     my $self = shift;
1424
1425     my @newkids;
1426     push @newkids, $self->madness('dx d ( * $');
1427     push @newkids, $$self{Kids}[0]->ast();
1428     push @newkids, $self->madness(')');
1429     return $self->newtype->new(Kids => [@newkids]);
1430 }
1431
1432 package PLXML::op_rv2sv;
1433
1434 sub astnull {
1435     my $self = shift;
1436     return P5AST::op_rv2sv->new(Kids => [$self->madness('O o dx d ( $ ) : a')]);
1437 }
1438
1439 sub ast {
1440     my $self = shift;
1441
1442     my @newkids;
1443     push @newkids, $self->madness('dx d ( $');
1444     if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
1445         push @newkids, $$self{Kids}[0]->ast();
1446     }
1447     push @newkids, $self->madness(') : a');
1448     return $self->newtype->new(Kids => [@newkids]);
1449 }
1450
1451 package PLXML::op_av2arylen;
1452
1453 sub ast {
1454     my $self = shift;
1455
1456     my @newkids;
1457     push @newkids, $$self{Kids}[0]->madness('l');
1458     push @newkids, $$self{Kids}[0]->ast();
1459     return $self->newtype->new(Kids => [@newkids]);
1460 }
1461
1462 package PLXML::op_rv2cv;
1463
1464 sub astnull {
1465     my $self = shift;
1466     my @newkids;
1467     push @newkids, $self->madness('X');
1468     return @newkids if @newkids;
1469     if (exists $$self{mp}{'&'}) {
1470         push @newkids, $self->madness('&');
1471         if (@{$$self{Kids}}) {
1472             push @newkids, $$self{Kids}[0]->ast(@_);
1473         }
1474     }
1475     else {
1476         push @newkids, $$self{Kids}[0]->ast(@_);
1477     }
1478     return P5AST::op_rv2cv->new(Kids => [@newkids]);
1479 }
1480
1481 sub ast {
1482     my $self = shift;
1483
1484     my @newkids;
1485     push @newkids, $self->madness('&');
1486     if (@{$$self{Kids}}) {
1487         push @newkids, $$self{Kids}[0]->ast();
1488     }
1489     return $self->newtype->new(Kids => [@newkids]);
1490 }
1491
1492 package PLXML::op_anoncode;
1493
1494 sub ast {
1495     my $self = shift;
1496     my $arg = $$self{Kids}[0];
1497     local $::curstate;          # hide nested statements in sub
1498     local $::curenc = $::curenc;
1499     if (defined $arg) {
1500         return $arg->ast(@_);
1501     }
1502     return ';';  # XXX literal ; should come through somewhere
1503 }
1504
1505 package PLXML::op_prototype;
1506 package PLXML::op_refgen;
1507
1508 sub ast {
1509     my $self = shift;
1510     my @newkids = $self->madness('o s a');
1511
1512     if (exists $$self{Kids}) {
1513         my $arg = $$self{Kids}[0];
1514         push @newkids, $arg->ast($self, @_) if defined $arg;
1515     }
1516
1517     my $res = $self->newtype->new(Kids => [@newkids]);
1518     return $res;
1519 }
1520
1521 package PLXML::op_srefgen;
1522
1523 sub ast {
1524     my @newkids;
1525     my $self = shift;
1526     if ($$self{mp}{FIRST} eq '{') {
1527         local $::curstate;      # this is officially a block, so hide it
1528         local $::curenc = $::curenc;
1529         push @newkids, $self->madness('{');
1530         for my $kid (@{$$self{Kids}}) {
1531             push @newkids, $kid->ast($self, @_);
1532         }
1533         push @newkids, $self->madness('; }');
1534         return P5AST::op_stringify->new(Kids => [@newkids]);
1535     }
1536     else {
1537         push @newkids, $self->madness('o [');
1538         for my $kid (@{$$self{Kids}}) {
1539             push @newkids, $kid->ast($self, @_);
1540         }
1541         push @newkids, $self->madness(']');
1542         return P5AST::op_stringify->new(Kids => [@newkids]);
1543     }
1544 }
1545
1546 package PLXML::op_ref;
1547 package PLXML::op_bless;
1548 package PLXML::op_backtick;
1549
1550 sub ast {
1551     my $self = shift;
1552     my @args;
1553     if (exists $self->{mp}{q}) {
1554         push @args, $self->madness('q');
1555         if ($args[-1]->uni =~ /^<</) {
1556             my $opstub = bless { start => $args[-1] }, 'P5AST::heredoc';
1557             $args[-1] = $opstub;
1558             $opstub->{doc} = P5AST::op_const->new(Kids => [$self->madness('=')]);
1559             $opstub->{end} = ($self->madness('Q'))[-1];
1560         }
1561         else {
1562             push @args, $self->madness('= Q');
1563         }
1564     }
1565     return $self->newtype->new(Kids => [@args]);
1566 }
1567
1568 package PLXML::op_glob;
1569
1570 sub astnull {
1571     my $self = shift;
1572     my @retval = $self->madness('o q = Q');
1573     if (not @retval or $retval[-1]->uni eq 'glob') {
1574         push @retval, $self->madness('(');
1575         push @retval, $$self{Kids}[0]->ast($self,@_);
1576         push @retval, $self->madness(')');
1577     }
1578     return P5AST::op_glob->new(Kids => [@retval]);
1579 }
1580
1581 package PLXML::op_readline;
1582
1583 sub astnull {
1584     my $self = shift;
1585     my @retval;
1586     if (exists $$self{mp}{q}) {
1587         @retval = $self->madness('q = Q');
1588     }
1589     elsif (exists $$self{mp}{X}) {
1590         @retval = $self->madness('X');
1591     }
1592     return P5AST::op_readline->new(Kids => [@retval]);
1593 }
1594
1595 sub ast {
1596     my $self = shift;
1597
1598     my @retval;
1599
1600     my @args;
1601     my $const;
1602     if (exists $$self{mp}{q}) {
1603         @args = $self->madness('q = Q');
1604     }
1605     elsif (exists $$self{mp}{X}) {
1606         @args = $self->madness('X');
1607     }
1608     elsif (exists $$self{GV}) {
1609         @args = $$self{IV};
1610     }
1611     elsif (@{$$self{Kids}}) {
1612         @args = $self->PLXML::unop::ast(@_);
1613     }
1614     else {
1615         @args = $self->SUPER::text(@_);
1616     }
1617     return $self->newtype->new(Kids => [@retval,@args]);
1618 }
1619
1620
1621 package PLXML::op_rcatline;
1622 package PLXML::op_regcmaybe;
1623 package PLXML::op_regcreset;
1624 package PLXML::op_regcomp;
1625
1626 sub ast {
1627     my $self = shift;
1628     $self->PLXML::unop::ast(@_);
1629 }
1630
1631 package PLXML::op_match;
1632
1633 sub ast {
1634     my $self = shift;
1635     my $retval = $self->SUPER::ast(@_);
1636     my $p5re;
1637     if (not $p5re = $retval->p5text()) {
1638         $retval = $self->newtype->new(Kids => [$self->madness('X q = Q m')]);
1639         $p5re = $retval->p5text();
1640     }
1641     if ($deinterpolate) {
1642         $retval->{P5re} = P5re::qrparse($p5re);
1643     }
1644     return $retval;
1645 }
1646
1647 package PLXML::op_qr;
1648
1649 sub ast {
1650     my $self = shift;
1651     my $retval;
1652     if (exists $$self{flags}) {
1653         $retval = $self->SUPER::ast(@_);
1654     }
1655     else {
1656         $retval = $self->newtype->new(Kids => [$self->madness('X q = Q m')]);
1657     }
1658     if ($deinterpolate) {
1659         my $p5re = $retval->p5text();
1660         $retval->{P5re} = P5re::qrparse($p5re);
1661     }
1662     return $retval;
1663 }
1664
1665 package PLXML::op_subst;
1666
1667 sub ast {
1668     my $self = shift;
1669
1670     my $bits = $self->fetchbits($$self{flags},@_);
1671
1672     my @newkids;
1673     if ($bits->{binding}) {
1674         push @newkids, $bits->{binding};
1675         push @newkids, $self->madness('~');
1676     }
1677     my $X = p5::token->new($$self{mp}{X});
1678     my @lfirst = $self->madness('q');
1679     my @llast = $self->madness('Q');
1680     push @newkids,
1681         @lfirst,
1682         $self->madness('E'),    # XXX s/b e probably
1683         @llast;
1684     my @rfirst = $self->madness('z');
1685     my @rlast = $self->madness('Z');
1686     my @mods = $self->madness('m');
1687     if ($rfirst[-1]->uni ne $llast[-1]->uni) {
1688         push @newkids, @rfirst;
1689     }
1690
1691     push @newkids, $bits->{repl}, @rlast, @mods;
1692
1693     my $retval = $self->newtype->new(Kids => [@newkids]);
1694     if ($deinterpolate) {
1695         my $p5re = $retval->p5text();
1696         $retval->{P5re} = P5re::qrparse($p5re);
1697     }
1698     return $retval;
1699 }
1700
1701 package PLXML::op_substcont;
1702 package PLXML::op_trans;
1703
1704 sub ast {
1705     my $self = shift;
1706
1707 #    my $bits = $self->fetchbits($$self{flags},@_);
1708 #
1709     my @newkids;
1710     my @lfirst = $self->madness('q');
1711     my @llast = $self->madness('Q');
1712     push @newkids,
1713         @lfirst,
1714         $self->madness('E'),
1715         @llast;
1716     my @rfirst = $self->madness('z');
1717     my @repl = $self->madness('R');
1718     my @rlast = $self->madness('Z');
1719     my @mods = $self->madness('m');
1720     if ($rfirst[-1]->uni ne $llast[-1]->uni) {
1721         push @newkids, @rfirst;
1722     }
1723
1724     push @newkids, @repl, @rlast, @mods;
1725
1726     my $res = $self->newtype->new(Kids => [@newkids]);
1727     return $res;
1728 }
1729
1730 package PLXML::op_sassign;
1731
1732 sub ast {
1733     my $self = shift;
1734     my @newkids;
1735
1736     my $right = $$self{Kids}[1];
1737     eval { push @newkids, $right->ast($self, @_); };
1738
1739     push @newkids, $self->madness('o');
1740
1741     my $left = $$self{Kids}[0];
1742     push @newkids, $left->ast($self, @_);
1743
1744     return $self->newtype->new(Kids => [@newkids]);
1745 }
1746
1747 package PLXML::op_aassign;
1748
1749 sub astnull { ast(@_) }
1750
1751 sub ast {
1752     my $self = shift;
1753     my @newkids;
1754
1755     my $right = $$self{Kids}[1];
1756     push @newkids, $right->ast($self, @_);
1757
1758     push @newkids, $self->madness('o');
1759
1760     my $left = $$self{Kids}[0];
1761     push @newkids, $left->ast($self, @_);
1762
1763     return $self->newtype->new(Kids => [@newkids]);
1764 }
1765
1766 package PLXML::op_chop;
1767 package PLXML::op_schop;
1768 package PLXML::op_chomp;
1769 package PLXML::op_schomp;
1770 package PLXML::op_defined;
1771 package PLXML::op_undef;
1772 package PLXML::op_study;
1773 package PLXML::op_pos;
1774 package PLXML::op_preinc;
1775
1776 sub ast {
1777     my $self = shift;
1778     if ($$self{targ}) {         # stealth post inc or dec
1779         return $self->PLXML::op_postinc::ast(@_);
1780     }
1781     return $self->SUPER::ast(@_);
1782 }
1783
1784 package PLXML::op_i_preinc;
1785
1786 sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
1787
1788 package PLXML::op_predec;
1789
1790 sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
1791
1792 package PLXML::op_i_predec;
1793
1794 sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
1795
1796 package PLXML::op_postinc;
1797
1798 sub ast {
1799     my $self = shift;
1800     my @newkids;
1801
1802     if (exists $$self{Kids}) {
1803         my $arg = $$self{Kids}[0];
1804         push @newkids, $arg->ast($self, @_) if defined $arg;
1805     }
1806     push @newkids, $self->madness('o');
1807
1808     my $res = $self->newtype->new(Kids => [@newkids]);
1809     return $res;
1810 }
1811
1812 package PLXML::op_i_postinc;
1813
1814 sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
1815
1816 package PLXML::op_postdec;
1817
1818 sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
1819
1820 package PLXML::op_i_postdec;
1821
1822 sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
1823
1824 package PLXML::op_pow;
1825 package PLXML::op_multiply;
1826 package PLXML::op_i_multiply;
1827 package PLXML::op_divide;
1828 package PLXML::op_i_divide;
1829 package PLXML::op_modulo;
1830 package PLXML::op_i_modulo;
1831 package PLXML::op_repeat;
1832
1833 sub ast {
1834     my $self = shift;
1835     return $self->SUPER::ast(@_)
1836         unless exists $$self{private} and $$self{private} =~ /DOLIST/;
1837
1838     my $newself = $$self{Kids}[0]->ast($self,@_);
1839     splice @{$newself->{Kids}}, -1, 0, $self->madness('o');
1840
1841     return bless $newself, $self->newtype;      # rebless the op_null
1842 }
1843
1844 package PLXML::op_add;
1845 package PLXML::op_i_add;
1846 package PLXML::op_subtract;
1847 package PLXML::op_i_subtract;
1848 package PLXML::op_concat;
1849
1850 sub astnull {
1851     my $self = shift;
1852     my @newkids;
1853
1854     my @after;
1855     my $left = $$self{Kids}[0];
1856     push @newkids, $left->ast($self, @_);
1857
1858     push @newkids, $self->madness('o');
1859
1860     my $right = $$self{Kids}[1];
1861     push @newkids, $right->ast($self, @_);
1862     return P5AST::op_concat->new(Kids => [@newkids]);
1863 }
1864
1865 sub ast {
1866     my $self = shift;
1867     my $parent = $_[0];
1868     my @newkids;
1869
1870     my @after;
1871     my $left = $$self{Kids}[0];
1872     push @newkids, $left->ast($self, @_);
1873
1874     push @newkids, $self->madness('o');
1875
1876     my $right = $$self{Kids}[1];
1877     push @newkids, $right->ast($self, @_);
1878
1879     return $self->newtype->new(Kids => [@newkids, @after]);
1880 }
1881
1882 package PLXML::op_stringify;
1883
1884 sub astnull {
1885     ast(@_);
1886 }
1887
1888 sub ast {
1889     my $self = shift;
1890     my @newkids;
1891     my @front = $self->madness('q (');
1892     my @back = $self->madness(') Q');
1893     my @M = $self->madness('M');
1894     if (@M) {
1895         push @newkids, $M[0], $self->madness('o');
1896     }
1897     push @newkids, @front;
1898     for my $kid (@{$$self{Kids}}) {
1899         push @newkids, $kid->ast($self, @_);
1900     }
1901     push @newkids, @back;
1902     return P5AST::op_stringify->new(Kids => [@newkids]);
1903 }
1904
1905 package PLXML::op_left_shift;
1906 package PLXML::op_right_shift;
1907 package PLXML::op_lt;
1908 package PLXML::op_i_lt;
1909 package PLXML::op_gt;
1910 package PLXML::op_i_gt;
1911 package PLXML::op_le;
1912 package PLXML::op_i_le;
1913 package PLXML::op_ge;
1914 package PLXML::op_i_ge;
1915 package PLXML::op_eq;
1916 package PLXML::op_i_eq;
1917 package PLXML::op_ne;
1918 package PLXML::op_i_ne;
1919 package PLXML::op_ncmp;
1920 package PLXML::op_i_ncmp;
1921 package PLXML::op_slt;
1922 package PLXML::op_sgt;
1923 package PLXML::op_sle;
1924 package PLXML::op_sge;
1925 package PLXML::op_seq;
1926 package PLXML::op_sne;
1927 package PLXML::op_scmp;
1928 package PLXML::op_bit_and;
1929 package PLXML::op_bit_xor;
1930 package PLXML::op_bit_or;
1931 package PLXML::op_negate;
1932 package PLXML::op_i_negate;
1933 package PLXML::op_not;
1934
1935 sub ast {
1936     my $self = shift;
1937     my @newkids = $self->madness('o (');
1938     my @swap;
1939     if (@newkids and $newkids[-1]->uni eq '!~') {
1940         @swap = @newkids;
1941         @newkids = ();
1942     }
1943
1944     if (exists $$self{Kids}) {
1945         my $arg = $$self{Kids}[0];
1946         push @newkids, $arg->ast($self, @_) if defined $arg;
1947     }
1948     if (@swap) {
1949         splice @{$newkids[-1][0]{Kids}}, -2, 0, @swap;  # XXX WAG
1950     }
1951     push @newkids, $self->madness(')');
1952
1953     my $res = $self->newtype->new(Kids => [@newkids]);
1954     return $res;
1955 }
1956
1957 package PLXML::op_complement;
1958 package PLXML::op_atan2;
1959 package PLXML::op_sin;
1960 package PLXML::op_cos;
1961 package PLXML::op_rand;
1962 package PLXML::op_srand;
1963 package PLXML::op_exp;
1964 package PLXML::op_log;
1965 package PLXML::op_sqrt;
1966 package PLXML::op_int;
1967 package PLXML::op_hex;
1968 package PLXML::op_oct;
1969 package PLXML::op_abs;
1970 package PLXML::op_length;
1971 package PLXML::op_substr;
1972 package PLXML::op_vec;
1973 package PLXML::op_index;
1974 package PLXML::op_rindex;
1975 package PLXML::op_sprintf;
1976 package PLXML::op_formline;
1977 package PLXML::op_ord;
1978 package PLXML::op_chr;
1979 package PLXML::op_crypt;
1980 package PLXML::op_ucfirst;
1981
1982 sub ast {
1983     my $self = shift;
1984     return $self->PLXML::listop::ast(@_);
1985 }
1986
1987 package PLXML::op_lcfirst;
1988
1989 sub ast {
1990     my $self = shift;
1991     return $self->PLXML::listop::ast(@_);
1992 }
1993
1994 package PLXML::op_uc;
1995
1996 sub ast {
1997     my $self = shift;
1998     return $self->PLXML::listop::ast(@_);
1999 }
2000
2001 package PLXML::op_lc;
2002
2003 sub ast {
2004     my $self = shift;
2005     return $self->PLXML::listop::ast(@_);
2006 }
2007
2008 package PLXML::op_quotemeta;
2009
2010 sub ast {
2011     my $self = shift;
2012     return $self->PLXML::listop::ast(@_);
2013 }
2014
2015 package PLXML::op_rv2av;
2016
2017 sub astnull {
2018     my $self = shift;
2019     return P5AST::op_rv2av->new(Kids => [$self->madness('$ @')]);
2020 }
2021
2022 sub ast {
2023     my $self = shift;
2024
2025     if (ref $$self{Kids}[0] eq 'PLXML::op_const' and $$self{mp}{'O'}) {
2026         return $self->madness('O');
2027     }
2028
2029     my @before;
2030     push @before, $self->madness('dx d (');
2031
2032     my @newkids;
2033     push @newkids, $self->madness('$ @ K');
2034     if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
2035         push @newkids, $$self{Kids}[0]->ast();
2036     }
2037     my @after;
2038     push @after, $self->madness(') a');
2039     return $self->newtype->new(Kids => [@before, @newkids, @after]);
2040 }
2041
2042 package PLXML::op_aelemfast;
2043
2044 sub ast {
2045     my $self = shift;
2046     return $self->madness('$');
2047 }
2048
2049 package PLXML::op_aelem;
2050
2051 sub astnull {
2052     my $self = shift;
2053     my @newkids;
2054     push @newkids, $self->madness('dx d');
2055     for my $kid (@{$$self{Kids}}) {
2056         push @newkids, $kid->ast($self, @_);
2057     }
2058     splice @newkids, -1, 0, $self->madness('a [');
2059     push @newkids, $self->madness(']');
2060     return P5AST::op_aelem->new(Kids => [@newkids]);
2061 }
2062
2063 sub ast {
2064     my $self = shift;
2065
2066     my @before = $self->madness('dx d');
2067     my @newkids;
2068     for my $kid (@{$$self{Kids}}) {
2069         push @newkids, $kid->ast(@_);
2070     }
2071     splice @newkids, -1, 0, $self->madness('a [');
2072     push @newkids, $self->madness(']');
2073
2074     return $self->newtype->new(Kids => [@before, @newkids]);
2075 }
2076
2077 package PLXML::op_aslice;
2078
2079 sub astnull {
2080     my $self = shift;
2081     my @newkids;
2082     push @newkids, $self->madness('[');
2083     for my $kid (@{$$self{Kids}}) {
2084         push @newkids, $kid->ast(@_);
2085     }
2086     unshift @newkids, pop @newkids;
2087     unshift @newkids, $self->madness('dx d');
2088     push @newkids, $self->madness(']');
2089     return P5AST::op_aslice->new(Kids => [@newkids]);
2090 }
2091
2092 sub ast {
2093     my $self = shift;
2094
2095     my @newkids;
2096     push @newkids, $self->madness('[');
2097     for my $kid (@{$$self{Kids}}) {
2098         push @newkids, $kid->ast(@_);
2099     }
2100     unshift @newkids, pop @newkids;
2101     unshift @newkids, $self->madness('dx d');
2102     push @newkids, $self->madness(']');
2103
2104     return $self->newtype->new(Kids => [@newkids]);
2105 }
2106
2107 package PLXML::op_each;
2108 package PLXML::op_values;
2109 package PLXML::op_keys;
2110 package PLXML::op_delete;
2111 package PLXML::op_exists;
2112 package PLXML::op_rv2hv;
2113
2114 sub astnull {
2115     my $self = shift;
2116     return P5AST::op_rv2hv->new(Kids => [$self->madness('$')]);
2117 }
2118
2119 sub ast {
2120     my $self = shift;
2121
2122     my @before;
2123     push @before, $self->madness('dx d (');
2124
2125     my @newkids;
2126     push @newkids, $self->madness('$ @ % K');
2127     if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
2128         push @newkids, $$self{Kids}[0]->ast();
2129     }
2130     my @after;
2131     push @after, $self->madness(') a');
2132     return $self->newtype->new(Kids => [@before, @newkids, @after]);
2133 }
2134
2135 package PLXML::op_helem;
2136
2137 sub astnull {
2138     my $self = shift;
2139     local $::curstate;  # hash subscript potentially a lineseq
2140     local $::curenc = $::curenc;
2141
2142     my @newkids;
2143     push @newkids, $self->madness('dx d');
2144     for my $kid (@{$$self{Kids}}) {
2145         push @newkids, $kid->ast($self, @_);
2146     }
2147     splice @newkids, -1, 0, $self->madness('a {');
2148     push @newkids, $self->madness('}');
2149     return P5AST::op_helem->new(Kids => [@newkids]);
2150 }
2151
2152 sub ast {
2153     my $self = shift;
2154     local $::curstate;  # hash subscript potentially a lineseq
2155     local $::curenc = $::curenc;
2156
2157     my @before = $self->madness('dx d');
2158     my @newkids;
2159     for my $kid (@{$$self{Kids}}) {
2160         push @newkids, $kid->ast($self, @_);
2161     }
2162     splice @newkids, -1, 0, $self->madness('a {');
2163     push @newkids, $self->madness('}');
2164
2165     return $self->newtype->new(Kids => [@before, @newkids]);
2166 }
2167
2168
2169 package PLXML::op_hslice;
2170
2171 sub astnull {
2172     my $self = shift;
2173     my @newkids;
2174     push @newkids, $self->madness('{');
2175     for my $kid (@{$$self{Kids}}) {
2176         push @newkids, $kid->ast(@_);
2177     }
2178     unshift @newkids, pop @newkids;
2179     unshift @newkids, $self->madness('dx d'); 
2180     push @newkids, $self->madness('}');
2181     return P5AST::op_hslice->new(Kids => [@newkids]);
2182 }
2183
2184 sub ast {
2185     my $self = shift;
2186
2187     my @newkids;
2188     push @newkids, $self->madness('{');
2189     for my $kid (@{$$self{Kids}}) {
2190         push @newkids, $kid->ast(@_);
2191     }
2192     unshift @newkids, pop @newkids;
2193     unshift @newkids, $self->madness('dx d'); 
2194     push @newkids, $self->madness('}');
2195
2196     return $self->newtype->new(Kids => [@newkids]);
2197 }
2198
2199 package PLXML::op_unpack;
2200 package PLXML::op_pack;
2201 package PLXML::op_split;
2202 package PLXML::op_join;
2203 package PLXML::op_list;
2204
2205 sub astnull {
2206     my $self = shift;
2207     my @newkids;
2208     my @retval;
2209     my @before;
2210     if (@retval = $self->madness('X')) {
2211         push @before, $self->madness('x o');
2212         return @before,@retval;
2213     }
2214     my @kids = @{$$self{Kids}};
2215     for my $kid (@kids) {
2216         next if ref $kid eq 'PLXML::op_pushmark';
2217         next if ref $kid eq 'PLXML::op_null' and
2218                 defined $$kid{was} and $$kid{was} eq 'pushmark';
2219         push @newkids, $kid->ast($self, @_);
2220     }
2221
2222     my $x = "";
2223     my @newnewkids = ();
2224     push @newnewkids, $self->madness('dx d (');
2225     push @newnewkids, @newkids;
2226     push @newnewkids, $self->madness(') :');
2227     return P5AST::op_list->new(Kids => [@newnewkids]);
2228 }
2229
2230 sub ast {
2231     my $self = shift;
2232
2233     my @retval;
2234     my @before;
2235     if (@retval = $self->madness('X')) {
2236         push @before, $self->madness('o');
2237         return $self->newtype->new(Kids => [@before,@retval]);
2238     }
2239     push @retval, $self->madness('dx d (');
2240
2241     my @newkids;
2242     for my $kid (@{$$self{Kids}}) {
2243         push @newkids, $kid->ast($self, @_);
2244     }
2245     my $x = "";
2246     my @newnewkids = ();
2247     push @newnewkids, @newkids;
2248     @newkids = @newnewkids;
2249     push @retval, @newkids;
2250     push @retval, $self->madness(') :');
2251     return $self->newtype->new(Kids => [@retval]);
2252 }
2253
2254 package PLXML::op_lslice;
2255
2256 sub ast {
2257     my $self = shift;
2258     my @newkids;
2259
2260     if ($$self{mp}{q}) {
2261         push @newkids, $self->madness('q = Q');
2262     }
2263     elsif ($$self{mp}{x}) {
2264         push @newkids, $self->madness('x');
2265     }
2266     else {
2267         push @newkids, $self->madness('(');
2268         my $list = $$self{Kids}[1];
2269         push @newkids, $list->ast($self, @_);
2270         push @newkids, $self->madness(')');
2271     }
2272
2273     push @newkids, $self->madness('[');
2274
2275     my $slice = $$self{Kids}[0];
2276     push @newkids, $slice->ast($self, @_);
2277     push @newkids, $self->madness(']');
2278
2279     return $self->newtype->new(Kids => [@newkids]);
2280 }
2281
2282 package PLXML::op_anonlist;
2283 package PLXML::op_anonhash;
2284 package PLXML::op_splice;
2285 package PLXML::op_push;
2286 package PLXML::op_pop;
2287 package PLXML::op_shift;
2288 package PLXML::op_unshift;
2289 package PLXML::op_sort;
2290 package PLXML::op_reverse;
2291
2292 sub astnull {
2293     my $self = shift;
2294     $self->PLXML::listop::ast(@_);
2295 }
2296
2297 package PLXML::op_grepstart;
2298 package PLXML::op_grepwhile;
2299 package PLXML::op_mapstart;
2300 package PLXML::op_mapwhile;
2301 package PLXML::op_range;
2302
2303 sub ast {
2304     my $self = shift;
2305     return $self->PLXML::binop::ast(@_);
2306 }
2307
2308 package PLXML::op_flip;
2309 package PLXML::op_flop;
2310 package PLXML::op_and;
2311
2312 sub astnull {
2313     my $self = shift;
2314     my @newkids;
2315     my @first = $self->madness('1');
2316     my @second = $self->madness('2');
2317     my @stuff = $$self{Kids}[0]->ast();
2318     if (my @I = $self->madness('I')) {
2319         if (@second) {
2320             push @newkids, @I;
2321             push @newkids, $self->madness('(');
2322             push @newkids, @stuff;
2323             push @newkids, $self->madness(')');
2324             push @newkids, @second;
2325         }
2326         else {
2327             push @newkids, @I;
2328             push @newkids, $self->madness('(');
2329             push @newkids, @first;
2330             push @newkids, $self->madness(')');
2331             push @newkids, @stuff;
2332         }
2333     }
2334     elsif (my @i = $self->madness('i')) {
2335         if (@second) {
2336             push @newkids, @second;
2337             push @newkids, @i;
2338             push @newkids, @stuff;
2339         }
2340         else {
2341             push @newkids, @stuff;
2342             push @newkids, @i;
2343             push @newkids, @first;
2344         }
2345     }
2346     elsif (my @o = $self->madness('o')) {
2347         if (@second) {
2348             push @newkids, @stuff;
2349             push @newkids, @o;
2350             push @newkids, @second;
2351         }
2352         else {
2353             push @newkids, @first;
2354             push @newkids, @o;
2355             push @newkids, @stuff;
2356         }
2357     }
2358     return P5AST::op_and->new(Kids => [@newkids]);
2359 }
2360
2361 package PLXML::op_or;
2362
2363 sub astnull {
2364     my $self = shift;
2365     my @newkids;
2366     my @first = $self->madness('1');
2367     my @second = $self->madness('2');
2368     my @i = $self->madness('i');
2369     my @stuff = $$self{Kids}[0]->ast();
2370     if (@second) {
2371         if (@i) {
2372             push @newkids, @second;
2373             push @newkids, $self->madness('i');
2374             push @newkids, @stuff;
2375         }
2376         else {
2377             push @newkids, @stuff;
2378             push @newkids, $self->madness('o');
2379             push @newkids, @second;
2380         }
2381     }
2382     else {
2383         if (@i) {
2384             push @newkids, @stuff;
2385             push @newkids, $self->madness('i');
2386             push @newkids, @first;
2387         }
2388         else {
2389             push @newkids, @first;
2390             push @newkids, $self->madness('o');
2391             push @newkids, @stuff;
2392         }
2393     }
2394     return "P5AST::op_$$self{was}"->new(Kids => [@newkids]);
2395 }
2396
2397
2398 package PLXML::op_xor;
2399 package PLXML::op_cond_expr;
2400 package PLXML::op_andassign;
2401 package PLXML::op_orassign;
2402 package PLXML::op_method;
2403 package PLXML::op_entersub;
2404
2405 sub ast {
2406     my $self = shift;
2407
2408     if ($$self{mp}{q}) {
2409         return $self->madness('q = Q');
2410     }
2411     if ($$self{mp}{X}) {                # <FH> override?
2412         return $self->madness('X');
2413     }
2414     if ($$self{mp}{A}) {
2415         return $self->astmethod(@_);
2416     }
2417     if ($$self{mp}{a}) {
2418         return $self->astarrow(@_);
2419     }
2420
2421     my @retval;
2422
2423     my @newkids;
2424     my @kids = @{$$self{Kids}};
2425     if (@kids == 1 and ref $kids[0] eq 'PLXML::op_null' and $kids[0]{was} =~ /list/) {
2426         @kids = @{$kids[0]{Kids}};
2427     }
2428     my $dest = pop @kids;
2429     my @dest = $dest->ast($self, @_);
2430     
2431     if (ref($dest) =~ /method/) {
2432         my $invocant = shift @kids;
2433         $invocant = shift @kids if ref($invocant) eq 'PLXML::op_pushmark';
2434         my @invocant = $invocant->ast($self, @_);
2435         push @retval, @dest;
2436         push @retval, @invocant;
2437     }
2438     elsif (exists $$self{mp}{o} and $$self{mp}{o} eq 'do') {
2439         push @retval, $self->madness('o');
2440         push @retval, @dest;
2441     }
2442     else {
2443         push @retval, $self->madness('o');
2444         push @retval, @dest;
2445     }
2446     while (@kids) {
2447         my $kid = shift(@kids);
2448         push @newkids, $kid->ast($self, @_);
2449     }
2450
2451     push @retval, $self->madness('(');
2452     push @retval, @newkids;
2453     push @retval, $self->madness(')');
2454     return $self->newtype->new(Kids => [@retval]);
2455 }
2456
2457 sub astmethod {
2458     my $self = shift;
2459     my @newkids;
2460     my @kids;
2461     for my $kid (@{$$self{Kids}}) {
2462         next if ref $kid eq 'PLXML::op_pushmark';
2463         next if ref $kid eq 'PLXML::op_null' and
2464                 defined $$kid{was} and $$kid{was} eq 'pushmark';
2465         push @kids, $kid;
2466     }
2467     my @invocant;
2468     if ($$self{flags} =~ /\bSTACKED\b/) {
2469         push @invocant, shift(@kids)->ast($self, @_);
2470     }
2471     for my $kid (@kids) {
2472         push @newkids, $kid->ast($self, @_);
2473     }
2474     my $dest = pop(@newkids);
2475     if (ref $dest eq 'PLXML::op_rv2cv' and $$self{flags} =~ /\bMOD\b/) {
2476         $dest = pop(@newkids);
2477     }
2478     my $x = "";
2479     my @retval;
2480     push @retval, @invocant;
2481     push @retval, $self->madness('A');
2482     push @retval, $dest;
2483     push @retval, $self->madness('(');
2484     push @retval, @newkids;
2485     push @retval, $self->madness(')');
2486     return $self->newtype->new(Kids => [@retval]);
2487 }
2488
2489 sub astarrow {
2490     my $self = shift;
2491     my @newkids;
2492     my @retval;
2493     my @kids = @{$$self{Kids}};
2494     if (@kids == 1 and ref $kids[0] eq 'PLXML::op_null' and $kids[0]{was} =~ /list/) {
2495         @kids = @{$kids[0]{Kids}};
2496     }
2497     while (@kids > 1) {
2498         my $kid = shift(@kids);
2499         push @newkids, $kid->ast($self, @_);
2500     }
2501     my @dest = $kids[0]->ast($self, @_);
2502     my $x = "";
2503     push @retval, @dest;
2504     push @retval, $self->madness('a');
2505     push @retval, $self->madness('(');
2506     push @retval, @newkids;
2507     push @retval, $self->madness(')');
2508     return $self->newtype->new(Kids => [@retval]);
2509 }
2510
2511 package PLXML::op_leavesub;
2512
2513 sub ast {
2514     my $self = shift;
2515     if (ref $$self{Kids}[0] eq "PLXML::op_null") {
2516         return $$self{Kids}[0]->ast(@_);
2517     }
2518     return $$self{Kids}[0]->blockast($self, @_);
2519 }
2520
2521 package PLXML::op_leavesublv;
2522
2523 sub ast {
2524     my $self = shift;
2525
2526     return $$self{Kids}[0]->blockast($self, @_);
2527 }
2528
2529 package PLXML::op_caller;
2530 package PLXML::op_warn;
2531 package PLXML::op_die;
2532 package PLXML::op_reset;
2533 package PLXML::op_lineseq;
2534
2535 sub lineseq {
2536     my $self = shift;
2537     my @kids = @{$$self{Kids}};
2538     local $::curstate = 0;      # (probably redundant, but that's okay)
2539     local $::prevstate = 0;
2540     local $::curenc = $::curenc;
2541     my @retval;
2542     my @newstuff;
2543     my $newprev;
2544     while (@kids) {
2545         my $kid = shift @kids;
2546         my $thing = $kid->ast($self, @_);
2547         next unless defined $thing;
2548         if ($::curstate ne $::prevstate) {
2549             if ($::prevstate) {
2550                 push @newstuff, $::prevstate->madness(';');
2551                 push @{$newprev->{Kids}}, @newstuff if $newprev;
2552                 @newstuff = ();
2553             }
2554             $::prevstate = $::curstate;
2555             $newprev = $thing;
2556             push @retval, $thing;
2557         }
2558         elsif ($::prevstate) {
2559             push @newstuff, $thing;
2560         }
2561         else {
2562             push @retval, $thing;
2563         }
2564     }
2565     if ($::prevstate) {
2566         push @newstuff, $::prevstate->madness(';');
2567         push @{$newprev->{Kids}}, @newstuff if $newprev;
2568         @newstuff = ();
2569         $::prevstate = 0;
2570     }
2571     return @retval;
2572 }
2573
2574 sub blockast {
2575     my $self = shift;
2576     local $::curstate;
2577
2578     my @retval;
2579     push @retval, $self->madness('{');
2580  
2581     my @newkids = $self->PLXML::op_lineseq::lineseq(@_);
2582     push @retval, @newkids;
2583
2584     push @retval, $self->madness('; }');
2585     return $self->newtype->new(Kids => [@retval]);
2586 }
2587
2588 package PLXML::op_nextstate;
2589
2590 sub newtype { return "P5AST::statement" }
2591
2592 sub astnull {
2593     my $self = shift;
2594     my @newkids;
2595     push @newkids, $self->madness('L');
2596     $::curstate = $self;
2597     return P5AST::statement->new(Kids => [@newkids]);
2598 }
2599
2600 sub ast {
2601     my $self = shift;
2602
2603     my @newkids;
2604     push @newkids, $self->madness('L');
2605     $::curstate = $self;
2606     return $self->newtype->new(Kids => [@newkids]);
2607 }
2608
2609
2610 package PLXML::op_dbstate;
2611 package PLXML::op_unstack;
2612 package PLXML::op_enter;
2613
2614 sub ast { () }
2615
2616 package PLXML::op_leave;
2617
2618 sub astnull {
2619     ast(@_);
2620 }
2621
2622 sub ast {
2623     my $self = shift;
2624
2625     my $mad = $$self{mp}{FIRST} || "unknown";
2626
2627     my @retval;
2628     if ($mad eq 'w') {
2629         my @newkids;
2630         my @tmpkids;
2631         push @tmpkids, $self->{Kids};
2632         my $anddo = $$self{Kids}[-1]{Kids}[0]{Kids};
2633         eval { push @newkids, $anddo->[1]->ast($self,@_); };
2634         push @newkids, "[[[NOANDDO]]]" if $@;
2635         push @newkids, $self->madness('w');
2636         push @newkids, $anddo->[0]->ast($self,@_);
2637
2638         return $self->newtype->new(Kids => [@newkids]);
2639     }
2640
2641     local $::curstate;
2642     push @retval, $self->madness('o {');
2643
2644     my @newkids = $self->PLXML::op_lineseq::lineseq(@_);
2645     push @retval, @newkids;
2646     push @retval, $self->madness(q/; }/);
2647     my $retval = $self->newtype->new(Kids => [@retval]);
2648
2649     if ($$self{mp}{C}) {
2650         my @before;
2651         my @after;
2652         push @before, $self->madness('I ( C )');
2653         if ($$self{mp}{t}) {
2654             push @before, $self->madness('t');
2655         }
2656         elsif ($$self{mp}{e}) {
2657             push @after, $self->madness('e');
2658         }
2659         return P5AST::op_cond->new(Kids => [@before, $retval, @after]);
2660     }
2661     else {
2662         return $retval;
2663     }
2664 }
2665
2666 package PLXML::op_scope;
2667
2668 sub ast {
2669     my $self = shift;
2670     local $::curstate;
2671
2672     my @newkids;
2673     push @newkids, $self->madness('o');
2674
2675     push @newkids, $self->madness('{');
2676     push @newkids, $self->PLXML::op_lineseq::lineseq(@_);
2677     push @newkids, $self->madness('; }');
2678
2679     my @folded = $self->madness('C');
2680     if (@folded) {
2681         my @t = $self->madness('t');
2682         my @e = $self->madness('e');
2683         if (@e) {
2684             return $self->newtype->new(
2685                 Kids => [
2686                     $self->madness('I ('),
2687                     @folded,
2688                     $self->madness(')'),
2689                     $self->newtype->new(Kids => [@newkids]),
2690                     @e
2691                 ] );
2692         }
2693         else {
2694             return $self->newtype->new(
2695                 Kids => [
2696                     $self->madness('I ('),
2697                     @folded,
2698                     $self->madness(')'),
2699                     @t,
2700                     $self->newtype->new(Kids => [@newkids])
2701                 ] );
2702         }
2703     }
2704     return $self->newtype->new(Kids => [@newkids]);
2705 }
2706
2707 package PLXML::op_enteriter;
2708
2709 sub ast {
2710     my $self = shift;
2711     my (undef,$range,$var) = @{$self->{Kids}};
2712     my @retval;
2713     push @retval, $self->madness('v');
2714     if (!@retval and defined $var) {
2715         push @retval, $var->ast($self,@_);
2716     }
2717     else {
2718         push @retval, '';
2719     }
2720     if (ref $range eq 'PLXML::op_null' and $$self{flags} =~ /STACKED/) {
2721         my (undef,$min,$max) = @{$range->{Kids}};
2722         push @retval, $min->ast($self,@_);
2723         if (defined $max) {
2724             if (exists $$range{mp}{O}) {        # deeply buried .. operator
2725                 PLXML::prepreproc($$range{mp}{O});
2726                 push @retval,
2727                   $$range{mp}{'O'}{Kids}[0]{Kids}[0]{Kids}[0]{Kids}[0]->madness('o')
2728             }
2729             else {
2730                 push @retval, '..';             # XXX missing whitespace
2731             }
2732             push @retval, $max->ast($self,@_);
2733         }
2734     }
2735     else {
2736         push @retval, $range->ast($self,@_);
2737     }
2738     return $self->newtype->new(Kids => [@retval]);
2739 }
2740
2741 package PLXML::op_iter;
2742 package PLXML::op_enterloop;
2743
2744 sub ast {
2745 }
2746
2747 package PLXML::op_leaveloop;
2748
2749 sub ast {
2750     my $self = shift;
2751
2752     my @retval;
2753     my @newkids;
2754     my $enterloop = $$self{Kids}[0];
2755     my $nextthing = $$self{Kids}[1];
2756
2757     if ($$self{mp}{W}) {
2758         push @retval, $self->madness('L');
2759         push @newkids, $self->madness('W d');
2760
2761         if (ref $enterloop eq 'PLXML::op_enteriter') {
2762             my ($var,@rest) = @{$enterloop->ast($self,@_)->{Kids}};
2763             push @newkids, $var if $var;
2764             push @newkids, $self->madness('q ( x = Q');
2765             push @newkids, @rest;
2766         }
2767         else {
2768             push @newkids, $self->madness('(');
2769             push @newkids, $enterloop->ast($self,@_);
2770         }
2771     }
2772     my $andor;
2773
2774     if (ref $nextthing eq 'PLXML::op_null') {
2775         if ($$nextthing{mp}{'1'}) {
2776             push @newkids, $nextthing->madness('1');
2777             push @newkids, $self->madness(')');
2778             push @newkids, $$nextthing{Kids}[0]->blockast($self,@_);
2779         }
2780         elsif ($$nextthing{mp}{'2'}) {
2781             push @newkids, $$nextthing{Kids}[0]->ast($self,@_);
2782             push @newkids, $self->madness(')');
2783             push @newkids, $$nextthing{mp}{'2'}->blockast($self,@_);
2784         }
2785         elsif ($$nextthing{mp}{'U'}) {
2786             push @newkids, $nextthing->ast($self,@_);
2787         }
2788         else {
2789             # bypass the op_null
2790             $andor = $nextthing->{Kids}[0];
2791             eval {
2792                 push @newkids, $$andor{Kids}[0]->ast($self, @_);
2793             };
2794             push @newkids, $self->madness(')');
2795             eval {
2796                 push @newkids, $$andor{Kids}[1]->blockast($self, @_);
2797             };
2798         }
2799     }
2800     else {
2801         $andor = $nextthing;
2802         push @newkids, $nextthing->madness('O');
2803         push @newkids, $self->madness(')');
2804         push @newkids, $nextthing->blockast($self, @_);
2805     }
2806     if ($$self{mp}{w}) {
2807         push @newkids, $self->madness('w');
2808         push @newkids, $enterloop->ast($self,@_);
2809     }
2810
2811     push @retval, @newkids;
2812
2813     return $self->newtype->new(Kids => [@retval]);
2814 }
2815
2816 package PLXML::op_return;
2817 package PLXML::op_last;
2818 package PLXML::op_next;
2819 package PLXML::op_redo;
2820 package PLXML::op_dump;
2821 package PLXML::op_goto;
2822 package PLXML::op_exit;
2823 package PLXML::op_open;
2824 package PLXML::op_close;
2825 package PLXML::op_pipe_op;
2826 package PLXML::op_fileno;
2827 package PLXML::op_umask;
2828 package PLXML::op_binmode;
2829 package PLXML::op_tie;
2830 package PLXML::op_untie;
2831 package PLXML::op_tied;
2832 package PLXML::op_dbmopen;
2833 package PLXML::op_dbmclose;
2834 package PLXML::op_sselect;
2835 package PLXML::op_select;
2836 package PLXML::op_getc;
2837 package PLXML::op_read;
2838 package PLXML::op_enterwrite;
2839 package PLXML::op_leavewrite;
2840 package PLXML::op_prtf;
2841 package PLXML::op_print;
2842 package PLXML::op_sysopen;
2843 package PLXML::op_sysseek;
2844 package PLXML::op_sysread;
2845 package PLXML::op_syswrite;
2846 package PLXML::op_send;
2847 package PLXML::op_recv;
2848 package PLXML::op_eof;
2849 package PLXML::op_tell;
2850 package PLXML::op_seek;
2851 package PLXML::op_truncate;
2852 package PLXML::op_fcntl;
2853 package PLXML::op_ioctl;
2854 package PLXML::op_flock;
2855 package PLXML::op_socket;
2856 package PLXML::op_sockpair;
2857 package PLXML::op_bind;
2858 package PLXML::op_connect;
2859 package PLXML::op_listen;
2860 package PLXML::op_accept;
2861 package PLXML::op_shutdown;
2862 package PLXML::op_gsockopt;
2863 package PLXML::op_ssockopt;
2864 package PLXML::op_getsockname;
2865 package PLXML::op_getpeername;
2866 package PLXML::op_lstat;
2867 package PLXML::op_stat;
2868 package PLXML::op_ftrread;
2869 package PLXML::op_ftrwrite;
2870 package PLXML::op_ftrexec;
2871 package PLXML::op_fteread;
2872 package PLXML::op_ftewrite;
2873 package PLXML::op_fteexec;
2874 package PLXML::op_ftis;
2875 package PLXML::op_fteowned;
2876 package PLXML::op_ftrowned;
2877 package PLXML::op_ftzero;
2878 package PLXML::op_ftsize;
2879 package PLXML::op_ftmtime;
2880 package PLXML::op_ftatime;
2881 package PLXML::op_ftctime;
2882 package PLXML::op_ftsock;
2883 package PLXML::op_ftchr;
2884 package PLXML::op_ftblk;
2885 package PLXML::op_ftfile;
2886 package PLXML::op_ftdir;
2887 package PLXML::op_ftpipe;
2888 package PLXML::op_ftlink;
2889 package PLXML::op_ftsuid;
2890 package PLXML::op_ftsgid;
2891 package PLXML::op_ftsvtx;
2892 package PLXML::op_fttty;
2893 package PLXML::op_fttext;
2894 package PLXML::op_ftbinary;
2895 package PLXML::op_chdir;
2896 package PLXML::op_chown;
2897 package PLXML::op_chroot;
2898 package PLXML::op_unlink;
2899 package PLXML::op_chmod;
2900 package PLXML::op_utime;
2901 package PLXML::op_rename;
2902 package PLXML::op_link;
2903 package PLXML::op_symlink;
2904 package PLXML::op_readlink;
2905 package PLXML::op_mkdir;
2906 package PLXML::op_rmdir;
2907 package PLXML::op_open_dir;
2908 package PLXML::op_readdir;
2909 package PLXML::op_telldir;
2910 package PLXML::op_seekdir;
2911 package PLXML::op_rewinddir;
2912 package PLXML::op_closedir;
2913 package PLXML::op_fork;
2914 package PLXML::op_wait;
2915 package PLXML::op_waitpid;
2916 package PLXML::op_system;
2917 package PLXML::op_exec;
2918 package PLXML::op_kill;
2919 package PLXML::op_getppid;
2920 package PLXML::op_getpgrp;
2921 package PLXML::op_setpgrp;
2922 package PLXML::op_getpriority;
2923 package PLXML::op_setpriority;
2924 package PLXML::op_time;
2925 package PLXML::op_tms;
2926 package PLXML::op_localtime;
2927 package PLXML::op_gmtime;
2928 package PLXML::op_alarm;
2929 package PLXML::op_sleep;
2930 package PLXML::op_shmget;
2931 package PLXML::op_shmctl;
2932 package PLXML::op_shmread;
2933 package PLXML::op_shmwrite;
2934 package PLXML::op_msgget;
2935 package PLXML::op_msgctl;
2936 package PLXML::op_msgsnd;
2937 package PLXML::op_msgrcv;
2938 package PLXML::op_semget;
2939 package PLXML::op_semctl;
2940 package PLXML::op_semop;
2941 package PLXML::op_require;
2942 package PLXML::op_dofile;
2943 package PLXML::op_entereval;
2944
2945 sub ast {
2946     my $self = shift;
2947     local $::curstate;          # eval {} has own statement sequence
2948     return $self->SUPER::ast(@_);
2949 }
2950
2951 package PLXML::op_leaveeval;
2952 package PLXML::op_entertry;
2953 package PLXML::op_leavetry;
2954
2955 sub ast {
2956     my $self = shift;
2957
2958     return $self->PLXML::op_leave::ast(@_);
2959 }
2960
2961 package PLXML::op_ghbyname;
2962 package PLXML::op_ghbyaddr;
2963 package PLXML::op_ghostent;
2964 package PLXML::op_gnbyname;
2965 package PLXML::op_gnbyaddr;
2966 package PLXML::op_gnetent;
2967 package PLXML::op_gpbyname;
2968 package PLXML::op_gpbynumber;
2969 package PLXML::op_gprotoent;
2970 package PLXML::op_gsbyname;
2971 package PLXML::op_gsbyport;
2972 package PLXML::op_gservent;
2973 package PLXML::op_shostent;
2974 package PLXML::op_snetent;
2975 package PLXML::op_sprotoent;
2976 package PLXML::op_sservent;
2977 package PLXML::op_ehostent;
2978 package PLXML::op_enetent;
2979 package PLXML::op_eprotoent;
2980 package PLXML::op_eservent;
2981 package PLXML::op_gpwnam;
2982 package PLXML::op_gpwuid;
2983 package PLXML::op_gpwent;
2984 package PLXML::op_spwent;
2985 package PLXML::op_epwent;
2986 package PLXML::op_ggrnam;
2987 package PLXML::op_ggrgid;
2988 package PLXML::op_ggrent;
2989 package PLXML::op_sgrent;
2990 package PLXML::op_egrent;
2991 package PLXML::op_getlogin;
2992 package PLXML::op_syscall;
2993 package PLXML::op_lock;
2994 package PLXML::op_threadsv;
2995 package PLXML::op_setstate;
2996 package PLXML::op_method_named;
2997
2998 sub ast {
2999     my $self = shift;
3000     return $self->madness('O');
3001 }
3002
3003 package PLXML::op_dor;
3004
3005 sub astnull {
3006     my $self = shift;
3007     $self->PLXML::op_or::astnull(@_);
3008 }
3009
3010 package PLXML::op_dorassign;
3011 package PLXML::op_custom;
3012