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