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         '&' => '&amp;',
 136         "'" => '&apos;',
 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