lib/warnings/register.pm For "use warnings::register"
lib/warnings.t See if warning controls work
locale.c locale-specific utility functions
+mad/P5AST.pm Used by nomad
+mad/P5RE.pm Used by nomad
+mad/P5re.pm Used by nomad
+mad/PLXML.pm Used by nomad
+mad/nomad Converts raw XML dump to something vaguely sane
+mad/p55 Perl 5 to Perl 5 translator - driver for nomad
madly.act parser actions; derived from madly.y
madly.c parser code (NOT derived from madly.y)
madly.h header file for madly.c; derived from madly.y
--- /dev/null
+package P5AST;
+
+$::herequeue = '';
+
+1;
+
+{
+ my %newkey = qw(
+ );
+
+ sub translate {
+ my $class = shift;
+ my $key = shift;
+ $key = $newkey{$key} || "op_$key";
+ return "P5AST::$key";
+ }
+}
+
+sub new {
+ my $class = shift;
+ bless {@_}, $class;
+}
+
+sub AUTOLOAD {
+ warn "AUTOLOAD $P5AST::AUTOLOAD(" . join(',', @_) . ")\n";
+}
+
+sub DESTROY { }
+
+sub p5arraytext {
+ my $kid = shift;
+ my $text = "";
+ for my $subkid (@$kid) {
+ my $type = ref $subkid;
+ if ($type eq 'ARRAY') {
+ if ($dowarn) {
+ warn "Extra array\n";
+ $text .= '〔 '. p5arraytext($subkid) . ' 〕';
+ }
+ else {
+ $text .= p5arraytext($subkid);
+ }
+ }
+ elsif ($type =~ /^p5::/) {
+ my $newtext = $subkid->enc();
+ if ($::herequeue && $newtext =~ s/\n/\n$::herequeue/) {
+ $::herequeue = '';
+ }
+ $text .= $newtext;
+ }
+ elsif ($type) {
+ $text .= $subkid->text(@_);
+ }
+ else {
+ $text .= $subkid;
+ }
+ }
+ return $text;
+}
+
+sub p5text {
+ my $self = shift;
+# my $pre = $self->pretext();
+# my $post = $self->posttext();
+ my $text = "";
+ foreach my $kid (@{$$self{Kids}}) {
+ my $type = ref $kid;
+ if ($type eq 'ARRAY') {
+ $text .= p5arraytext($kid);
+ }
+ elsif ($type =~ /^p5::/) {
+ my $newtext = $kid->enc();
+ if ($::herequeue && $newtext =~ s/\n/\n$::herequeue/) {
+ $::herequeue = '';
+ }
+ $text .= $newtext;
+ }
+ elsif ($type) {
+ $text .= $kid->p5text(@_);
+ }
+ elsif (defined $kid) {
+ $text .= $kid;
+ }
+ else {
+ $text .= '[[[ UNDEF ]]]';
+ }
+ }
+ return $text;
+}
+
+sub p5subtext {
+ my $self = shift;
+ my @text;
+ foreach my $kid (@{$$self{Kids}}) {
+ my $text = $kid->p5text(@_);
+ push @text, $text if defined $text;
+ }
+ return @text;
+}
+
+sub p6text {
+ return $_[0]->p5text(); # assume it's the same
+}
+
+package P5AST::heredoc; @ISA = 'P5AST';
+
+sub p5text {
+ my $self = shift;
+ my $newdoc;
+ {
+ local $::herequeue; # don't interpolate outer heredoc yet
+ $newdoc = $self->{doc}->p5text(@_) . $self->{end}->enc();
+ if ($::herequeue) { # heredoc within the heredoc?
+ $newdoc .= $::herequeue;
+ $::herequeue = '';
+ }
+ }
+ $::herequeue .= $newdoc;
+ my $start = $self->{start};
+ my $type = ref $start;
+ if ($type =~ /^p5::/) { # XXX too much cut-n-paste here...
+ return $start->enc();
+ }
+ elsif ($type) {
+ return $start->p5text(@_);
+ }
+ else {
+ return $start;
+ }
+}
+
+package P5AST::BAD;
+
+sub p5text {
+ my $self = shift;
+ my $t = ref $t;
+ warn "Shouldn't have a node of type $t";
+}
+
+package P5AST::baseop; @ISA = 'P5AST';
+package P5AST::baseop_unop; @ISA = 'P5AST::baseop';
+package P5AST::binop; @ISA = 'P5AST::baseop';
+package P5AST::cop; @ISA = 'P5AST::baseop';
+package P5AST::filestatop; @ISA = 'P5AST::baseop';
+package P5AST::listop; @ISA = 'P5AST::baseop';
+package P5AST::logop; @ISA = 'P5AST::baseop';
+package P5AST::loop; @ISA = 'P5AST::baseop';
+package P5AST::loopexop; @ISA = 'P5AST::baseop';
+package P5AST::padop; @ISA = 'P5AST::baseop';
+package P5AST::padop_svop; @ISA = 'P5AST::baseop';
+package P5AST::pmop; @ISA = 'P5AST::baseop';
+package P5AST::pvop_svop; @ISA = 'P5AST::baseop';
+package P5AST::unop; @ISA = 'P5AST::baseop';
+
+# Nothing.
+
+package P5AST::op_null; @ISA = 'P5AST::baseop';
+package P5AST::op_stub; @ISA = 'P5AST::baseop';
+package P5AST::op_scalar; @ISA = 'P5AST::baseop_unop';
+
+# Pushy stuff.
+
+package P5AST::op_pushmark; @ISA = 'P5AST::baseop';
+package P5AST::op_wantarray; @ISA = 'P5AST::baseop';
+package P5AST::op_const; @ISA = 'P5AST::padop_svop';
+package P5AST::op_gvsv; @ISA = 'P5AST::padop_svop';
+package P5AST::op_gv; @ISA = 'P5AST::padop_svop';
+package P5AST::op_gelem; @ISA = 'P5AST::binop';
+package P5AST::op_padsv; @ISA = 'P5AST::baseop';
+package P5AST::op_padav; @ISA = 'P5AST::baseop';
+package P5AST::op_padhv; @ISA = 'P5AST::baseop';
+package P5AST::op_padany; @ISA = 'P5AST::baseop';
+package P5AST::op_pushre; @ISA = 'P5AST::pmop';
+package P5AST::op_rv2gv; @ISA = 'P5AST::unop';
+package P5AST::op_rv2sv; @ISA = 'P5AST::unop';
+package P5AST::op_av2arylen; @ISA = 'P5AST::unop';
+package P5AST::op_rv2cv; @ISA = 'P5AST::unop';
+package P5AST::op_anoncode; @ISA = 'P5AST::padop_svop';
+package P5AST::op_prototype; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_refgen; @ISA = 'P5AST::unop';
+package P5AST::op_srefgen; @ISA = 'P5AST::unop';
+package P5AST::op_ref; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_bless; @ISA = 'P5AST::listop';
+package P5AST::op_backtick; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_glob; @ISA = 'P5AST::listop';
+package P5AST::op_readline; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_rcatline; @ISA = 'P5AST::padop_svop';
+package P5AST::op_regcmaybe; @ISA = 'P5AST::unop';
+package P5AST::op_regcreset; @ISA = 'P5AST::unop';
+package P5AST::op_regcomp; @ISA = 'P5AST::logop';
+package P5AST::op_match; @ISA = 'P5AST::pmop';
+package P5AST::op_qr; @ISA = 'P5AST::pmop';
+package P5AST::op_subst; @ISA = 'P5AST::pmop';
+package P5AST::op_substcont; @ISA = 'P5AST::logop';
+package P5AST::op_trans; @ISA = 'P5AST::pvop_svop';
+package P5AST::op_sassign; @ISA = 'P5AST::baseop';
+package P5AST::op_aassign; @ISA = 'P5AST::binop';
+package P5AST::op_chop; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_schop; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_chomp; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_schomp; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_defined; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_undef; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_study; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_pos; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_preinc; @ISA = 'P5AST::unop';
+package P5AST::op_i_preinc; @ISA = 'P5AST::unop';
+package P5AST::op_predec; @ISA = 'P5AST::unop';
+package P5AST::op_i_predec; @ISA = 'P5AST::unop';
+package P5AST::op_postinc; @ISA = 'P5AST::unop';
+package P5AST::op_i_postinc; @ISA = 'P5AST::unop';
+package P5AST::op_postdec; @ISA = 'P5AST::unop';
+package P5AST::op_i_postdec; @ISA = 'P5AST::unop';
+package P5AST::op_pow; @ISA = 'P5AST::binop';
+package P5AST::op_multiply; @ISA = 'P5AST::binop';
+package P5AST::op_i_multiply; @ISA = 'P5AST::binop';
+package P5AST::op_divide; @ISA = 'P5AST::binop';
+package P5AST::op_i_divide; @ISA = 'P5AST::binop';
+package P5AST::op_modulo; @ISA = 'P5AST::binop';
+package P5AST::op_i_modulo; @ISA = 'P5AST::binop';
+package P5AST::op_repeat; @ISA = 'P5AST::binop';
+package P5AST::op_add; @ISA = 'P5AST::binop';
+package P5AST::op_i_add; @ISA = 'P5AST::binop';
+package P5AST::op_subtract; @ISA = 'P5AST::binop';
+package P5AST::op_i_subtract; @ISA = 'P5AST::binop';
+package P5AST::op_concat; @ISA = 'P5AST::binop';
+package P5AST::op_stringify; @ISA = 'P5AST::listop';
+package P5AST::op_left_shift; @ISA = 'P5AST::binop';
+package P5AST::op_right_shift; @ISA = 'P5AST::binop';
+package P5AST::op_lt; @ISA = 'P5AST::binop';
+package P5AST::op_i_lt; @ISA = 'P5AST::binop';
+package P5AST::op_gt; @ISA = 'P5AST::binop';
+package P5AST::op_i_gt; @ISA = 'P5AST::binop';
+package P5AST::op_le; @ISA = 'P5AST::binop';
+package P5AST::op_i_le; @ISA = 'P5AST::binop';
+package P5AST::op_ge; @ISA = 'P5AST::binop';
+package P5AST::op_i_ge; @ISA = 'P5AST::binop';
+package P5AST::op_eq; @ISA = 'P5AST::binop';
+package P5AST::op_i_eq; @ISA = 'P5AST::binop';
+package P5AST::op_ne; @ISA = 'P5AST::binop';
+package P5AST::op_i_ne; @ISA = 'P5AST::binop';
+package P5AST::op_ncmp; @ISA = 'P5AST::binop';
+package P5AST::op_i_ncmp; @ISA = 'P5AST::binop';
+package P5AST::op_slt; @ISA = 'P5AST::binop';
+package P5AST::op_sgt; @ISA = 'P5AST::binop';
+package P5AST::op_sle; @ISA = 'P5AST::binop';
+package P5AST::op_sge; @ISA = 'P5AST::binop';
+package P5AST::op_seq; @ISA = 'P5AST::binop';
+package P5AST::op_sne; @ISA = 'P5AST::binop';
+package P5AST::op_scmp; @ISA = 'P5AST::binop';
+package P5AST::op_bit_and; @ISA = 'P5AST::binop';
+package P5AST::op_bit_xor; @ISA = 'P5AST::binop';
+package P5AST::op_bit_or; @ISA = 'P5AST::binop';
+package P5AST::op_negate; @ISA = 'P5AST::unop';
+package P5AST::op_i_negate; @ISA = 'P5AST::unop';
+package P5AST::op_not; @ISA = 'P5AST::unop';
+package P5AST::op_complement; @ISA = 'P5AST::unop';
+package P5AST::op_atan2; @ISA = 'P5AST::listop';
+package P5AST::op_sin; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_cos; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_rand; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_srand; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_exp; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_log; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_sqrt; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_int; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_hex; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_oct; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_abs; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_length; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_substr; @ISA = 'P5AST::listop';
+package P5AST::op_vec; @ISA = 'P5AST::listop';
+package P5AST::op_index; @ISA = 'P5AST::listop';
+package P5AST::op_rindex; @ISA = 'P5AST::listop';
+package P5AST::op_sprintf; @ISA = 'P5AST::listop';
+package P5AST::op_formline; @ISA = 'P5AST::listop';
+package P5AST::op_ord; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_chr; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_crypt; @ISA = 'P5AST::listop';
+package P5AST::op_ucfirst; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_lcfirst; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_uc; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_lc; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_quotemeta; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_rv2av; @ISA = 'P5AST::unop';
+package P5AST::op_aelemfast; @ISA = 'P5AST::padop_svop';
+package P5AST::op_aelem; @ISA = 'P5AST::binop';
+package P5AST::op_aslice; @ISA = 'P5AST::listop';
+package P5AST::op_each; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_values; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_keys; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_delete; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_exists; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_rv2hv; @ISA = 'P5AST::unop';
+package P5AST::op_helem; @ISA = 'P5AST::listop';
+package P5AST::op_hslice; @ISA = 'P5AST::listop';
+package P5AST::op_unpack; @ISA = 'P5AST::listop';
+package P5AST::op_pack; @ISA = 'P5AST::listop';
+package P5AST::op_split; @ISA = 'P5AST::listop';
+package P5AST::op_join; @ISA = 'P5AST::listop';
+package P5AST::op_list; @ISA = 'P5AST::listop';
+package P5AST::op_lslice; @ISA = 'P5AST::binop';
+package P5AST::op_anonlist; @ISA = 'P5AST::listop';
+package P5AST::op_anonhash; @ISA = 'P5AST::listop';
+package P5AST::op_splice; @ISA = 'P5AST::listop';
+package P5AST::op_push; @ISA = 'P5AST::listop';
+package P5AST::op_pop; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_shift; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_unshift; @ISA = 'P5AST::listop';
+package P5AST::op_sort; @ISA = 'P5AST::listop';
+package P5AST::op_reverse; @ISA = 'P5AST::listop';
+package P5AST::op_grepstart; @ISA = 'P5AST::listop';
+package P5AST::op_grepwhile; @ISA = 'P5AST::logop';
+package P5AST::op_mapstart; @ISA = 'P5AST::listop';
+package P5AST::op_mapwhile; @ISA = 'P5AST::logop';
+package P5AST::op_range; @ISA = 'P5AST::logop';
+package P5AST::op_flip; @ISA = 'P5AST::unop';
+package P5AST::op_flop; @ISA = 'P5AST::unop';
+package P5AST::op_and; @ISA = 'P5AST::logop';
+package P5AST::op_or; @ISA = 'P5AST::logop';
+package P5AST::op_xor; @ISA = 'P5AST::binop';
+package P5AST::op_cond_expr; @ISA = 'P5AST::logop';
+package P5AST::op_andassign; @ISA = 'P5AST::logop';
+package P5AST::op_orassign; @ISA = 'P5AST::logop';
+package P5AST::op_method; @ISA = 'P5AST::unop';
+package P5AST::op_entersub; @ISA = 'P5AST::unop';
+package P5AST::op_leavesub; @ISA = 'P5AST::unop';
+package P5AST::op_leavesublv; @ISA = 'P5AST::unop';
+package P5AST::op_caller; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_warn; @ISA = 'P5AST::listop';
+package P5AST::op_die; @ISA = 'P5AST::listop';
+package P5AST::op_reset; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_lineseq; @ISA = 'P5AST::listop';
+package P5AST::op_nextstate; @ISA = 'P5AST::BAD';
+package P5AST::op_dbstate; @ISA = 'P5AST::cop';
+package P5AST::op_unstack; @ISA = 'P5AST::baseop';
+package P5AST::op_enter; @ISA = 'P5AST::baseop';
+package P5AST::op_leave; @ISA = 'P5AST::listop';
+package P5AST::op_scope; @ISA = 'P5AST::listop';
+package P5AST::op_enteriter; @ISA = 'P5AST::loop';
+package P5AST::op_iter; @ISA = 'P5AST::baseop';
+package P5AST::op_enterloop; @ISA = 'P5AST::loop';
+package P5AST::op_leaveloop; @ISA = 'P5AST::binop';
+package P5AST::op_return; @ISA = 'P5AST::listop';
+package P5AST::op_last; @ISA = 'P5AST::loopexop';
+package P5AST::op_next; @ISA = 'P5AST::loopexop';
+package P5AST::op_redo; @ISA = 'P5AST::loopexop';
+package P5AST::op_dump; @ISA = 'P5AST::loopexop';
+package P5AST::op_goto; @ISA = 'P5AST::loopexop';
+package P5AST::op_exit; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_open; @ISA = 'P5AST::listop';
+package P5AST::op_close; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_pipe_op; @ISA = 'P5AST::listop';
+package P5AST::op_fileno; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_umask; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_binmode; @ISA = 'P5AST::listop';
+package P5AST::op_tie; @ISA = 'P5AST::listop';
+package P5AST::op_untie; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_tied; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_dbmopen; @ISA = 'P5AST::listop';
+package P5AST::op_dbmclose; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_sselect; @ISA = 'P5AST::listop';
+package P5AST::op_select; @ISA = 'P5AST::listop';
+package P5AST::op_getc; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_read; @ISA = 'P5AST::listop';
+package P5AST::op_enterwrite; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_leavewrite; @ISA = 'P5AST::unop';
+package P5AST::op_prtf; @ISA = 'P5AST::listop';
+package P5AST::op_print; @ISA = 'P5AST::listop';
+package P5AST::op_sysopen; @ISA = 'P5AST::listop';
+package P5AST::op_sysseek; @ISA = 'P5AST::listop';
+package P5AST::op_sysread; @ISA = 'P5AST::listop';
+package P5AST::op_syswrite; @ISA = 'P5AST::listop';
+package P5AST::op_send; @ISA = 'P5AST::listop';
+package P5AST::op_recv; @ISA = 'P5AST::listop';
+package P5AST::op_eof; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_tell; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_seek; @ISA = 'P5AST::listop';
+package P5AST::op_truncate; @ISA = 'P5AST::listop';
+package P5AST::op_fcntl; @ISA = 'P5AST::listop';
+package P5AST::op_ioctl; @ISA = 'P5AST::listop';
+package P5AST::op_flock; @ISA = 'P5AST::listop';
+package P5AST::op_socket; @ISA = 'P5AST::listop';
+package P5AST::op_sockpair; @ISA = 'P5AST::listop';
+package P5AST::op_bind; @ISA = 'P5AST::listop';
+package P5AST::op_connect; @ISA = 'P5AST::listop';
+package P5AST::op_listen; @ISA = 'P5AST::listop';
+package P5AST::op_accept; @ISA = 'P5AST::listop';
+package P5AST::op_shutdown; @ISA = 'P5AST::listop';
+package P5AST::op_gsockopt; @ISA = 'P5AST::listop';
+package P5AST::op_ssockopt; @ISA = 'P5AST::listop';
+package P5AST::op_getsockname; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_getpeername; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_lstat; @ISA = 'P5AST::filestatop';
+package P5AST::op_stat; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftrread; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftrwrite; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftrexec; @ISA = 'P5AST::filestatop';
+package P5AST::op_fteread; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftewrite; @ISA = 'P5AST::filestatop';
+package P5AST::op_fteexec; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftis; @ISA = 'P5AST::filestatop';
+package P5AST::op_fteowned; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftrowned; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftzero; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftsize; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftmtime; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftatime; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftctime; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftsock; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftchr; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftblk; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftfile; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftdir; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftpipe; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftlink; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftsuid; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftsgid; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftsvtx; @ISA = 'P5AST::filestatop';
+package P5AST::op_fttty; @ISA = 'P5AST::filestatop';
+package P5AST::op_fttext; @ISA = 'P5AST::filestatop';
+package P5AST::op_ftbinary; @ISA = 'P5AST::filestatop';
+package P5AST::op_chdir; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_chown; @ISA = 'P5AST::listop';
+package P5AST::op_chroot; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_unlink; @ISA = 'P5AST::listop';
+package P5AST::op_chmod; @ISA = 'P5AST::listop';
+package P5AST::op_utime; @ISA = 'P5AST::listop';
+package P5AST::op_rename; @ISA = 'P5AST::listop';
+package P5AST::op_link; @ISA = 'P5AST::listop';
+package P5AST::op_symlink; @ISA = 'P5AST::listop';
+package P5AST::op_readlink; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_mkdir; @ISA = 'P5AST::listop';
+package P5AST::op_rmdir; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_open_dir; @ISA = 'P5AST::listop';
+package P5AST::op_readdir; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_telldir; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_seekdir; @ISA = 'P5AST::listop';
+package P5AST::op_rewinddir; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_closedir; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_fork; @ISA = 'P5AST::baseop';
+package P5AST::op_wait; @ISA = 'P5AST::baseop';
+package P5AST::op_waitpid; @ISA = 'P5AST::listop';
+package P5AST::op_system; @ISA = 'P5AST::listop';
+package P5AST::op_exec; @ISA = 'P5AST::listop';
+package P5AST::op_kill; @ISA = 'P5AST::listop';
+package P5AST::op_getppid; @ISA = 'P5AST::baseop';
+package P5AST::op_getpgrp; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_setpgrp; @ISA = 'P5AST::listop';
+package P5AST::op_getpriority; @ISA = 'P5AST::listop';
+package P5AST::op_setpriority; @ISA = 'P5AST::listop';
+package P5AST::op_time; @ISA = 'P5AST::baseop';
+package P5AST::op_tms; @ISA = 'P5AST::baseop';
+package P5AST::op_localtime; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_gmtime; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_alarm; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_sleep; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_shmget; @ISA = 'P5AST::listop';
+package P5AST::op_shmctl; @ISA = 'P5AST::listop';
+package P5AST::op_shmread; @ISA = 'P5AST::listop';
+package P5AST::op_shmwrite; @ISA = 'P5AST::listop';
+package P5AST::op_msgget; @ISA = 'P5AST::listop';
+package P5AST::op_msgctl; @ISA = 'P5AST::listop';
+package P5AST::op_msgsnd; @ISA = 'P5AST::listop';
+package P5AST::op_msgrcv; @ISA = 'P5AST::listop';
+package P5AST::op_semget; @ISA = 'P5AST::listop';
+package P5AST::op_semctl; @ISA = 'P5AST::listop';
+package P5AST::op_semop; @ISA = 'P5AST::listop';
+package P5AST::op_require; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_dofile; @ISA = 'P5AST::unop';
+package P5AST::op_entereval; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_leaveeval; @ISA = 'P5AST::unop';
+package P5AST::op_entertry; @ISA = 'P5AST::logop';
+package P5AST::op_leavetry; @ISA = 'P5AST::listop';
+package P5AST::op_ghbyname; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_ghbyaddr; @ISA = 'P5AST::listop';
+package P5AST::op_ghostent; @ISA = 'P5AST::baseop';
+package P5AST::op_gnbyname; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_gnbyaddr; @ISA = 'P5AST::listop';
+package P5AST::op_gnetent; @ISA = 'P5AST::baseop';
+package P5AST::op_gpbyname; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_gpbynumber; @ISA = 'P5AST::listop';
+package P5AST::op_gprotoent; @ISA = 'P5AST::baseop';
+package P5AST::op_gsbyname; @ISA = 'P5AST::listop';
+package P5AST::op_gsbyport; @ISA = 'P5AST::listop';
+package P5AST::op_gservent; @ISA = 'P5AST::baseop';
+package P5AST::op_shostent; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_snetent; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_sprotoent; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_sservent; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_ehostent; @ISA = 'P5AST::baseop';
+package P5AST::op_enetent; @ISA = 'P5AST::baseop';
+package P5AST::op_eprotoent; @ISA = 'P5AST::baseop';
+package P5AST::op_eservent; @ISA = 'P5AST::baseop';
+package P5AST::op_gpwnam; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_gpwuid; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_gpwent; @ISA = 'P5AST::baseop';
+package P5AST::op_spwent; @ISA = 'P5AST::baseop';
+package P5AST::op_epwent; @ISA = 'P5AST::baseop';
+package P5AST::op_ggrnam; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_ggrgid; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_ggrent; @ISA = 'P5AST::baseop';
+package P5AST::op_sgrent; @ISA = 'P5AST::baseop';
+package P5AST::op_egrent; @ISA = 'P5AST::baseop';
+package P5AST::op_getlogin; @ISA = 'P5AST::baseop';
+package P5AST::op_syscall; @ISA = 'P5AST::listop';
+package P5AST::op_lock; @ISA = 'P5AST::baseop_unop';
+package P5AST::op_threadsv; @ISA = 'P5AST::baseop';
+package P5AST::op_setstate; @ISA = 'P5AST::cop';
+package P5AST::op_method_named; @ISA = 'P5AST::padop_svop';
+package P5AST::op_dor; @ISA = 'P5AST::logop';
+package P5AST::op_dorassign; @ISA = 'P5AST::logop';
+package P5AST::op_custom; @ISA = 'P5AST::baseop';
+
+# New node types (implicit types within perl)
+
+package P5AST::statement; @ISA = 'P5AST::cop';
+package P5AST::peg; @ISA = 'P5AST::baseop';
+package P5AST::parens; @ISA = 'P5AST::baseop';
+package P5AST::bindop; @ISA = 'P5AST::baseop';
+package P5AST::nothing; @ISA = 'P5AST::baseop';
+package P5AST::condstate; @ISA = 'P5AST::logop';
+package P5AST::use; @ISA = 'P5AST::baseop';
+package P5AST::ternary; @ISA = 'P5AST::baseop';
+package P5AST::sub; @ISA = 'P5AST::baseop';
+package P5AST::condmod; @ISA = 'P5AST::logop';
+package P5AST::package; @ISA = 'P5AST::baseop';
+package P5AST::format; @ISA = 'P5AST::baseop';
+package P5AST::qwliteral; @ISA = 'P5AST::baseop';
+package P5AST::quote; @ISA = 'P5AST::baseop';
+package P5AST::token; @ISA = 'P5AST::baseop';
+package P5AST::attrlist; @ISA = 'P5AST::baseop';
+package P5AST::listelem; @ISA = 'P5AST::baseop';
+package P5AST::preplus; @ISA = 'P5AST::baseop';
+package P5AST::doblock; @ISA = 'P5AST::baseop';
+package P5AST::cfor; @ISA = 'P5AST::baseop';
+package P5AST::pmop; @ISA = 'P5AST::baseop';
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+my $depth = 0;
+my $in = "";
+my $delim = 1;
+
+package P5RE;
+
+our $extended;
+our $insensitive;
+our $singleline;
+our $multiline;
+
+my %xmlish = (
+ chr(0x00) => "STUPIDXML(#x00)",
+ chr(0x01) => "STUPIDXML(#x01)",
+ chr(0x02) => "STUPIDXML(#x02)",
+ chr(0x03) => "STUPIDXML(#x03)",
+ chr(0x04) => "STUPIDXML(#x04)",
+ chr(0x05) => "STUPIDXML(#x05)",
+ chr(0x06) => "STUPIDXML(#x06)",
+ chr(0x07) => "STUPIDXML(#x07)",
+ chr(0x08) => "STUPIDXML(#x08)",
+ chr(0x09) => "	",
+ chr(0x0a) => " ",
+ chr(0x0b) => "STUPIDXML(#x0b)",
+ chr(0x0c) => "STUPIDXML(#x0c)",
+ chr(0x0d) => " ",
+ chr(0x0e) => "STUPIDXML(#x0e)",
+ chr(0x0f) => "STUPIDXML(#x0f)",
+ chr(0x10) => "STUPIDXML(#x10)",
+ chr(0x11) => "STUPIDXML(#x11)",
+ chr(0x12) => "STUPIDXML(#x12)",
+ chr(0x13) => "STUPIDXML(#x13)",
+ chr(0x14) => "STUPIDXML(#x14)",
+ chr(0x15) => "STUPIDXML(#x15)",
+ chr(0x16) => "STUPIDXML(#x16)",
+ chr(0x17) => "STUPIDXML(#x17)",
+ chr(0x18) => "STUPIDXML(#x18)",
+ chr(0x19) => "STUPIDXML(#x19)",
+ chr(0x1a) => "STUPIDXML(#x1a)",
+ chr(0x1b) => "STUPIDXML(#x1b)",
+ chr(0x1c) => "STUPIDXML(#x1c)",
+ chr(0x1d) => "STUPIDXML(#x1d)",
+ chr(0x1e) => "STUPIDXML(#x1e)",
+ chr(0x1f) => "STUPIDXML(#x1f)",
+ chr(0x7f) => "STUPIDXML(#x7f)",
+ chr(0x80) => "STUPIDXML(#x80)",
+ chr(0x81) => "STUPIDXML(#x81)",
+ chr(0x82) => "STUPIDXML(#x82)",
+ chr(0x83) => "STUPIDXML(#x83)",
+ chr(0x84) => "STUPIDXML(#x84)",
+ chr(0x86) => "STUPIDXML(#x86)",
+ chr(0x87) => "STUPIDXML(#x87)",
+ chr(0x88) => "STUPIDXML(#x88)",
+ chr(0x89) => "STUPIDXML(#x89)",
+ chr(0x90) => "STUPIDXML(#x90)",
+ chr(0x91) => "STUPIDXML(#x91)",
+ chr(0x92) => "STUPIDXML(#x92)",
+ chr(0x93) => "STUPIDXML(#x93)",
+ chr(0x94) => "STUPIDXML(#x94)",
+ chr(0x95) => "STUPIDXML(#x95)",
+ chr(0x96) => "STUPIDXML(#x96)",
+ chr(0x97) => "STUPIDXML(#x97)",
+ chr(0x98) => "STUPIDXML(#x98)",
+ chr(0x99) => "STUPIDXML(#x99)",
+ chr(0x9a) => "STUPIDXML(#x9a)",
+ chr(0x9b) => "STUPIDXML(#x9b)",
+ chr(0x9c) => "STUPIDXML(#x9c)",
+ chr(0x9d) => "STUPIDXML(#x9d)",
+ chr(0x9e) => "STUPIDXML(#x9e)",
+ chr(0x9f) => "STUPIDXML(#x9f)",
+ '<' => "<",
+ '>' => ">",
+ '&' => "&",
+ '"' => """, # XML idiocy
+);
+
+sub xmlquote {
+ my $text = shift;
+ $text =~ s/(.)/$xmlish{$1} || $1/seg;
+ return $text;
+}
+
+sub text {
+ my $self = shift;
+ return xmlquote($self->{text});
+}
+
+sub rep {
+ my $self = shift;
+ return xmlquote($self->{rep});
+}
+
+sub xmlkids {
+ my $self = shift;
+ my $array = $self->{Kids};
+ my $ret = "";
+ $depth++;
+ $in = ' ' x ($depth * 2);
+ foreach my $chunk (@$array) {
+ if (ref $chunk eq "ARRAY") {
+ die;
+ }
+ elsif (ref $chunk) {
+ $ret .= $chunk->xml();
+ }
+ else {
+ warn $chunk;
+ }
+ }
+ $depth--;
+ $in = ' ' x ($depth * 2);
+ return $ret;
+};
+
+package P5RE::RE; BEGIN { our @ISA = 'P5RE'; }
+
+sub xml {
+ my $self = shift;
+ my $kind = $self->{kind};
+ my $modifiers = $self->{modifiers} || "";
+ if ($modifiers) {
+ $modifiers = " modifiers=\"$modifiers\"";
+ }
+ my $text = "$in<$kind$modifiers>\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</$kind>\n";
+ return $text;
+}
+
+package P5RE::Alt; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ my $text = "$in<alt>\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</alt>\n";
+ return $text;
+}
+
+#package P5RE::Atom; our @ISA = 'P5RE';
+#
+#sub xml {
+# my $self = shift;
+# my $text = "$in<atom>\n";
+# $text .= $self->xmlkids();
+# $text .= "$in</atom>\n";
+# return $text;
+#}
+
+package P5RE::Quant; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ my $q = $self->{type};
+ my $text = "$in<quant type=\"$q\">\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</quant>\n";
+ return $text;
+}
+
+package P5RE::White; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ return "$in<white text=\"" . $self->text() . "\" />\n";
+}
+
+package P5RE::Char; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ return "$in<char text=\"" . $self->text() . "\" />\n";
+}
+
+package P5RE::Comment; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ return "$in<comment rep=\"" . $self->rep() . "\" />\n";
+}
+
+package P5RE::Mod; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ return "$in<mod modifiers=\"" . $self->{modifiers} . "\" />\n";
+}
+
+package P5RE::Meta; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ my $sem = "";
+ if ($self->{sem}) {
+ $sem = 'sem="' . $self->{sem} . '" '
+ }
+ return "$in<meta rep=\"" . $self->rep() . "\" $sem/>\n";
+}
+
+package P5RE::Var; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ return "$in<var name=\"" . $self->{name} . "\" />\n";
+}
+
+package P5RE::Closure; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ return "$in<closure rep=\"" . $self->{rep} . "\" />\n";
+}
+
+package P5RE::CClass; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ my $neg = $self->{neg} ? "negated" : "normal";
+ my $text = "$in<cclass match=\"$neg\">\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</cclass>\n";
+ return $text;
+}
+
+package P5RE::Range; our @ISA = 'P5RE';
+
+sub xml {
+ my $self = shift;
+ my $text = "$in<range>\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</range>\n";
+ return $text;
+}
+
+package P5RE;
+
+sub re {
+ my $kind = shift;
+ my @alts;
+
+ push(@alts, alt());
+
+ while (s/^\|//) {
+ push(@alts, alt());
+ }
+ return bless { Kids => [@alts], kind => $kind }, "P5RE::RE";
+}
+
+sub alt {
+ my @quants;
+
+ my $quant;
+ local $extended = $extended;
+ local $insensitive = $insensitive;
+ local $multiline = $multiline;
+ local $singleline = $singleline;
+ while ($quant = quant()) {
+ if (@quants and
+ ref $quant eq ref $quants[-1] and
+ exists $quants[-1]{text} and
+ exists $quant->{text} )
+ {
+ $quants[-1]{text} .= $quant->{text};
+ }
+ else {
+ push(@quants, $quant);
+ }
+ }
+ return bless { Kids => [@quants] }, "P5RE::Alt";
+}
+
+sub quant {
+ my $atom = atom();
+ return 0 unless $atom;
+# $atom = bless { Kids => [$atom] }, "P5RE::Atom";
+ if (s/^([*+?]\??|\{\d+(?:,\d*)?\}\??)//) {
+ return bless { Kids => [$atom], type => $1 }, "P5RE::Quant";
+ }
+ return $atom;
+}
+
+sub atom {
+ my $re;
+ if ($_ eq "") { return 0 }
+ if (/^[)|]/) { return 0 }
+
+ # whitespace is special because we don't know if /x is in effect
+ if ($extended) {
+ if (s/^(?=\s|#)(\s*(?:#.*)?)//) { return bless { text => $1 }, "P5RE::White"; }
+ }
+
+ # all the parenthesized forms
+ if (s/^\(//) {
+ if (s/^\?://) {
+ $re = re('bracket');
+ }
+ elsif (s/^(\?#.*?)\)/)/) {
+ $re = bless { rep => "($1)" }, "P5RE::Comment";
+ }
+ elsif (s/^\?=//) {
+ $re = re('lookahead');
+ }
+ elsif (s/^\?!//) {
+ $re = re('neglookahead');
+ }
+ elsif (s/^\?<=//) {
+ $re = re('lookbehind');
+ }
+ elsif (s/^\?<!//) {
+ $re = re('neglookbehind');
+ }
+ elsif (s/^\?>//) {
+ $re = re('nobacktrack');
+ }
+ elsif (s/^(\?\??\{.*?\})\)/)/) {
+ $re = bless { rep => "($1)" }, "P5RE::Closure";
+ }
+ elsif (s/^(\?\(\d+\))//) {
+ my $mods = $1;
+ $re = re('conditional');
+ $re->{modifiers} = "$mods";
+ }
+ elsif (s/^\?(?=\(\?)//) {
+ my $mods = $1;
+ my $cond = atom();
+ $re = re('conditional');
+ unshift(@{$re->{Kids}}, $cond);
+ }
+ elsif (s/^(\?[-imsx]+)://) {
+ my $mods = $1;
+ local $extended = $extended;
+ local $insensitive = $insensitive;
+ local $multiline = $multiline;
+ local $singleline = $singleline;
+ setmods($mods);
+ $re = re('bracket');
+ $re->{modifiers} = "$mods";
+ }
+ elsif (s/^(\?[-imsx]+)//) {
+ my $mods = $1;
+ $re = bless { modifiers => "($mods)" }, "P5RE::Mod";
+ setmods($mods);
+ }
+ elsif (s/^\?//) {
+ $re = re('UNRECOGNIZED');
+ }
+ else {
+ $re = re('capture');
+ }
+
+ if (not s/^\)//) { die "Expected right paren at: '$_'" }
+ return $re;
+ }
+
+ # special meta
+ if (s/^\.//) {
+ my $s = $singleline ? '.' : '\N';
+ return bless { rep => '.', sem => $s }, "P5RE::Meta";
+ }
+ if (s/^\^//) {
+ my $s = $multiline ? '^^' : '^';
+ return bless { rep => '^', sem => $s }, "P5RE::Meta";
+ }
+ if (s/^\$(?:$|(?=[|)]))//) {
+ my $s = $multiline ? '$$' : '$';
+ return bless { rep => '$', sem => $s }, "P5RE::Meta";
+ }
+ if (s/^([\$\@](\w+|.))//) { # XXX need to handle subscripts here
+ return bless { name => $1 }, "P5RE::Var";
+ }
+
+ # character classes
+ if (s/^\[//) {
+ my $re = cclass();
+ if (not s/^\]//) { die "Expected right paren at: '$_'" }
+ return $re;
+ }
+
+ # backwhacks
+ if (/^\\(?=.)/) {
+ return bless { rep => onechar() }, "P5RE::Meta";
+ }
+
+ # optimization, would happen anyway
+ if (s/^(\w+)//) { return bless { text => $1 }, "P5RE::Char"; }
+
+ # random character
+ if (s/^(.)//) { return bless { text => $1 }, "P5RE::Char"; }
+}
+
+sub cclass {
+ my @cclass;
+ my $cclass = "";
+ my $neg = 0;
+ if (s/^\^//) { $neg = 1 }
+ if (s/^([\]\-])//) { $cclass .= $1 }
+
+ while ($_ ne "" and not /^\]/) {
+ # backwhacks
+ if (/^\\(?=.)|.-/) {
+ my $o1 = onecharobj();
+ if ($cclass ne "") {
+ push @cclass, bless { text => $cclass }, "P5RE::Char";
+ $cclass = "";
+ }
+
+ if (s/^-(?=[^]])//) {
+ my $o2 = onecharobj();
+ push @cclass, bless { Kids => [$o1, $o2] }, "P5RE::Range";
+ }
+ else {
+ push @cclass, $o1;
+ }
+ }
+ elsif (s/^(\[([:=.])\^?\w*\2\])//) {
+ if ($cclass ne "") {
+ push @cclass, bless { text => $cclass }, "P5RE::Char";
+ $cclass = "";
+ }
+ push @cclass, bless { rep => $1 }, "P5RE::Meta";
+ }
+ else {
+ $cclass .= onechar();
+ }
+ }
+
+ if ($cclass ne "") {
+ push @cclass, bless { text => $cclass }, "P5RE::Char";
+ }
+ return bless { Kids => [@cclass], neg => $neg }, "P5RE::CClass";
+}
+
+sub onecharobj {
+ my $ch = onechar();
+ if ($ch =~ /^\\/) {
+ $ch = bless { rep => $ch }, "P5RE::Meta";
+ }
+ else {
+ $ch = bless { text => $ch }, "P5RE::Char";
+ }
+}
+
+sub onechar {
+ die "Oops, short cclass" unless s/^(.)//;
+ my $ch = $1;
+ if ($ch eq '\\') {
+ if (s/^([rntf]|[0-7]{1,4})//) { $ch .= $1 }
+ elsif (s/^(x[0-9a-fA-f]{1,2})//) { $ch .= $1 }
+ elsif (s/^(x\{[0-9a-fA-f]+\})//) { $ch .= $1 }
+ elsif (s/^([NpP]\{.*?\})//) { $ch .= $1 }
+ elsif (s/^([cpP].)//) { $ch .= $1 }
+ elsif (s/^(.)//) { $ch .= $1 }
+ else {
+ die "Oops, short backwhack";
+ }
+ }
+ return $ch;
+}
+
+sub setmods {
+ my $mods = shift;
+ if ($mods =~ /\-.*x/) {
+ $extended = 0;
+ }
+ elsif ($mods =~ /x/) {
+ $extended = 1;
+ }
+ if ($mods =~ /\-.*i/) {
+ $insensitive = 0;
+ }
+ elsif ($mods =~ /i/) {
+ $insensitive = 1;
+ }
+ if ($mods =~ /\-.*m/) {
+ $multiline = 0;
+ }
+ elsif ($mods =~ /m/) {
+ $multiline = 1;
+ }
+ if ($mods =~ /\-.*s/) {
+ $singleline = 0;
+ }
+ elsif ($mods =~ /s/) {
+ $singleline = 1;
+ }
+}
+
+sub reparse {
+ local $_ = shift;
+ s/^(\W)(.*)\1(\w*)$/$2/;
+ my $mod = $3;
+ substr($_,0,0) = "(?$mod)" if $mod ne "";
+ print $_,"\n";
+ return re('re');
+}
+
+if (not caller) {
+ while (my $line = <>) {
+ chop $line;
+ my $x = P5RE::reparse($line);
+ print $x->xml();
+ print "#######################################\n";
+ }
+}
+
--- /dev/null
+#!/usr/bin/perl
+
+# Copyright (C) 2005, Larry Wall
+# This software may be copied under the same terms as Perl.
+
+package P5re;
+
+use strict;
+use warnings;
+
+our @EXPORT_OK = qw(re re2xml qr2xml);
+
+my $indent = 0;
+my $in = "";
+my $delim = 1;
+my $debug = 0;
+my $maxbrack;
+
+our $extended;
+our $insensitive;
+our $singleline;
+our $multiline;
+
+my %xmlish = (
+ chr(0x00) => "STUPIDXML(#x00)",
+ chr(0x01) => "STUPIDXML(#x01)",
+ chr(0x02) => "STUPIDXML(#x02)",
+ chr(0x03) => "STUPIDXML(#x03)",
+ chr(0x04) => "STUPIDXML(#x04)",
+ chr(0x05) => "STUPIDXML(#x05)",
+ chr(0x06) => "STUPIDXML(#x06)",
+ chr(0x07) => "STUPIDXML(#x07)",
+ chr(0x08) => "STUPIDXML(#x08)",
+ chr(0x09) => "	",
+ chr(0x0a) => " ",
+ chr(0x0b) => "STUPIDXML(#x0b)",
+ chr(0x0c) => "STUPIDXML(#x0c)",
+ chr(0x0d) => " ",
+ chr(0x0e) => "STUPIDXML(#x0e)",
+ chr(0x0f) => "STUPIDXML(#x0f)",
+ chr(0x10) => "STUPIDXML(#x10)",
+ chr(0x11) => "STUPIDXML(#x11)",
+ chr(0x12) => "STUPIDXML(#x12)",
+ chr(0x13) => "STUPIDXML(#x13)",
+ chr(0x14) => "STUPIDXML(#x14)",
+ chr(0x15) => "STUPIDXML(#x15)",
+ chr(0x16) => "STUPIDXML(#x16)",
+ chr(0x17) => "STUPIDXML(#x17)",
+ chr(0x18) => "STUPIDXML(#x18)",
+ chr(0x19) => "STUPIDXML(#x19)",
+ chr(0x1a) => "STUPIDXML(#x1a)",
+ chr(0x1b) => "STUPIDXML(#x1b)",
+ chr(0x1c) => "STUPIDXML(#x1c)",
+ chr(0x1d) => "STUPIDXML(#x1d)",
+ chr(0x1e) => "STUPIDXML(#x1e)",
+ chr(0x1f) => "STUPIDXML(#x1f)",
+ chr(0x7f) => "STUPIDXML(#x7f)",
+ chr(0x80) => "STUPIDXML(#x80)",
+ chr(0x81) => "STUPIDXML(#x81)",
+ chr(0x82) => "STUPIDXML(#x82)",
+ chr(0x83) => "STUPIDXML(#x83)",
+ chr(0x84) => "STUPIDXML(#x84)",
+ chr(0x86) => "STUPIDXML(#x86)",
+ chr(0x87) => "STUPIDXML(#x87)",
+ chr(0x88) => "STUPIDXML(#x88)",
+ chr(0x89) => "STUPIDXML(#x89)",
+ chr(0x90) => "STUPIDXML(#x90)",
+ chr(0x91) => "STUPIDXML(#x91)",
+ chr(0x92) => "STUPIDXML(#x92)",
+ chr(0x93) => "STUPIDXML(#x93)",
+ chr(0x94) => "STUPIDXML(#x94)",
+ chr(0x95) => "STUPIDXML(#x95)",
+ chr(0x96) => "STUPIDXML(#x96)",
+ chr(0x97) => "STUPIDXML(#x97)",
+ chr(0x98) => "STUPIDXML(#x98)",
+ chr(0x99) => "STUPIDXML(#x99)",
+ chr(0x9a) => "STUPIDXML(#x9a)",
+ chr(0x9b) => "STUPIDXML(#x9b)",
+ chr(0x9c) => "STUPIDXML(#x9c)",
+ chr(0x9d) => "STUPIDXML(#x9d)",
+ chr(0x9e) => "STUPIDXML(#x9e)",
+ chr(0x9f) => "STUPIDXML(#x9f)",
+ '<' => "<",
+ '>' => ">",
+ '&' => "&",
+ '"' => """, # XML idiocy
+);
+
+sub xmlquote {
+ my $text = shift;
+ $text =~ s/(.)/$xmlish{$1} || $1/seg;
+ return $text;
+}
+
+sub text {
+ my $self = shift;
+ return xmlquote($self->{text});
+}
+
+sub rep {
+ my $self = shift;
+ return xmlquote($self->{rep});
+}
+
+sub xmlkids {
+ my $self = shift;
+ my $array = $self->{Kids};
+ my $ret = "";
+ $indent += 2;
+ $in = ' ' x $indent;
+ foreach my $chunk (@$array) {
+ if (ref $chunk eq "ARRAY") {
+ die;
+ }
+ elsif (ref $chunk) {
+ $ret .= $chunk->xml();
+ }
+ else {
+ warn $chunk;
+ }
+ }
+ $indent -= 2;
+ $in = ' ' x $indent;
+ return $ret;
+};
+
+package P5re::RE; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ my %flags = @_;
+ if ($flags{indent}) {
+ $indent = delete $flags{indent} || 0;
+ $in = ' ' x $indent;
+ }
+
+ my $kind = $self->{kind};
+
+ my $first = $self->{Kids}[0];
+ if ($first and ref $first eq 'P5re::Mod') {
+ for my $c (qw(i m s x)) {
+ next unless defined $first->{$c};
+ $self->{$c} = $first->{$c};
+ delete $first->{$c};
+ }
+ }
+
+ my $modifiers = "";
+ foreach my $k (sort keys %$self) {
+ next if $k eq 'kind' or $k eq "Kids";
+ my $v = $self->{$k};
+ $k =~ s/^[A-Z]//;
+ $modifiers .= " $k=\"$v\"";
+ }
+ my $text = "$in<$kind$modifiers>\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</$kind>\n";
+ return $text;
+}
+
+package P5re::Alt; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ my $text = "$in<alt>\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</alt>\n";
+ return $text;
+}
+
+#package P5re::Atom; our @ISA = 'P5re';
+#
+#sub xml {
+# my $self = shift;
+# my $text = "$in<atom>\n";
+# $text .= $self->xmlkids();
+# $text .= "$in</atom>\n";
+# return $text;
+#}
+
+package P5re::Quant; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ my $q = $self->{rep};
+ my $min = $self->{min};
+ my $max = $self->{max};
+ my $greedy = $self->{greedy};
+ my $text = "$in<quant rep=\"$q\" min=\"$min\" max=\"$max\" greedy=\"$greedy\">\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</quant>\n";
+ return $text;
+}
+
+package P5re::White; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ return "$in<white text=\"" . $self->text() . "\" />\n";
+}
+
+package P5re::Char; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ return "$in<char text=\"" . $self->text() . "\" />\n";
+}
+
+package P5re::Comment; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ return "$in<comment rep=\"" . $self->rep() . "\" />\n";
+}
+
+package P5re::Mod; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ my $modifiers = "";
+ foreach my $k (sort keys %$self) {
+ next if $k eq 'kind' or $k eq "Kids";
+ my $v = $self->{$k};
+ $k =~ s/^[A-Z]//;
+ $modifiers .= " $k=\"$v\"";
+ }
+ return "$in<mod$modifiers />\n";
+}
+
+package P5re::Meta; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ my $sem = "";
+ if ($self->{sem}) {
+ $sem = 'sem="' . $self->{sem} . '" '
+ }
+ return "$in<meta rep=\"" . $self->rep() . "\" $sem/>\n";
+}
+
+package P5re::Back; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ return "$in<backref to=\"" . P5re::xmlquote($self->{to}) . "\"/>\n";
+}
+
+package P5re::Var; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ return "$in<var name=\"" . $self->{name} . "\" />\n";
+}
+
+package P5re::Closure; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ return "$in<closure rep=\"" . P5re::xmlquote($self->{rep}) . "\" />\n";
+}
+
+package P5re::CClass; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ my $neg = $self->{neg} ? "negated" : "normal";
+ my $text = "$in<cclass match=\"$neg\">\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</cclass>\n";
+ return $text;
+}
+
+package P5re::Range; our @ISA = 'P5re';
+
+sub xml {
+ my $self = shift;
+ my $text = "$in<range>\n";
+ $text .= $self->xmlkids();
+ $text .= "$in</range>\n";
+ return $text;
+}
+
+package P5re;
+
+unless (caller) {
+ while (<>) {
+ chomp;
+ print qr2xml($_);
+ print "#######################################\n";
+ }
+}
+
+sub qrparse {
+ my $qr = shift;
+ my $mod;
+ if ($qr =~ /^s/) {
+ $qr =~ s/^(?:\w*)(\W)((?:\\.|.)*?)\1(.*)\1(\w*)$/$2/;
+ $mod = $4;
+ }
+ else {
+ $qr =~ s/^(?:\w*)(\W)(.*)\1(\w*)$/$2/;
+ $mod = $3;
+ }
+ substr($qr,0,0) = "(?$mod)" if defined $mod and $mod ne "";
+ return parse($qr,@_);
+}
+
+sub qr2xml {
+ return qrparse(@_)->xml();
+}
+
+sub re2xml {
+ my $re = shift;
+ return parse($re,@_)->xml();
+}
+
+sub parse {
+ local($_) = shift;
+ my %flags = @_;
+ $maxbrack = 0;
+ $indent = delete $flags{indent} || 0;
+ $in = ' ' x $indent;
+ warn "$_\n" if $debug;
+ my $re = re('re');
+ @$re{keys %flags} = values %flags;
+ return $re;
+}
+
+sub re {
+ my $kind = shift;
+
+ my $oldextended = $extended;
+ my $oldinsensitive = $insensitive;
+ my $oldmultiline = $multiline;
+ my $oldsingleline = $singleline;
+
+ local $extended = $extended;
+ local $insensitive = $insensitive;
+ local $multiline = $multiline;
+ local $singleline = $singleline;
+
+ my $first = alt();
+
+ my $re;
+ if (not /^\|/) {
+ $first->{kind} = $kind;
+ $re = bless $first, "P5re::RE"; # rebless to remove single alt
+ }
+ else {
+ my @alts = ($first);
+
+ while (s/^\|//) {
+ push(@alts, alt());
+ }
+ $re = bless { Kids => [@alts], kind => $kind }, "P5re::RE";
+ }
+
+ $re->{x} = $oldextended || 0;
+ $re->{i} = $oldinsensitive || 0;
+ $re->{m} = $oldmultiline || 0;
+ $re->{s} = $oldsingleline || 0;
+ return $re;
+}
+
+sub alt {
+ my @quants;
+
+ my $quant;
+ while ($quant = quant()) {
+ if (@quants and
+ ref $quant eq ref $quants[-1] and
+ exists $quants[-1]{text} and
+ exists $quant->{text} )
+ {
+ $quants[-1]{text} .= $quant->{text};
+ }
+ else {
+ push(@quants, $quant);
+ }
+ }
+ return bless { Kids => [@quants] }, "P5re::Alt";
+}
+
+sub quant {
+ my $atom = atom();
+ return 0 unless $atom;
+# $atom = bless { Kids => [$atom] }, "P5re::Atom";
+ if (s/^(([*+?])(\??)|\{(\d+)(?:(,)(\d*))?\}(\??))//) {
+ my $min = 0;
+ my $max = "Inf";
+ my $greed = 1;
+ if ($2) {
+ if ($2 eq '+') {
+ $min = 1;
+ }
+ elsif ($2 eq '?') {
+ $max = 1;
+ }
+ $greed = 0 if $3;
+ }
+ elsif (defined $4) {
+ $min = $4;
+ if ($5) {
+ $max = $6 if $6;
+ }
+ else {
+ $max = $min;
+ }
+ $greed = 0 if $7;
+ }
+ $greed = "na" if $min == $max;
+ return bless { Kids => [$atom],
+ rep => $1,
+ min => $min,
+ max => $max,
+ greedy => $greed
+ }, "P5re::Quant";
+ }
+ return $atom;
+}
+
+sub atom {
+ my $re;
+ if ($_ eq "") { return 0 }
+ if (/^[)|]/) { return 0 }
+
+ # whitespace is special because we don't know if /x is in effect
+ if ($extended) {
+ if (s/^(?=\s|#)(\s*(?:#.*)?)//) { return bless { text => $1 }, "P5re::White"; }
+ }
+
+ # all the parenthesized forms
+ if (s/^\(//) {
+ if (s/^\?://) {
+ $re = re('bracket');
+ }
+ elsif (s/^(\?#.*?)\)/)/) {
+ $re = bless { rep => "($1)" }, "P5re::Comment";
+ }
+ elsif (s/^\?=//) {
+ $re = re('lookahead');
+ }
+ elsif (s/^\?!//) {
+ $re = re('neglookahead');
+ }
+ elsif (s/^\?<=//) {
+ $re = re('lookbehind');
+ }
+ elsif (s/^\?<!//) {
+ $re = re('neglookbehind');
+ }
+ elsif (s/^\?>//) {
+ $re = re('nobacktrack');
+ }
+ elsif (s/^(\?\??\{.*?\})\)/)/) {
+ $re = bless { rep => "($1)" }, "P5re::Closure";
+ }
+ elsif (s/^(\?\(\d+\))//) {
+ my $mods = $1;
+ $re = re('conditional');
+ $re->{Arep} = "$mods";
+ }
+ elsif (s/^\?(?=\(\?)//) {
+ my $mods = $1;
+ my $cond = atom();
+ $re = re('conditional');
+ unshift(@{$re->{Kids}}, $cond);
+ }
+ elsif (s/^(\?[-\w]+)://) {
+ my $mods = $1;
+ local $extended = $extended;
+ local $insensitive = $insensitive;
+ local $multiline = $multiline;
+ local $singleline = $singleline;
+ setmods($mods);
+ $re = re('bracket');
+ $re->{Arep} = "($mods)";
+ $re->{x} = $extended || 0;
+ $re->{i} = $insensitive || 0;
+ $re->{m} = $multiline || 0;
+ $re->{s} = $singleline || 0;
+ }
+ elsif (s/^(\?[-\w]+)//) {
+ my $mods = $1;
+ $re = bless { Arep => "($mods)" }, "P5re::Mod";
+ setmods($mods);
+ $re->{x} = $extended || 0;
+ $re->{i} = $insensitive || 0;
+ $re->{m} = $multiline || 0;
+ $re->{s} = $singleline || 0;
+ }
+ elsif (s/^\?//) {
+ $re = re('UNRECOGNIZED');
+ }
+ else {
+ my $brack = ++$maxbrack;
+ $re = re('capture');
+ $re->{Ato} = $brack;
+ }
+
+ if (not s/^\)//) { warn "Expected right paren at: '$_'" }
+ return $re;
+ }
+
+ # special meta
+ if (s/^\.//) {
+ my $s = $singleline ? '.' : '\N';
+ return bless { rep => '.', sem => $s }, "P5re::Meta";
+ }
+ if (s/^\^//) {
+ my $s = $multiline ? '^^' : '^';
+ return bless { rep => '^', sem => $s }, "P5re::Meta";
+ }
+ if (s/^\$(?:$|(?=[|)]))//) {
+ my $s = $multiline ? '$$' : '$';
+ return bless { rep => '$', sem => $s }, "P5re::Meta";
+ }
+ if (s/^([\$\@](\w+|.))//) { # XXX need to handle subscripts here
+ return bless { name => $1 }, "P5re::Var";
+ }
+
+ # character classes
+ if (s/^\[//) {
+ my $re = cclass();
+ if (not s/^\]//) { warn "Expected right bracket at: '$_'" }
+ return $re;
+ }
+
+ # backwhacks
+ if (/^\\([1-9]\d*)/ and $1 <= $maxbrack) {
+ my $to = $1;
+ onechar();
+ return bless { to => $to }, "P5re::Back";
+ }
+
+ # backwhacks
+ if (/^\\(?=\w)/) {
+ return bless { rep => onechar() }, "P5re::Meta";
+ }
+
+ # backwhacks
+ if (s/^\\(.)//) {
+ return bless { text => $1 }, "P5re::Char";
+ }
+
+ # optimization, would happen anyway
+ if (s/^(\w+)//) { return bless { text => $1 }, "P5re::Char"; }
+
+ # random character
+ if (s/^(.)//) { return bless { text => $1 }, "P5re::Char"; }
+}
+
+sub cclass {
+ my @cclass;
+ my $cclass = "";
+ my $neg = 0;
+ if (s/^\^//) { $neg = 1 }
+ if (s/^([\]\-])//) { $cclass .= $1 }
+
+ while ($_ ne "" and not /^\]/) {
+ # backwhacks
+ if (/^\\(?=.)|.-/) {
+ my $o1 = onecharobj();
+ if ($cclass ne "") {
+ push @cclass, bless { text => $cclass }, "P5re::Char";
+ $cclass = "";
+ }
+
+ if (s/^-(?=[^]])//) {
+ my $o2 = onecharobj();
+ push @cclass, bless { Kids => [$o1, $o2] }, "P5re::Range";
+ }
+ else {
+ push @cclass, $o1;
+ }
+ }
+ elsif (s/^(\[([:=.])\^?\w*\2\])//) {
+ if ($cclass ne "") {
+ push @cclass, bless { text => $cclass }, "P5re::Char";
+ $cclass = "";
+ }
+ push @cclass, bless { rep => $1 }, "P5re::Meta";
+ }
+ else {
+ $cclass .= onechar();
+ }
+ }
+
+ if ($cclass ne "") {
+ push @cclass, bless { text => $cclass }, "P5re::Char";
+ }
+ return bless { Kids => [@cclass], neg => $neg }, "P5re::CClass";
+}
+
+sub onecharobj {
+ my $ch = onechar();
+ if ($ch =~ /^\\/) {
+ $ch = bless { rep => $ch }, "P5re::Meta";
+ }
+ else {
+ $ch = bless { text => $ch }, "P5re::Char";
+ }
+}
+
+sub onechar {
+ die "Oops, short cclass" unless s/^(.)//;
+ my $ch = $1;
+ if ($ch eq '\\') {
+ if (s/^([rntf]|[0-7]{1,4})//) { $ch .= $1 }
+ elsif (s/^(x[0-9a-fA-f]{1,2})//) { $ch .= $1 }
+ elsif (s/^(x\{[0-9a-fA-f]+\})//) { $ch .= $1 }
+ elsif (s/^([NpP]\{.*?\})//) { $ch .= $1 }
+ elsif (s/^([cpP].)//) { $ch .= $1 }
+ elsif (s/^(.)//) { $ch .= $1 }
+ else {
+ die "Oops, short backwhack";
+ }
+ }
+ return $ch;
+}
+
+sub setmods {
+ my $mods = shift;
+ if ($mods =~ /\-.*x/) {
+ $extended = 0;
+ }
+ elsif ($mods =~ /x/) {
+ $extended = 1;
+ }
+ if ($mods =~ /\-.*i/) {
+ $insensitive = 0;
+ }
+ elsif ($mods =~ /i/) {
+ $insensitive = 1;
+ }
+ if ($mods =~ /\-.*m/) {
+ $multiline = 0;
+ }
+ elsif ($mods =~ /m/) {
+ $multiline = 1;
+ }
+ if ($mods =~ /\-.*s/) {
+ $singleline = 0;
+ }
+ elsif ($mods =~ /s/) {
+ $singleline = 1;
+ }
+}
+
+1;
--- /dev/null
+package PLXML;
+
+sub DESTROY { }
+
+sub walk {
+ print "walk(" . join(',', @_) . ")\n";
+ my $self = shift;
+ for my $key (sort keys %$self) {
+ print "\t$key = <$$self{$key}>\n";
+ }
+ foreach $kid (@{$$self{Kids}}) {
+ $kid->walk(@_);
+ }
+}
+
+package PLXML::Characters;
+
+@ISA = ('PLXML');
+sub walk {}
+
+package PLXML::madprops;
+
+@ISA = ('PLXML');
+
+package PLXML::mad_op;
+
+@ISA = ('PLXML');
+
+package PLXML::mad_pv;
+
+@ISA = ('PLXML');
+
+package PLXML::baseop;
+
+@ISA = ('PLXML');
+
+package PLXML::baseop_unop;
+
+@ISA = ('PLXML');
+
+package PLXML::binop;
+
+@ISA = ('PLXML');
+
+package PLXML::cop;
+
+@ISA = ('PLXML');
+
+package PLXML::filestatop;
+
+@ISA = ('PLXML::baseop_unop');
+
+package PLXML::listop;
+
+@ISA = ('PLXML');
+
+package PLXML::logop;
+
+@ISA = ('PLXML');
+
+package PLXML::loop;
+
+@ISA = ('PLXML');
+
+package PLXML::loopexop;
+
+@ISA = ('PLXML');
+
+package PLXML::padop;
+
+@ISA = ('PLXML');
+
+package PLXML::padop_svop;
+
+@ISA = ('PLXML');
+
+package PLXML::pmop;
+
+@ISA = ('PLXML');
+
+package PLXML::pvop_svop;
+
+@ISA = ('PLXML');
+
+package PLXML::unop;
+
+@ISA = ('PLXML');
+
+
+# New ops always go at the end, just before 'custom'
+
+# A recapitulation of the format of this file:
+# The file consists of five columns: the name of the op, an English
+# description, the name of the "check" routine used to optimize this
+# operation, some flags, and a description of the operands.
+
+# The flags consist of options followed by a mandatory op class signifier
+
+# The classes are:
+# baseop - 0 unop - 1 binop - 2
+# logop - | listop - @ pmop - /
+# padop/svop - $ padop - # (unused) loop - {
+# baseop/unop - % loopexop - } filestatop - -
+# pvop/svop - " cop - ;
+
+# Other options are:
+# needs stack mark - m
+# needs constant folding - f
+# produces a scalar - s
+# produces an integer - i
+# needs a target - t
+# target can be in a pad - T
+# has a corresponding integer version - I
+# has side effects - d
+# uses $_ if no argument given - u
+
+# Values for the operands are:
+# scalar - S list - L array - A
+# hash - H sub (CV) - C file - F
+# socket - Fs filetest - F- reference - R
+# "?" denotes an optional operand.
+
+# Nothing.
+
+package PLXML::op_null;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'null' }
+sub desc { 'null operation' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_stub;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'stub' }
+sub desc { 'stub' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_scalar;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'scalar' }
+sub desc { 'scalar' }
+sub check { 'ck_fun' }
+sub flags { 's%' }
+sub args { 'S' }
+
+
+
+# Pushy stuff.
+
+package PLXML::op_pushmark;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'pushmark' }
+sub desc { 'pushmark' }
+sub check { 'ck_null' }
+sub flags { 's0' }
+sub args { '' }
+
+
+package PLXML::op_wantarray;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'wantarray' }
+sub desc { 'wantarray' }
+sub check { 'ck_null' }
+sub flags { 'is0' }
+sub args { '' }
+
+
+
+package PLXML::op_const;
+
+@ISA = ('PLXML::padop_svop');
+
+sub key { 'const' }
+sub desc { 'constant item' }
+sub check { 'ck_svconst' }
+sub flags { 's$' }
+sub args { '' }
+
+
+
+package PLXML::op_gvsv;
+
+@ISA = ('PLXML::padop_svop');
+
+sub key { 'gvsv' }
+sub desc { 'scalar variable' }
+sub check { 'ck_null' }
+sub flags { 'ds$' }
+sub args { '' }
+
+
+package PLXML::op_gv;
+
+@ISA = ('PLXML::padop_svop');
+
+sub key { 'gv' }
+sub desc { 'glob value' }
+sub check { 'ck_null' }
+sub flags { 'ds$' }
+sub args { '' }
+
+
+package PLXML::op_gelem;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'gelem' }
+sub desc { 'glob elem' }
+sub check { 'ck_null' }
+sub flags { 'd2' }
+sub args { 'S S' }
+
+
+package PLXML::op_padsv;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'padsv' }
+sub desc { 'private variable' }
+sub check { 'ck_null' }
+sub flags { 'ds0' }
+sub args { '' }
+
+
+package PLXML::op_padav;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'padav' }
+sub desc { 'private array' }
+sub check { 'ck_null' }
+sub flags { 'd0' }
+sub args { '' }
+
+
+package PLXML::op_padhv;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'padhv' }
+sub desc { 'private hash' }
+sub check { 'ck_null' }
+sub flags { 'd0' }
+sub args { '' }
+
+
+package PLXML::op_padany;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'padany' }
+sub desc { 'private value' }
+sub check { 'ck_null' }
+sub flags { 'd0' }
+sub args { '' }
+
+
+
+package PLXML::op_pushre;
+
+@ISA = ('PLXML::pmop');
+
+sub key { 'pushre' }
+sub desc { 'push regexp' }
+sub check { 'ck_null' }
+sub flags { 'd/' }
+sub args { '' }
+
+
+
+# References and stuff.
+
+package PLXML::op_rv2gv;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'rv2gv' }
+sub desc { 'ref-to-glob cast' }
+sub check { 'ck_rvconst' }
+sub flags { 'ds1' }
+sub args { '' }
+
+
+package PLXML::op_rv2sv;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'rv2sv' }
+sub desc { 'scalar dereference' }
+sub check { 'ck_rvconst' }
+sub flags { 'ds1' }
+sub args { '' }
+
+
+package PLXML::op_av2arylen;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'av2arylen' }
+sub desc { 'array length' }
+sub check { 'ck_null' }
+sub flags { 'is1' }
+sub args { '' }
+
+
+package PLXML::op_rv2cv;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'rv2cv' }
+sub desc { 'subroutine dereference' }
+sub check { 'ck_rvconst' }
+sub flags { 'd1' }
+sub args { '' }
+
+
+package PLXML::op_anoncode;
+
+@ISA = ('PLXML::padop_svop');
+
+sub key { 'anoncode' }
+sub desc { 'anonymous subroutine' }
+sub check { 'ck_anoncode' }
+sub flags { '$' }
+sub args { '' }
+
+
+package PLXML::op_prototype;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'prototype' }
+sub desc { 'subroutine prototype' }
+sub check { 'ck_null' }
+sub flags { 's%' }
+sub args { 'S' }
+
+
+package PLXML::op_refgen;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'refgen' }
+sub desc { 'reference constructor' }
+sub check { 'ck_spair' }
+sub flags { 'm1' }
+sub args { 'L' }
+
+
+package PLXML::op_srefgen;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'srefgen' }
+sub desc { 'single ref constructor' }
+sub check { 'ck_null' }
+sub flags { 'fs1' }
+sub args { 'S' }
+
+
+package PLXML::op_ref;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'ref' }
+sub desc { 'reference-type operator' }
+sub check { 'ck_fun' }
+sub flags { 'stu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_bless;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'bless' }
+sub desc { 'bless' }
+sub check { 'ck_fun' }
+sub flags { 's@' }
+sub args { 'S S?' }
+
+
+
+# Pushy I/O.
+
+package PLXML::op_backtick;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'backtick' }
+sub desc { 'quoted execution (``, qx)' }
+sub check { 'ck_open' }
+sub flags { 't%' }
+sub args { '' }
+
+
+# glob defaults its first arg to $_
+package PLXML::op_glob;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'glob' }
+sub desc { 'glob' }
+sub check { 'ck_glob' }
+sub flags { 't@' }
+sub args { 'S?' }
+
+
+package PLXML::op_readline;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'readline' }
+sub desc { '<HANDLE>' }
+sub check { 'ck_null' }
+sub flags { 't%' }
+sub args { 'F?' }
+
+
+package PLXML::op_rcatline;
+
+@ISA = ('PLXML::padop_svop');
+
+sub key { 'rcatline' }
+sub desc { 'append I/O operator' }
+sub check { 'ck_null' }
+sub flags { 't$' }
+sub args { '' }
+
+
+
+# Bindable operators.
+
+package PLXML::op_regcmaybe;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'regcmaybe' }
+sub desc { 'regexp internal guard' }
+sub check { 'ck_fun' }
+sub flags { 's1' }
+sub args { 'S' }
+
+
+package PLXML::op_regcreset;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'regcreset' }
+sub desc { 'regexp internal reset' }
+sub check { 'ck_fun' }
+sub flags { 's1' }
+sub args { 'S' }
+
+
+package PLXML::op_regcomp;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'regcomp' }
+sub desc { 'regexp compilation' }
+sub check { 'ck_null' }
+sub flags { 's|' }
+sub args { 'S' }
+
+
+package PLXML::op_match;
+
+@ISA = ('PLXML::pmop');
+
+sub key { 'match' }
+sub desc { 'pattern match (m//)' }
+sub check { 'ck_match' }
+sub flags { 'd/' }
+sub args { '' }
+
+
+package PLXML::op_qr;
+
+@ISA = ('PLXML::pmop');
+
+sub key { 'qr' }
+sub desc { 'pattern quote (qr//)' }
+sub check { 'ck_match' }
+sub flags { 's/' }
+sub args { '' }
+
+
+package PLXML::op_subst;
+
+@ISA = ('PLXML::pmop');
+
+sub key { 'subst' }
+sub desc { 'substitution (s///)' }
+sub check { 'ck_match' }
+sub flags { 'dis/' }
+sub args { 'S' }
+
+
+package PLXML::op_substcont;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'substcont' }
+sub desc { 'substitution iterator' }
+sub check { 'ck_null' }
+sub flags { 'dis|' }
+sub args { '' }
+
+
+package PLXML::op_trans;
+
+@ISA = ('PLXML::pvop_svop');
+
+sub key { 'trans' }
+sub desc { 'transliteration (tr///)' }
+sub check { 'ck_match' }
+sub flags { 'is"' }
+sub args { 'S' }
+
+
+
+# Lvalue operators.
+# sassign is special-cased for op class
+
+package PLXML::op_sassign;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'sassign' }
+sub desc { 'scalar assignment' }
+sub check { 'ck_sassign' }
+sub flags { 's0' }
+sub args { '' }
+
+
+package PLXML::op_aassign;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'aassign' }
+sub desc { 'list assignment' }
+sub check { 'ck_null' }
+sub flags { 't2' }
+sub args { 'L L' }
+
+
+
+package PLXML::op_chop;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'chop' }
+sub desc { 'chop' }
+sub check { 'ck_spair' }
+sub flags { 'mts%' }
+sub args { 'L' }
+
+
+package PLXML::op_schop;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'schop' }
+sub desc { 'scalar chop' }
+sub check { 'ck_null' }
+sub flags { 'stu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_chomp;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'chomp' }
+sub desc { 'chomp' }
+sub check { 'ck_spair' }
+sub flags { 'mTs%' }
+sub args { 'L' }
+
+
+package PLXML::op_schomp;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'schomp' }
+sub desc { 'scalar chomp' }
+sub check { 'ck_null' }
+sub flags { 'sTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_defined;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'defined' }
+sub desc { 'defined operator' }
+sub check { 'ck_defined' }
+sub flags { 'isu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_undef;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'undef' }
+sub desc { 'undef operator' }
+sub check { 'ck_lfun' }
+sub flags { 's%' }
+sub args { 'S?' }
+
+
+package PLXML::op_study;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'study' }
+sub desc { 'study' }
+sub check { 'ck_fun' }
+sub flags { 'su%' }
+sub args { 'S?' }
+
+
+package PLXML::op_pos;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'pos' }
+sub desc { 'match position' }
+sub check { 'ck_lfun' }
+sub flags { 'stu%' }
+sub args { 'S?' }
+
+
+
+package PLXML::op_preinc;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'preinc' }
+sub desc { 'preincrement (++)' }
+sub check { 'ck_lfun' }
+sub flags { 'dIs1' }
+sub args { 'S' }
+
+
+package PLXML::op_i_preinc;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'i_preinc' }
+sub desc { 'integer preincrement (++)' }
+sub check { 'ck_lfun' }
+sub flags { 'dis1' }
+sub args { 'S' }
+
+
+package PLXML::op_predec;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'predec' }
+sub desc { 'predecrement (--)' }
+sub check { 'ck_lfun' }
+sub flags { 'dIs1' }
+sub args { 'S' }
+
+
+package PLXML::op_i_predec;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'i_predec' }
+sub desc { 'integer predecrement (--)' }
+sub check { 'ck_lfun' }
+sub flags { 'dis1' }
+sub args { 'S' }
+
+
+package PLXML::op_postinc;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'postinc' }
+sub desc { 'postincrement (++)' }
+sub check { 'ck_lfun' }
+sub flags { 'dIst1' }
+sub args { 'S' }
+
+
+package PLXML::op_i_postinc;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'i_postinc' }
+sub desc { 'integer postincrement (++)' }
+sub check { 'ck_lfun' }
+sub flags { 'disT1' }
+sub args { 'S' }
+
+
+package PLXML::op_postdec;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'postdec' }
+sub desc { 'postdecrement (--)' }
+sub check { 'ck_lfun' }
+sub flags { 'dIst1' }
+sub args { 'S' }
+
+
+package PLXML::op_i_postdec;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'i_postdec' }
+sub desc { 'integer postdecrement (--)' }
+sub check { 'ck_lfun' }
+sub flags { 'disT1' }
+sub args { 'S' }
+
+
+
+# Ordinary operators.
+
+package PLXML::op_pow;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'pow' }
+sub desc { 'exponentiation (**)' }
+sub check { 'ck_null' }
+sub flags { 'fsT2' }
+sub args { 'S S' }
+
+
+
+package PLXML::op_multiply;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'multiply' }
+sub desc { 'multiplication (*)' }
+sub check { 'ck_null' }
+sub flags { 'IfsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_multiply;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_multiply' }
+sub desc { 'integer multiplication (*)' }
+sub check { 'ck_null' }
+sub flags { 'ifsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_divide;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'divide' }
+sub desc { 'division (/)' }
+sub check { 'ck_null' }
+sub flags { 'IfsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_divide;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_divide' }
+sub desc { 'integer division (/)' }
+sub check { 'ck_null' }
+sub flags { 'ifsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_modulo;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'modulo' }
+sub desc { 'modulus (%)' }
+sub check { 'ck_null' }
+sub flags { 'IifsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_modulo;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_modulo' }
+sub desc { 'integer modulus (%)' }
+sub check { 'ck_null' }
+sub flags { 'ifsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_repeat;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'repeat' }
+sub desc { 'repeat (x)' }
+sub check { 'ck_repeat' }
+sub flags { 'mt2' }
+sub args { 'L S' }
+
+
+
+package PLXML::op_add;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'add' }
+sub desc { 'addition (+)' }
+sub check { 'ck_null' }
+sub flags { 'IfsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_add;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_add' }
+sub desc { 'integer addition (+)' }
+sub check { 'ck_null' }
+sub flags { 'ifsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_subtract;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'subtract' }
+sub desc { 'subtraction (-)' }
+sub check { 'ck_null' }
+sub flags { 'IfsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_subtract;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_subtract' }
+sub desc { 'integer subtraction (-)' }
+sub check { 'ck_null' }
+sub flags { 'ifsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_concat;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'concat' }
+sub desc { 'concatenation (.) or string' }
+sub check { 'ck_concat' }
+sub flags { 'fsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_stringify;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'stringify' }
+sub desc { 'string' }
+sub check { 'ck_fun' }
+sub flags { 'fsT@' }
+sub args { 'S' }
+
+
+
+package PLXML::op_left_shift;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'left_shift' }
+sub desc { 'left bitshift (<<)' }
+sub check { 'ck_bitop' }
+sub flags { 'fsT2' }
+sub args { 'S S' }
+
+
+package PLXML::op_right_shift;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'right_shift' }
+sub desc { 'right bitshift (>>)' }
+sub check { 'ck_bitop' }
+sub flags { 'fsT2' }
+sub args { 'S S' }
+
+
+
+package PLXML::op_lt;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'lt' }
+sub desc { 'numeric lt (<)' }
+sub check { 'ck_null' }
+sub flags { 'Iifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_lt;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_lt' }
+sub desc { 'integer lt (<)' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_gt;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'gt' }
+sub desc { 'numeric gt (>)' }
+sub check { 'ck_null' }
+sub flags { 'Iifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_gt;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_gt' }
+sub desc { 'integer gt (>)' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_le;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'le' }
+sub desc { 'numeric le (<=)' }
+sub check { 'ck_null' }
+sub flags { 'Iifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_le;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_le' }
+sub desc { 'integer le (<=)' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_ge;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'ge' }
+sub desc { 'numeric ge (>=)' }
+sub check { 'ck_null' }
+sub flags { 'Iifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_ge;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_ge' }
+sub desc { 'integer ge (>=)' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_eq;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'eq' }
+sub desc { 'numeric eq (==)' }
+sub check { 'ck_null' }
+sub flags { 'Iifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_eq;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_eq' }
+sub desc { 'integer eq (==)' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_ne;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'ne' }
+sub desc { 'numeric ne (!=)' }
+sub check { 'ck_null' }
+sub flags { 'Iifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_ne;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_ne' }
+sub desc { 'integer ne (!=)' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_ncmp;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'ncmp' }
+sub desc { 'numeric comparison (<=>)' }
+sub check { 'ck_null' }
+sub flags { 'Iifst2' }
+sub args { 'S S' }
+
+
+package PLXML::op_i_ncmp;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'i_ncmp' }
+sub desc { 'integer comparison (<=>)' }
+sub check { 'ck_null' }
+sub flags { 'ifst2' }
+sub args { 'S S' }
+
+
+
+package PLXML::op_slt;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'slt' }
+sub desc { 'string lt' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_sgt;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'sgt' }
+sub desc { 'string gt' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_sle;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'sle' }
+sub desc { 'string le' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_sge;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'sge' }
+sub desc { 'string ge' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_seq;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'seq' }
+sub desc { 'string eq' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_sne;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'sne' }
+sub desc { 'string ne' }
+sub check { 'ck_null' }
+sub flags { 'ifs2' }
+sub args { 'S S' }
+
+
+package PLXML::op_scmp;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'scmp' }
+sub desc { 'string comparison (cmp)' }
+sub check { 'ck_null' }
+sub flags { 'ifst2' }
+sub args { 'S S' }
+
+
+
+package PLXML::op_bit_and;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'bit_and' }
+sub desc { 'bitwise and (&)' }
+sub check { 'ck_bitop' }
+sub flags { 'fst2' }
+sub args { 'S S' }
+
+
+package PLXML::op_bit_xor;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'bit_xor' }
+sub desc { 'bitwise xor (^)' }
+sub check { 'ck_bitop' }
+sub flags { 'fst2' }
+sub args { 'S S' }
+
+
+package PLXML::op_bit_or;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'bit_or' }
+sub desc { 'bitwise or (|)' }
+sub check { 'ck_bitop' }
+sub flags { 'fst2' }
+sub args { 'S S' }
+
+
+
+package PLXML::op_negate;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'negate' }
+sub desc { 'negation (-)' }
+sub check { 'ck_null' }
+sub flags { 'Ifst1' }
+sub args { 'S' }
+
+
+package PLXML::op_i_negate;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'i_negate' }
+sub desc { 'integer negation (-)' }
+sub check { 'ck_null' }
+sub flags { 'ifsT1' }
+sub args { 'S' }
+
+
+package PLXML::op_not;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'not' }
+sub desc { 'not' }
+sub check { 'ck_null' }
+sub flags { 'ifs1' }
+sub args { 'S' }
+
+
+package PLXML::op_complement;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'complement' }
+sub desc { '1\'s complement (~)' }
+sub check { 'ck_bitop' }
+sub flags { 'fst1' }
+sub args { 'S' }
+
+
+
+# High falutin' math.
+
+package PLXML::op_atan2;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'atan2' }
+sub desc { 'atan2' }
+sub check { 'ck_fun' }
+sub flags { 'fsT@' }
+sub args { 'S S' }
+
+
+package PLXML::op_sin;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'sin' }
+sub desc { 'sin' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_cos;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'cos' }
+sub desc { 'cos' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_rand;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'rand' }
+sub desc { 'rand' }
+sub check { 'ck_fun' }
+sub flags { 'sT%' }
+sub args { 'S?' }
+
+
+package PLXML::op_srand;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'srand' }
+sub desc { 'srand' }
+sub check { 'ck_fun' }
+sub flags { 's%' }
+sub args { 'S?' }
+
+
+package PLXML::op_exp;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'exp' }
+sub desc { 'exp' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_log;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'log' }
+sub desc { 'log' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_sqrt;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'sqrt' }
+sub desc { 'sqrt' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+
+# Lowbrow math.
+
+package PLXML::op_int;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'int' }
+sub desc { 'int' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_hex;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'hex' }
+sub desc { 'hex' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_oct;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'oct' }
+sub desc { 'oct' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_abs;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'abs' }
+sub desc { 'abs' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+
+# String stuff.
+
+package PLXML::op_length;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'length' }
+sub desc { 'length' }
+sub check { 'ck_lengthconst' }
+sub flags { 'isTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_substr;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'substr' }
+sub desc { 'substr' }
+sub check { 'ck_substr' }
+sub flags { 'st@' }
+sub args { 'S S S? S?' }
+
+
+package PLXML::op_vec;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'vec' }
+sub desc { 'vec' }
+sub check { 'ck_fun' }
+sub flags { 'ist@' }
+sub args { 'S S S' }
+
+
+
+package PLXML::op_index;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'index' }
+sub desc { 'index' }
+sub check { 'ck_index' }
+sub flags { 'isT@' }
+sub args { 'S S S?' }
+
+
+package PLXML::op_rindex;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'rindex' }
+sub desc { 'rindex' }
+sub check { 'ck_index' }
+sub flags { 'isT@' }
+sub args { 'S S S?' }
+
+
+
+package PLXML::op_sprintf;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'sprintf' }
+sub desc { 'sprintf' }
+sub check { 'ck_fun' }
+sub flags { 'mfst@' }
+sub args { 'S L' }
+
+
+package PLXML::op_formline;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'formline' }
+sub desc { 'formline' }
+sub check { 'ck_fun' }
+sub flags { 'ms@' }
+sub args { 'S L' }
+
+
+package PLXML::op_ord;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'ord' }
+sub desc { 'ord' }
+sub check { 'ck_fun' }
+sub flags { 'ifsTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_chr;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'chr' }
+sub desc { 'chr' }
+sub check { 'ck_fun' }
+sub flags { 'fsTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_crypt;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'crypt' }
+sub desc { 'crypt' }
+sub check { 'ck_fun' }
+sub flags { 'fsT@' }
+sub args { 'S S' }
+
+
+package PLXML::op_ucfirst;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'ucfirst' }
+sub desc { 'ucfirst' }
+sub check { 'ck_fun' }
+sub flags { 'fstu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_lcfirst;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'lcfirst' }
+sub desc { 'lcfirst' }
+sub check { 'ck_fun' }
+sub flags { 'fstu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_uc;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'uc' }
+sub desc { 'uc' }
+sub check { 'ck_fun' }
+sub flags { 'fstu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_lc;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'lc' }
+sub desc { 'lc' }
+sub check { 'ck_fun' }
+sub flags { 'fstu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_quotemeta;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'quotemeta' }
+sub desc { 'quotemeta' }
+sub check { 'ck_fun' }
+sub flags { 'fstu%' }
+sub args { 'S?' }
+
+
+
+# Arrays.
+
+package PLXML::op_rv2av;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'rv2av' }
+sub desc { 'array dereference' }
+sub check { 'ck_rvconst' }
+sub flags { 'dt1' }
+sub args { '' }
+
+
+package PLXML::op_aelemfast;
+
+@ISA = ('PLXML::padop_svop');
+
+sub key { 'aelemfast' }
+sub desc { 'constant array element' }
+sub check { 'ck_null' }
+sub flags { 's$' }
+sub args { 'A S' }
+
+
+package PLXML::op_aelem;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'aelem' }
+sub desc { 'array element' }
+sub check { 'ck_null' }
+sub flags { 's2' }
+sub args { 'A S' }
+
+
+package PLXML::op_aslice;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'aslice' }
+sub desc { 'array slice' }
+sub check { 'ck_null' }
+sub flags { 'm@' }
+sub args { 'A L' }
+
+
+
+# Hashes.
+
+package PLXML::op_each;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'each' }
+sub desc { 'each' }
+sub check { 'ck_fun' }
+sub flags { '%' }
+sub args { 'H' }
+
+
+package PLXML::op_values;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'values' }
+sub desc { 'values' }
+sub check { 'ck_fun' }
+sub flags { 't%' }
+sub args { 'H' }
+
+
+package PLXML::op_keys;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'keys' }
+sub desc { 'keys' }
+sub check { 'ck_fun' }
+sub flags { 't%' }
+sub args { 'H' }
+
+
+package PLXML::op_delete;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'delete' }
+sub desc { 'delete' }
+sub check { 'ck_delete' }
+sub flags { '%' }
+sub args { 'S' }
+
+
+package PLXML::op_exists;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'exists' }
+sub desc { 'exists' }
+sub check { 'ck_exists' }
+sub flags { 'is%' }
+sub args { 'S' }
+
+
+package PLXML::op_rv2hv;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'rv2hv' }
+sub desc { 'hash dereference' }
+sub check { 'ck_rvconst' }
+sub flags { 'dt1' }
+sub args { '' }
+
+
+package PLXML::op_helem;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'helem' }
+sub desc { 'hash element' }
+sub check { 'ck_null' }
+sub flags { 's2@' }
+sub args { 'H S' }
+
+
+package PLXML::op_hslice;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'hslice' }
+sub desc { 'hash slice' }
+sub check { 'ck_null' }
+sub flags { 'm@' }
+sub args { 'H L' }
+
+
+
+# Explosives and implosives.
+
+package PLXML::op_unpack;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'unpack' }
+sub desc { 'unpack' }
+sub check { 'ck_unpack' }
+sub flags { '@' }
+sub args { 'S S?' }
+
+
+package PLXML::op_pack;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'pack' }
+sub desc { 'pack' }
+sub check { 'ck_fun' }
+sub flags { 'mst@' }
+sub args { 'S L' }
+
+
+package PLXML::op_split;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'split' }
+sub desc { 'split' }
+sub check { 'ck_split' }
+sub flags { 't@' }
+sub args { 'S S S' }
+
+
+package PLXML::op_join;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'join' }
+sub desc { 'join or string' }
+sub check { 'ck_join' }
+sub flags { 'mst@' }
+sub args { 'S L' }
+
+
+
+# List operators.
+
+package PLXML::op_list;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'list' }
+sub desc { 'list' }
+sub check { 'ck_null' }
+sub flags { 'm@' }
+sub args { 'L' }
+
+
+package PLXML::op_lslice;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'lslice' }
+sub desc { 'list slice' }
+sub check { 'ck_null' }
+sub flags { '2' }
+sub args { 'H L L' }
+
+
+package PLXML::op_anonlist;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'anonlist' }
+sub desc { 'anonymous list ([])' }
+sub check { 'ck_fun' }
+sub flags { 'ms@' }
+sub args { 'L' }
+
+
+package PLXML::op_anonhash;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'anonhash' }
+sub desc { 'anonymous hash ({})' }
+sub check { 'ck_fun' }
+sub flags { 'ms@' }
+sub args { 'L' }
+
+
+
+package PLXML::op_splice;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'splice' }
+sub desc { 'splice' }
+sub check { 'ck_fun' }
+sub flags { 'm@' }
+sub args { 'A S? S? L' }
+
+
+package PLXML::op_push;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'push' }
+sub desc { 'push' }
+sub check { 'ck_fun' }
+sub flags { 'imsT@' }
+sub args { 'A L' }
+
+
+package PLXML::op_pop;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'pop' }
+sub desc { 'pop' }
+sub check { 'ck_shift' }
+sub flags { 's%' }
+sub args { 'A?' }
+
+
+package PLXML::op_shift;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'shift' }
+sub desc { 'shift' }
+sub check { 'ck_shift' }
+sub flags { 's%' }
+sub args { 'A?' }
+
+
+package PLXML::op_unshift;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'unshift' }
+sub desc { 'unshift' }
+sub check { 'ck_fun' }
+sub flags { 'imsT@' }
+sub args { 'A L' }
+
+
+package PLXML::op_sort;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'sort' }
+sub desc { 'sort' }
+sub check { 'ck_sort' }
+sub flags { 'm@' }
+sub args { 'C? L' }
+
+
+package PLXML::op_reverse;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'reverse' }
+sub desc { 'reverse' }
+sub check { 'ck_fun' }
+sub flags { 'mt@' }
+sub args { 'L' }
+
+
+
+package PLXML::op_grepstart;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'grepstart' }
+sub desc { 'grep' }
+sub check { 'ck_grep' }
+sub flags { 'dm@' }
+sub args { 'C L' }
+
+
+package PLXML::op_grepwhile;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'grepwhile' }
+sub desc { 'grep iterator' }
+sub check { 'ck_null' }
+sub flags { 'dt|' }
+sub args { '' }
+
+
+
+package PLXML::op_mapstart;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'mapstart' }
+sub desc { 'map' }
+sub check { 'ck_grep' }
+sub flags { 'dm@' }
+sub args { 'C L' }
+
+
+package PLXML::op_mapwhile;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'mapwhile' }
+sub desc { 'map iterator' }
+sub check { 'ck_null' }
+sub flags { 'dt|' }
+sub args { '' }
+
+
+
+# Range stuff.
+
+package PLXML::op_range;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'range' }
+sub desc { 'flipflop' }
+sub check { 'ck_null' }
+sub flags { '|' }
+sub args { 'S S' }
+
+
+package PLXML::op_flip;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'flip' }
+sub desc { 'range (or flip)' }
+sub check { 'ck_null' }
+sub flags { '1' }
+sub args { 'S S' }
+
+
+package PLXML::op_flop;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'flop' }
+sub desc { 'range (or flop)' }
+sub check { 'ck_null' }
+sub flags { '1' }
+sub args { '' }
+
+
+
+# Control.
+
+package PLXML::op_and;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'and' }
+sub desc { 'logical and (&&)' }
+sub check { 'ck_null' }
+sub flags { '|' }
+sub args { '' }
+
+
+package PLXML::op_or;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'or' }
+sub desc { 'logical or (||)' }
+sub check { 'ck_null' }
+sub flags { '|' }
+sub args { '' }
+
+
+package PLXML::op_xor;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'xor' }
+sub desc { 'logical xor' }
+sub check { 'ck_null' }
+sub flags { 'fs2' }
+sub args { 'S S ' }
+
+
+package PLXML::op_cond_expr;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'cond_expr' }
+sub desc { 'conditional expression' }
+sub check { 'ck_null' }
+sub flags { 'd|' }
+sub args { '' }
+
+
+package PLXML::op_andassign;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'andassign' }
+sub desc { 'logical and assignment (&&=)' }
+sub check { 'ck_null' }
+sub flags { 's|' }
+sub args { '' }
+
+
+package PLXML::op_orassign;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'orassign' }
+sub desc { 'logical or assignment (||=)' }
+sub check { 'ck_null' }
+sub flags { 's|' }
+sub args { '' }
+
+
+
+package PLXML::op_method;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'method' }
+sub desc { 'method lookup' }
+sub check { 'ck_method' }
+sub flags { 'd1' }
+sub args { '' }
+
+
+package PLXML::op_entersub;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'entersub' }
+sub desc { 'subroutine entry' }
+sub check { 'ck_subr' }
+sub flags { 'dmt1' }
+sub args { 'L' }
+
+
+package PLXML::op_leavesub;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'leavesub' }
+sub desc { 'subroutine exit' }
+sub check { 'ck_null' }
+sub flags { '1' }
+sub args { '' }
+
+
+package PLXML::op_leavesublv;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'leavesublv' }
+sub desc { 'lvalue subroutine return' }
+sub check { 'ck_null' }
+sub flags { '1' }
+sub args { '' }
+
+
+package PLXML::op_caller;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'caller' }
+sub desc { 'caller' }
+sub check { 'ck_fun' }
+sub flags { 't%' }
+sub args { 'S?' }
+
+
+package PLXML::op_warn;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'warn' }
+sub desc { 'warn' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'L' }
+
+
+package PLXML::op_die;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'die' }
+sub desc { 'die' }
+sub check { 'ck_die' }
+sub flags { 'dimst@' }
+sub args { 'L' }
+
+
+package PLXML::op_reset;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'reset' }
+sub desc { 'symbol reset' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'S?' }
+
+
+
+package PLXML::op_lineseq;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'lineseq' }
+sub desc { 'line sequence' }
+sub check { 'ck_null' }
+sub flags { '@' }
+sub args { '' }
+
+
+package PLXML::op_nextstate;
+
+@ISA = ('PLXML::cop');
+
+sub key { 'nextstate' }
+sub desc { 'next statement' }
+sub check { 'ck_null' }
+sub flags { 's;' }
+sub args { '' }
+
+
+package PLXML::op_dbstate;
+
+@ISA = ('PLXML::cop');
+
+sub key { 'dbstate' }
+sub desc { 'debug next statement' }
+sub check { 'ck_null' }
+sub flags { 's;' }
+sub args { '' }
+
+
+package PLXML::op_unstack;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'unstack' }
+sub desc { 'iteration finalizer' }
+sub check { 'ck_null' }
+sub flags { 's0' }
+sub args { '' }
+
+
+package PLXML::op_enter;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'enter' }
+sub desc { 'block entry' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_leave;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'leave' }
+sub desc { 'block exit' }
+sub check { 'ck_null' }
+sub flags { '@' }
+sub args { '' }
+
+
+package PLXML::op_scope;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'scope' }
+sub desc { 'block' }
+sub check { 'ck_null' }
+sub flags { '@' }
+sub args { '' }
+
+
+package PLXML::op_enteriter;
+
+@ISA = ('PLXML::loop');
+
+sub key { 'enteriter' }
+sub desc { 'foreach loop entry' }
+sub check { 'ck_null' }
+sub flags { 'd{' }
+sub args { '' }
+
+
+package PLXML::op_iter;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'iter' }
+sub desc { 'foreach loop iterator' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_enterloop;
+
+@ISA = ('PLXML::loop');
+
+sub key { 'enterloop' }
+sub desc { 'loop entry' }
+sub check { 'ck_null' }
+sub flags { 'd{' }
+sub args { '' }
+
+
+package PLXML::op_leaveloop;
+
+@ISA = ('PLXML::binop');
+
+sub key { 'leaveloop' }
+sub desc { 'loop exit' }
+sub check { 'ck_null' }
+sub flags { '2' }
+sub args { '' }
+
+
+package PLXML::op_return;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'return' }
+sub desc { 'return' }
+sub check { 'ck_return' }
+sub flags { 'dm@' }
+sub args { 'L' }
+
+
+package PLXML::op_last;
+
+@ISA = ('PLXML::loopexop');
+
+sub key { 'last' }
+sub desc { 'last' }
+sub check { 'ck_null' }
+sub flags { 'ds}' }
+sub args { '' }
+
+
+package PLXML::op_next;
+
+@ISA = ('PLXML::loopexop');
+
+sub key { 'next' }
+sub desc { 'next' }
+sub check { 'ck_null' }
+sub flags { 'ds}' }
+sub args { '' }
+
+
+package PLXML::op_redo;
+
+@ISA = ('PLXML::loopexop');
+
+sub key { 'redo' }
+sub desc { 'redo' }
+sub check { 'ck_null' }
+sub flags { 'ds}' }
+sub args { '' }
+
+
+package PLXML::op_dump;
+
+@ISA = ('PLXML::loopexop');
+
+sub key { 'dump' }
+sub desc { 'dump' }
+sub check { 'ck_null' }
+sub flags { 'ds}' }
+sub args { '' }
+
+
+package PLXML::op_goto;
+
+@ISA = ('PLXML::loopexop');
+
+sub key { 'goto' }
+sub desc { 'goto' }
+sub check { 'ck_null' }
+sub flags { 'ds}' }
+sub args { '' }
+
+
+package PLXML::op_exit;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'exit' }
+sub desc { 'exit' }
+sub check { 'ck_exit' }
+sub flags { 'ds%' }
+sub args { 'S?' }
+
+
+# continued below
+
+#nswitch numeric switch ck_null d
+#cswitch character switch ck_null d
+
+# I/O.
+
+package PLXML::op_open;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'open' }
+sub desc { 'open' }
+sub check { 'ck_open' }
+sub flags { 'ismt@' }
+sub args { 'F S? L' }
+
+
+package PLXML::op_close;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'close' }
+sub desc { 'close' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'F?' }
+
+
+package PLXML::op_pipe_op;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'pipe_op' }
+sub desc { 'pipe' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'F F' }
+
+
+
+package PLXML::op_fileno;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'fileno' }
+sub desc { 'fileno' }
+sub check { 'ck_fun' }
+sub flags { 'ist%' }
+sub args { 'F' }
+
+
+package PLXML::op_umask;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'umask' }
+sub desc { 'umask' }
+sub check { 'ck_fun' }
+sub flags { 'ist%' }
+sub args { 'S?' }
+
+
+package PLXML::op_binmode;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'binmode' }
+sub desc { 'binmode' }
+sub check { 'ck_fun' }
+sub flags { 's@' }
+sub args { 'F S?' }
+
+
+
+package PLXML::op_tie;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'tie' }
+sub desc { 'tie' }
+sub check { 'ck_fun' }
+sub flags { 'idms@' }
+sub args { 'R S L' }
+
+
+package PLXML::op_untie;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'untie' }
+sub desc { 'untie' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'R' }
+
+
+package PLXML::op_tied;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'tied' }
+sub desc { 'tied' }
+sub check { 'ck_fun' }
+sub flags { 's%' }
+sub args { 'R' }
+
+
+package PLXML::op_dbmopen;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'dbmopen' }
+sub desc { 'dbmopen' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'H S S' }
+
+
+package PLXML::op_dbmclose;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'dbmclose' }
+sub desc { 'dbmclose' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'H' }
+
+
+
+package PLXML::op_sselect;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'sselect' }
+sub desc { 'select system call' }
+sub check { 'ck_select' }
+sub flags { 't@' }
+sub args { 'S S S S' }
+
+
+package PLXML::op_select;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'select' }
+sub desc { 'select' }
+sub check { 'ck_select' }
+sub flags { 'st@' }
+sub args { 'F?' }
+
+
+
+package PLXML::op_getc;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'getc' }
+sub desc { 'getc' }
+sub check { 'ck_eof' }
+sub flags { 'st%' }
+sub args { 'F?' }
+
+
+package PLXML::op_read;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'read' }
+sub desc { 'read' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'F R S S?' }
+
+
+package PLXML::op_enterwrite;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'enterwrite' }
+sub desc { 'write' }
+sub check { 'ck_fun' }
+sub flags { 'dis%' }
+sub args { 'F?' }
+
+
+package PLXML::op_leavewrite;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'leavewrite' }
+sub desc { 'write exit' }
+sub check { 'ck_null' }
+sub flags { '1' }
+sub args { '' }
+
+
+
+package PLXML::op_prtf;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'prtf' }
+sub desc { 'printf' }
+sub check { 'ck_listiob' }
+sub flags { 'ims@' }
+sub args { 'F? L' }
+
+
+package PLXML::op_print;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'print' }
+sub desc { 'print' }
+sub check { 'ck_listiob' }
+sub flags { 'ims@' }
+sub args { 'F? L' }
+
+
+
+package PLXML::op_sysopen;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'sysopen' }
+sub desc { 'sysopen' }
+sub check { 'ck_fun' }
+sub flags { 's@' }
+sub args { 'F S S S?' }
+
+
+package PLXML::op_sysseek;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'sysseek' }
+sub desc { 'sysseek' }
+sub check { 'ck_fun' }
+sub flags { 's@' }
+sub args { 'F S S' }
+
+
+package PLXML::op_sysread;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'sysread' }
+sub desc { 'sysread' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'F R S S?' }
+
+
+package PLXML::op_syswrite;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'syswrite' }
+sub desc { 'syswrite' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'F S S? S?' }
+
+
+
+package PLXML::op_send;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'send' }
+sub desc { 'send' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'Fs S S S?' }
+
+
+package PLXML::op_recv;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'recv' }
+sub desc { 'recv' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'Fs R S S' }
+
+
+
+package PLXML::op_eof;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'eof' }
+sub desc { 'eof' }
+sub check { 'ck_eof' }
+sub flags { 'is%' }
+sub args { 'F?' }
+
+
+package PLXML::op_tell;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'tell' }
+sub desc { 'tell' }
+sub check { 'ck_fun' }
+sub flags { 'st%' }
+sub args { 'F?' }
+
+
+package PLXML::op_seek;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'seek' }
+sub desc { 'seek' }
+sub check { 'ck_fun' }
+sub flags { 's@' }
+sub args { 'F S S' }
+
+
+# truncate really behaves as if it had both "S S" and "F S"
+package PLXML::op_truncate;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'truncate' }
+sub desc { 'truncate' }
+sub check { 'ck_trunc' }
+sub flags { 'is@' }
+sub args { 'S S' }
+
+
+
+package PLXML::op_fcntl;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'fcntl' }
+sub desc { 'fcntl' }
+sub check { 'ck_fun' }
+sub flags { 'st@' }
+sub args { 'F S S' }
+
+
+package PLXML::op_ioctl;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'ioctl' }
+sub desc { 'ioctl' }
+sub check { 'ck_fun' }
+sub flags { 'st@' }
+sub args { 'F S S' }
+
+
+package PLXML::op_flock;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'flock' }
+sub desc { 'flock' }
+sub check { 'ck_fun' }
+sub flags { 'isT@' }
+sub args { 'F S' }
+
+
+
+# Sockets.
+
+package PLXML::op_socket;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'socket' }
+sub desc { 'socket' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'Fs S S S' }
+
+
+package PLXML::op_sockpair;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'sockpair' }
+sub desc { 'socketpair' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'Fs Fs S S S' }
+
+
+
+package PLXML::op_bind;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'bind' }
+sub desc { 'bind' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'Fs S' }
+
+
+package PLXML::op_connect;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'connect' }
+sub desc { 'connect' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'Fs S' }
+
+
+package PLXML::op_listen;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'listen' }
+sub desc { 'listen' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'Fs S' }
+
+
+package PLXML::op_accept;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'accept' }
+sub desc { 'accept' }
+sub check { 'ck_fun' }
+sub flags { 'ist@' }
+sub args { 'Fs Fs' }
+
+
+package PLXML::op_shutdown;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'shutdown' }
+sub desc { 'shutdown' }
+sub check { 'ck_fun' }
+sub flags { 'ist@' }
+sub args { 'Fs S' }
+
+
+
+package PLXML::op_gsockopt;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'gsockopt' }
+sub desc { 'getsockopt' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'Fs S S' }
+
+
+package PLXML::op_ssockopt;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'ssockopt' }
+sub desc { 'setsockopt' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'Fs S S S' }
+
+
+
+package PLXML::op_getsockname;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'getsockname' }
+sub desc { 'getsockname' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'Fs' }
+
+
+package PLXML::op_getpeername;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'getpeername' }
+sub desc { 'getpeername' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'Fs' }
+
+
+
+# Stat calls.
+
+package PLXML::op_lstat;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'lstat' }
+sub desc { 'lstat' }
+sub check { 'ck_ftst' }
+sub flags { 'u-' }
+sub args { 'F' }
+
+
+package PLXML::op_stat;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'stat' }
+sub desc { 'stat' }
+sub check { 'ck_ftst' }
+sub flags { 'u-' }
+sub args { 'F' }
+
+
+package PLXML::op_ftrread;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftrread' }
+sub desc { '-R' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftrwrite;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftrwrite' }
+sub desc { '-W' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftrexec;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftrexec' }
+sub desc { '-X' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_fteread;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'fteread' }
+sub desc { '-r' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftewrite;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftewrite' }
+sub desc { '-w' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_fteexec;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'fteexec' }
+sub desc { '-x' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftis;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftis' }
+sub desc { '-e' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_fteowned;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'fteowned' }
+sub desc { '-O' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftrowned;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftrowned' }
+sub desc { '-o' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftzero;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftzero' }
+sub desc { '-z' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftsize;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftsize' }
+sub desc { '-s' }
+sub check { 'ck_ftst' }
+sub flags { 'istu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftmtime;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftmtime' }
+sub desc { '-M' }
+sub check { 'ck_ftst' }
+sub flags { 'stu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftatime;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftatime' }
+sub desc { '-A' }
+sub check { 'ck_ftst' }
+sub flags { 'stu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftctime;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftctime' }
+sub desc { '-C' }
+sub check { 'ck_ftst' }
+sub flags { 'stu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftsock;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftsock' }
+sub desc { '-S' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftchr;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftchr' }
+sub desc { '-c' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftblk;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftblk' }
+sub desc { '-b' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftfile;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftfile' }
+sub desc { '-f' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftdir;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftdir' }
+sub desc { '-d' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftpipe;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftpipe' }
+sub desc { '-p' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftlink;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftlink' }
+sub desc { '-l' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftsuid;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftsuid' }
+sub desc { '-u' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftsgid;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftsgid' }
+sub desc { '-g' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftsvtx;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftsvtx' }
+sub desc { '-k' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_fttty;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'fttty' }
+sub desc { '-t' }
+sub check { 'ck_ftst' }
+sub flags { 'is-' }
+sub args { 'F-' }
+
+
+package PLXML::op_fttext;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'fttext' }
+sub desc { '-T' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+package PLXML::op_ftbinary;
+
+@ISA = ('PLXML::filestatop');
+
+sub key { 'ftbinary' }
+sub desc { '-B' }
+sub check { 'ck_ftst' }
+sub flags { 'isu-' }
+sub args { 'F-' }
+
+
+
+# File calls.
+
+package PLXML::op_chdir;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'chdir' }
+sub desc { 'chdir' }
+sub check { 'ck_fun' }
+sub flags { 'isT%' }
+sub args { 'S?' }
+
+
+package PLXML::op_chown;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'chown' }
+sub desc { 'chown' }
+sub check { 'ck_fun' }
+sub flags { 'imsT@' }
+sub args { 'L' }
+
+
+package PLXML::op_chroot;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'chroot' }
+sub desc { 'chroot' }
+sub check { 'ck_fun' }
+sub flags { 'isTu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_unlink;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'unlink' }
+sub desc { 'unlink' }
+sub check { 'ck_fun' }
+sub flags { 'imsTu@' }
+sub args { 'L' }
+
+
+package PLXML::op_chmod;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'chmod' }
+sub desc { 'chmod' }
+sub check { 'ck_fun' }
+sub flags { 'imsT@' }
+sub args { 'L' }
+
+
+package PLXML::op_utime;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'utime' }
+sub desc { 'utime' }
+sub check { 'ck_fun' }
+sub flags { 'imsT@' }
+sub args { 'L' }
+
+
+package PLXML::op_rename;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'rename' }
+sub desc { 'rename' }
+sub check { 'ck_fun' }
+sub flags { 'isT@' }
+sub args { 'S S' }
+
+
+package PLXML::op_link;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'link' }
+sub desc { 'link' }
+sub check { 'ck_fun' }
+sub flags { 'isT@' }
+sub args { 'S S' }
+
+
+package PLXML::op_symlink;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'symlink' }
+sub desc { 'symlink' }
+sub check { 'ck_fun' }
+sub flags { 'isT@' }
+sub args { 'S S' }
+
+
+package PLXML::op_readlink;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'readlink' }
+sub desc { 'readlink' }
+sub check { 'ck_fun' }
+sub flags { 'stu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_mkdir;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'mkdir' }
+sub desc { 'mkdir' }
+sub check { 'ck_fun' }
+sub flags { 'isT@' }
+sub args { 'S S?' }
+
+
+package PLXML::op_rmdir;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'rmdir' }
+sub desc { 'rmdir' }
+sub check { 'ck_fun' }
+sub flags { 'isTu%' }
+sub args { 'S?' }
+
+
+
+# Directory calls.
+
+package PLXML::op_open_dir;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'open_dir' }
+sub desc { 'opendir' }
+sub check { 'ck_fun' }
+sub flags { 'is@' }
+sub args { 'F S' }
+
+
+package PLXML::op_readdir;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'readdir' }
+sub desc { 'readdir' }
+sub check { 'ck_fun' }
+sub flags { '%' }
+sub args { 'F' }
+
+
+package PLXML::op_telldir;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'telldir' }
+sub desc { 'telldir' }
+sub check { 'ck_fun' }
+sub flags { 'st%' }
+sub args { 'F' }
+
+
+package PLXML::op_seekdir;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'seekdir' }
+sub desc { 'seekdir' }
+sub check { 'ck_fun' }
+sub flags { 's@' }
+sub args { 'F S' }
+
+
+package PLXML::op_rewinddir;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'rewinddir' }
+sub desc { 'rewinddir' }
+sub check { 'ck_fun' }
+sub flags { 's%' }
+sub args { 'F' }
+
+
+package PLXML::op_closedir;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'closedir' }
+sub desc { 'closedir' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'F' }
+
+
+
+# Process control.
+
+package PLXML::op_fork;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'fork' }
+sub desc { 'fork' }
+sub check { 'ck_null' }
+sub flags { 'ist0' }
+sub args { '' }
+
+
+package PLXML::op_wait;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'wait' }
+sub desc { 'wait' }
+sub check { 'ck_null' }
+sub flags { 'isT0' }
+sub args { '' }
+
+
+package PLXML::op_waitpid;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'waitpid' }
+sub desc { 'waitpid' }
+sub check { 'ck_fun' }
+sub flags { 'isT@' }
+sub args { 'S S' }
+
+
+package PLXML::op_system;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'system' }
+sub desc { 'system' }
+sub check { 'ck_exec' }
+sub flags { 'imsT@' }
+sub args { 'S? L' }
+
+
+package PLXML::op_exec;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'exec' }
+sub desc { 'exec' }
+sub check { 'ck_exec' }
+sub flags { 'dimsT@' }
+sub args { 'S? L' }
+
+
+package PLXML::op_kill;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'kill' }
+sub desc { 'kill' }
+sub check { 'ck_fun' }
+sub flags { 'dimsT@' }
+sub args { 'L' }
+
+
+package PLXML::op_getppid;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'getppid' }
+sub desc { 'getppid' }
+sub check { 'ck_null' }
+sub flags { 'isT0' }
+sub args { '' }
+
+
+package PLXML::op_getpgrp;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'getpgrp' }
+sub desc { 'getpgrp' }
+sub check { 'ck_fun' }
+sub flags { 'isT%' }
+sub args { 'S?' }
+
+
+package PLXML::op_setpgrp;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'setpgrp' }
+sub desc { 'setpgrp' }
+sub check { 'ck_fun' }
+sub flags { 'isT@' }
+sub args { 'S? S?' }
+
+
+package PLXML::op_getpriority;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'getpriority' }
+sub desc { 'getpriority' }
+sub check { 'ck_fun' }
+sub flags { 'isT@' }
+sub args { 'S S' }
+
+
+package PLXML::op_setpriority;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'setpriority' }
+sub desc { 'setpriority' }
+sub check { 'ck_fun' }
+sub flags { 'isT@' }
+sub args { 'S S S' }
+
+
+
+# Time calls.
+
+# NOTE: MacOS patches the 'i' of time() away later when the interpreter
+# is created because in MacOS time() is already returning times > 2**31-1,
+# that is, non-integers.
+
+package PLXML::op_time;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'time' }
+sub desc { 'time' }
+sub check { 'ck_null' }
+sub flags { 'isT0' }
+sub args { '' }
+
+
+package PLXML::op_tms;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'tms' }
+sub desc { 'times' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_localtime;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'localtime' }
+sub desc { 'localtime' }
+sub check { 'ck_fun' }
+sub flags { 't%' }
+sub args { 'S?' }
+
+
+package PLXML::op_gmtime;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'gmtime' }
+sub desc { 'gmtime' }
+sub check { 'ck_fun' }
+sub flags { 't%' }
+sub args { 'S?' }
+
+
+package PLXML::op_alarm;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'alarm' }
+sub desc { 'alarm' }
+sub check { 'ck_fun' }
+sub flags { 'istu%' }
+sub args { 'S?' }
+
+
+package PLXML::op_sleep;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'sleep' }
+sub desc { 'sleep' }
+sub check { 'ck_fun' }
+sub flags { 'isT%' }
+sub args { 'S?' }
+
+
+
+# Shared memory.
+
+package PLXML::op_shmget;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'shmget' }
+sub desc { 'shmget' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S S' }
+
+
+package PLXML::op_shmctl;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'shmctl' }
+sub desc { 'shmctl' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S S' }
+
+
+package PLXML::op_shmread;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'shmread' }
+sub desc { 'shmread' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S S S' }
+
+
+package PLXML::op_shmwrite;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'shmwrite' }
+sub desc { 'shmwrite' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S S S' }
+
+
+
+# Message passing.
+
+package PLXML::op_msgget;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'msgget' }
+sub desc { 'msgget' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S' }
+
+
+package PLXML::op_msgctl;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'msgctl' }
+sub desc { 'msgctl' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S S' }
+
+
+package PLXML::op_msgsnd;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'msgsnd' }
+sub desc { 'msgsnd' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S S' }
+
+
+package PLXML::op_msgrcv;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'msgrcv' }
+sub desc { 'msgrcv' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S S S S' }
+
+
+
+# Semaphores.
+
+package PLXML::op_semget;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'semget' }
+sub desc { 'semget' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S S' }
+
+
+package PLXML::op_semctl;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'semctl' }
+sub desc { 'semctl' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S S S' }
+
+
+package PLXML::op_semop;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'semop' }
+sub desc { 'semop' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S S' }
+
+
+
+# Eval.
+
+package PLXML::op_require;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'require' }
+sub desc { 'require' }
+sub check { 'ck_require' }
+sub flags { 'du%' }
+sub args { 'S?' }
+
+
+package PLXML::op_dofile;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'dofile' }
+sub desc { 'do "file"' }
+sub check { 'ck_fun' }
+sub flags { 'd1' }
+sub args { 'S' }
+
+
+package PLXML::op_entereval;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'entereval' }
+sub desc { 'eval "string"' }
+sub check { 'ck_eval' }
+sub flags { 'd%' }
+sub args { 'S' }
+
+
+package PLXML::op_leaveeval;
+
+@ISA = ('PLXML::unop');
+
+sub key { 'leaveeval' }
+sub desc { 'eval "string" exit' }
+sub check { 'ck_null' }
+sub flags { '1' }
+sub args { 'S' }
+
+
+#evalonce eval constant string ck_null d1 S
+package PLXML::op_entertry;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'entertry' }
+sub desc { 'eval {block}' }
+sub check { 'ck_null' }
+sub flags { '|' }
+sub args { '' }
+
+
+package PLXML::op_leavetry;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'leavetry' }
+sub desc { 'eval {block} exit' }
+sub check { 'ck_null' }
+sub flags { '@' }
+sub args { '' }
+
+
+
+# Get system info.
+
+package PLXML::op_ghbyname;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'ghbyname' }
+sub desc { 'gethostbyname' }
+sub check { 'ck_fun' }
+sub flags { '%' }
+sub args { 'S' }
+
+
+package PLXML::op_ghbyaddr;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'ghbyaddr' }
+sub desc { 'gethostbyaddr' }
+sub check { 'ck_fun' }
+sub flags { '@' }
+sub args { 'S S' }
+
+
+package PLXML::op_ghostent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'ghostent' }
+sub desc { 'gethostent' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_gnbyname;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'gnbyname' }
+sub desc { 'getnetbyname' }
+sub check { 'ck_fun' }
+sub flags { '%' }
+sub args { 'S' }
+
+
+package PLXML::op_gnbyaddr;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'gnbyaddr' }
+sub desc { 'getnetbyaddr' }
+sub check { 'ck_fun' }
+sub flags { '@' }
+sub args { 'S S' }
+
+
+package PLXML::op_gnetent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'gnetent' }
+sub desc { 'getnetent' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_gpbyname;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'gpbyname' }
+sub desc { 'getprotobyname' }
+sub check { 'ck_fun' }
+sub flags { '%' }
+sub args { 'S' }
+
+
+package PLXML::op_gpbynumber;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'gpbynumber' }
+sub desc { 'getprotobynumber' }
+sub check { 'ck_fun' }
+sub flags { '@' }
+sub args { 'S' }
+
+
+package PLXML::op_gprotoent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'gprotoent' }
+sub desc { 'getprotoent' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_gsbyname;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'gsbyname' }
+sub desc { 'getservbyname' }
+sub check { 'ck_fun' }
+sub flags { '@' }
+sub args { 'S S' }
+
+
+package PLXML::op_gsbyport;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'gsbyport' }
+sub desc { 'getservbyport' }
+sub check { 'ck_fun' }
+sub flags { '@' }
+sub args { 'S S' }
+
+
+package PLXML::op_gservent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'gservent' }
+sub desc { 'getservent' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_shostent;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'shostent' }
+sub desc { 'sethostent' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'S' }
+
+
+package PLXML::op_snetent;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'snetent' }
+sub desc { 'setnetent' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'S' }
+
+
+package PLXML::op_sprotoent;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'sprotoent' }
+sub desc { 'setprotoent' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'S' }
+
+
+package PLXML::op_sservent;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'sservent' }
+sub desc { 'setservent' }
+sub check { 'ck_fun' }
+sub flags { 'is%' }
+sub args { 'S' }
+
+
+package PLXML::op_ehostent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'ehostent' }
+sub desc { 'endhostent' }
+sub check { 'ck_null' }
+sub flags { 'is0' }
+sub args { '' }
+
+
+package PLXML::op_enetent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'enetent' }
+sub desc { 'endnetent' }
+sub check { 'ck_null' }
+sub flags { 'is0' }
+sub args { '' }
+
+
+package PLXML::op_eprotoent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'eprotoent' }
+sub desc { 'endprotoent' }
+sub check { 'ck_null' }
+sub flags { 'is0' }
+sub args { '' }
+
+
+package PLXML::op_eservent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'eservent' }
+sub desc { 'endservent' }
+sub check { 'ck_null' }
+sub flags { 'is0' }
+sub args { '' }
+
+
+package PLXML::op_gpwnam;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'gpwnam' }
+sub desc { 'getpwnam' }
+sub check { 'ck_fun' }
+sub flags { '%' }
+sub args { 'S' }
+
+
+package PLXML::op_gpwuid;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'gpwuid' }
+sub desc { 'getpwuid' }
+sub check { 'ck_fun' }
+sub flags { '%' }
+sub args { 'S' }
+
+
+package PLXML::op_gpwent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'gpwent' }
+sub desc { 'getpwent' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_spwent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'spwent' }
+sub desc { 'setpwent' }
+sub check { 'ck_null' }
+sub flags { 'is0' }
+sub args { '' }
+
+
+package PLXML::op_epwent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'epwent' }
+sub desc { 'endpwent' }
+sub check { 'ck_null' }
+sub flags { 'is0' }
+sub args { '' }
+
+
+package PLXML::op_ggrnam;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'ggrnam' }
+sub desc { 'getgrnam' }
+sub check { 'ck_fun' }
+sub flags { '%' }
+sub args { 'S' }
+
+
+package PLXML::op_ggrgid;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'ggrgid' }
+sub desc { 'getgrgid' }
+sub check { 'ck_fun' }
+sub flags { '%' }
+sub args { 'S' }
+
+
+package PLXML::op_ggrent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'ggrent' }
+sub desc { 'getgrent' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
+package PLXML::op_sgrent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'sgrent' }
+sub desc { 'setgrent' }
+sub check { 'ck_null' }
+sub flags { 'is0' }
+sub args { '' }
+
+
+package PLXML::op_egrent;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'egrent' }
+sub desc { 'endgrent' }
+sub check { 'ck_null' }
+sub flags { 'is0' }
+sub args { '' }
+
+
+package PLXML::op_getlogin;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'getlogin' }
+sub desc { 'getlogin' }
+sub check { 'ck_null' }
+sub flags { 'st0' }
+sub args { '' }
+
+
+
+# Miscellaneous.
+
+package PLXML::op_syscall;
+
+@ISA = ('PLXML::listop');
+
+sub key { 'syscall' }
+sub desc { 'syscall' }
+sub check { 'ck_fun' }
+sub flags { 'imst@' }
+sub args { 'S L' }
+
+
+
+# For multi-threading
+package PLXML::op_lock;
+
+@ISA = ('PLXML::baseop_unop');
+
+sub key { 'lock' }
+sub desc { 'lock' }
+sub check { 'ck_rfun' }
+sub flags { 's%' }
+sub args { 'R' }
+
+
+package PLXML::op_threadsv;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'threadsv' }
+sub desc { 'per-thread value' }
+sub check { 'ck_null' }
+sub flags { 'ds0' }
+sub args { '' }
+
+
+
+# Control (contd.)
+package PLXML::op_setstate;
+
+@ISA = ('PLXML::cop');
+
+sub key { 'setstate' }
+sub desc { 'set statement info' }
+sub check { 'ck_null' }
+sub flags { 's;' }
+sub args { '' }
+
+
+package PLXML::op_method_named;
+
+@ISA = ('PLXML::padop_svop');
+
+sub key { 'method_named' }
+sub desc { 'method with known name' }
+sub check { 'ck_null' }
+sub flags { 'd$' }
+sub args { '' }
+
+
+
+package PLXML::op_dor;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'dor' }
+sub desc { 'defined or (//)' }
+sub check { 'ck_null' }
+sub flags { '|' }
+sub args { '' }
+
+
+package PLXML::op_dorassign;
+
+@ISA = ('PLXML::logop');
+
+sub key { 'dorassign' }
+sub desc { 'defined or assignment (//=)' }
+sub check { 'ck_null' }
+sub flags { 's|' }
+sub args { '' }
+
+
+
+# Add new ops before this, the custom operator.
+
+package PLXML::op_custom;
+
+@ISA = ('PLXML::baseop');
+
+sub key { 'custom' }
+sub desc { 'unknown custom operator' }
+sub check { 'ck_null' }
+sub flags { '0' }
+sub args { '' }
+
+
--- /dev/null
+#!/usr/bin/perl
+
+# Suboptimal things:
+# ast type info is generally still implicit
+# the combined madness calls are actually losing type information
+# brace madprops tend to be too low in the tree
+# could use about 18 more refactorings...
+# lots of unused cruft left around from previous refactorings
+
+use strict;
+use warnings;
+use Carp;
+use lib '/home/larry/src/p55';
+
+use P5AST;
+use P5re;
+
+my $dowarn = 0;
+my $YAML = 0;
+my $deinterpolate;
+
+while (@ARGV and $ARGV[0] =~ /^-/) {
+ my $switch = shift;
+ if ($switch eq '-w') {
+ $dowarn = 1;
+ }
+ elsif ($switch eq '-Y') {
+ $YAML = 1;
+ }
+ elsif ($switch eq '-d') {
+ $deinterpolate = 1;
+ }
+ else {
+ die "Unrecognized switch: -$switch";
+ }
+}
+
+@ARGV = ('foo.xml') unless @ARGV;
+my $filename = shift;
+
+$::curstate = 0;
+$::prevstate = 0;
+$::curenc = 1; # start in iso-8859-1, sigh...
+
+$::H = "HeredocHere000";
+%::H = ();
+
+my @enc = (
+ 'utf-8',
+ 'iso-8859-1',
+);
+
+my %enc = (
+ 'utf-8' => 0,
+ 'iso-8859-1' => 1,
+);
+
+my %madtype = (
+ '$' => 'p5::sigil',
+ '@' => 'p5::sigil',
+ '%' => 'p5::sigil',
+ '&' => 'p5::sigil',
+ '*' => 'p5::sigil',
+ 'o' => 'p5::operator',
+ '~' => 'p5::operator',
+ '+' => 'p5::punct',
+ '?' => 'p5::punct',
+ ':' => 'p5::punct',
+ ',' => 'p5::punct',
+ ';' => 'p5::punct',
+ '#' => 'p5::punct',
+ '(' => 'p5::opener',
+ ')' => 'p5::closer',
+ '[' => 'p5::opener',
+ ']' => 'p5::closer',
+ '{' => 'p5::opener',
+ '}' => 'p5::closer',
+ '1' => 'p5::punct',
+ '2' => 'p5::punct',
+ 'a' => 'p5::operator',
+ 'A' => 'p5::operator',
+ 'd' => 'p5::declarator',
+ 'E' => 'p5::text',
+ 'L' => 'p5::label',
+ 'm' => 'p5::remod',
+# 'n' => 'p5::name',
+ 'q' => 'p5::openquote',
+ 'Q' => 'p5::closequote',
+ '=' => 'p5::text',
+ 'R' => 'p5::text',
+ 's' => 'p5::text',
+ 's' => 'p5::declarator',
+# 'V' => 'p5::version',
+ 'X' => 'p5::token',
+);
+
+$SIG{__DIE__} = sub {
+ my $e = shift;
+ $e =~ s/\n$/\n [NODE $filename line $::prevstate->{line}]/ if $::prevstate;
+ confess $e;
+};
+
+use Data::Dumper;
+$Data::Dumper::Indent = 1;
+$Data::Dumper::Quotekeys = 0;
+
+sub d {
+ my $text = Dumper(@_);
+ # doesn't scale well, alas
+ 1 while $text =~ s/(.*)^([^\n]*)bless\( \{\n(.*?)^(\s*\}), '([^']*)' \)([^\n]*)/$1$2$5 {\n$3$4$6 # $5/ms;
+ $text =~ s/PLXML:://g;
+ if ($text) {
+ my ($package, $filename, $line) = caller;
+ my $subroutine = (caller(1))[3];
+ $text =~ s/\n?\z/, called from $subroutine, line $line\n/;
+ warn $text;
+ }
+};
+
+{
+
+ my %xmlrepl = (
+ '&' => '&',
+ "'" => ''',
+ '"' => '&dquo;',
+ '<' => '<',
+ '>' => '>',
+ "\n" => ' ',
+ "\t" => '	',
+ );
+
+ sub x {
+ my $indent = 0;
+ if (@_ > 1) {
+ warn xdolist($indent,"LIST",@_);
+ }
+ else {
+ my $type = ref $_[0];
+ if ($type) {
+ warn xdoitem($indent,$type,@_);
+ }
+ else {
+ warn xdoitem($indent,"ITEM",@_);
+ }
+ }
+ }
+
+ sub xdolist {
+ my $indent = shift;
+ my $tag = shift;
+ my $in = ' ' x ($indent * 2);
+ my $result;
+ $result .= "$in<$tag>\n" if defined $tag;
+ for my $it (@_) {
+ my $itt = ref $it || "ITEM";
+ $itt =~ s/::/:/g;
+ $result .= xdoitem($indent+1,$itt,$it);
+ }
+ $result .= "$in</$tag>\n" if defined $tag;
+ return $result;
+ }
+
+ sub xdohash {
+ my $indent = shift;
+ my $tag = shift;
+ my $hash = shift;
+ my $in = ' ' x ($indent * 2);
+ my $result = "$in<$tag>\n";
+ my @keys = sort keys %$hash;
+ my $longest = 0;
+ for my $k (@keys) {
+ $longest = length($k) if length($k) > $longest;
+ }
+ my $K;
+ for my $k (@keys) {
+ my $tmp;
+ $K = $$hash{$k}, next if $k eq 'Kids';
+ my $sp = ' ' x ($longest - length($k));
+ if (ref $$hash{$k}) {
+ $tmp = xdoitem($indent+1,"kv",$$hash{$k});
+ $tmp =~ s!^ *<kv>\n *</kv>!$in <kv/>!;
+ }
+ else {
+ $tmp = xdoitem($indent+1,"kv",$$hash{$k});
+ }
+ $k =~ s/([\t\n'"<>&])/$xmlrepl{$1}/g;
+ $tmp =~ s/<kv/<kv k='$k'$sp/ or
+ $tmp =~ s/^(.*)$/$in <kv k='$k'>\n$in $1$in <\/kv>\n/s;
+ $result .= $tmp;
+ }
+ if ($K and @$K) {
+ $result .= xdolist($indent, undef, @$K);
+ }
+ $result .= "$in</$tag>\n";
+ }
+
+ sub xdoitem {
+ my $indent = shift;
+ my $tag = shift;
+ my $item = shift;
+ my $in = ' ' x ($indent * 2);
+ my $r = ref $item;
+ if (not $r) {
+ $item =~ s/([\t\n'"<>&])/$xmlrepl{$1}/g;
+ return "$in<$tag>$item</$tag>\n";
+ }
+ (my $newtag = $r) =~ s/::/:/g;
+ my $t = "$item";
+ if ($t =~ /\bARRAY\b/) {
+ if (@{$item}) {
+ return xdolist($indent,$tag,@{$item});
+ }
+ else {
+ return "$in<$tag />\n";
+ }
+ }
+ if ($t =~ /\bHASH\b/) {
+ return xdohash($indent,$tag,$item);
+ }
+ if ($r =~ /^p5::/) {
+ return "$in<$newtag>$$item</$newtag>\n";
+ }
+ else {
+ return "$in<$newtag type='$r'/>\n";
+ }
+ }
+
+ my %trepl = (
+ "'" => '\\\'',
+ '"' => '\\"',
+ "\n" => '\\n',
+ "\t" => '\\t',
+ );
+
+ sub t {
+ my $indent = 0;
+ if (@_ > 1) {
+ tdolist($indent,"LIST",@_);
+ }
+ else {
+ my $type = ref $_[0];
+ if ($type) {
+ tdoitem($indent,$type,@_);
+ }
+ else {
+ tdoitem($indent,"ITEM",@_);
+ }
+ }
+ print STDERR "\n";
+ }
+
+ sub tdolist {
+ my $indent = shift;
+ my $tag = shift || "ARRAY";
+ my $in = ' ' x ($indent * 2);
+ if (@_) {
+ print STDERR "[\n";
+ for my $it (@_) {
+ my $itt = ref $it || "ITEM";
+ print STDERR $in," ";
+ tdoitem($indent+1,$itt,$it);
+ print STDERR "\n";
+ }
+ print STDERR "$in]";
+ }
+ else {
+ print STDERR "[]";
+ }
+ }
+
+ sub tdohash {
+ my $indent = shift;
+ my $tag = shift;
+ my $hash = shift;
+ my $in = ' ' x ($indent * 2);
+
+ print STDERR "$tag => {\n";
+
+ my @keys = sort keys %$hash;
+ my $longest = 0;
+ for my $k (@keys) {
+ $longest = length($k) if length($k) > $longest;
+ }
+ my $K;
+ for my $k (@keys) {
+ my $sp = ' ' x ($longest - length($k));
+ print STDERR "$in $k$sp => ";
+ tdoitem($indent+1,"",$$hash{$k});
+ if ($k eq 'Kids') {
+ print STDERR " # Kids";
+ }
+ print STDERR "\n";
+ }
+ print STDERR "$in} # $tag";
+ }
+
+ sub tdoitem {
+ my $indent = shift;
+ my $tag = shift;
+ my $item = shift;
+ if (not defined $item) {
+ print STDERR "UNDEF";
+ return;
+ }
+# my $in = ' ' x ($indent * 2);
+ my $r = ref $item;
+ if (not $r) {
+ $item =~ s/([\t\n"])/$trepl{$1}/g;
+ print STDERR "\"$item\"";
+ return;
+ }
+ my $t = "$item";
+ if ($r =~ /^p5::/) {
+ my $str = $$item{uni};
+ my $enc = $enc[$$item{enc}] . ' ';
+ $enc =~ s/iso-8859-1 //;
+ $str =~ s/([\t\n"])/$trepl{$1}/g;
+ print STDERR "$r $enc\"$str\"";
+ }
+ elsif ($t =~ /\bARRAY\b/) {
+ tdolist($indent,$tag,@{$item});
+ }
+ elsif ($t =~ /\bHASH\b/) {
+ tdohash($indent,$tag,$item);
+ }
+ else {
+ print STDERR "$r type='$r'";
+ }
+ }
+}
+
+sub encnum {
+ my $encname = shift;
+ if (not exists $enc{$encname}) {
+ push @enc, $encname;
+ return $enc{$encname} = $#enc;
+ }
+ return $enc{$encname};
+}
+
+use PLXML;
+
+use XML::Parser;
+my $p1 = new XML::Parser(Style => 'Objects', Pkg => 'PLXML');
+$p1->setHandlers('Char' => sub { warn "Chars $_[1]" if $_[1] =~ /\S/; });
+
+# First slurp XML into tree of objects.
+
+my $root = $p1->parsefile($filename);
+
+# Now turn XML tree into something more like an AST.
+
+PLXML::prepreproc($root->[0]);
+my $ast = P5AST->new('Kids' => [$root->[0]->ast()]);
+#::t($ast);
+
+if ($YAML) {
+ require YAML::Syck;
+ print YAML::Syck::Dump($ast);
+ exit;
+}
+
+# Finally, walk AST to produce new program.
+
+my $text = $ast->p5text(); # returns encoded, must output raw
+print $text;
+
+package p5::text;
+
+use Encode;
+
+sub new {
+ my $class = shift;
+ my $text = shift;
+ die "Too many args to new" if @_;
+ die "Attempt to bless non-text $text" if ref $text;
+ return bless( { uni => $text,
+ enc => $::curenc,
+ }, $class);
+}
+
+sub uni { my $self = shift; $$self{uni}; } # internal stuff all in utf8
+
+sub enc {
+ my $self = shift;
+ my $enc = $enc[$$self{enc} || 0];
+ return encode($enc, $$self{uni});
+}
+
+package p5::closequote; BEGIN { @p5::closequote::ISA = 'p5::punct'; }
+package p5::closer; BEGIN { @p5::closer::ISA = 'p5::punct'; }
+package p5::declarator; BEGIN { @p5::declarator::ISA = 'p5::token'; }
+package p5::junk; BEGIN { @p5::junk::ISA = 'p5::text'; }
+package p5::label; BEGIN { @p5::label::ISA = 'p5::token'; }
+#package p5::name; BEGIN { @p5::name::ISA = 'p5::token'; }
+package p5::opener; BEGIN { @p5::opener::ISA = 'p5::punct'; }
+package p5::openquote; BEGIN { @p5::openquote::ISA = 'p5::punct'; }
+package p5::operator; BEGIN { @p5::operator::ISA = 'p5::token'; }
+package p5::punct; BEGIN { @p5::punct::ISA = 'p5::token'; }
+package p5::remod; BEGIN { @p5::remod::ISA = 'p5::token'; }
+package p5::sigil; BEGIN { @p5::sigil::ISA = 'p5::punct'; }
+package p5::token; BEGIN { @p5::token::ISA = 'p5::text'; }
+#package p5::version; BEGIN { @p5::version::ISA = 'p5::token'; }
+
+################################################################
+# Routines to turn XML tree into an AST. Mostly this amounts to hoisting
+# misplaced nodes and flattening various things into lists.
+
+package PLXML;
+
+sub AUTOLOAD {
+ ::x("AUTOLOAD $PLXML::AUTOLOAD", @_);
+ return "[[[ $PLXML::AUTOLOAD ]]]";
+}
+
+sub prepreproc {
+ my $self = shift;
+ my $kids = $$self{Kids};
+ $self->{mp} = {};
+ if (defined $kids) {
+ my $i;
+ for ($i = 0; $i < @$kids; $i++) {
+ if (ref $kids->[$i] eq "PLXML::madprops") {
+ $self->{mp} = splice(@$kids, $i, 1)->hash($self,@_);
+ $i--;
+ next;
+ }
+ else {
+ prepreproc($kids->[$i], $self, @_);
+ }
+ }
+ }
+}
+
+sub preproc {
+ my $self = shift;
+ if (ref $self eq 'PLXML::op_null' and $$self{was}) {
+ return "PLXML::op_$$self{was}"->key();
+ }
+ else {
+ return $self->key();
+ }
+}
+
+sub newtype {
+ my $self = shift;
+ my $t = ref $self || $self;
+ $t = "PLXML::op_$$self{was}" if $t eq 'PLXML::op_null' and $$self{was};
+ $t =~ s/PLXML/P5AST/ or die "Bad type: $t";
+ return $t;
+}
+
+sub madness {
+ my $self = shift;
+ my @keys = split(' ', shift);
+ my @vals = ();
+ for my $key (@keys) {
+ my $madprop = $self->{mp}{$key};
+ next unless defined $madprop;
+ if (ref $madprop eq 'PLXML::mad_op') {
+ if ($key eq 'b') {
+ push @vals, $madprop->blockast($self, @_);
+ }
+ else {
+ push @vals, $madprop->ast($self, @_);
+ }
+ next;
+ }
+ my $white;
+ if ($white = $self->{mp}{"_$key"}) {
+ push @vals, p5::junk->new($white);
+ }
+ my $type = $madtype{$key} || "p5::token";
+ push @vals, $type->new($madprop);
+ if ($white = $self->{mp}{"#$key"}) {
+ push @vals, p5::junk->new($white);
+ }
+ }
+ @vals;
+}
+
+sub blockast {
+ my $self = shift;
+ $self->ast(@_);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @newkids;
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ return $self->newtype->new(Kids => [uc $self->key(), "(", @newkids, ")"]);
+}
+
+sub op {
+ my $self = shift;
+ my $desc = $self->desc();
+ if ($desc =~ /\((.*?)\)/) {
+ return $1;
+ }
+ else {
+ return " <<" . $self->key() . ">> ";
+ }
+}
+
+sub mp {
+ my $self = shift;
+ return $self->{mp};
+}
+
+package PLXML::Characters;
+
+sub ast { die "oops" }
+sub pair { die "oops" }
+
+package PLXML::madprops;
+
+sub ast {
+ die "oops madprops";
+}
+
+sub hash {
+ my $self = shift;
+ my @pairs;
+ my %hash = ();
+ my $firstthing = '';
+ my $lastthing = '';
+
+ # We need to guarantee key uniqueness at this point.
+ for my $kid (@{$$self{Kids}}) {
+ my ($k,$v) = $kid->pair($self, @_);
+ $firstthing ||= $k;
+ if ($k =~ /^[_#]$/) { # rekey whitespace according to preceding entry
+ $k .= $lastthing; # (which is actually the token the whitespace is before)
+ }
+ else {
+ $k .= 'x' while exists $hash{$k};
+ $lastthing = $k;
+ }
+ $hash{$k} = $v;
+ }
+ $hash{FIRST} = $firstthing;
+ $hash{LAST} = $lastthing;
+ return \%hash;
+}
+
+package PLXML::mad_op;
+
+sub pair {
+ my $self = shift;
+ my $key = $$self{key};
+ return $key,$self;
+}
+
+sub ast {
+ my $self = shift;
+ $self->prepreproc(@_);
+ my @vals;
+ for my $kid (@{$$self{Kids}}) {
+ push @vals, $kid->ast($self, @_);
+ }
+ if (@vals == 1) {
+ return @vals;
+ }
+ else {
+ return P5AST::op_list->new(Kids => [@vals]);
+ }
+}
+
+sub blockast {
+ my $self = shift;
+ $self->prepreproc(@_);
+ my @vals;
+ for my $kid (@{$$self{Kids}}) {
+ push @vals, $kid->blockast($self, @_);
+ }
+ if (@vals == 1) {
+ return @vals;
+ }
+ else {
+ return P5AST::op_lineseq->new(Kids => [@vals]);
+ }
+}
+
+package PLXML::mad_pv;
+
+sub pair {
+ my $self = shift;
+ my $key = $$self{key};
+ my $val = $$self{val};
+ $val =~ s/STUPIDXML\(#x(\w+)\)/chr(hex $1)/eg;
+ return $key,$val;
+}
+
+package PLXML::mad_sv;
+
+sub pair {
+ my $self = shift;
+ my $key = $$self{key};
+ my $val = $$self{val};
+ $val =~ s/STUPIDXML\(#x(\w+)\)/chr(hex $1)/eg;
+ return $key,$val;
+}
+
+package PLXML::baseop;
+
+sub ast {
+ my $self = shift;
+
+ my @retval;
+ my @newkids;
+ push @retval, $self->madness('M ox');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ if (@newkids) {
+ push @retval, uc $self->key(), "(", @newkids , ")";
+ }
+ else {
+ push @retval, $self->madness('o ( )');
+ }
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+package PLXML::baseop_unop;
+
+sub ast {
+ my $self = shift;
+ my @newkids = $self->madness('d M ox o (');
+
+ if (exists $$self{Kids}) {
+ my $arg = $$self{Kids}[0];
+ push @newkids, $arg->ast($self, @_) if defined $arg;
+ }
+ push @newkids, $self->madness(')');
+
+ return $self->newtype()->new(Kids => [@newkids]);
+}
+
+package PLXML::binop;
+
+sub ast {
+ my $self = shift;
+ my @newkids;
+
+ push @newkids, $self->madness('M ox');
+
+ my $left = $$self{Kids}[0];
+ push @newkids, $left->ast($self, @_);
+
+ push @newkids, $self->madness('o');
+
+ my $right = $$self{Kids}[1];
+ if (defined $right) {
+ push @newkids, $right->ast($self, @_);
+ }
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::cop;
+
+package PLXML::filestatop;
+
+sub ast {
+ my $self = shift;
+
+ my @newkids = $self->madness('o (');
+
+ if (@{$$self{Kids}}) {
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ }
+ if ($$self{mp}{O}) {
+ push @newkids, $self->madness('O');
+ }
+ push @newkids, $self->madness(')');
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::listop;
+
+sub ast {
+ my $self = shift;
+
+ my @retval;
+ my @before;
+ my @after;
+ if (@before = $self->madness('M')) {
+ push @before, $self->madness('ox'); # o is the function name
+ }
+ if (@retval = $self->madness('X')) {
+ push @before, $self->madness('o x');
+ return P5AST::listop->new(Kids => [@before,@retval]);
+ }
+
+ push @retval, $self->madness('o (');
+
+ my @newkids;
+ for my $kid (@{$$self{Kids}}) {
+ next if ref $kid eq 'PLXML::op_pushmark';
+ next if ref $kid eq 'PLXML::op_null' and
+ defined $$kid{was} and $$kid{was} eq 'pushmark';
+ push @newkids, $kid->ast($self, @_);
+ }
+
+ my $x = "";
+
+ if ($$self{mp}{S}) {
+ push @retval, $self->madness('S');
+ }
+ push @retval, @newkids;
+
+ push @retval, $self->madness(')');
+ return $self->newtype->new(Kids => [@before,@retval,@after]);
+}
+
+package PLXML::logop;
+
+sub ast {
+ my $self = shift;
+
+ my @newkids;
+ push @newkids, $self->madness('o (');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ push @newkids, $self->madness(')');
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::loop;
+
+package PLXML::loopexop;
+
+sub ast {
+ my $self = shift;
+ my @newkids = $self->madness('o (');
+
+ if ($$self{mp}{L} or not $$self{flags} =~ /\bSPECIAL\b/) {
+ my @label = $self->madness('L');
+ if (@label) {
+ push @newkids, @label;
+ }
+ else {
+ my $arg = $$self{Kids}[0];
+ push @newkids, $arg->ast($self, @_) if defined $arg;
+ }
+ }
+ push @newkids, $self->madness(')');
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+
+package PLXML::padop;
+
+package PLXML::padop_svop;
+
+package PLXML::pmop;
+
+sub ast {
+ my $self = shift;
+
+ return P5AST::pmop->new(Kids => []) unless exists $$self{flags};
+
+ my $bits = $self->fetchbits($$self{flags},@_);
+
+ my @newkids;
+ if ($bits->{binding}) {
+ push @newkids, $bits->{binding};
+ push @newkids, $self->madness('~');
+ }
+ if (exists $bits->{regcomp} and $bits->{regcomp}) {
+ my @front = $self->madness('q');
+ my @back = $self->madness('Q');
+ push @newkids, @front, $bits->{regcomp}, @back,
+ $self->madness('m');
+ }
+ elsif ($$self{mp}{q}) {
+ push @newkids, $self->madness('q = Q m');
+ }
+ elsif ($$self{mp}{X}) {
+ push @newkids, $self->madness('X m');
+ }
+ else {
+ push @newkids, $self->madness('e m');
+ }
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+sub innerpmop {
+ my $pmop = shift;
+ my $bits = shift;
+ for my $key (grep {!/^Kids/} keys %$pmop) {
+ $bits->{$key} = $pmop->{$key};
+ }
+
+ # Have to delete all the fake evals of the repl. This is a pain...
+ if (@{$$pmop{Kids}}) {
+ my $really = $$pmop{Kids}[0]{Kids}[0];
+ if (ref $really eq 'PLXML::op_substcont') {
+ $really = $$really{Kids}[0];
+ }
+ while ((ref $really) =~ /^PLXML::op_.*(null|entereval)/) {
+ if (exists $$really{was}) {
+ $bits->{repl} = $really->ast(@_);
+ return;
+ }
+ $really = $$really{Kids}[0];
+ }
+ if (ref $really eq 'PLXML::op_scope' and
+ @{$$really{Kids}} == 1 and
+ ref $$really{Kids}[0] eq 'PLXML::op_null' and
+ not @{$$really{Kids}[0]{Kids}})
+ {
+ $bits->{repl} = '';
+ return;
+ }
+ if (ref $really eq 'PLXML::op_leave' and
+ @{$$really{Kids}} == 2 and
+ ref $$really{Kids}[1] eq 'PLXML::op_null' and
+ not @{$$really{Kids}[1]{Kids}})
+ {
+ $bits->{repl} = '';
+ return;
+ }
+ if ((ref $really) =~ /^PLXML::op_(scope|leave)/) {
+ # should be at inner do {...} here, so skip that fakery too
+ $bits->{repl} = $really->newtype->new(Kids => [$really->PLXML::op_lineseq::lineseq(@_)]);
+ # but retrieve the whitespace before fake '}'
+ if ($$really{mp}{'_}'}) {
+ push(@{$bits->{repl}->{Kids}}, p5::junk->new($$really{mp}{'_}'}));
+ }
+ }
+ else { # something else, padsv probably
+ $bits->{repl} = $really->ast(@_);
+ }
+ }
+}
+
+sub fetchbits {
+ my $self = shift;
+ my $flags = shift || '';
+ my %bits = %$self;
+ my @kids = @{$$self{Kids}};
+ if (@kids) {
+ delete $bits{Kids};
+ my $arg = shift @kids;
+ innerpmop($arg,\%bits, $self, @_);
+ if ($flags =~ /STACKED/) {
+ $arg = shift @kids;
+ $bits{binding} = $arg->ast($self, @_);
+ }
+ if ($bits{when} ne "COMP" and @kids) {
+ $arg = pop @kids;
+ $bits{regcomp} = $arg->ast($self, @_);
+ }
+ if (not exists $bits{repl} and @kids) {
+ $arg = shift @kids;
+ $bits{repl} = $arg->ast($self, @_);
+ }
+ }
+ return \%bits;
+}
+
+package PLXML::pvop_svop;
+
+package PLXML::unop;
+
+sub ast {
+ my $self = shift;
+ my @newkids = $self->madness('o (');
+
+ if (exists $$self{Kids}) {
+ my $arg = $$self{Kids}[0];
+ push @newkids, $arg->ast($self, @_) if defined $arg;
+ }
+ push @newkids, $self->madness(')');
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML;
+package PLXML::Characters;
+package PLXML::madprops;
+package PLXML::mad_op;
+package PLXML::mad_pv;
+package PLXML::baseop;
+package PLXML::baseop_unop;
+package PLXML::binop;
+package PLXML::cop;
+package PLXML::filestatop;
+package PLXML::listop;
+package PLXML::logop;
+package PLXML::loop;
+package PLXML::loopexop;
+package PLXML::padop;
+package PLXML::padop_svop;
+package PLXML::pmop;
+package PLXML::pvop_svop;
+package PLXML::unop;
+package PLXML::op_null;
+
+# Null nodes typed by first madprop.
+
+my %astmad;
+
+BEGIN {
+ %astmad = (
+ 'p' => sub { # peg for #! line, etc.
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('p px');
+ $::curstate = 0;
+ return P5AST::peg->new(Kids => [@newkids])
+ },
+ '(' => sub { # extra parens around the whole thing
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('dx d o (');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ push @newkids, $self->madness(')');
+ return P5AST::parens->new(Kids => [@newkids])
+ },
+ '~' => sub { # binding operator
+ my $self = shift;
+ my @newkids;
+ push @newkids, $$self{Kids}[0]->ast($self,@_);
+ push @newkids, $self->madness('~');
+ push @newkids, $$self{Kids}[1]->ast($self,@_);
+ return P5AST::bindop->new(Kids => [@newkids])
+ },
+ ';' => sub { # null statements/blocks
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('{ ; }');
+ $::curstate = 0;
+ return P5AST::nothing->new(Kids => [@newkids])
+ },
+ 'I' => sub { # if or unless statement keyword
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('L I (');
+ my @subkids;
+ for my $kid (@{$$self{Kids}}) {
+ push @subkids, $kid->ast($self, @_);
+ }
+ die "oops in op_null->new" unless @subkids == 1;
+ my $newself = $subkids[0];
+ @subkids = @{$$newself{Kids}};
+
+ unshift @{$subkids[0]{Kids}}, @newkids;
+ push @{$subkids[0]{Kids}}, $self->madness(')');
+ return bless($newself, 'P5AST::condstate');
+ },
+ 'U' => sub { # use
+ my $self = shift;
+ my @newkids;
+ my @module = $self->madness('U');
+ my @args = $self->madness('A');
+ my $module = $module[-1]{Kids}[-1];
+ if ($module->uni eq 'bytes') {
+ $::curenc = ::encnum('iso-8859-1');
+ }
+ elsif ($module->uni eq 'utf8') {
+ if ($$self{mp}{o} eq 'no') {
+ $::curenc = ::encnum('iso-8859-1');
+ }
+ else {
+ $::curenc = ::encnum('utf-8');
+ }
+ }
+ elsif ($module->uni eq 'encoding') {
+ if ($$self{mp}{o} eq 'no') {
+ $::curenc = ::encnum('iso-8859-1');
+ }
+ else {
+ $::curenc = ::encnum(eval $args[0]->p5text); # XXX bletch
+ }
+ }
+ # (Surrounding {} ends up here if use is only thing in block.)
+ push @newkids, $self->madness('{ o');
+ push @newkids, @module;
+ push @newkids, $self->madness('V');
+ push @newkids, @args;
+ push @newkids, $self->madness('S ; }');
+ $::curstate = 0;
+ return P5AST::use->new(Kids => [@newkids])
+ },
+ '?' => sub { # ternary
+ my $self = shift;
+ my @newkids;
+ my @subkids;
+ my @condkids = @{$$self{Kids}[0]{Kids}};
+
+ push @newkids, $condkids[0]->ast($self,@_), $self->madness('?');
+ push @newkids, $condkids[1]->ast($self,@_), $self->madness(':');
+ push @newkids, $condkids[2]->ast($self,@_);
+ return P5AST::ternary->new(Kids => [@newkids])
+ },
+ '&' => sub { # subroutine
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('d n s a : { & } ;');
+ $::curstate = 0;
+ return P5AST::sub->new(Kids => [@newkids])
+ },
+ 'i' => sub { # modifier if
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('i');
+ my $cond = $$self{Kids}[0];
+ my @subkids;
+ for my $kid (@{$$cond{Kids}}) {
+ push @subkids, $kid->ast($self, @_);
+ }
+ push @newkids, shift @subkids;
+ unshift @newkids, @subkids;
+ return P5AST::condmod->new(Kids => [@newkids])
+ },
+ 'P' => sub { # package declaration
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('o');
+ push @newkids, $self->madness('P');
+ push @newkids, $self->madness(';');
+ $::curstate = 0;
+ return P5AST::package->new(Kids => [@newkids])
+ },
+ 'F' => sub { # format
+ my $self = shift;
+ my @newkids = $self->madness('F n b');
+ $::curstate = 0;
+ return P5AST::format->new(Kids => [@newkids])
+ },
+ 'x' => sub { # qw literal
+ my $self = shift;
+ return P5AST::qwliteral->new(Kids => [$self->madness('x')])
+ },
+ 'q' => sub { # random quote
+ my $self = shift;
+ return P5AST::quote->new(Kids => [$self->madness('q = Q')])
+ },
+ 'X' => sub { # random literal
+ my $self = shift;
+ return P5AST::token->new(Kids => [$self->madness('X')])
+ },
+ ':' => sub { # attr list
+ my $self = shift;
+ return P5AST::attrlist->new(Kids => [$self->madness(':')])
+ },
+ ',' => sub { # "unary ," so to speak
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness(',');
+ push @newkids, $$self{Kids}[0]->ast($self,@_);
+ return P5AST::listelem->new(Kids => [@newkids])
+ },
+ 'C' => sub { # constant conditional
+ my $self = shift;
+ my @newkids;
+ push @newkids, $$self{Kids}[0]->ast($self,@_);
+ my @folded = $self->madness('C');
+ if (@folded) {
+ my @t = $self->madness('t');
+ my @e = $self->madness('e');
+ if (@e) {
+ return P5AST::op_cond_expr->new(
+ Kids => [
+ $self->madness('I ('),
+ @folded,
+ $self->madness(') ?'),
+ P5AST::op_cond_expr->new(Kids => [@newkids]),
+ $self->madness(':'),
+ @e
+ ] );
+ }
+ else {
+ return P5AST::op_cond_expr->new(
+ Kids => [
+ $self->madness('I ('),
+ @folded,
+ $self->madness(') ?'),
+ @t,
+ $self->madness(':'),
+ @newkids
+ ] );
+ }
+ }
+ return P5AST::op_null->new(Kids => [@newkids])
+ },
+ '+' => sub { # unary +
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('+');
+ push @newkids, $$self{Kids}[0]->ast($self,@_);
+ return P5AST::preplus->new(Kids => [@newkids])
+ },
+ 'D' => sub { # do block
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('D');
+ push @newkids, $$self{Kids}[0]->ast($self,@_);
+ return P5AST::doblock->new(Kids => [@newkids])
+ },
+ '3' => sub { # C-style for loop
+ my $self = shift;
+ my @newkids;
+
+ # What a mess!
+ my (undef, $init, $lineseq) = @{$$self{Kids}[0]{Kids}};
+ my (undef, $leaveloop) = @{$$lineseq{Kids}};
+ my (undef, $null) = @{$$leaveloop{Kids}};
+ my $and;
+ my $cond;
+ my $lineseq2;
+ my $block;
+ my $cont;
+ if (exists $$null{was} and $$null{was} eq 'and') {
+ ($lineseq2) = @{$$null{Kids}};
+ }
+ else {
+ ($and) = @{$$null{Kids}};
+ ($cond, $lineseq2) = @{$$and{Kids}};
+ }
+ if ($$lineseq2{mp}{'{'}) {
+ $block = $lineseq2;
+ }
+ else {
+ ($block, $cont) = @{$$lineseq2{Kids}};
+ }
+
+ push @newkids, $self->madness('L 3 (');
+ push @newkids, $init->ast($self,@_);
+ push @newkids, $self->madness('1');
+ if (defined $cond) {
+ push @newkids, $cond->ast($self,@_);
+ }
+ elsif (defined $null) {
+ push @newkids, $null->madness('1');
+ }
+ push @newkids, $self->madness('2');
+ if (defined $cont) {
+ push @newkids, $cont->ast($self,@_);
+ }
+ push @newkids, $self->madness(')');
+ push @newkids, $block->blockast($self,@_);
+ $::curstate = 0;
+ return P5AST::cfor->new(Kids => [@newkids])
+ },
+ 'o' => sub { # random useless operator
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('o');
+ my $kind = $newkids[-1] || '';
+ $kind = $kind->uni if ref $kind;
+ my @subkids;
+ for my $kid (@{$$self{Kids}}) {
+ push @subkids, $kid->ast($self, @_);
+ }
+ if ($kind eq '=') { # stealth readline
+ unshift(@newkids, shift(@subkids));
+ push(@newkids, @subkids);
+ return P5AST::op_aassign->new(Kids => [@newkids])
+ }
+ else {
+ my $newself = $subkids[0];
+ splice(@{$newself->{Kids}}, 1, 0,
+ $self->madness('ox ('),
+ @newkids,
+ $self->madness(')')
+ );
+ return $newself;
+ }
+ },
+ );
+}
+
+# Null nodes are an untyped mess inside Perl. Instead of fixing it there,
+# we derive an effective type either from the "was" field or the first madprop.
+# (The individual routines select the actual new type.)
+
+sub ast {
+ my $self = shift;
+ my $was = $$self{was} || 'peg';
+ my $mad = $$self{mp}{FIRST} || "unknown";
+
+ # First try for a "was".
+ my $meth = "PLXML::op_${was}::astnull";
+ if (exists &{$meth}) {
+ return $self->$meth(@_);
+ }
+
+ # Look at first madprop.
+ if (exists $astmad{$mad}) {
+ return $astmad{$mad}->($self);
+ }
+ warn "No mad $mad" unless $mad eq 'unknown';
+
+ # Do something generic.
+ my @newkids;
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+sub blockast {
+ my $self = shift;
+ local $::curstate;
+ local $::curenc = $::curenc;
+ return $self->madness('{ ; }');
+}
+
+package PLXML::op_stub;
+
+sub ast {
+ my $self = shift;
+ return $self->newtype->new(Kids => [$self->madness(', x ( ) q = Q')]);
+}
+
+package PLXML::op_scalar;
+
+sub ast {
+ my $self = shift;
+
+ my @pre = $self->madness('o q');
+ my $op = pop @pre;
+ if ($op->uni =~ /^<</) {
+ my @newkids;
+ my $opstub = bless { start => $op }, 'P5AST::heredoc';
+ push @newkids, $opstub;
+ push @newkids, $self->madness('(');
+
+ my @kids = @{$$self{Kids}};
+
+ my @divert;
+ for my $kid (@kids) {
+ next if ref $kid eq 'PLXML::op_pushmark';
+ next if ref $kid eq 'PLXML::op_null' and
+ defined $$kid{was} and $$kid{was} eq 'pushmark';
+ push @divert, $kid->ast($self, @_);
+ }
+ $opstub->{doc} = P5AST::op_list->new(Kids => [@divert]);
+ $opstub->{end} = ($self->madness('Q'))[-1];
+
+ push @newkids, $self->madness(')');
+
+ return $self->newtype->new(Kids => [@pre,@newkids]);
+ }
+ return $self->PLXML::baseop_unop::ast();
+}
+
+package PLXML::op_pushmark;
+
+sub ast { () }
+
+package PLXML::op_wantarray;
+package PLXML::op_const;
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+ return unless $$self{mp};
+ push @newkids, $self->madness('q = Q X : f O ( )');
+ return P5AST::op_const->new(Kids => [@newkids]);
+}
+
+sub ast {
+ my $self = shift;
+ return unless %{$$self{mp}};
+
+ my @before;
+
+ my $const;
+ my @args = $self->madness('f');
+ if (@args) {
+ }
+ elsif (exists $self->{mp}{q}) {
+ push @args, $self->madness('d q');
+ if ($args[-1]->uni =~ /^<</) {
+ my $opstub = bless { start => pop(@args) }, 'P5AST::heredoc';
+ $opstub->{doc} = P5AST::op_const->new(Kids => [$self->madness('=')]);
+ $opstub->{end} = ($self->madness('Q'))[-1];
+ push @args, $opstub;
+ }
+ else {
+ push @args, $self->madness('= Q');
+ }
+ }
+ elsif (exists $self->{mp}{X}) {
+ push @before, $self->madness('d'); # was local $[ probably
+ if (not $$self{mp}{O}) {
+ push @before, $self->madness('o'); # was unary
+ }
+ my @X = $self->madness(': X');
+ if (exists $$self{private} and $$self{private} =~ /BARE/) {
+ return $self->newtype->new(Kids => [@X]);
+ }
+ my $X = pop @X;
+ push @before, @X;
+ @args = (
+ $self->madness('x'),
+ $X);
+ if ($$self{mp}{O}) {
+ push @args, $self->madness('o O');
+ }
+ }
+ elsif (exists $self->{mp}{O}) {
+ push @args, $self->madness('O');
+ }
+ elsif ($$self{private} =~ /\bBARE\b/) {
+ @args = ($$self{PV});
+ }
+ elsif (exists $$self{mp}{o}) {
+ @args = $self->madness('o');
+ }
+ elsif (exists $$self{PV}) {
+ @args = ('"', $$self{PV}, '"');
+ }
+ elsif (exists $$self{NV}) {
+ @args = $$self{NV};
+ }
+ elsif (exists $$self{IV}) {
+ @args = $$self{IV};
+ }
+ else {
+ @args = $self->SUPER::text(@_);
+ }
+ return $self->newtype->new(Kids => [@before, @args]);
+}
+
+
+package PLXML::op_gvsv;
+
+sub ast {
+ my $self = shift;
+ my @args;
+ my @retval;
+ for my $attr (qw/gv GV flags/) {
+ if (exists $$self{$attr}) {
+ push @args, $attr, $$self{$attr};
+ }
+ }
+ push @retval, @args;
+ push @retval, $self->madness('X');
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+package PLXML::op_gv;
+
+sub ast {
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('X K');
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_gelem;
+
+sub ast {
+ my $self = shift;
+
+ local $::curstate; # in case there are statements in subscript
+ local $::curenc = $::curenc;
+ my @newkids;
+ push @newkids, $self->madness('dx d');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ splice @newkids, -1, 0, $self->madness('o {');
+ push @newkids, $self->madness('}');
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_padsv;
+
+sub ast {
+ my $self = shift;
+ my @args;
+ push @args, $self->madness('dx d ( $ )');
+
+ return $self->newtype->new(Kids => [@args]);
+}
+
+package PLXML::op_padav;
+
+sub astnull { ast(@_) }
+
+sub ast {
+ my $self = shift;
+ my @retval;
+ push @retval, $self->madness('dx d (');
+ push @retval, $self->madness('$ @');
+ push @retval, $self->madness(') o O');
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+package PLXML::op_padhv;
+
+sub astnull { ast(@_) }
+
+sub ast {
+ my $self = shift;
+ my @retval;
+ push @retval, $self->madness('dx d (');
+ push @retval, $self->madness('$ @ %');
+ push @retval, $self->madness(') o O');
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+package PLXML::op_padany;
+
+package PLXML::op_pushre;
+
+sub ast {
+ my $self = shift;
+ if ($$self{mp}{q}) {
+ return $self->madness('q = Q m');
+ }
+ if ($$self{mp}{X}) {
+ return $self->madness('X m');
+ }
+ if ($$self{mp}{e}) {
+ return $self->madness('e m');
+ }
+ return $$self{Kids}[1]->ast($self,@_), $self->madness('m');
+}
+
+package PLXML::op_rv2gv;
+
+sub ast {
+ my $self = shift;
+
+ my @newkids;
+ push @newkids, $self->madness('dx d ( * $');
+ push @newkids, $$self{Kids}[0]->ast();
+ push @newkids, $self->madness(')');
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_rv2sv;
+
+sub astnull {
+ my $self = shift;
+ return P5AST::op_rv2sv->new(Kids => [$self->madness('O o dx d ( $ ) : a')]);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @newkids;
+ push @newkids, $self->madness('dx d ( $');
+ if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
+ push @newkids, $$self{Kids}[0]->ast();
+ }
+ push @newkids, $self->madness(') : a');
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_av2arylen;
+
+sub ast {
+ my $self = shift;
+
+ my @newkids;
+ push @newkids, $$self{Kids}[0]->madness('l');
+ push @newkids, $$self{Kids}[0]->ast();
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_rv2cv;
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('X');
+ return @newkids if @newkids;
+ if (exists $$self{mp}{'&'}) {
+ push @newkids, $self->madness('&');
+ if (@{$$self{Kids}}) {
+ push @newkids, $$self{Kids}[0]->ast(@_);
+ }
+ }
+ else {
+ push @newkids, $$self{Kids}[0]->ast(@_);
+ }
+ return P5AST::op_rv2cv->new(Kids => [@newkids]);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @newkids;
+ push @newkids, $self->madness('&');
+ if (@{$$self{Kids}}) {
+ push @newkids, $$self{Kids}[0]->ast();
+ }
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_anoncode;
+
+sub ast {
+ my $self = shift;
+ my $arg = $$self{Kids}[0];
+ local $::curstate; # hide nested statements in sub
+ local $::curenc = $::curenc;
+ if (defined $arg) {
+ return $arg->ast(@_);
+ }
+ return ';'; # XXX literal ; should come through somewhere
+}
+
+package PLXML::op_prototype;
+package PLXML::op_refgen;
+
+sub ast {
+ my $self = shift;
+ my @newkids = $self->madness('o s a');
+
+ if (exists $$self{Kids}) {
+ my $arg = $$self{Kids}[0];
+ push @newkids, $arg->ast($self, @_) if defined $arg;
+ }
+
+ my $res = $self->newtype->new(Kids => [@newkids]);
+ return $res;
+}
+
+package PLXML::op_srefgen;
+
+sub ast {
+ my @newkids;
+ my $self = shift;
+ if ($$self{mp}{FIRST} eq '{') {
+ local $::curstate; # this is officially a block, so hide it
+ local $::curenc = $::curenc;
+ push @newkids, $self->madness('{');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ push @newkids, $self->madness('; }');
+ return P5AST::op_stringify->new(Kids => [@newkids]);
+ }
+ else {
+ push @newkids, $self->madness('o [');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ push @newkids, $self->madness(']');
+ return P5AST::op_stringify->new(Kids => [@newkids]);
+ }
+}
+
+package PLXML::op_ref;
+package PLXML::op_bless;
+package PLXML::op_backtick;
+
+sub ast {
+ my $self = shift;
+ my @args;
+ if (exists $self->{mp}{q}) {
+ push @args, $self->madness('q');
+ if ($args[-1]->uni =~ /^<</) {
+ my $opstub = bless { start => $args[-1] }, 'P5AST::heredoc';
+ $args[-1] = $opstub;
+ $opstub->{doc} = P5AST::op_const->new(Kids => [$self->madness('=')]);
+ $opstub->{end} = ($self->madness('Q'))[-1];
+ }
+ else {
+ push @args, $self->madness('= Q');
+ }
+ }
+ return $self->newtype->new(Kids => [@args]);
+}
+
+package PLXML::op_glob;
+
+sub astnull {
+ my $self = shift;
+ my @retval = $self->madness('o q = Q');
+ if (not @retval or $retval[-1]->uni eq 'glob') {
+ push @retval, $self->madness('(');
+ push @retval, $$self{Kids}[0]->ast($self,@_);
+ push @retval, $self->madness(')');
+ }
+ return P5AST::op_glob->new(Kids => [@retval]);
+}
+
+package PLXML::op_readline;
+
+sub astnull {
+ my $self = shift;
+ my @retval;
+ if (exists $$self{mp}{q}) {
+ @retval = $self->madness('q = Q');
+ }
+ elsif (exists $$self{mp}{X}) {
+ @retval = $self->madness('X');
+ }
+ return P5AST::op_readline->new(Kids => [@retval]);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @retval;
+
+ my @args;
+ my $const;
+ if (exists $$self{mp}{q}) {
+ @args = $self->madness('q = Q');
+ }
+ elsif (exists $$self{mp}{X}) {
+ @args = $self->madness('X');
+ }
+ elsif (exists $$self{GV}) {
+ @args = $$self{IV};
+ }
+ elsif (@{$$self{Kids}}) {
+ @args = $self->PLXML::unop::ast(@_);
+ }
+ else {
+ @args = $self->SUPER::text(@_);
+ }
+ return $self->newtype->new(Kids => [@retval,@args]);
+}
+
+
+package PLXML::op_rcatline;
+package PLXML::op_regcmaybe;
+package PLXML::op_regcreset;
+package PLXML::op_regcomp;
+
+sub ast {
+ my $self = shift;
+ $self->PLXML::unop::ast(@_);
+}
+
+package PLXML::op_match;
+
+sub ast {
+ my $self = shift;
+ my $retval = $self->SUPER::ast(@_);
+ my $p5re;
+ if (not $p5re = $retval->p5text()) {
+ $retval = $self->newtype->new(Kids => [$self->madness('X q = Q m')]);
+ $p5re = $retval->p5text();
+ }
+ if ($deinterpolate) {
+ $retval->{P5re} = P5re::qrparse($p5re);
+ }
+ return $retval;
+}
+
+package PLXML::op_qr;
+
+sub ast {
+ my $self = shift;
+ my $retval;
+ if (exists $$self{flags}) {
+ $retval = $self->SUPER::ast(@_);
+ }
+ else {
+ $retval = $self->newtype->new(Kids => [$self->madness('X q = Q m')]);
+ }
+ if ($deinterpolate) {
+ my $p5re = $retval->p5text();
+ $retval->{P5re} = P5re::qrparse($p5re);
+ }
+ return $retval;
+}
+
+package PLXML::op_subst;
+
+sub ast {
+ my $self = shift;
+
+ my $bits = $self->fetchbits($$self{flags},@_);
+
+ my @newkids;
+ if ($bits->{binding}) {
+ push @newkids, $bits->{binding};
+ push @newkids, $self->madness('~');
+ }
+ my $X = p5::token->new($$self{mp}{X});
+ my @lfirst = $self->madness('q');
+ my @llast = $self->madness('Q');
+ push @newkids,
+ @lfirst,
+ $self->madness('E'), # XXX s/b e probably
+ @llast;
+ my @rfirst = $self->madness('z');
+ my @rlast = $self->madness('Z');
+ my @mods = $self->madness('m');
+ if ($rfirst[-1]->uni ne $llast[-1]->uni) {
+ push @newkids, @rfirst;
+ }
+
+ push @newkids, $bits->{repl}, @rlast, @mods;
+
+ my $retval = $self->newtype->new(Kids => [@newkids]);
+ if ($deinterpolate) {
+ my $p5re = $retval->p5text();
+ $retval->{P5re} = P5re::qrparse($p5re);
+ }
+ return $retval;
+}
+
+package PLXML::op_substcont;
+package PLXML::op_trans;
+
+sub ast {
+ my $self = shift;
+
+# my $bits = $self->fetchbits($$self{flags},@_);
+#
+ my @newkids;
+ my @lfirst = $self->madness('q');
+ my @llast = $self->madness('Q');
+ push @newkids,
+ @lfirst,
+ $self->madness('E'),
+ @llast;
+ my @rfirst = $self->madness('z');
+ my @repl = $self->madness('R');
+ my @rlast = $self->madness('Z');
+ my @mods = $self->madness('m');
+ if ($rfirst[-1]->uni ne $llast[-1]->uni) {
+ push @newkids, @rfirst;
+ }
+
+ push @newkids, @repl, @rlast, @mods;
+
+ my $res = $self->newtype->new(Kids => [@newkids]);
+ return $res;
+}
+
+package PLXML::op_sassign;
+
+sub ast {
+ my $self = shift;
+ my @newkids;
+
+ my $right = $$self{Kids}[1];
+ eval { push @newkids, $right->ast($self, @_); };
+
+ push @newkids, $self->madness('o');
+
+ my $left = $$self{Kids}[0];
+ push @newkids, $left->ast($self, @_);
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_aassign;
+
+sub astnull { ast(@_) }
+
+sub ast {
+ my $self = shift;
+ my @newkids;
+
+ my $right = $$self{Kids}[1];
+ push @newkids, $right->ast($self, @_);
+
+ push @newkids, $self->madness('o');
+
+ my $left = $$self{Kids}[0];
+ push @newkids, $left->ast($self, @_);
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_chop;
+package PLXML::op_schop;
+package PLXML::op_chomp;
+package PLXML::op_schomp;
+package PLXML::op_defined;
+package PLXML::op_undef;
+package PLXML::op_study;
+package PLXML::op_pos;
+package PLXML::op_preinc;
+
+sub ast {
+ my $self = shift;
+ if ($$self{targ}) { # stealth post inc or dec
+ return $self->PLXML::op_postinc::ast(@_);
+ }
+ return $self->SUPER::ast(@_);
+}
+
+package PLXML::op_i_preinc;
+
+sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
+
+package PLXML::op_predec;
+
+sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
+
+package PLXML::op_i_predec;
+
+sub ast { my $self = shift; $self->PLXML::op_preinc::ast(@_); }
+
+package PLXML::op_postinc;
+
+sub ast {
+ my $self = shift;
+ my @newkids;
+
+ if (exists $$self{Kids}) {
+ my $arg = $$self{Kids}[0];
+ push @newkids, $arg->ast($self, @_) if defined $arg;
+ }
+ push @newkids, $self->madness('o');
+
+ my $res = $self->newtype->new(Kids => [@newkids]);
+ return $res;
+}
+
+package PLXML::op_i_postinc;
+
+sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
+
+package PLXML::op_postdec;
+
+sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
+
+package PLXML::op_i_postdec;
+
+sub ast { my $self = shift; $self->PLXML::op_postinc::ast(@_); }
+
+package PLXML::op_pow;
+package PLXML::op_multiply;
+package PLXML::op_i_multiply;
+package PLXML::op_divide;
+package PLXML::op_i_divide;
+package PLXML::op_modulo;
+package PLXML::op_i_modulo;
+package PLXML::op_repeat;
+
+sub ast {
+ my $self = shift;
+ return $self->SUPER::ast(@_)
+ unless exists $$self{private} and $$self{private} =~ /DOLIST/;
+
+ my $newself = $$self{Kids}[0]->ast($self,@_);
+ splice @{$newself->{Kids}}, -1, 0, $self->madness('o');
+
+ return bless $newself, $self->newtype; # rebless the op_null
+}
+
+package PLXML::op_add;
+package PLXML::op_i_add;
+package PLXML::op_subtract;
+package PLXML::op_i_subtract;
+package PLXML::op_concat;
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+
+ my @before;
+ if (@before = $self->madness('M')) {
+ push @before, $self->madness('ox'); # o is the .
+ }
+ my @after;
+ my $left = $$self{Kids}[0];
+ push @newkids, $left->ast($self, @_);
+
+ push @newkids, $self->madness('o');
+
+ my $right = $$self{Kids}[1];
+ push @newkids, $right->ast($self, @_);
+ return P5AST::op_concat->new(Kids => [@newkids]);
+}
+
+sub ast {
+ my $self = shift;
+ my $parent = $_[0];
+ my @newkids;
+
+ my @before;
+ if (@before = $self->madness('M')) {
+ push @before, $self->madness('ox'); # o is the .
+ }
+ my @after;
+ my $left = $$self{Kids}[0];
+ push @newkids, $left->ast($self, @_);
+
+ push @newkids, $self->madness('o');
+
+ my $right = $$self{Kids}[1];
+ push @newkids, $right->ast($self, @_);
+
+ return $self->newtype->new(Kids => [@before, @newkids, @after]);
+}
+
+package PLXML::op_stringify;
+
+sub astnull {
+ ast(@_);
+}
+
+sub ast {
+ my $self = shift;
+ my @newkids;
+ my @front = $self->madness('q (');
+ my @back = $self->madness(') Q');
+ my @M = $self->madness('M');
+ if (@M) {
+ push @newkids, $M[0], $self->madness('o');
+ }
+ push @newkids, @front;
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ push @newkids, @back;
+ return P5AST::op_stringify->new(Kids => [@newkids]);
+}
+
+package PLXML::op_left_shift;
+package PLXML::op_right_shift;
+package PLXML::op_lt;
+package PLXML::op_i_lt;
+package PLXML::op_gt;
+package PLXML::op_i_gt;
+package PLXML::op_le;
+package PLXML::op_i_le;
+package PLXML::op_ge;
+package PLXML::op_i_ge;
+package PLXML::op_eq;
+package PLXML::op_i_eq;
+package PLXML::op_ne;
+package PLXML::op_i_ne;
+package PLXML::op_ncmp;
+package PLXML::op_i_ncmp;
+package PLXML::op_slt;
+package PLXML::op_sgt;
+package PLXML::op_sle;
+package PLXML::op_sge;
+package PLXML::op_seq;
+package PLXML::op_sne;
+package PLXML::op_scmp;
+package PLXML::op_bit_and;
+package PLXML::op_bit_xor;
+package PLXML::op_bit_or;
+package PLXML::op_negate;
+package PLXML::op_i_negate;
+package PLXML::op_not;
+
+sub ast {
+ my $self = shift;
+ my @newkids = $self->madness('o (');
+ my @swap;
+ if (@newkids and $newkids[-1]->uni eq '!~') {
+ @swap = @newkids;
+ @newkids = ();
+ }
+
+ if (exists $$self{Kids}) {
+ my $arg = $$self{Kids}[0];
+ push @newkids, $arg->ast($self, @_) if defined $arg;
+ }
+ if (@swap) {
+ splice @{$newkids[-1][0]{Kids}}, -2, 0, @swap; # XXX WAG
+ }
+ push @newkids, $self->madness(')');
+
+ my $res = $self->newtype->new(Kids => [@newkids]);
+ return $res;
+}
+
+package PLXML::op_complement;
+package PLXML::op_atan2;
+package PLXML::op_sin;
+package PLXML::op_cos;
+package PLXML::op_rand;
+package PLXML::op_srand;
+package PLXML::op_exp;
+package PLXML::op_log;
+package PLXML::op_sqrt;
+package PLXML::op_int;
+package PLXML::op_hex;
+package PLXML::op_oct;
+package PLXML::op_abs;
+package PLXML::op_length;
+package PLXML::op_substr;
+package PLXML::op_vec;
+package PLXML::op_index;
+package PLXML::op_rindex;
+package PLXML::op_sprintf;
+package PLXML::op_formline;
+package PLXML::op_ord;
+package PLXML::op_chr;
+package PLXML::op_crypt;
+package PLXML::op_ucfirst;
+
+sub ast {
+ my $self = shift;
+ return $self->PLXML::listop::ast(@_);
+}
+
+package PLXML::op_lcfirst;
+
+sub ast {
+ my $self = shift;
+ return $self->PLXML::listop::ast(@_);
+}
+
+package PLXML::op_uc;
+
+sub ast {
+ my $self = shift;
+ return $self->PLXML::listop::ast(@_);
+}
+
+package PLXML::op_lc;
+
+sub ast {
+ my $self = shift;
+ return $self->PLXML::listop::ast(@_);
+}
+
+package PLXML::op_quotemeta;
+
+sub ast {
+ my $self = shift;
+ return $self->PLXML::listop::ast(@_);
+}
+
+package PLXML::op_rv2av;
+
+sub astnull {
+ my $self = shift;
+ return P5AST::op_rv2av->new(Kids => [$self->madness('$ @')]);
+}
+
+sub ast {
+ my $self = shift;
+
+ if (ref $$self{Kids}[0] eq 'PLXML::op_const' and $$self{mp}{'O'}) {
+ return $self->madness('O');
+ }
+
+ my @before;
+ push @before, $self->madness('dx d (');
+
+ my @newkids;
+ push @newkids, $self->madness('$ @ K');
+ if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
+ push @newkids, $$self{Kids}[0]->ast();
+ }
+ my @after;
+ push @after, $self->madness(') a');
+ return $self->newtype->new(Kids => [@before, @newkids, @after]);
+}
+
+package PLXML::op_aelemfast;
+
+sub ast {
+ my $self = shift;
+ return $self->madness('$');
+}
+
+package PLXML::op_aelem;
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('dx d');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ splice @newkids, -1, 0, $self->madness('a [');
+ push @newkids, $self->madness(']');
+ return P5AST::op_aelem->new(Kids => [@newkids]);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @before = $self->madness('dx d');
+ my @newkids;
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast(@_);
+ }
+ splice @newkids, -1, 0, $self->madness('a [');
+ push @newkids, $self->madness(']');
+
+ return $self->newtype->new(Kids => [@before, @newkids]);
+}
+
+package PLXML::op_aslice;
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('[');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast(@_);
+ }
+ unshift @newkids, pop @newkids;
+ unshift @newkids, $self->madness('dx d');
+ push @newkids, $self->madness(']');
+ return P5AST::op_aslice->new(Kids => [@newkids]);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @newkids;
+ push @newkids, $self->madness('[');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast(@_);
+ }
+ unshift @newkids, pop @newkids;
+ unshift @newkids, $self->madness('dx d');
+ push @newkids, $self->madness(']');
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_each;
+package PLXML::op_values;
+package PLXML::op_keys;
+package PLXML::op_delete;
+package PLXML::op_exists;
+package PLXML::op_rv2hv;
+
+sub astnull {
+ my $self = shift;
+ return P5AST::op_rv2hv->new(Kids => [$self->madness('$')]);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @before;
+ push @before, $self->madness('dx d (');
+
+ my @newkids;
+ push @newkids, $self->madness('$ @ % K');
+ if (ref $$self{Kids}[0] ne "PLXML::op_gv") {
+ push @newkids, $$self{Kids}[0]->ast();
+ }
+ my @after;
+ push @after, $self->madness(') a');
+ return $self->newtype->new(Kids => [@before, @newkids, @after]);
+}
+
+package PLXML::op_helem;
+
+sub astnull {
+ my $self = shift;
+ local $::curstate; # hash subscript potentially a lineseq
+ local $::curenc = $::curenc;
+
+ my @newkids;
+ push @newkids, $self->madness('dx d');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ splice @newkids, -1, 0, $self->madness('a {');
+ push @newkids, $self->madness('}');
+ return P5AST::op_helem->new(Kids => [@newkids]);
+}
+
+sub ast {
+ my $self = shift;
+ local $::curstate; # hash subscript potentially a lineseq
+ local $::curenc = $::curenc;
+
+ my @before = $self->madness('dx d');
+ my @newkids;
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ splice @newkids, -1, 0, $self->madness('a {');
+ push @newkids, $self->madness('}');
+
+ return $self->newtype->new(Kids => [@before, @newkids]);
+}
+
+
+package PLXML::op_hslice;
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('{');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast(@_);
+ }
+ unshift @newkids, pop @newkids;
+ unshift @newkids, $self->madness('dx d');
+ push @newkids, $self->madness('}');
+ return P5AST::op_hslice->new(Kids => [@newkids]);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @newkids;
+ push @newkids, $self->madness('{');
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast(@_);
+ }
+ unshift @newkids, pop @newkids;
+ unshift @newkids, $self->madness('dx d');
+ push @newkids, $self->madness('}');
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_unpack;
+package PLXML::op_pack;
+package PLXML::op_split;
+
+sub ast {
+ my $self = shift;
+ my $results = $self->SUPER::ast(@_);
+ if (my @dest = $self->madness('R')) {
+ return PLXML::op_aassign->newtype->new(Kids => [@dest, $self->madness('ox'), $results]);
+ }
+ return $results;
+}
+
+package PLXML::op_join;
+package PLXML::op_list;
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+ my @retval;
+ my @before;
+ if (@retval = $self->madness('X')) {
+ push @before, $self->madness('x o');
+ return @before,@retval;
+ }
+ my @kids = @{$$self{Kids}};
+ for my $kid (@kids) {
+ next if ref $kid eq 'PLXML::op_pushmark';
+ next if ref $kid eq 'PLXML::op_null' and
+ defined $$kid{was} and $$kid{was} eq 'pushmark';
+ push @newkids, $kid->ast($self, @_);
+ }
+
+ my $x = "";
+ my @newnewkids = ();
+ push @newnewkids, $self->madness('dx d (');
+ push @newnewkids, @newkids;
+ push @newnewkids, $self->madness(') :');
+ return P5AST::op_list->new(Kids => [@newnewkids]);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @retval;
+ my @before;
+ if (@retval = $self->madness('X')) {
+ push @before, $self->madness('o');
+ return $self->newtype->new(Kids => [@before,@retval]);
+ }
+ push @retval, $self->madness('dx d (');
+
+ my @newkids;
+ for my $kid (@{$$self{Kids}}) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ my $x = "";
+ my @newnewkids = ();
+ push @newnewkids, @newkids;
+ @newkids = @newnewkids;
+ push @retval, @newkids;
+ push @retval, $self->madness(') :');
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+package PLXML::op_lslice;
+
+sub ast {
+ my $self = shift;
+ my @newkids;
+
+ if ($$self{mp}{q}) {
+ push @newkids, $self->madness('q = Q');
+ }
+ elsif ($$self{mp}{x}) {
+ push @newkids, $self->madness('x');
+ }
+ else {
+ push @newkids, $self->madness('(');
+ my $list = $$self{Kids}[1];
+ push @newkids, $list->ast($self, @_);
+ push @newkids, $self->madness(')');
+ }
+
+ push @newkids, $self->madness('[');
+
+ my $slice = $$self{Kids}[0];
+ push @newkids, $slice->ast($self, @_);
+ push @newkids, $self->madness(']');
+
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_anonlist;
+package PLXML::op_anonhash;
+package PLXML::op_splice;
+package PLXML::op_push;
+package PLXML::op_pop;
+package PLXML::op_shift;
+package PLXML::op_unshift;
+package PLXML::op_sort;
+package PLXML::op_reverse;
+
+sub astnull {
+ my $self = shift;
+ $self->PLXML::listop::ast(@_);
+}
+
+package PLXML::op_grepstart;
+package PLXML::op_grepwhile;
+package PLXML::op_mapstart;
+package PLXML::op_mapwhile;
+package PLXML::op_range;
+
+sub ast {
+ my $self = shift;
+ return $self->PLXML::binop::ast(@_);
+}
+
+package PLXML::op_flip;
+package PLXML::op_flop;
+package PLXML::op_and;
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+ my @first = $self->madness('1');
+ my @second = $self->madness('2');
+ my @stuff = $$self{Kids}[0]->ast();
+ if (my @I = $self->madness('I')) {
+ if (@second) {
+ push @newkids, @I;
+ push @newkids, $self->madness('(');
+ push @newkids, @stuff;
+ push @newkids, $self->madness(')');
+ push @newkids, @second;
+ }
+ else {
+ push @newkids, @I;
+ push @newkids, $self->madness('(');
+ push @newkids, @first;
+ push @newkids, $self->madness(')');
+ push @newkids, @stuff;
+ }
+ }
+ elsif (my @i = $self->madness('i')) {
+ if (@second) {
+ push @newkids, @second;
+ push @newkids, @i;
+ push @newkids, @stuff;
+ }
+ else {
+ push @newkids, @stuff;
+ push @newkids, @i;
+ push @newkids, @first;
+ }
+ }
+ elsif (my @o = $self->madness('o')) {
+ if (@second) {
+ push @newkids, @stuff;
+ push @newkids, @o;
+ push @newkids, @second;
+ }
+ else {
+ push @newkids, @first;
+ push @newkids, @o;
+ push @newkids, @stuff;
+ }
+ }
+ return P5AST::op_and->new(Kids => [@newkids]);
+}
+
+package PLXML::op_or;
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+ my @first = $self->madness('1');
+ my @second = $self->madness('2');
+ my @i = $self->madness('i');
+ my @stuff = $$self{Kids}[0]->ast();
+ if (@second) {
+ if (@i) {
+ push @newkids, @second;
+ push @newkids, $self->madness('i');
+ push @newkids, @stuff;
+ }
+ else {
+ push @newkids, @stuff;
+ push @newkids, $self->madness('o');
+ push @newkids, @second;
+ }
+ }
+ else {
+ if (@i) {
+ push @newkids, @stuff;
+ push @newkids, $self->madness('i');
+ push @newkids, @first;
+ }
+ else {
+ push @newkids, @first;
+ push @newkids, $self->madness('o');
+ push @newkids, @stuff;
+ }
+ }
+ return "P5AST::op_$$self{was}"->new(Kids => [@newkids]);
+}
+
+
+package PLXML::op_xor;
+package PLXML::op_cond_expr;
+package PLXML::op_andassign;
+package PLXML::op_orassign;
+package PLXML::op_method;
+package PLXML::op_entersub;
+
+sub ast {
+ my $self = shift;
+
+ if ($$self{mp}{q}) {
+ return $self->madness('q = Q');
+ }
+ if ($$self{mp}{X}) { # <FH> override?
+ return $self->madness('X');
+ }
+ if ($$self{mp}{A}) {
+ return $self->astmethod(@_);
+ }
+ if ($$self{mp}{a}) {
+ return $self->astarrow(@_);
+ }
+
+ my @retval;
+
+ my @newkids;
+ my @kids = @{$$self{Kids}};
+ if (@kids == 1 and ref $kids[0] eq 'PLXML::op_null' and $kids[0]{was} =~ /list/) {
+ @kids = @{$kids[0]{Kids}};
+ }
+ my $dest = pop @kids;
+ my @dest = $dest->ast($self, @_);
+
+ if (ref($dest) =~ /method/) {
+ my $invocant = shift @kids;
+ $invocant = shift @kids if ref($invocant) eq 'PLXML::op_pushmark';
+ my @invocant = $invocant->ast($self, @_);
+ push @retval, @dest;
+ push @retval, @invocant;
+ }
+ elsif (exists $$self{mp}{o} and $$self{mp}{o} eq 'do') {
+ push @retval, $self->madness('o');
+ push @retval, @dest;
+ }
+ else {
+ push @retval, $self->madness('o');
+ push @retval, @dest;
+ }
+ while (@kids) {
+ my $kid = shift(@kids);
+ push @newkids, $kid->ast($self, @_);
+ }
+
+ push @retval, $self->madness('(');
+ push @retval, @newkids;
+ push @retval, $self->madness(')');
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+sub astmethod {
+ my $self = shift;
+ my @newkids;
+ my @kids;
+ for my $kid (@{$$self{Kids}}) {
+ next if ref $kid eq 'PLXML::op_pushmark';
+ next if ref $kid eq 'PLXML::op_null' and
+ defined $$kid{was} and $$kid{was} eq 'pushmark';
+ push @kids, $kid;
+ }
+ my @invocant;
+ if ($$self{flags} =~ /\bSTACKED\b/) {
+ push @invocant, shift(@kids)->ast($self, @_);
+ }
+ for my $kid (@kids) {
+ push @newkids, $kid->ast($self, @_);
+ }
+ my $dest = pop(@newkids);
+ if (ref $dest eq 'PLXML::op_rv2cv' and $$self{flags} =~ /\bMOD\b/) {
+ $dest = pop(@newkids);
+ }
+ my $x = "";
+ my @retval;
+ push @retval, @invocant;
+ push @retval, $self->madness('A');
+ push @retval, $dest;
+ push @retval, $self->madness('(');
+ push @retval, @newkids;
+ push @retval, $self->madness(')');
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+sub astarrow {
+ my $self = shift;
+ my @newkids;
+ my @retval;
+ my @kids = @{$$self{Kids}};
+ if (@kids == 1 and ref $kids[0] eq 'PLXML::op_null' and $kids[0]{was} =~ /list/) {
+ @kids = @{$kids[0]{Kids}};
+ }
+ while (@kids > 1) {
+ my $kid = shift(@kids);
+ push @newkids, $kid->ast($self, @_);
+ }
+ my @dest = $kids[0]->ast($self, @_);
+ my $x = "";
+ push @retval, @dest;
+ push @retval, $self->madness('a');
+ push @retval, $self->madness('(');
+ push @retval, @newkids;
+ push @retval, $self->madness(')');
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+package PLXML::op_leavesub;
+
+sub ast {
+ my $self = shift;
+ if (ref $$self{Kids}[0] eq "PLXML::op_null") {
+ return $$self{Kids}[0]->ast(@_);
+ }
+ return $$self{Kids}[0]->blockast($self, @_);
+}
+
+package PLXML::op_leavesublv;
+
+sub ast {
+ my $self = shift;
+
+ return $$self{Kids}[0]->blockast($self, @_);
+}
+
+package PLXML::op_caller;
+package PLXML::op_warn;
+package PLXML::op_die;
+package PLXML::op_reset;
+package PLXML::op_lineseq;
+
+sub lineseq {
+ my $self = shift;
+ my @kids = @{$$self{Kids}};
+ local $::curstate = 0; # (probably redundant, but that's okay)
+ local $::prevstate = 0;
+ local $::curenc = $::curenc;
+ my @retval;
+ my @newstuff;
+ my $newprev;
+ while (@kids) {
+ my $kid = shift @kids;
+ my $thing = $kid->ast($self, @_);
+ next unless defined $thing;
+ if ($::curstate ne $::prevstate) {
+ if ($::prevstate) {
+ push @newstuff, $::prevstate->madness(';');
+ push @{$newprev->{Kids}}, @newstuff if $newprev;
+ @newstuff = ();
+ }
+ $::prevstate = $::curstate;
+ $newprev = $thing;
+ push @retval, $thing;
+ }
+ elsif ($::prevstate) {
+ push @newstuff, $thing;
+ }
+ else {
+ push @retval, $thing;
+ }
+ }
+ if ($::prevstate) {
+ push @newstuff, $::prevstate->madness(';');
+ push @{$newprev->{Kids}}, @newstuff if $newprev;
+ @newstuff = ();
+ $::prevstate = 0;
+ }
+ return @retval;
+}
+
+sub blockast {
+ my $self = shift;
+ local $::curstate;
+
+ my @retval;
+ push @retval, $self->madness('{');
+
+ my @newkids = $self->PLXML::op_lineseq::lineseq(@_);
+ push @retval, @newkids;
+
+ push @retval, $self->madness('; }');
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+package PLXML::op_nextstate;
+
+sub newtype { return "P5AST::statement" }
+
+sub astnull {
+ my $self = shift;
+ my @newkids;
+ push @newkids, $self->madness('L');
+ $::curstate = $self;
+ return P5AST::statement->new(Kids => [@newkids]);
+}
+
+sub ast {
+ my $self = shift;
+
+ my @newkids;
+ push @newkids, $self->madness('L');
+ $::curstate = $self;
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+
+package PLXML::op_dbstate;
+package PLXML::op_unstack;
+package PLXML::op_enter;
+
+sub ast { () }
+
+package PLXML::op_leave;
+
+sub astnull {
+ ast(@_);
+}
+
+sub ast {
+ my $self = shift;
+
+ my $mad = $$self{mp}{FIRST} || "unknown";
+
+ my @retval;
+ if ($mad eq 'w') {
+ my @newkids;
+ my @tmpkids;
+ push @tmpkids, $self->{Kids};
+ my $anddo = $$self{Kids}[-1]{Kids}[0]{Kids};
+ eval { push @newkids, $anddo->[1]->ast($self,@_); };
+ push @newkids, "[[[NOANDDO]]]" if $@;
+ push @newkids, $self->madness('w');
+ push @newkids, $anddo->[0]->ast($self,@_);
+
+ return $self->newtype->new(Kids => [@newkids]);
+ }
+
+ local $::curstate;
+ push @retval, $self->madness('o {');
+
+ my @newkids = $self->PLXML::op_lineseq::lineseq(@_);
+ push @retval, @newkids;
+ push @retval, $self->madness(q/; }/);
+ my $retval = $self->newtype->new(Kids => [@retval]);
+
+ if ($$self{mp}{C}) {
+ my @before;
+ my @after;
+ push @before, $self->madness('I ( C )');
+ if ($$self{mp}{t}) {
+ push @before, $self->madness('t');
+ }
+ elsif ($$self{mp}{e}) {
+ push @after, $self->madness('e');
+ }
+ return P5AST::op_cond->new(Kids => [@before, $retval, @after]);
+ }
+ else {
+ return $retval;
+ }
+}
+
+package PLXML::op_scope;
+
+sub ast {
+ my $self = shift;
+ local $::curstate;
+
+ my @newkids;
+ push @newkids, $self->madness('o');
+
+ push @newkids, $self->madness('{');
+ push @newkids, $self->PLXML::op_lineseq::lineseq(@_);
+ push @newkids, $self->madness('; }');
+
+ my @folded = $self->madness('C');
+ if (@folded) {
+ my @t = $self->madness('t');
+ my @e = $self->madness('e');
+ if (@e) {
+ return $self->newtype->new(
+ Kids => [
+ $self->madness('I ('),
+ @folded,
+ $self->madness(')'),
+ $self->newtype->new(Kids => [@newkids]),
+ @e
+ ] );
+ }
+ else {
+ return $self->newtype->new(
+ Kids => [
+ $self->madness('I ('),
+ @folded,
+ $self->madness(')'),
+ @t,
+ $self->newtype->new(Kids => [@newkids])
+ ] );
+ }
+ }
+ return $self->newtype->new(Kids => [@newkids]);
+}
+
+package PLXML::op_enteriter;
+
+sub ast {
+ my $self = shift;
+ my (undef,$range,$var) = @{$self->{Kids}};
+ my @retval;
+ push @retval, $self->madness('v');
+ if (!@retval and defined $var) {
+ push @retval, $var->ast($self,@_);
+ }
+ else {
+ push @retval, '';
+ }
+ if (ref $range eq 'PLXML::op_null' and $$self{flags} =~ /STACKED/) {
+ my (undef,$min,$max) = @{$range->{Kids}};
+ push @retval, $min->ast($self,@_);
+ if (defined $max) {
+ if (exists $$range{mp}{O}) { # deeply buried .. operator
+ PLXML::prepreproc($$range{mp}{O});
+ push @retval,
+ $$range{mp}{'O'}{Kids}[0]{Kids}[0]{Kids}[0]{Kids}[0]->madness('o')
+ }
+ else {
+ push @retval, '..'; # XXX missing whitespace
+ }
+ push @retval, $max->ast($self,@_);
+ }
+ }
+ else {
+ push @retval, $range->ast($self,@_);
+ }
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+package PLXML::op_iter;
+package PLXML::op_enterloop;
+
+sub ast {
+}
+
+package PLXML::op_leaveloop;
+
+sub ast {
+ my $self = shift;
+
+ my @retval;
+ my @newkids;
+ my $enterloop = $$self{Kids}[0];
+ my $nextthing = $$self{Kids}[1];
+
+ if ($$self{mp}{W}) {
+ push @retval, $self->madness('L');
+ push @newkids, $self->madness('W d');
+
+ if (ref $enterloop eq 'PLXML::op_enteriter') {
+ my ($var,@rest) = @{$enterloop->ast($self,@_)->{Kids}};
+ push @newkids, $var if $var;
+ push @newkids, $self->madness('q ( x = Q');
+ push @newkids, @rest;
+ }
+ else {
+ push @newkids, $self->madness('(');
+ push @newkids, $enterloop->ast($self,@_);
+ }
+ }
+ my $andor;
+
+ if (ref $nextthing eq 'PLXML::op_null') {
+ if ($$nextthing{mp}{'1'}) {
+ push @newkids, $nextthing->madness('1');
+ push @newkids, $self->madness(')');
+ push @newkids, $$nextthing{Kids}[0]->blockast($self,@_);
+ }
+ elsif ($$nextthing{mp}{'2'}) {
+ push @newkids, $$nextthing{Kids}[0]->ast($self,@_);
+ push @newkids, $self->madness(')');
+ push @newkids, $$nextthing{mp}{'2'}->blockast($self,@_);
+ }
+ elsif ($$nextthing{mp}{'U'}) {
+ push @newkids, $nextthing->ast($self,@_);
+ }
+ else {
+ # bypass the op_null
+ $andor = $nextthing->{Kids}[0];
+ eval {
+ push @newkids, $$andor{Kids}[0]->ast($self, @_);
+ };
+ push @newkids, $self->madness(')');
+ eval {
+ push @newkids, $$andor{Kids}[1]->blockast($self, @_);
+ };
+ }
+ }
+ else {
+ $andor = $nextthing;
+ push @newkids, $nextthing->madness('O');
+ push @newkids, $self->madness(')');
+ push @newkids, $nextthing->blockast($self, @_);
+ }
+ if ($$self{mp}{w}) {
+ push @newkids, $self->madness('w');
+ push @newkids, $enterloop->ast($self,@_);
+ }
+
+ push @retval, @newkids;
+
+ return $self->newtype->new(Kids => [@retval]);
+}
+
+package PLXML::op_return;
+package PLXML::op_last;
+package PLXML::op_next;
+package PLXML::op_redo;
+package PLXML::op_dump;
+package PLXML::op_goto;
+package PLXML::op_exit;
+package PLXML::op_open;
+package PLXML::op_close;
+package PLXML::op_pipe_op;
+package PLXML::op_fileno;
+package PLXML::op_umask;
+package PLXML::op_binmode;
+package PLXML::op_tie;
+package PLXML::op_untie;
+package PLXML::op_tied;
+package PLXML::op_dbmopen;
+package PLXML::op_dbmclose;
+package PLXML::op_sselect;
+package PLXML::op_select;
+package PLXML::op_getc;
+package PLXML::op_read;
+package PLXML::op_enterwrite;
+package PLXML::op_leavewrite;
+package PLXML::op_prtf;
+package PLXML::op_print;
+package PLXML::op_sysopen;
+package PLXML::op_sysseek;
+package PLXML::op_sysread;
+package PLXML::op_syswrite;
+package PLXML::op_send;
+package PLXML::op_recv;
+package PLXML::op_eof;
+package PLXML::op_tell;
+package PLXML::op_seek;
+package PLXML::op_truncate;
+package PLXML::op_fcntl;
+package PLXML::op_ioctl;
+package PLXML::op_flock;
+package PLXML::op_socket;
+package PLXML::op_sockpair;
+package PLXML::op_bind;
+package PLXML::op_connect;
+package PLXML::op_listen;
+package PLXML::op_accept;
+package PLXML::op_shutdown;
+package PLXML::op_gsockopt;
+package PLXML::op_ssockopt;
+package PLXML::op_getsockname;
+package PLXML::op_getpeername;
+package PLXML::op_lstat;
+package PLXML::op_stat;
+package PLXML::op_ftrread;
+package PLXML::op_ftrwrite;
+package PLXML::op_ftrexec;
+package PLXML::op_fteread;
+package PLXML::op_ftewrite;
+package PLXML::op_fteexec;
+package PLXML::op_ftis;
+package PLXML::op_fteowned;
+package PLXML::op_ftrowned;
+package PLXML::op_ftzero;
+package PLXML::op_ftsize;
+package PLXML::op_ftmtime;
+package PLXML::op_ftatime;
+package PLXML::op_ftctime;
+package PLXML::op_ftsock;
+package PLXML::op_ftchr;
+package PLXML::op_ftblk;
+package PLXML::op_ftfile;
+package PLXML::op_ftdir;
+package PLXML::op_ftpipe;
+package PLXML::op_ftlink;
+package PLXML::op_ftsuid;
+package PLXML::op_ftsgid;
+package PLXML::op_ftsvtx;
+package PLXML::op_fttty;
+package PLXML::op_fttext;
+package PLXML::op_ftbinary;
+package PLXML::op_chdir;
+package PLXML::op_chown;
+package PLXML::op_chroot;
+package PLXML::op_unlink;
+package PLXML::op_chmod;
+package PLXML::op_utime;
+package PLXML::op_rename;
+package PLXML::op_link;
+package PLXML::op_symlink;
+package PLXML::op_readlink;
+package PLXML::op_mkdir;
+package PLXML::op_rmdir;
+package PLXML::op_open_dir;
+package PLXML::op_readdir;
+package PLXML::op_telldir;
+package PLXML::op_seekdir;
+package PLXML::op_rewinddir;
+package PLXML::op_closedir;
+package PLXML::op_fork;
+package PLXML::op_wait;
+package PLXML::op_waitpid;
+package PLXML::op_system;
+package PLXML::op_exec;
+package PLXML::op_kill;
+package PLXML::op_getppid;
+package PLXML::op_getpgrp;
+package PLXML::op_setpgrp;
+package PLXML::op_getpriority;
+package PLXML::op_setpriority;
+package PLXML::op_time;
+package PLXML::op_tms;
+package PLXML::op_localtime;
+package PLXML::op_gmtime;
+package PLXML::op_alarm;
+package PLXML::op_sleep;
+package PLXML::op_shmget;
+package PLXML::op_shmctl;
+package PLXML::op_shmread;
+package PLXML::op_shmwrite;
+package PLXML::op_msgget;
+package PLXML::op_msgctl;
+package PLXML::op_msgsnd;
+package PLXML::op_msgrcv;
+package PLXML::op_semget;
+package PLXML::op_semctl;
+package PLXML::op_semop;
+package PLXML::op_require;
+package PLXML::op_dofile;
+package PLXML::op_entereval;
+
+sub ast {
+ my $self = shift;
+ local $::curstate; # eval {} has own statement sequence
+ return $self->SUPER::ast(@_);
+}
+
+package PLXML::op_leaveeval;
+package PLXML::op_entertry;
+package PLXML::op_leavetry;
+
+sub ast {
+ my $self = shift;
+
+ return $self->PLXML::op_leave::ast(@_);
+}
+
+package PLXML::op_ghbyname;
+package PLXML::op_ghbyaddr;
+package PLXML::op_ghostent;
+package PLXML::op_gnbyname;
+package PLXML::op_gnbyaddr;
+package PLXML::op_gnetent;
+package PLXML::op_gpbyname;
+package PLXML::op_gpbynumber;
+package PLXML::op_gprotoent;
+package PLXML::op_gsbyname;
+package PLXML::op_gsbyport;
+package PLXML::op_gservent;
+package PLXML::op_shostent;
+package PLXML::op_snetent;
+package PLXML::op_sprotoent;
+package PLXML::op_sservent;
+package PLXML::op_ehostent;
+package PLXML::op_enetent;
+package PLXML::op_eprotoent;
+package PLXML::op_eservent;
+package PLXML::op_gpwnam;
+package PLXML::op_gpwuid;
+package PLXML::op_gpwent;
+package PLXML::op_spwent;
+package PLXML::op_epwent;
+package PLXML::op_ggrnam;
+package PLXML::op_ggrgid;
+package PLXML::op_ggrent;
+package PLXML::op_sgrent;
+package PLXML::op_egrent;
+package PLXML::op_getlogin;
+package PLXML::op_syscall;
+package PLXML::op_lock;
+package PLXML::op_threadsv;
+package PLXML::op_setstate;
+package PLXML::op_method_named;
+
+sub ast {
+ my $self = shift;
+ return $self->madness('O');
+}
+
+package PLXML::op_dor;
+
+sub astnull {
+ my $self = shift;
+ $self->PLXML::op_or::astnull(@_);
+}
+
+package PLXML::op_dorassign;
+package PLXML::op_custom;
+
--- /dev/null
+#!/usr/bin/perl
+
+while (@ARGV and $ARGV[0] =~ /^-/) {
+ my $switch = shift;
+ if ($switch eq '-Y') {
+ $YAML = '-Y ';
+ }
+ else {
+ die "Unrecognized switch: -$switch";
+ }
+}
+
+my $file = shift;
+my $infile = $file;
+
+unlink "$file.msg";
+my $top = "/home/larry/src/p55";
+
+my $text;
+open(FILE, $file) or die "Can't open $file: $!\n";
+{
+ local $/;
+ $text = <FILE>;
+}
+close FILE;
+my $T;
+$switches = $1 if $text =~ /^#!.*?\s(-.*)/;
+$switches =~ s/\s+-[-*].*//;
+$switches =~ s/\s+#.*//;
+
+#if ($text =~ s/\bexit\b/DUMMYEXIT/g) {
+# $infile = "$file.tmp";
+# open FILE, ">$infile";
+# print FILE $text;
+# close FILE;
+#}
+
+unlink "$file.xml", "$file.msg", "$file.err", "$file.diff", "$file.p5";
+print "PERL_XMLDUMP='$file.xml' $top/perl $switches -I lib $infile 2>$file.err\n";
+system "PERL_XMLDUMP='$file.xml' $top/perl $switches -I lib $infile 2>$file.err";
+
+if ($?) {
+ print "Exit status $?\n";
+ system "cat $file.err";
+ exit 1;
+}
+
+if (not -s "$file.xml") {
+ die "Didn't produce an xml file!?!\n"
+}
+
+if ($YAML) {
+ system "$top/nomad -Y $file.xml";
+ exit;
+}
+
+system "$top/nomad $file.xml >$file.p5 2>$file.msg";
+
+if ($?) {
+ print "Oops!\n" unless -s "$file.msg";
+ system "cat $file.msg";
+ exit 1;
+}
+
+system "diff -u $file $file.p5 >$file.diff";
+if (-s "$file.diff") {
+ system "cat $file.diff";
+ exit 1;
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff