From: Nicholas Clark Date: Thu, 9 Mar 2006 22:03:55 +0000 (+0000) Subject: Add the Perl 5 to Perl 5 convertor scripts. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6a28abbc8c08ff5da570415ad3f8a343b51e103d;p=p5sagit%2Fp5-mst-13.2.git Add the Perl 5 to Perl 5 convertor scripts. p4raw-id: //depot/perl@27453 --- diff --git a/MANIFEST b/MANIFEST index d1cf7ce..1232f11 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2621,6 +2621,12 @@ lib/warnings.pm For "use warnings" 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 diff --git a/mad/P5AST.pm b/mad/P5AST.pm new file mode 100644 index 0000000..d253c86 --- /dev/null +++ b/mad/P5AST.pm @@ -0,0 +1,537 @@ +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'; diff --git a/mad/P5RE.pm b/mad/P5RE.pm new file mode 100755 index 0000000..3f28465 --- /dev/null +++ b/mad/P5RE.pm @@ -0,0 +1,510 @@ +#!/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\n"; + return $text; +} + +package P5RE::Alt; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + my $text = "$in\n"; + $text .= $self->xmlkids(); + $text .= "$in\n"; + return $text; +} + +#package P5RE::Atom; our @ISA = 'P5RE'; +# +#sub xml { +# my $self = shift; +# my $text = "$in\n"; +# $text .= $self->xmlkids(); +# $text .= "$in\n"; +# return $text; +#} + +package P5RE::Quant; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + my $q = $self->{type}; + my $text = "$in\n"; + $text .= $self->xmlkids(); + $text .= "$in\n"; + return $text; +} + +package P5RE::White; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + return "$intext() . "\" />\n"; +} + +package P5RE::Char; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + return "$intext() . "\" />\n"; +} + +package P5RE::Comment; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + return "$inrep() . "\" />\n"; +} + +package P5RE::Mod; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + return "$in{modifiers} . "\" />\n"; +} + +package P5RE::Meta; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + my $sem = ""; + if ($self->{sem}) { + $sem = 'sem="' . $self->{sem} . '" ' + } + return "$inrep() . "\" $sem/>\n"; +} + +package P5RE::Var; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + return "$in{name} . "\" />\n"; +} + +package P5RE::Closure; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + return "$in{rep} . "\" />\n"; +} + +package P5RE::CClass; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + my $neg = $self->{neg} ? "negated" : "normal"; + my $text = "$in\n"; + $text .= $self->xmlkids(); + $text .= "$in\n"; + return $text; +} + +package P5RE::Range; our @ISA = 'P5RE'; + +sub xml { + my $self = shift; + my $text = "$in\n"; + $text .= $self->xmlkids(); + $text .= "$in\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('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"; + } +} + diff --git a/mad/P5re.pm b/mad/P5re.pm new file mode 100755 index 0000000..24037ec --- /dev/null +++ b/mad/P5re.pm @@ -0,0 +1,650 @@ +#!/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\n"; + return $text; +} + +package P5re::Alt; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + my $text = "$in\n"; + $text .= $self->xmlkids(); + $text .= "$in\n"; + return $text; +} + +#package P5re::Atom; our @ISA = 'P5re'; +# +#sub xml { +# my $self = shift; +# my $text = "$in\n"; +# $text .= $self->xmlkids(); +# $text .= "$in\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\n"; + $text .= $self->xmlkids(); + $text .= "$in\n"; + return $text; +} + +package P5re::White; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + return "$intext() . "\" />\n"; +} + +package P5re::Char; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + return "$intext() . "\" />\n"; +} + +package P5re::Comment; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + return "$inrep() . "\" />\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\n"; +} + +package P5re::Meta; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + my $sem = ""; + if ($self->{sem}) { + $sem = 'sem="' . $self->{sem} . '" ' + } + return "$inrep() . "\" $sem/>\n"; +} + +package P5re::Back; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + return "$in{to}) . "\"/>\n"; +} + +package P5re::Var; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + return "$in{name} . "\" />\n"; +} + +package P5re::Closure; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + return "$in{rep}) . "\" />\n"; +} + +package P5re::CClass; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + my $neg = $self->{neg} ? "negated" : "normal"; + my $text = "$in\n"; + $text .= $self->xmlkids(); + $text .= "$in\n"; + return $text; +} + +package P5re::Range; our @ISA = 'P5re'; + +sub xml { + my $self = shift; + my $text = "$in\n"; + $text .= $self->xmlkids(); + $text .= "$in\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('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; diff --git a/mad/PLXML.pm b/mad/PLXML.pm new file mode 100644 index 0000000..590d0ff --- /dev/null +++ b/mad/PLXML.pm @@ -0,0 +1,4153 @@ +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 { '' } +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 { '' } + + diff --git a/mad/nomad b/mad/nomad new file mode 100755 index 0000000..dd33901 --- /dev/null +++ b/mad/nomad @@ -0,0 +1,3050 @@ +#!/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\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!^ *\n *!$in !; + } + else { + $tmp = xdoitem($indent+1,"kv",$$hash{$k}); + } + $k =~ s/([\t\n'"<>&])/$xmlrepl{$1}/g; + $tmp =~ s/\n$in $1$in <\/kv>\n/s; + $result .= $tmp; + } + if ($K and @$K) { + $result .= xdolist($indent, undef, @$K); + } + $result .= "$in\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\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\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 =~ /^< $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 =~ /^< 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 =~ /^< $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}) { # 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; + diff --git a/mad/p55 b/mad/p55 new file mode 100755 index 0000000..20b879b --- /dev/null +++ b/mad/p55 @@ -0,0 +1,69 @@ +#!/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 = ; +} +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; +}