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