Put a watchdog on openpid.t: it has been found to hang in some Win32 smokes.
[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     @keys = map { $_ eq 'd' ? ('k', 'd') : $_ } @keys;
444     my @vals = ();
445     for my $key (@keys) {
446         my $madprop = $self->{mp}{$key};
447         next unless defined $madprop;
448         if (ref $madprop eq 'PLXML::mad_op') {
449             if ($key eq 'b') {
450                 push @vals, $madprop->blockast($self, @_);
451             }
452             else {
453                 push @vals, $madprop->ast($self, @_);
454             }
455             next;
456         }
457         my $white;
458         if ($white = $self->{mp}{"_$key"}) {
459             push @vals, p5::junk->new($white);
460         }
461         my $type = $madtype{$key} || "p5::token";
462         push @vals, $type->new($madprop);
463         if ($white = $self->{mp}{"#$key"}) {
464             push @vals, p5::junk->new($white);
465         }
466     }
467     @vals;
468 }
469
470 sub blockast {
471     my $self = shift;
472     $self->ast(@_);
473 }
474
475 sub ast {
476     my $self = shift;
477
478     my @newkids;
479     for my $kid (@{$$self{Kids}}) {
480         push @newkids, $kid->ast($self, @_);
481     }
482     return $self->newtype->new(Kids => [uc $self->key(), "(", @newkids, ")"]);
483 }
484
485 sub op {
486     my $self = shift;
487     my $desc = $self->desc();
488     if ($desc =~ /\((.*?)\)/) {
489         return $1;
490     }
491     else {
492         return " <<" . $self->key() . ">> ";
493     }
494 }
495
496 sub mp {
497     my $self = shift;
498     return $self->{mp};
499 }
500
501 package PLXML::Characters;
502
503 sub ast { die "oops" }
504 sub pair { die "oops" }
505
506 package PLXML::madprops;
507
508 sub ast {
509     die "oops madprops";
510 }
511
512 sub hash {
513     my $self = shift;
514     my @pairs;
515     my %hash = ();
516     my $firstthing = '';
517     my $lastthing = '';
518     
519     # We need to guarantee key uniqueness at this point.
520     for my $kid (@{$$self{Kids}}) {
521         my ($k,$v) = $kid->pair($self, @_);
522         $firstthing ||= $k;
523         $k .= 'x' while exists $hash{$k};
524         $lastthing = $k;
525         $hash{$k} = $v;
526     }
527     $hash{FIRST} = $firstthing;
528     $hash{LAST} = $lastthing;
529     return \%hash;
530 }
531
532 package PLXML::mad_op;
533
534 sub pair {
535     my $self = shift;
536     my $key = $$self{key};
537     return $key,$self;
538 }
539
540 sub ast {
541     my $self = shift;
542     $self->prepreproc(@_);
543     my @vals;
544     for my $kid (@{$$self{Kids}}) {
545         push @vals, $kid->ast($self, @_);
546     }
547     if (@vals == 1) {
548         return @vals;
549     }
550     else {
551         return P5AST::op_list->new(Kids => [@vals]);
552     }
553 }
554
555 sub blockast {
556     my $self = shift;
557     $self->prepreproc(@_);
558     my @vals;
559     for my $kid (@{$$self{Kids}}) {
560         push @vals, $kid->blockast($self, @_);
561     }
562     if (@vals == 1) {
563         return @vals;
564     }
565     else {
566         return P5AST::op_lineseq->new(Kids => [@vals]);
567     }
568 }
569
570 package PLXML::mad_pv;
571
572 sub pair {
573     my $self = shift;
574     my $key = $$self{key};
575     my $val = $$self{val};
576     $val =~ s/STUPIDXML\(#x(\w+)\)/chr(hex $1)/eg;
577     return $key,$val;
578 }
579
580 package PLXML::mad_sv;
581
582 sub pair {
583     my $self = shift;
584     my $key = $$self{key};
585     my $val = $$self{val};
586     $val =~ s/STUPIDXML\(#x(\w+)\)/chr(hex $1)/eg;
587     return $key,$val;
588 }
589
590 package PLXML::baseop;
591
592 sub ast {
593     my $self = shift;
594
595     my @retval;
596     my @newkids;
597     for my $kid (@{$$self{Kids}}) {
598         push @newkids, $kid->ast($self, @_);
599     }
600     if (@newkids) {
601         push @retval, uc $self->key(), "(", @newkids , ")";
602     }
603     else {
604         push @retval, $self->madness('o ( )');
605     }
606     return $self->newtype->new(Kids => [@retval]);
607 }
608
609 package PLXML::baseop_unop;
610
611 sub ast {
612     my $self = shift;
613     my @newkids = $self->madness('d o (');
614
615     if (exists $$self{Kids}) {
616         my $arg = $$self{Kids}[0];
617         push @newkids, $arg->ast($self, @_) if defined $arg;
618     }
619     push @newkids, $self->madness(')');
620
621     return $self->newtype()->new(Kids => [@newkids]);
622 }
623
624 package PLXML::binop;
625
626 sub ast {
627     my $self = shift;
628     my @newkids;
629
630     my $left = $$self{Kids}[0];
631     push @newkids, $left->ast($self, @_);
632
633     push @newkids, $self->madness('o');
634
635     my $right = $$self{Kids}[1];
636     if (defined $right) {
637         push @newkids, $right->ast($self, @_);
638     }
639
640     return $self->newtype->new(Kids => [@newkids]);
641 }
642
643 package PLXML::cop;
644
645 package PLXML::filestatop;
646
647 sub ast {
648     my $self = shift;
649
650     my @newkids = $self->madness('o (');
651
652     if (@{$$self{Kids}}) {
653         for my $kid (@{$$self{Kids}}) {
654             push @newkids, $kid->ast($self, @_);
655         }
656     }
657     if ($$self{mp}{O}) {
658         push @newkids, $self->madness('O');
659     }
660     push @newkids, $self->madness(')');
661
662     return $self->newtype->new(Kids => [@newkids]);
663 }
664
665 package PLXML::listop;
666
667 sub ast {
668     my $self = shift;
669
670     my @retval;
671     my @after;
672     if (@retval = $self->madness('X')) {
673         my @before, $self->madness('o x');
674         return P5AST::listop->new(Kids => [@before,@retval]);
675     }
676
677     push @retval, $self->madness('o d ( [ {');
678
679     my @newkids;
680     for my $kid (@{$$self{Kids}}) {
681         next if ref $kid eq 'PLXML::op_pushmark';
682         next if ref $kid eq 'PLXML::op_null' and
683                 defined $$kid{was} and $$kid{was} eq 'pushmark';
684         push @newkids, $kid->ast($self, @_);
685     }
686
687     my $x = "";
688
689     if ($$self{mp}{S}) {
690         push @retval, $self->madness('S');
691     }
692     push @retval, @newkids;
693
694     push @retval, $self->madness('} ] )');
695     return $self->newtype->new(Kids => [@retval,@after]);
696 }
697
698 package PLXML::logop;
699
700 sub ast {
701     my $self = shift;
702
703     my @newkids;
704     push @newkids, $self->madness('o (');
705     for my $kid (@{$$self{Kids}}) {
706         push @newkids, $kid->ast($self, @_);
707     }
708     push @newkids, $self->madness(')');
709     return $self->newtype->new(Kids => [@newkids]);
710 }
711
712 package PLXML::loop;
713
714 package PLXML::loopexop;
715
716 sub ast {
717     my $self = shift;
718     my @newkids = $self->madness('o (');
719
720     if ($$self{mp}{L} or not $$self{flags} =~ /\bSPECIAL\b/) {
721         my @label = $self->madness('L');
722         if (@label) {
723             push @newkids, @label;
724         }
725         else {
726             my $arg = $$self{Kids}[0];
727             push @newkids, $arg->ast($self, @_) if defined $arg;
728         }
729     }
730     push @newkids, $self->madness(')');
731
732     return $self->newtype->new(Kids => [@newkids]);
733 }
734
735
736 package PLXML::padop;
737
738 package PLXML::padop_svop;
739
740 package PLXML::pmop;
741
742 sub ast {
743     my $self = shift;
744
745     return P5AST::pmop->new(Kids => []) unless exists $$self{flags};
746
747     my $bits = $self->fetchbits($$self{flags},@_);
748
749     my @newkids;
750     if ($bits->{binding}) {
751         push @newkids, $bits->{binding};
752         push @newkids, $self->madness('~');
753     }
754     if (exists $bits->{regcomp} and $bits->{regcomp}) {
755         my @front = $self->madness('q');
756         my @back = $self->madness('Q');
757         push @newkids, @front, $bits->{regcomp}, @back,
758                 $self->madness('m');
759     }
760     elsif ($$self{mp}{q}) {
761         push @newkids, $self->madness('q = Q m');
762     }
763     elsif ($$self{mp}{X}) {
764         push @newkids, $self->madness('X m');
765     }
766     else {
767         push @newkids, $self->madness('e m');
768     }
769
770     return $self->newtype->new(Kids => [@newkids]);
771 }
772
773 sub innerpmop {
774     my $pmop = shift;
775     my $bits = shift;
776     for my $key (grep {!/^Kids/} keys %$pmop) {
777         $bits->{$key} = $pmop->{$key};
778     }
779
780     # Have to delete all the fake evals of the repl.  This is a pain...
781     if (@{$$pmop{Kids}}) {
782         my $really = $$pmop{Kids}[0]{Kids}[0];
783         if (ref $really eq 'PLXML::op_substcont') {
784             $really = $$really{Kids}[0];
785         }
786         while ((ref $really) =~ /^PLXML::op_.*(null|entereval)/) {
787             if (exists $$really{was}) {
788                 $bits->{repl} = $really->ast(@_);
789                 return;
790             }
791             $really = $$really{Kids}[0];
792         }
793         if (ref $really eq 'PLXML::op_scope' and
794             @{$$really{Kids}} == 1 and
795             ref $$really{Kids}[0] eq 'PLXML::op_null' and
796             not @{$$really{Kids}[0]{Kids}})
797         {
798             $bits->{repl} = '';
799             return;
800         }
801         if (ref $really eq 'PLXML::op_leave' and
802             @{$$really{Kids}} == 2 and
803             ref $$really{Kids}[1] eq 'PLXML::op_null' and
804             not @{$$really{Kids}[1]{Kids}})
805         {
806             $bits->{repl} = '';
807             return;
808         }
809         if ((ref $really) =~ /^PLXML::op_(scope|leave)/) {
810             # should be at inner do {...} here, so skip that fakery too
811             $bits->{repl} = $really->newtype->new(Kids => [$really->PLXML::op_lineseq::lineseq(@_)]);
812             # but retrieve the whitespace before fake '}'
813             if ($$really{mp}{'_}'}) {
814                 push(@{$bits->{repl}->{Kids}}, p5::junk->new($$really{mp}{'_}'}));
815             }
816         }
817         else {  # something else, padsv probably
818             $bits->{repl} = $really->ast(@_);
819         }
820     }
821 }
822
823 sub fetchbits {
824     my $self = shift;
825     my $flags = shift || '';
826     my %bits = %$self;
827     my @kids = @{$$self{Kids}};
828     if (@kids) {
829         delete $bits{Kids};
830         my $arg = shift @kids;
831         innerpmop($arg,\%bits, $self, @_);
832         if ($flags =~ /STACKED/) {
833             $arg = shift @kids;
834             $bits{binding} = $arg->ast($self, @_);
835         }
836         if ($bits{when} ne "COMP" and @kids) {
837             $arg = pop @kids;
838             $bits{regcomp} = $arg->ast($self, @_);
839         }
840         if (not exists $bits{repl} and @kids) {
841             $arg = shift @kids;
842             $bits{repl} = $arg->ast($self, @_);
843         }
844     }
845     return \%bits;
846 }
847
848 package PLXML::pvop_svop;
849
850 package PLXML::unop;
851
852 sub ast {
853     my $self = shift;
854     my @newkids = $self->madness('o (');
855
856     if (exists $$self{Kids}) {
857         my $arg = $$self{Kids}[0];
858         push @newkids, $arg->ast($self, @_) if defined $arg;
859     }
860     push @newkids, $self->madness(')');
861
862     return $self->newtype->new(Kids => [@newkids]);
863 }
864
865 package PLXML;
866 package PLXML::Characters;
867 package PLXML::madprops;
868 package PLXML::mad_op;
869 package PLXML::mad_pv;
870 package PLXML::baseop;
871 package PLXML::baseop_unop;
872 package PLXML::binop;
873 package PLXML::cop;
874 package PLXML::filestatop;
875 package PLXML::listop;
876 package PLXML::logop;
877 package PLXML::loop;
878 package PLXML::loopexop;
879 package PLXML::padop;
880 package PLXML::padop_svop;
881 package PLXML::pmop;
882 package PLXML::pvop_svop;
883 package PLXML::unop;
884 package PLXML::op_null;
885
886 # Null nodes typed by first madprop.
887
888 my %astmad;
889
890 BEGIN {
891     %astmad = (
892         'p' => sub {            # peg for #! line, etc.
893             my $self = shift;
894             my @newkids;
895             push @newkids, $self->madness('p px');
896             $::curstate = 0;
897             return P5AST::peg->new(Kids => [@newkids])
898         },
899         '(' => sub {            # extra parens around the whole thing
900             my $self = shift;
901             my @newkids;
902             push @newkids, $self->madness('dx d o (');
903             for my $kid (@{$$self{Kids}}) {
904                 push @newkids, $kid->ast($self, @_);
905             }
906             push @newkids, $self->madness(')');
907             return P5AST::parens->new(Kids => [@newkids])
908         },
909         '~' => sub {                            # binding operator
910             my $self = shift;
911             my @newkids;
912             push @newkids, $$self{Kids}[0]->ast($self,@_);
913             push @newkids, $self->madness('~');
914             push @newkids, $$self{Kids}[1]->ast($self,@_);
915             return P5AST::bindop->new(Kids => [@newkids])
916         },
917         ';' => sub {            # null statements/blocks
918             my $self = shift;
919             my @newkids;
920             push @newkids, $self->madness('{ ; }');
921             $::curstate = 0;
922             return P5AST::nothing->new(Kids => [@newkids])
923         },
924         'I' => sub {            # if or unless statement keyword
925             my $self = shift;
926             my @newkids;
927             push @newkids, $self->madness('L I (');
928             my @subkids;
929             for my $kid (@{$$self{Kids}}) {
930                 push @subkids, $kid->ast($self, @_);
931             }
932             die "oops in op_null->new" unless @subkids == 1;
933             my $newself = $subkids[0];
934             @subkids = @{$$newself{Kids}};
935             
936             unshift @{$subkids[0]{Kids}}, @newkids;
937             push @{$subkids[0]{Kids}}, $self->madness(')');
938             return bless($newself, 'P5AST::condstate');
939         },
940         'U' => sub {                    # use
941             my $self = shift;
942             my @newkids;
943             my @module = $self->madness('U');
944             my @args = $self->madness('A');
945             my $module = $module[-1]{Kids}[-1];
946             if ($module->uni eq 'bytes') {
947                 $::curenc = Nomad::encnum('iso-8859-1');
948             }
949             elsif ($module->uni eq 'utf8') {
950                 if ($$self{mp}{o} eq 'no') {
951                     $::curenc = Nomad::encnum('iso-8859-1');
952                 }
953                 else {
954                     $::curenc = Nomad::encnum('utf-8');
955                 }
956             }
957             elsif ($module->uni eq 'encoding') {
958                 if ($$self{mp}{o} eq 'no') {
959                     $::curenc = Nomad::encnum('iso-8859-1');
960                 }
961                 else {
962                     $::curenc = Nomad::encnum(eval $args[0]->p5text); # XXX bletch
963                 }
964             }
965             # (Surrounding {} ends up here if use is only thing in block.)
966             push @newkids, $self->madness('{ o');
967             push @newkids, @module;
968             push @newkids, $self->madness('V');
969             push @newkids, @args;
970             push @newkids, $self->madness('S ; }');
971             $::curstate = 0;
972             return P5AST::use->new(Kids => [@newkids])
973         },
974         '?' => sub {                    # ternary
975             my $self = shift;
976             my @newkids;
977             my @subkids;
978             my @condkids = @{$$self{Kids}[0]{Kids}};
979             
980             push @newkids, $condkids[0]->ast($self,@_), $self->madness('?');
981             push @newkids, $condkids[1]->ast($self,@_), $self->madness(':');
982             push @newkids, $condkids[2]->ast($self,@_);
983             return P5AST::ternary->new(Kids => [@newkids])
984         },
985         '&' => sub {                    # subroutine
986             my $self = shift;
987             my @newkids;
988             push @newkids, $self->madness('d n s a : { & } ;');
989             $::curstate = 0;
990             return P5AST::sub->new(Kids => [@newkids])
991         },
992         'i' => sub {                    # modifier if
993             my $self = shift;
994             my @newkids;
995             push @newkids, $self->madness('i');
996             my $cond = $$self{Kids}[0];
997             my @subkids;
998             for my $kid (@{$$cond{Kids}}) {
999                 push @subkids, $kid->ast($self, @_);
1000             }
1001             push @newkids, shift @subkids;
1002             unshift @newkids, @subkids;
1003             return P5AST::condmod->new(Kids => [@newkids])
1004         },
1005         'P' => sub {                            # package declaration
1006             my $self = shift;
1007             my @newkids;
1008             push @newkids, $self->madness('o');
1009             push @newkids, $self->madness('P');
1010             push @newkids, $self->madness(';');
1011             $::curstate = 0;
1012             return P5AST::package->new(Kids => [@newkids])
1013         },
1014         'F' => sub {                            # format
1015             my $self = shift;
1016             my @newkids = $self->madness('F n b');
1017             $::curstate = 0;
1018             return P5AST::format->new(Kids => [@newkids])
1019         },
1020         'x' => sub {                            # qw literal
1021             my $self = shift;
1022             return P5AST::qwliteral->new(Kids => [$self->madness('x')])
1023         },
1024         'q' => sub {                            # random quote
1025             my $self = shift;
1026             return P5AST::quote->new(Kids => [$self->madness('q = Q')])
1027         },
1028         'X' => sub {                            # random literal
1029             my $self = shift;
1030             return P5AST::token->new(Kids => [$self->madness('X')])
1031         },
1032         ':' => sub {                            # attr list
1033             my $self = shift;
1034             return P5AST::attrlist->new(Kids => [$self->madness(':')])
1035         },
1036         ',' => sub {                            # "unary ," so to speak
1037             my $self = shift;
1038             my @newkids;
1039             push @newkids, $self->madness(',');
1040             push @newkids, $$self{Kids}[0]->ast($self,@_);
1041             return P5AST::listelem->new(Kids => [@newkids])
1042         },
1043         'C' => sub {                            # constant conditional
1044             my $self = shift;
1045             my @newkids;
1046             push @newkids, $$self{Kids}[0]->ast($self,@_);
1047             my @folded = $self->madness('C');
1048             if (@folded) {
1049                 my @t = $self->madness('t');
1050                 my @e = $self->madness('e');
1051                 if (@e) {
1052                     return P5AST::op_cond_expr->new(
1053                         Kids => [
1054                             $self->madness('I ('),
1055                             @folded,
1056                             $self->madness(') ?'),
1057                             P5AST::op_cond_expr->new(Kids => [@newkids]),
1058                             $self->madness(':'),
1059                             @e
1060                         ] );
1061                 }
1062                 else {
1063                     return P5AST::op_cond_expr->new(
1064                         Kids => [
1065                             $self->madness('I ('),
1066                             @folded,
1067                             $self->madness(') ?'),
1068                             @t,
1069                             $self->madness(':'),
1070                             @newkids
1071                         ] );
1072                 }
1073             }
1074             return P5AST::op_null->new(Kids => [@newkids])
1075         },
1076         '+' => sub {                            # unary +
1077             my $self = shift;
1078             my @newkids;
1079             push @newkids, $self->madness('+');
1080             push @newkids, $$self{Kids}[0]->ast($self,@_);
1081             return P5AST::preplus->new(Kids => [@newkids])
1082         },
1083         'D' => sub {                            # do block
1084             my $self = shift;
1085             my @newkids;
1086             push @newkids, $self->madness('D');
1087             push @newkids, $$self{Kids}[0]->ast($self,@_);
1088             return P5AST::doblock->new(Kids => [@newkids])
1089         },
1090         '3' => sub {                            # C-style for loop
1091             my $self = shift;
1092             my @newkids;
1093
1094             # What a mess!
1095             my (undef, $init, $lineseq) = @{$$self{Kids}[0]{Kids}};
1096             my (undef, $leaveloop) = @{$$lineseq{Kids}};
1097             my (undef, $null) = @{$$leaveloop{Kids}};
1098             my $and;
1099             my $cond;
1100             my $lineseq2;
1101             my $block;
1102             my $cont;
1103             if (exists $$null{was} and $$null{was} eq 'and') {
1104                 ($lineseq2) = @{$$null{Kids}};
1105             }
1106             else {
1107                 ($and) = @{$$null{Kids}};
1108                 ($cond, $lineseq2) = @{$$and{Kids}};
1109             }
1110             if ($$lineseq2{mp}{'{'}) {
1111                 $block = $lineseq2;
1112             }
1113             else {
1114                 ($block, $cont) = @{$$lineseq2{Kids}};
1115             }
1116
1117             push @newkids, $self->madness('L 3 (');
1118             push @newkids, $init->ast($self,@_);
1119             push @newkids, $self->madness('1');
1120             if (defined $cond) {
1121                 push @newkids, $cond->ast($self,@_);
1122             }
1123             elsif (defined $null) {
1124                 push @newkids, $null->madness('1');
1125             }
1126             push @newkids, $self->madness('2');
1127             if (defined $cont) {
1128                 push @newkids, $cont->ast($self,@_);
1129             }
1130             push @newkids, $self->madness(')');
1131             push @newkids, $block->blockast($self,@_);
1132             $::curstate = 0;
1133             return P5AST::cfor->new(Kids => [@newkids])
1134         },
1135         'o' => sub {                    # random useless operator
1136             my $self = shift;
1137             my @newkids;
1138             push @newkids, $self->madness('o');
1139             my $kind = $newkids[-1] || '';
1140             $kind = $kind->uni if ref $kind;
1141             my @subkids;
1142             for my $kid (@{$$self{Kids}}) {
1143                 push @subkids, $kid->ast($self, @_);
1144             }
1145             if ($kind eq '=') { # stealth readline
1146                 unshift(@newkids, shift(@subkids));
1147                 push(@newkids, @subkids);
1148                 return P5AST::op_aassign->new(Kids => [@newkids])
1149             }
1150             else {
1151                 my $newself = $subkids[0];
1152                 splice(@{$newself->{Kids}}, 1, 0,
1153                             $self->madness('ox ('),
1154                             @newkids,
1155                             $self->madness(')')
1156                 );
1157                 return $newself;
1158             }
1159         },
1160     );
1161 }
1162
1163 # Null nodes are an untyped mess inside Perl.  Instead of fixing it there,
1164 # we derive an effective type either from the "was" field or the first madprop.
1165 # (The individual routines select the actual new type.)
1166
1167 sub ast {
1168     my $self = shift;
1169     my $was = $$self{was} || 'peg';
1170     my $mad = $$self{mp}{FIRST} || "unknown";
1171
1172     # First try for a "was".
1173     my $meth = "PLXML::op_${was}::astnull";
1174     if (exists &{$meth}) {
1175         return $self->$meth(@_);
1176     }
1177
1178     # Look at first madprop.
1179     if (exists $astmad{$mad}) {
1180         return $astmad{$mad}->($self);
1181     }
1182     warn "No mad $mad" unless $mad eq 'unknown';
1183
1184     # Do something generic.
1185     my @newkids;
1186     for my $kid (@{$$self{Kids}}) {
1187         push @newkids, $kid->ast($self, @_);
1188     }
1189     return $self->newtype->new(Kids => [@newkids]);
1190 }
1191
1192 sub blockast {
1193     my $self = shift;
1194     local $::curstate;
1195     local $::curenc = $::curenc;
1196     return $self->madness('{ ; }');
1197 }
1198
1199 package PLXML::op_stub;
1200
1201 sub ast {
1202     my $self = shift;
1203     return $self->newtype->new(Kids => [$self->madness(', x ( ) q = Q')]);
1204 }
1205
1206 package PLXML::op_scalar;
1207
1208 sub ast {
1209     my $self = shift;
1210
1211     my @pre = $self->madness('o q');
1212     my $op = pop @pre;
1213     if ($op->uni =~ /^<</) {
1214         my @newkids;
1215         my $opstub = bless { start => $op }, 'P5AST::heredoc';
1216         push @newkids, $opstub;
1217         push @newkids, $self->madness('(');
1218
1219         my @kids = @{$$self{Kids}};
1220
1221         my @divert;
1222         for my $kid (@kids) {
1223             next if ref $kid eq 'PLXML::op_pushmark';
1224             next if ref $kid eq 'PLXML::op_null' and
1225                     defined $$kid{was} and $$kid{was} eq 'pushmark';
1226             push @divert, $kid->ast($self, @_);
1227         }
1228         $opstub->{doc} = P5AST::op_list->new(Kids => [@divert]);
1229         $opstub->{end} = ($self->madness('Q'))[-1];
1230
1231         push @newkids, $self->madness(')');
1232
1233         return $self->newtype->new(Kids => [@pre,@newkids]);
1234     }
1235     return $self->PLXML::baseop_unop::ast();
1236 }
1237
1238 package PLXML::op_pushmark;
1239
1240 sub ast { () }
1241
1242 package PLXML::op_wantarray;
1243 package PLXML::op_const;
1244
1245 sub astnull {
1246     my $self = shift;
1247     my @newkids;
1248     return unless $$self{mp};
1249     push @newkids, $self->madness('q = Q X : f O ( )');
1250     return P5AST::op_const->new(Kids => [@newkids]);
1251 }
1252
1253 sub ast {
1254     my $self = shift;
1255     return unless %{$$self{mp}};
1256
1257     my @before;
1258
1259     my $const;
1260     my @args = $self->madness('f');
1261     if (@args) {
1262     }
1263     elsif (exists $self->{mp}{q}) {
1264         push @args, $self->madness('d q');
1265         if ($args[-1]->uni =~ /^<</) {
1266             my $opstub = bless { start => pop(@args) }, 'P5AST::heredoc';
1267             $opstub->{doc} = P5AST::op_const->new(Kids => [$self->madness('=')]);
1268             $opstub->{end} = ($self->madness('Q'))[-1];
1269             push @args, $opstub;
1270         }
1271         else {
1272             push @args, $self->madness('= Q');
1273         }
1274     }
1275     elsif (exists $self->{mp}{X}) {
1276         push @before, $self->madness('d');      # was local $[ probably
1277         if (not $$self{mp}{O}) {
1278             push @before, $self->madness('o');  # was unary
1279         }
1280         my @X = $self->madness(': X');
1281         if (exists $$self{private} and $$self{private} =~ /BARE/) {
1282             return $self->newtype->new(Kids => [@X]);
1283         }
1284         my $X = pop @X;
1285         push @before, @X;
1286         @args = (
1287             $self->madness('x'),
1288             $X);
1289         if ($$self{mp}{O}) {
1290             push @args, $self->madness('o O');
1291         }
1292     }
1293     elsif (exists $self->{mp}{O}) {
1294         push @args, $self->madness('O');
1295     }
1296     elsif ($$self{private} =~ /\bBARE\b/) {
1297         @args = ($$self{PV});
1298     }
1299     elsif (exists $$self{mp}{o}) {
1300         @args = $self->madness('o');
1301     }
1302     elsif (exists $$self{PV}) {
1303         @args = ('"', $$self{PV}, '"');
1304     }
1305     elsif (exists $$self{NV}) {
1306         @args = $$self{NV};
1307     }
1308     elsif (exists $$self{IV}) {
1309         @args = $$self{IV};
1310     }
1311     else {
1312         @args = $self->SUPER::text(@_);
1313     }
1314     return $self->newtype->new(Kids => [@before, @args]);
1315 }
1316
1317
1318 package PLXML::op_gvsv;
1319
1320 sub ast {
1321     my $self = shift;
1322     my @args;
1323     my @retval;
1324     for my $attr (qw/gv GV flags/) {
1325         if (exists $$self{$attr}) {
1326             push @args, $attr, $$self{$attr};
1327         }
1328     }
1329     push @retval, @args;
1330     push @retval, $self->madness('X');
1331     return $self->newtype->new(Kids => [@retval]);
1332 }
1333
1334 package PLXML::op_gv;
1335
1336 sub ast {
1337     my $self = shift;
1338     my @newkids;
1339     push @newkids, $self->madness('X K');
1340
1341     return $self->newtype->new(Kids => [@newkids]);
1342 }
1343
1344 package PLXML::op_gelem;
1345
1346 sub ast {
1347     my $self = shift;
1348
1349     local $::curstate;  # in case there are statements in subscript
1350     local $::curenc = $::curenc;
1351     my @newkids;
1352     push @newkids, $self->madness('dx d');
1353     for my $kid (@{$$self{Kids}}) {
1354         push @newkids, $kid->ast($self, @_);
1355     }
1356     splice @newkids, -1, 0, $self->madness('o {');
1357     push @newkids, $self->madness('}');
1358
1359     return $self->newtype->new(Kids => [@newkids]);
1360 }
1361
1362 package PLXML::op_padsv;
1363
1364 sub ast {
1365     my $self = shift;
1366     my @args;
1367     push @args, $self->madness('dx d ( $ )');
1368
1369     return $self->newtype->new(Kids => [@args]);
1370 }
1371
1372 package PLXML::op_padav;
1373
1374 sub astnull { ast(@_) }
1375
1376 sub ast {
1377     my $self = shift;
1378     my @retval;
1379     push @retval, $self->madness('dx d (');
1380     push @retval, $self->madness('$ @');
1381     push @retval, $self->madness(') o O');
1382     return $self->newtype->new(Kids => [@retval]);
1383 }
1384
1385 package PLXML::op_padhv;
1386
1387 sub astnull { ast(@_) }
1388
1389 sub ast {
1390     my $self = shift;
1391     my @retval;
1392     push @retval, $self->madness('dx d (');
1393     push @retval, $self->madness('$ @ %');
1394     push @retval, $self->madness(') o O');
1395     return $self->newtype->new(Kids => [@retval]);
1396 }
1397
1398 package PLXML::op_padany;
1399
1400 package PLXML::op_pushre;
1401
1402 sub ast {
1403     my $self = shift;
1404     if ($$self{mp}{q}) {
1405         return $self->madness('q = Q m');
1406     }
1407     if ($$self{mp}{X}) {
1408         return $self->madness('X m');
1409     }
1410     if ($$self{mp}{e}) {
1411         return $self->madness('e m');
1412     }
1413     return $$self{Kids}[1]->ast($self,@_), $self->madness('m');
1414 }
1415
1416 package PLXML::op_rv2gv;
1417
1418 sub ast {
1419     my $self = shift;
1420
1421     my @newkids;
1422     push @newkids, $self->madness('dx d ( * $');
1423     push @newkids, $$self{Kids}[0]->ast();
1424     push @newkids, $self->madness(')');
1425     return $self->newtype->new(Kids => [@newkids]);
1426 }
1427
1428 package PLXML::op_rv2sv;
1429
1430 sub astnull {
1431     my $self = shift;
1432     return P5AST::op_rv2sv->new(Kids => [$self->madness('O o dx d ( $ ) : a')]);
1433 }
1434
1435 sub ast {
1436     my $self = shift;
1437
1438     my @newkids;
1439     push @newkids, $self->madness('dx d ( $');
1440     if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
1441         push @newkids, $$self{Kids}[0]->ast();
1442     }
1443     push @newkids, $self->madness(') : a');
1444     return $self->newtype->new(Kids => [@newkids]);
1445 }
1446
1447 package PLXML::op_av2arylen;
1448
1449 sub ast {
1450     my $self = shift;
1451
1452     my @newkids;
1453     push @newkids, $$self{Kids}[0]->madness('l');
1454     push @newkids, $$self{Kids}[0]->ast();
1455     return $self->newtype->new(Kids => [@newkids]);
1456 }
1457
1458 package PLXML::op_rv2cv;
1459
1460 sub astnull {
1461     my $self = shift;
1462     my @newkids;
1463     push @newkids, $self->madness('X');
1464     return @newkids if @newkids;
1465     if (exists $$self{mp}{'&'}) {
1466         push @newkids, $self->madness('&');
1467         if (@{$$self{Kids}}) {
1468             push @newkids, $$self{Kids}[0]->ast(@_);
1469         }
1470     }
1471     else {
1472         push @newkids, $$self{Kids}[0]->ast(@_);
1473     }
1474     return P5AST::op_rv2cv->new(Kids => [@newkids]);
1475 }
1476
1477 sub ast {
1478     my $self = shift;
1479
1480     my @newkids;
1481     push @newkids, $self->madness('&');
1482     if (@{$$self{Kids}}) {
1483         push @newkids, $$self{Kids}[0]->ast();
1484     }
1485     return $self->newtype->new(Kids => [@newkids]);
1486 }
1487
1488 package PLXML::op_anoncode;
1489
1490 sub ast {
1491     my $self = shift;
1492     my $arg = $$self{Kids}[0];
1493     local $::curstate;          # hide nested statements in sub
1494     local $::curenc = $::curenc;
1495     if (defined $arg) {
1496         return $arg->ast(@_);
1497     }
1498     return ';';  # XXX literal ; should come through somewhere
1499 }
1500
1501 package PLXML::op_prototype;
1502 package PLXML::op_refgen;
1503
1504 sub ast {
1505     my $self = shift;
1506     my @newkids = $self->madness('o s a');
1507
1508     if (exists $$self{Kids}) {
1509         my $arg = $$self{Kids}[0];
1510         push @newkids, $arg->ast($self, @_) if defined $arg;
1511     }
1512
1513     my $res = $self->newtype->new(Kids => [@newkids]);
1514     return $res;
1515 }
1516
1517 package PLXML::op_srefgen;
1518
1519 sub ast {
1520     my @newkids;
1521     my $self = shift;
1522     if ($$self{mp}{FIRST} eq '{') {
1523         local $::curstate;      # this is officially a block, so hide it
1524         local $::curenc = $::curenc;
1525         push @newkids, $self->madness('{');
1526         for my $kid (@{$$self{Kids}}) {
1527             push @newkids, $kid->ast($self, @_);
1528         }
1529         push @newkids, $self->madness('; }');
1530         return P5AST::op_stringify->new(Kids => [@newkids]);
1531     }
1532     else {
1533         push @newkids, $self->madness('o [');
1534         for my $kid (@{$$self{Kids}}) {
1535             push @newkids, $kid->ast($self, @_);
1536         }
1537         push @newkids, $self->madness(']');
1538         return P5AST::op_stringify->new(Kids => [@newkids]);
1539     }
1540 }
1541
1542 package PLXML::op_ref;
1543 package PLXML::op_bless;
1544 package PLXML::op_backtick;
1545
1546 sub ast {
1547     my $self = shift;
1548     my @args;
1549     if (exists $self->{mp}{q}) {
1550         push @args, $self->madness('q');
1551         if ($args[-1]->uni =~ /^<</) {
1552             my $opstub = bless { start => $args[-1] }, 'P5AST::heredoc';
1553             $args[-1] = $opstub;
1554             $opstub->{doc} = P5AST::op_const->new(Kids => [$self->madness('=')]);
1555             $opstub->{end} = ($self->madness('Q'))[-1];
1556         }
1557         else {
1558             push @args, $self->madness('= Q');
1559         }
1560     }
1561     return $self->newtype->new(Kids => [@args]);
1562 }
1563
1564 package PLXML::op_glob;
1565
1566 sub astnull {
1567     my $self = shift;
1568     my @retval = $self->madness('o q = Q');
1569     if (not @retval or $retval[-1]->uni eq 'glob') {
1570         push @retval, $self->madness('(');
1571         push @retval, $$self{Kids}[0]->ast($self,@_);
1572         push @retval, $self->madness(')');
1573     }
1574     return P5AST::op_glob->new(Kids => [@retval]);
1575 }
1576
1577 package PLXML::op_readline;
1578
1579 sub astnull {
1580     my $self = shift;
1581     my @retval;
1582     if (exists $$self{mp}{q}) {
1583         @retval = $self->madness('q = Q');
1584     }
1585     elsif (exists $$self{mp}{X}) {
1586         @retval = $self->madness('X');
1587     }
1588     return P5AST::op_readline->new(Kids => [@retval]);
1589 }
1590
1591 sub ast {
1592     my $self = shift;
1593
1594     my @retval;
1595
1596     my @args;
1597     my $const;
1598     if (exists $$self{mp}{q}) {
1599         @args = $self->madness('q = Q');
1600     }
1601     elsif (exists $$self{mp}{X}) {
1602         @args = $self->madness('X');
1603     }
1604     elsif (exists $$self{GV}) {
1605         @args = $$self{IV};
1606     }
1607     elsif (@{$$self{Kids}}) {
1608         @args = $self->PLXML::unop::ast(@_);
1609     }
1610     else {
1611         @args = $self->SUPER::text(@_);
1612     }
1613     return $self->newtype->new(Kids => [@retval,@args]);
1614 }
1615
1616
1617 package PLXML::op_rcatline;
1618 package PLXML::op_regcmaybe;
1619 package PLXML::op_regcreset;
1620 package PLXML::op_regcomp;
1621
1622 sub ast {
1623     my $self = shift;
1624     $self->PLXML::unop::ast(@_);
1625 }
1626
1627 package PLXML::op_match;
1628
1629 sub ast {
1630     my $self = shift;
1631     my $retval = $self->SUPER::ast(@_);
1632     my $p5re;
1633     if (not $p5re = $retval->p5text()) {
1634         $retval = $self->newtype->new(Kids => [$self->madness('X q = Q m')]);
1635         $p5re = $retval->p5text();
1636     }
1637     if ($deinterpolate) {
1638         $retval->{P5re} = P5re::qrparse($p5re);
1639     }
1640     return $retval;
1641 }
1642
1643 package PLXML::op_qr;
1644
1645 sub ast {
1646     my $self = shift;
1647     my $retval;
1648     if (exists $$self{flags}) {
1649         $retval = $self->SUPER::ast(@_);
1650     }
1651     else {
1652         $retval = $self->newtype->new(Kids => [$self->madness('X q = Q m')]);
1653     }
1654     if ($deinterpolate) {
1655         my $p5re = $retval->p5text();
1656         $retval->{P5re} = P5re::qrparse($p5re);
1657     }
1658     return $retval;
1659 }
1660
1661 package PLXML::op_subst;
1662
1663 sub ast {
1664     my $self = shift;
1665
1666     my $bits = $self->fetchbits($$self{flags},@_);
1667
1668     my @newkids;
1669     if ($bits->{binding}) {
1670         push @newkids, $bits->{binding};
1671         push @newkids, $self->madness('~');
1672     }
1673     my $X = p5::token->new($$self{mp}{X});
1674     my @lfirst = $self->madness('q');
1675     my @llast = $self->madness('Q');
1676     push @newkids,
1677         @lfirst,
1678         $self->madness('E'),    # XXX s/b e probably
1679         @llast;
1680     my @rfirst = $self->madness('z');
1681     my @rlast = $self->madness('Z');
1682     my @mods = $self->madness('m');
1683     if ($rfirst[-1]->uni ne $llast[-1]->uni) {
1684         push @newkids, @rfirst;
1685     }
1686     # remove the fake '\n' if /e and '#' in replacement.
1687     if (@mods and $mods[0] =~ m/e/ and ($self->madness('R'))[0]->uni =~ m/#/) {
1688         unshift @rlast, bless {}, 'chomp'; # hack to remove '\n'
1689     }
1690     push @newkids, $bits->{repl}, @rlast, @mods;
1691
1692     my $retval = $self->newtype->new(Kids => [@newkids]);
1693     if ($deinterpolate) {
1694         my $p5re = $retval->p5text();
1695         $retval->{P5re} = P5re::qrparse($p5re);
1696     }
1697     return $retval;
1698 }
1699
1700 package PLXML::op_substcont;
1701 package PLXML::op_trans;
1702
1703 sub ast {
1704     my $self = shift;
1705
1706 #    my $bits = $self->fetchbits($$self{flags},@_);
1707 #
1708     my @newkids;
1709     my @lfirst = $self->madness('q');
1710     my @llast = $self->madness('Q');
1711     push @newkids,
1712         @lfirst,
1713         $self->madness('E'),
1714         @llast;
1715     my @rfirst = $self->madness('z');
1716     my @repl = $self->madness('R');
1717     my @rlast = $self->madness('Z');
1718     my @mods = $self->madness('m');
1719     if ($rfirst[-1]->uni ne $llast[-1]->uni) {
1720         push @newkids, @rfirst;
1721     }
1722
1723     push @newkids, @repl, @rlast, @mods;
1724
1725     my $res = $self->newtype->new(Kids => [@newkids]);
1726     return $res;
1727 }
1728
1729 package PLXML::op_sassign;
1730
1731 sub ast {
1732     my $self = shift;
1733     my @newkids;
1734
1735     my $right = $$self{Kids}[1];
1736     eval { push @newkids, $right->ast($self, @_); };
1737
1738     push @newkids, $self->madness('o');
1739
1740     my $left = $$self{Kids}[0];
1741     push @newkids, $left->ast($self, @_);
1742
1743     return $self->newtype->new(Kids => [@newkids]);
1744 }
1745
1746 package PLXML::op_aassign;
1747
1748 sub astnull { ast(@_) }
1749
1750 sub ast {
1751     my $self = shift;
1752     my @newkids;
1753
1754     my $right = $$self{Kids}[1];
1755     push @newkids, $right->ast($self, @_);
1756
1757     push @newkids, $self->madness('o');
1758
1759     my $left = $$self{Kids}[0];
1760     push @newkids, $left->ast($self, @_);
1761
1762     return $self->newtype->new(Kids => [@newkids]);
1763 }
1764
1765 package PLXML::op_chop;
1766 package PLXML::op_schop;
1767 package PLXML::op_chomp;
1768 package PLXML::op_schomp;
1769 package PLXML::op_defined;
1770 package PLXML::op_undef;
1771 package PLXML::op_study;
1772 package PLXML::op_pos;
1773 package PLXML::op_preinc;
1774
1775 sub ast {
1776     my $self = shift;
1777     if ($$self{targ}) {         # stealth post inc or dec
1778         return $self->PLXML::op_postinc::ast(@_);
1779     }
1780     return $self->SUPER::ast(@_);
1781 }
1782
1783 package PLXML::op_i_preinc;
1784
1785 sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
1786
1787 package PLXML::op_predec;
1788
1789 sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
1790
1791 package PLXML::op_i_predec;
1792
1793 sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
1794
1795 package PLXML::op_postinc;
1796
1797 sub ast {
1798     my $self = shift;
1799     my @newkids;
1800
1801     if (exists $$self{Kids}) {
1802         my $arg = $$self{Kids}[0];
1803         push @newkids, $arg->ast($self, @_) if defined $arg;
1804     }
1805     push @newkids, $self->madness('o');
1806
1807     my $res = $self->newtype->new(Kids => [@newkids]);
1808     return $res;
1809 }
1810
1811 package PLXML::op_i_postinc;
1812
1813 sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
1814
1815 package PLXML::op_postdec;
1816
1817 sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
1818
1819 package PLXML::op_i_postdec;
1820
1821 sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
1822
1823 package PLXML::op_pow;
1824 package PLXML::op_multiply;
1825 package PLXML::op_i_multiply;
1826 package PLXML::op_divide;
1827 package PLXML::op_i_divide;
1828 package PLXML::op_modulo;
1829 package PLXML::op_i_modulo;
1830 package PLXML::op_repeat;
1831
1832 sub ast {
1833     my $self = shift;
1834     return $self->SUPER::ast(@_)
1835         unless exists $$self{private} and $$self{private} =~ /DOLIST/;
1836
1837     my $newself = $$self{Kids}[0]->ast($self,@_);
1838     splice @{$newself->{Kids}}, -1, 0, $self->madness('o');
1839
1840     return bless $newself, $self->newtype;      # rebless the op_null
1841 }
1842
1843 package PLXML::op_add;
1844 package PLXML::op_i_add;
1845 package PLXML::op_subtract;
1846 package PLXML::op_i_subtract;
1847 package PLXML::op_concat;
1848
1849 sub astnull {
1850     my $self = shift;
1851     my @newkids;
1852
1853     my @after;
1854     my $left = $$self{Kids}[0];
1855     push @newkids, $left->ast($self, @_);
1856
1857     push @newkids, $self->madness('o');
1858
1859     my $right = $$self{Kids}[1];
1860     push @newkids, $right->ast($self, @_);
1861     return P5AST::op_concat->new(Kids => [@newkids]);
1862 }
1863
1864 sub ast {
1865     my $self = shift;
1866     my $parent = $_[0];
1867     my @newkids;
1868
1869     my @after;
1870     my $left = $$self{Kids}[0];
1871     push @newkids, $left->ast($self, @_);
1872
1873     push @newkids, $self->madness('o');
1874
1875     my $right = $$self{Kids}[1];
1876     push @newkids, $right->ast($self, @_);
1877
1878     return $self->newtype->new(Kids => [@newkids, @after]);
1879 }
1880
1881 package PLXML::op_stringify;
1882
1883 sub astnull {
1884     ast(@_);
1885 }
1886
1887 sub ast {
1888     my $self = shift;
1889     my @newkids;
1890     my @front = $self->madness('q (');
1891     my @back = $self->madness(') Q');
1892     my @M = $self->madness('M');
1893     if (@M) {
1894         push @newkids, $M[0], $self->madness('o');
1895     }
1896     push @newkids, @front;
1897     for my $kid (@{$$self{Kids}}) {
1898         push @newkids, $kid->ast($self, @_);
1899     }
1900     push @newkids, @back;
1901     return P5AST::op_stringify->new(Kids => [@newkids]);
1902 }
1903
1904 package PLXML::op_left_shift;
1905 package PLXML::op_right_shift;
1906 package PLXML::op_lt;
1907 package PLXML::op_i_lt;
1908 package PLXML::op_gt;
1909 package PLXML::op_i_gt;
1910 package PLXML::op_le;
1911 package PLXML::op_i_le;
1912 package PLXML::op_ge;
1913 package PLXML::op_i_ge;
1914 package PLXML::op_eq;
1915 package PLXML::op_i_eq;
1916 package PLXML::op_ne;
1917 package PLXML::op_i_ne;
1918 package PLXML::op_ncmp;
1919 package PLXML::op_i_ncmp;
1920 package PLXML::op_slt;
1921 package PLXML::op_sgt;
1922 package PLXML::op_sle;
1923 package PLXML::op_sge;
1924 package PLXML::op_seq;
1925 package PLXML::op_sne;
1926 package PLXML::op_scmp;
1927 package PLXML::op_bit_and;
1928 package PLXML::op_bit_xor;
1929 package PLXML::op_bit_or;
1930 package PLXML::op_negate;
1931 package PLXML::op_i_negate;
1932 package PLXML::op_not;
1933
1934 sub ast {
1935     my $self = shift;
1936     my @newkids = $self->madness('o (');
1937     my @swap;
1938     if (@newkids and $newkids[-1]->uni eq '!~') {
1939         @swap = @newkids;
1940         @newkids = ();
1941     }
1942
1943     if (exists $$self{Kids}) {
1944         my $arg = $$self{Kids}[0];
1945         push @newkids, $arg->ast($self, @_) if defined $arg;
1946     }
1947     if (@swap) {
1948         splice @{$newkids[-1][0]{Kids}}, -2, 0, @swap;  # XXX WAG
1949     }
1950     push @newkids, $self->madness(')');
1951
1952     my $res = $self->newtype->new(Kids => [@newkids]);
1953     return $res;
1954 }
1955
1956 package PLXML::op_complement;
1957 package PLXML::op_atan2;
1958 package PLXML::op_sin;
1959 package PLXML::op_cos;
1960 package PLXML::op_rand;
1961 package PLXML::op_srand;
1962 package PLXML::op_exp;
1963 package PLXML::op_log;
1964 package PLXML::op_sqrt;
1965 package PLXML::op_int;
1966 package PLXML::op_hex;
1967 package PLXML::op_oct;
1968 package PLXML::op_abs;
1969 package PLXML::op_length;
1970 package PLXML::op_substr;
1971 package PLXML::op_vec;
1972 package PLXML::op_index;
1973 package PLXML::op_rindex;
1974 package PLXML::op_sprintf;
1975 package PLXML::op_formline;
1976 package PLXML::op_ord;
1977 package PLXML::op_chr;
1978 package PLXML::op_crypt;
1979 package PLXML::op_ucfirst;
1980
1981 sub ast {
1982     my $self = shift;
1983     return $self->PLXML::listop::ast(@_);
1984 }
1985
1986 package PLXML::op_lcfirst;
1987
1988 sub ast {
1989     my $self = shift;
1990     return $self->PLXML::listop::ast(@_);
1991 }
1992
1993 package PLXML::op_uc;
1994
1995 sub ast {
1996     my $self = shift;
1997     return $self->PLXML::listop::ast(@_);
1998 }
1999
2000 package PLXML::op_lc;
2001
2002 sub ast {
2003     my $self = shift;
2004     return $self->PLXML::listop::ast(@_);
2005 }
2006
2007 package PLXML::op_quotemeta;
2008
2009 sub ast {
2010     my $self = shift;
2011     return $self->PLXML::listop::ast(@_);
2012 }
2013
2014 package PLXML::op_rv2av;
2015
2016 sub astnull {
2017     my $self = shift;
2018     return P5AST::op_rv2av->new(Kids => [$self->madness('$ @')]);
2019 }
2020
2021 sub ast {
2022     my $self = shift;
2023
2024     if (ref $$self{Kids}[0] eq 'PLXML::op_const' and $$self{mp}{'O'}) {
2025         return $self->madness('O');
2026     }
2027
2028     my @before;
2029     push @before, $self->madness('dx d (');
2030
2031     my @newkids;
2032     push @newkids, $self->madness('$ @ K');
2033     if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
2034         push @newkids, $$self{Kids}[0]->ast();
2035     }
2036     my @after;
2037     push @after, $self->madness(') a');
2038     return $self->newtype->new(Kids => [@before, @newkids, @after]);
2039 }
2040
2041 package PLXML::op_aelemfast;
2042
2043 sub ast {
2044     my $self = shift;
2045     return $self->madness('$');
2046 }
2047
2048 package PLXML::op_aelem;
2049
2050 sub astnull {
2051     my $self = shift;
2052     my @newkids;
2053     push @newkids, $self->madness('dx d');
2054     for my $kid (@{$$self{Kids}}) {
2055         push @newkids, $kid->ast($self, @_);
2056     }
2057     splice @newkids, -1, 0, $self->madness('a [');
2058     push @newkids, $self->madness(']');
2059     return P5AST::op_aelem->new(Kids => [@newkids]);
2060 }
2061
2062 sub ast {
2063     my $self = shift;
2064
2065     my @before = $self->madness('dx d');
2066     my @newkids;
2067     for my $kid (@{$$self{Kids}}) {
2068         push @newkids, $kid->ast(@_);
2069     }
2070     splice @newkids, -1, 0, $self->madness('a [');
2071     push @newkids, $self->madness(']');
2072
2073     return $self->newtype->new(Kids => [@before, @newkids]);
2074 }
2075
2076 package PLXML::op_aslice;
2077
2078 sub astnull {
2079     my $self = shift;
2080     my @newkids;
2081     push @newkids, $self->madness('[');
2082     for my $kid (@{$$self{Kids}}) {
2083         push @newkids, $kid->ast(@_);
2084     }
2085     unshift @newkids, pop @newkids;
2086     unshift @newkids, $self->madness('dx d');
2087     push @newkids, $self->madness(']');
2088     return P5AST::op_aslice->new(Kids => [@newkids]);
2089 }
2090
2091 sub ast {
2092     my $self = shift;
2093
2094     my @newkids;
2095     push @newkids, $self->madness('[');
2096     for my $kid (@{$$self{Kids}}) {
2097         push @newkids, $kid->ast(@_);
2098     }
2099     unshift @newkids, pop @newkids;
2100     unshift @newkids, $self->madness('dx d');
2101     push @newkids, $self->madness(']');
2102
2103     return $self->newtype->new(Kids => [@newkids]);
2104 }
2105
2106 package PLXML::op_each;
2107 package PLXML::op_values;
2108 package PLXML::op_keys;
2109 package PLXML::op_delete;
2110 package PLXML::op_exists;
2111 package PLXML::op_rv2hv;
2112
2113 sub astnull {
2114     my $self = shift;
2115     return P5AST::op_rv2hv->new(Kids => [$self->madness('$')]);
2116 }
2117
2118 sub ast {
2119     my $self = shift;
2120
2121     my @before;
2122     push @before, $self->madness('dx d (');
2123
2124     my @newkids;
2125     push @newkids, $self->madness('$ @ % K');
2126     if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
2127         push @newkids, $$self{Kids}[0]->ast();
2128     }
2129     my @after;
2130     push @after, $self->madness(') a');
2131     return $self->newtype->new(Kids => [@before, @newkids, @after]);
2132 }
2133
2134 package PLXML::op_helem;
2135
2136 sub astnull {
2137     my $self = shift;
2138     local $::curstate;  # hash subscript potentially a lineseq
2139     local $::curenc = $::curenc;
2140
2141     my @newkids;
2142     push @newkids, $self->madness('dx d');
2143     for my $kid (@{$$self{Kids}}) {
2144         push @newkids, $kid->ast($self, @_);
2145     }
2146     splice @newkids, -1, 0, $self->madness('a {');
2147     push @newkids, $self->madness('}');
2148     return P5AST::op_helem->new(Kids => [@newkids]);
2149 }
2150
2151 sub ast {
2152     my $self = shift;
2153     local $::curstate;  # hash subscript potentially a lineseq
2154     local $::curenc = $::curenc;
2155
2156     my @before = $self->madness('dx d');
2157     my @newkids;
2158     for my $kid (@{$$self{Kids}}) {
2159         push @newkids, $kid->ast($self, @_);
2160     }
2161     splice @newkids, -1, 0, $self->madness('a {');
2162     push @newkids, $self->madness('}');
2163
2164     return $self->newtype->new(Kids => [@before, @newkids]);
2165 }
2166
2167
2168 package PLXML::op_hslice;
2169
2170 sub astnull {
2171     my $self = shift;
2172     my @newkids;
2173     push @newkids, $self->madness('{');
2174     for my $kid (@{$$self{Kids}}) {
2175         push @newkids, $kid->ast(@_);
2176     }
2177     unshift @newkids, pop @newkids;
2178     unshift @newkids, $self->madness('dx d'); 
2179     push @newkids, $self->madness('}');
2180     return P5AST::op_hslice->new(Kids => [@newkids]);
2181 }
2182
2183 sub ast {
2184     my $self = shift;
2185
2186     my @newkids;
2187     push @newkids, $self->madness('{');
2188     for my $kid (@{$$self{Kids}}) {
2189         push @newkids, $kid->ast(@_);
2190     }
2191     unshift @newkids, pop @newkids;
2192     unshift @newkids, $self->madness('dx d'); 
2193     push @newkids, $self->madness('}');
2194
2195     return $self->newtype->new(Kids => [@newkids]);
2196 }
2197
2198 package PLXML::op_unpack;
2199 package PLXML::op_pack;
2200 package PLXML::op_split;
2201 package PLXML::op_join;
2202 package PLXML::op_list;
2203
2204 sub astnull {
2205     my $self = shift;
2206     my @newkids;
2207     my @retval;
2208     my @before;
2209     if (@retval = $self->madness('X')) {
2210         push @before, $self->madness('x o');
2211         return @before,@retval;
2212     }
2213     my @kids = @{$$self{Kids}};
2214     for my $kid (@kids) {
2215         next if ref $kid eq 'PLXML::op_pushmark';
2216         next if ref $kid eq 'PLXML::op_null' and
2217                 defined $$kid{was} and $$kid{was} eq 'pushmark';
2218         push @newkids, $kid->ast($self, @_);
2219     }
2220
2221     my $x = "";
2222     my @newnewkids = ();
2223     push @newnewkids, $self->madness('dx d (');
2224     push @newnewkids, @newkids;
2225     push @newnewkids, $self->madness(') :');
2226     return P5AST::op_list->new(Kids => [@newnewkids]);
2227 }
2228
2229 sub ast {
2230     my $self = shift;
2231
2232     my @retval;
2233     my @before;
2234     if (@retval = $self->madness('X')) {
2235         push @before, $self->madness('o');
2236         return $self->newtype->new(Kids => [@before,@retval]);
2237     }
2238     push @retval, $self->madness('dx d (');
2239
2240     my @newkids;
2241     for my $kid (@{$$self{Kids}}) {
2242         push @newkids, $kid->ast($self, @_);
2243     }
2244     my $x = "";
2245     my @newnewkids = ();
2246     push @newnewkids, @newkids;
2247     @newkids = @newnewkids;
2248     push @retval, @newkids;
2249     push @retval, $self->madness(') :');
2250     return $self->newtype->new(Kids => [@retval]);
2251 }
2252
2253 package PLXML::op_lslice;
2254
2255 sub ast {
2256     my $self = shift;
2257     my @newkids;
2258
2259     if ($$self{mp}{q}) {
2260         push @newkids, $self->madness('q = Q');
2261     }
2262     elsif ($$self{mp}{x}) {
2263         push @newkids, $self->madness('x');
2264     }
2265     else {
2266         push @newkids, $self->madness('(');
2267         my $list = $$self{Kids}[1];
2268         push @newkids, $list->ast($self, @_);
2269         push @newkids, $self->madness(')');
2270     }
2271
2272     push @newkids, $self->madness('[');
2273
2274     my $slice = $$self{Kids}[0];
2275     push @newkids, $slice->ast($self, @_);
2276     push @newkids, $self->madness(']');
2277
2278     return $self->newtype->new(Kids => [@newkids]);
2279 }
2280
2281 package PLXML::op_anonlist;
2282 package PLXML::op_anonhash;
2283 package PLXML::op_splice;
2284 package PLXML::op_push;
2285 package PLXML::op_pop;
2286 package PLXML::op_shift;
2287 package PLXML::op_unshift;
2288 package PLXML::op_sort;
2289 package PLXML::op_reverse;
2290
2291 sub astnull {
2292     my $self = shift;
2293     $self->PLXML::listop::ast(@_);
2294 }
2295
2296 package PLXML::op_grepstart;
2297 package PLXML::op_grepwhile;
2298 package PLXML::op_mapstart;
2299 package PLXML::op_mapwhile;
2300 package PLXML::op_range;
2301
2302 sub ast {
2303     my $self = shift;
2304     return $self->PLXML::binop::ast(@_);
2305 }
2306
2307 package PLXML::op_flip;
2308 package PLXML::op_flop;
2309 package PLXML::op_and;
2310
2311 sub astnull {
2312     my $self = shift;
2313     my @newkids;
2314     my @first = $self->madness('1');
2315     my @second = $self->madness('2');
2316     my @stuff = $$self{Kids}[0]->ast();
2317     if (my @I = $self->madness('I')) {
2318         if (@second) {
2319             push @newkids, @I;
2320             push @newkids, $self->madness('(');
2321             push @newkids, @stuff;
2322             push @newkids, $self->madness(')');
2323             push @newkids, @second;
2324         }
2325         else {
2326             push @newkids, @I;
2327             push @newkids, $self->madness('(');
2328             push @newkids, @first;
2329             push @newkids, $self->madness(')');
2330             push @newkids, @stuff;
2331         }
2332     }
2333     elsif (my @i = $self->madness('i')) {
2334         if (@second) {
2335             push @newkids, @second;
2336             push @newkids, @i;
2337             push @newkids, @stuff;
2338         }
2339         else {
2340             push @newkids, @stuff;
2341             push @newkids, @i;
2342             push @newkids, @first;
2343         }
2344     }
2345     elsif (my @o = $self->madness('o')) {
2346         if (@second) {
2347             push @newkids, @stuff;
2348             push @newkids, @o;
2349             push @newkids, @second;
2350         }
2351         else {
2352             push @newkids, @first;
2353             push @newkids, @o;
2354             push @newkids, @stuff;
2355         }
2356     }
2357     return P5AST::op_and->new(Kids => [@newkids]);
2358 }
2359
2360 package PLXML::op_or;
2361
2362 sub astnull {
2363     my $self = shift;
2364     my @newkids;
2365     my @first = $self->madness('1');
2366     my @second = $self->madness('2');
2367     my @i = $self->madness('i');
2368     my @stuff = $$self{Kids}[0]->ast();
2369     if (@second) {
2370         if (@i) {
2371             push @newkids, @second;
2372             push @newkids, $self->madness('i');
2373             push @newkids, @stuff;
2374         }
2375         else {
2376             push @newkids, @stuff;
2377             push @newkids, $self->madness('o');
2378             push @newkids, @second;
2379         }
2380     }
2381     else {
2382         if (@i) {
2383             push @newkids, @stuff;
2384             push @newkids, $self->madness('i');
2385             push @newkids, @first;
2386         }
2387         else {
2388             push @newkids, @first;
2389             push @newkids, $self->madness('o');
2390             push @newkids, @stuff;
2391         }
2392     }
2393     return "P5AST::op_$$self{was}"->new(Kids => [@newkids]);
2394 }
2395
2396
2397 package PLXML::op_xor;
2398 package PLXML::op_cond_expr;
2399 package PLXML::op_andassign;
2400 package PLXML::op_orassign;
2401 package PLXML::op_method;
2402 package PLXML::op_entersub;
2403
2404 sub ast {
2405     my $self = shift;
2406
2407     if ($$self{mp}{q}) {
2408         return $self->madness('q = Q');
2409     }
2410     if ($$self{mp}{X}) {                # <FH> override?
2411         return $self->madness('X');
2412     }
2413     if ($$self{mp}{A}) {
2414         return $self->astmethod(@_);
2415     }
2416     if ($$self{mp}{a}) {
2417         return $self->astarrow(@_);
2418     }
2419
2420     my @retval;
2421
2422     my @newkids;
2423     my @kids = @{$$self{Kids}};
2424     if (@kids == 1 and ref $kids[0] eq 'PLXML::op_null' and $kids[0]{was} =~ /list/) {
2425         @kids = @{$kids[0]{Kids}};
2426     }
2427     my $dest = pop @kids;
2428     my @dest = $dest->ast($self, @_);
2429     
2430     if (ref($dest) =~ /method/) {
2431         my $invocant = shift @kids;
2432         $invocant = shift @kids if ref($invocant) eq 'PLXML::op_pushmark';
2433         my @invocant = $invocant->ast($self, @_);
2434         push @retval, @dest;
2435         push @retval, @invocant;
2436     }
2437     elsif (exists $$self{mp}{o} and $$self{mp}{o} eq 'do') {
2438         push @retval, $self->madness('o');
2439         push @retval, @dest;
2440     }
2441     else {
2442         push @retval, $self->madness('o');
2443         push @retval, @dest;
2444     }
2445     while (@kids) {
2446         my $kid = shift(@kids);
2447         push @newkids, $kid->ast($self, @_);
2448     }
2449
2450     push @retval, $self->madness('(');
2451     push @retval, @newkids;
2452     push @retval, $self->madness(')');
2453     return $self->newtype->new(Kids => [@retval]);
2454 }
2455
2456 sub astmethod {
2457     my $self = shift;
2458     my @newkids;
2459     my @kids;
2460     for my $kid (@{$$self{Kids}}) {
2461         next if ref $kid eq 'PLXML::op_pushmark';
2462         next if ref $kid eq 'PLXML::op_null' and
2463                 defined $$kid{was} and $$kid{was} eq 'pushmark';
2464         push @kids, $kid;
2465     }
2466     my @invocant;
2467     if ($$self{flags} =~ /\bSTACKED\b/) {
2468         push @invocant, shift(@kids)->ast($self, @_);
2469     }
2470     for my $kid (@kids) {
2471         push @newkids, $kid->ast($self, @_);
2472     }
2473     my $dest = pop(@newkids);
2474     if (ref $dest eq 'PLXML::op_rv2cv' and $$self{flags} =~ /\bMOD\b/) {
2475         $dest = pop(@newkids);
2476     }
2477     my $x = "";
2478     my @retval;
2479     push @retval, @invocant;
2480     push @retval, $self->madness('A');
2481     push @retval, $dest;
2482     push @retval, $self->madness('(');
2483     push @retval, @newkids;
2484     push @retval, $self->madness(')');
2485     return $self->newtype->new(Kids => [@retval]);
2486 }
2487
2488 sub astarrow {
2489     my $self = shift;
2490     my @newkids;
2491     my @retval;
2492     my @kids = @{$$self{Kids}};
2493     if (@kids == 1 and ref $kids[0] eq 'PLXML::op_null' and $kids[0]{was} =~ /list/) {
2494         @kids = @{$kids[0]{Kids}};
2495     }
2496     while (@kids > 1) {
2497         my $kid = shift(@kids);
2498         push @newkids, $kid->ast($self, @_);
2499     }
2500     my @dest = $kids[0]->ast($self, @_);
2501     my $x = "";
2502     push @retval, @dest;
2503     push @retval, $self->madness('a');
2504     push @retval, $self->madness('(');
2505     push @retval, @newkids;
2506     push @retval, $self->madness(')');
2507     return $self->newtype->new(Kids => [@retval]);
2508 }
2509
2510 package PLXML::op_leavesub;
2511
2512 sub ast {
2513     my $self = shift;
2514     if (ref $$self{Kids}[0] eq "PLXML::op_null") {
2515         return $$self{Kids}[0]->ast(@_);
2516     }
2517     return $$self{Kids}[0]->blockast($self, @_);
2518 }
2519
2520 package PLXML::op_leavesublv;
2521
2522 sub ast {
2523     my $self = shift;
2524
2525     return $$self{Kids}[0]->blockast($self, @_);
2526 }
2527
2528 package PLXML::op_caller;
2529 package PLXML::op_warn;
2530 package PLXML::op_die;
2531 package PLXML::op_reset;
2532 package PLXML::op_lineseq;
2533
2534 sub lineseq {
2535     my $self = shift;
2536     my @kids = @{$$self{Kids}};
2537     local $::curstate = 0;      # (probably redundant, but that's okay)
2538     local $::prevstate = 0;
2539     local $::curenc = $::curenc;
2540     my @retval;
2541     my @newstuff;
2542     my $newprev;
2543     while (@kids) {
2544         my $kid = shift @kids;
2545         my $thing = $kid->ast($self, @_);
2546         next unless defined $thing;
2547         if ($::curstate ne $::prevstate) {
2548             if ($::prevstate) {
2549                 push @newstuff, $::prevstate->madness(';');
2550                 push @{$newprev->{Kids}}, @newstuff if $newprev;
2551                 @newstuff = ();
2552             }
2553             $::prevstate = $::curstate;
2554             $newprev = $thing;
2555             push @retval, $thing;
2556         }
2557         elsif ($::prevstate) {
2558             push @newstuff, $thing;
2559         }
2560         else {
2561             push @retval, $thing;
2562         }
2563     }
2564     if ($::prevstate) {
2565         push @newstuff, $::prevstate->madness(';');
2566         push @{$newprev->{Kids}}, @newstuff if $newprev;
2567         @newstuff = ();
2568         $::prevstate = 0;
2569     }
2570     return @retval;
2571 }
2572
2573 sub blockast {
2574     my $self = shift;
2575     local $::curstate;
2576
2577     my @retval;
2578     push @retval, $self->madness('{');
2579  
2580     my @newkids = $self->PLXML::op_lineseq::lineseq(@_);
2581     push @retval, @newkids;
2582
2583     push @retval, $self->madness('; }');
2584     return $self->newtype->new(Kids => [@retval]);
2585 }
2586
2587 package PLXML::op_nextstate;
2588
2589 sub newtype { return "P5AST::statement" }
2590
2591 sub astnull {
2592     my $self = shift;
2593     my @newkids;
2594     push @newkids, $self->madness('L');
2595     $::curstate = $self;
2596     return P5AST::statement->new(Kids => [@newkids]);
2597 }
2598
2599 sub ast {
2600     my $self = shift;
2601
2602     my @newkids;
2603     push @newkids, $self->madness('L');
2604     $::curstate = $self;
2605     return $self->newtype->new(Kids => [@newkids]);
2606 }
2607
2608
2609 package PLXML::op_dbstate;
2610 package PLXML::op_unstack;
2611 package PLXML::op_enter;
2612
2613 sub ast { () }
2614
2615 package PLXML::op_leave;
2616
2617 sub astnull {
2618     ast(@_);
2619 }
2620
2621 sub ast {
2622     my $self = shift;
2623
2624     my $mad = $$self{mp}{FIRST} || "unknown";
2625
2626     my @retval;
2627     if ($mad eq 'w') {
2628         my @newkids;
2629         my @tmpkids;
2630         push @tmpkids, $self->{Kids};
2631         my $anddo = $$self{Kids}[-1]{Kids}[0]{Kids};
2632         eval { push @newkids, $anddo->[1]->ast($self,@_); };
2633         push @newkids, "[[[NOANDDO]]]" if $@;
2634         push @newkids, $self->madness('w');
2635         push @newkids, $anddo->[0]->ast($self,@_);
2636
2637         return $self->newtype->new(Kids => [@newkids]);
2638     }
2639
2640     local $::curstate;
2641     push @retval, $self->madness('o {');
2642
2643     my @newkids = $self->PLXML::op_lineseq::lineseq(@_);
2644     push @retval, @newkids;
2645     push @retval, $self->madness(q/; }/);
2646     my $retval = $self->newtype->new(Kids => [@retval]);
2647
2648     if ($$self{mp}{C}) {
2649         my @before;
2650         my @after;
2651         push @before, $self->madness('I ( C )');
2652         if ($$self{mp}{t}) {
2653             push @before, $self->madness('t');
2654         }
2655         elsif ($$self{mp}{e}) {
2656             push @after, $self->madness('e');
2657         }
2658         return P5AST::op_cond->new(Kids => [@before, $retval, @after]);
2659     }
2660     else {
2661         return $retval;
2662     }
2663 }
2664
2665 package PLXML::op_scope;
2666
2667 sub ast {
2668     my $self = shift;
2669     local $::curstate;
2670
2671     my @newkids;
2672     push @newkids, $self->madness('o');
2673
2674     push @newkids, $self->madness('{');
2675     push @newkids, $self->PLXML::op_lineseq::lineseq(@_);
2676     push @newkids, $self->madness('; }');
2677
2678     my @folded = $self->madness('C');
2679     if (@folded) {
2680         my @t = $self->madness('t');
2681         my @e = $self->madness('e');
2682         if (@e) {
2683             return $self->newtype->new(
2684                 Kids => [
2685                     $self->madness('I ('),
2686                     @folded,
2687                     $self->madness(')'),
2688                     $self->newtype->new(Kids => [@newkids]),
2689                     @e
2690                 ] );
2691         }
2692         else {
2693             return $self->newtype->new(
2694                 Kids => [
2695                     $self->madness('I ('),
2696                     @folded,
2697                     $self->madness(')'),
2698                     @t,
2699                     $self->newtype->new(Kids => [@newkids])
2700                 ] );
2701         }
2702     }
2703     return $self->newtype->new(Kids => [@newkids]);
2704 }
2705
2706 package PLXML::op_enteriter;
2707
2708 sub ast {
2709     my $self = shift;
2710     my (undef,$range,$var) = @{$self->{Kids}};
2711     my @retval;
2712     push @retval, $self->madness('v');
2713     if (!@retval and defined $var) {
2714         push @retval, $var->ast($self,@_);
2715     }
2716     else {
2717         push @retval, '';
2718     }
2719     if (ref $range eq 'PLXML::op_null' and $$self{flags} =~ /STACKED/) {
2720         my (undef,$min,$max) = @{$range->{Kids}};
2721         push @retval, $min->ast($self,@_);
2722         if (defined $max) {
2723             if (exists $$range{mp}{O}) {        # deeply buried .. operator
2724                 PLXML::prepreproc($$range{mp}{O});
2725                 push @retval,
2726                   $$range{mp}{'O'}{Kids}[0]{Kids}[0]{Kids}[0]{Kids}[0]->madness('o')
2727             }
2728             else {
2729                 push @retval, '..';             # XXX missing whitespace
2730             }
2731             push @retval, $max->ast($self,@_);
2732         }
2733     }
2734     else {
2735         push @retval, $range->ast($self,@_);
2736     }
2737     return $self->newtype->new(Kids => [@retval]);
2738 }
2739
2740 package PLXML::op_iter;
2741 package PLXML::op_enterloop;
2742
2743 sub ast {
2744 }
2745
2746 package PLXML::op_leaveloop;
2747
2748 sub ast {
2749     my $self = shift;
2750
2751     my @retval;
2752     my @newkids;
2753     my $enterloop = $$self{Kids}[0];
2754     my $nextthing = $$self{Kids}[1];
2755
2756     if ($$self{mp}{W}) {
2757         push @retval, $self->madness('L');
2758         push @newkids, $self->madness('W d');
2759
2760         if (ref $enterloop eq 'PLXML::op_enteriter') {
2761             my ($var,@rest) = @{$enterloop->ast($self,@_)->{Kids}};
2762             push @newkids, $var if $var;
2763             push @newkids, $self->madness('q ( x = Q');
2764             push @newkids, @rest;
2765         }
2766         else {
2767             push @newkids, $self->madness('(');
2768             push @newkids, $enterloop->ast($self,@_);
2769         }
2770     }
2771     my $andor;
2772
2773     if (ref $nextthing eq 'PLXML::op_null') {
2774         if ($$nextthing{mp}{'1'}) {
2775             push @newkids, $nextthing->madness('1');
2776             push @newkids, $self->madness(')');
2777             push @newkids, $$nextthing{Kids}[0]->blockast($self,@_);
2778         }
2779         elsif ($$nextthing{mp}{'2'}) {
2780             push @newkids, $$nextthing{Kids}[0]->ast($self,@_);
2781             push @newkids, $self->madness(')');
2782             push @newkids, $$nextthing{mp}{'2'}->blockast($self,@_);
2783         }
2784         elsif ($$nextthing{mp}{'U'}) {
2785             push @newkids, $nextthing->ast($self,@_);
2786         }
2787         else {
2788             # bypass the op_null
2789             $andor = $nextthing->{Kids}[0];
2790             eval {
2791                 push @newkids, $$andor{Kids}[0]->ast($self, @_);
2792             };
2793             push @newkids, $self->madness(')');
2794             eval {
2795                 push @newkids, $$andor{Kids}[1]->blockast($self, @_);
2796             };
2797         }
2798     }
2799     else {
2800         $andor = $nextthing;
2801         push @newkids, $nextthing->madness('O');
2802         push @newkids, $self->madness(')');
2803         push @newkids, $nextthing->blockast($self, @_);
2804     }
2805     if ($$self{mp}{w}) {
2806         push @newkids, $self->madness('w');
2807         push @newkids, $enterloop->ast($self,@_);
2808     }
2809
2810     push @retval, @newkids;
2811
2812     return $self->newtype->new(Kids => [@retval]);
2813 }
2814
2815 package PLXML::op_return;
2816 package PLXML::op_last;
2817 package PLXML::op_next;
2818 package PLXML::op_redo;
2819 package PLXML::op_dump;
2820 package PLXML::op_goto;
2821 package PLXML::op_exit;
2822 package PLXML::op_open;
2823 package PLXML::op_close;
2824 package PLXML::op_pipe_op;
2825 package PLXML::op_fileno;
2826 package PLXML::op_umask;
2827 package PLXML::op_binmode;
2828 package PLXML::op_tie;
2829 package PLXML::op_untie;
2830 package PLXML::op_tied;
2831 package PLXML::op_dbmopen;
2832 package PLXML::op_dbmclose;
2833 package PLXML::op_sselect;
2834 package PLXML::op_select;
2835 package PLXML::op_getc;
2836 package PLXML::op_read;
2837 package PLXML::op_enterwrite;
2838 package PLXML::op_leavewrite;
2839 package PLXML::op_prtf;
2840 package PLXML::op_print;
2841 package PLXML::op_say;
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