use strict;
use warnings;
no warnings 'recursion';
$/ = '';

while (<>) {

    # Remove first two lines.
    s/\A((?:(?>.+)\n)(?:(?>.+)\n))// or die;
    my $header = $1;
    $header =~ s/^/%% /gm;

    # All the leading goo is turned into spaces.
    s/^(?>\S+)((?>(?:\s{3})*))(?>\s*)<.>/' ' x length $1/meg;

    # The trailing goo is also turned into spaces.
    s!\s*[\w/,]*(?>\s+)->(?>\S+)$!!mg;

    # Quote anything in parentheses.
    s<\((.+)\)>
      {
       my $thing = $1;
       $thing =~ s/([\\'"])/\\$1/g;
       qq[ '$thing'];
      }ge;

    # Quote whatever is in brackets.
    s<\[(.+)\]>
      {
       my $thing = $1;
       $thing =~ s/([\\'"%])/\\$1/g;
       qq[ '$thing'];
      }ge;

    # Remove trailing lines
    s/\s+\z//;
    $_ .= "\n";

    $_ = concise_2prolog( $_, 'ROOT' );
    print "${header}optree( $_ ).\n\n\n";
}
print <<'FOOTER';
%% Local Variables: ***
%% mode: prolog ***
%% End: ***
FOOTER

sub concise_2prolog {
    local $_ = shift @_;

    ### "$_[0]=<" . join( '', map length( /^(\s+)/ ? $1 : '' ) . $_, /
+(.*\n)/g ) . ">\n";

    my $times = 0;
    s[# Preceded by a newline or the start of the string
      (?:(?<=\n)|(?<=\A))
      (?: # First line
       (^\ *)   # Capture leading space in $1
       ([-\w]*) # Capture the opcode name in $2
       (.*)\n   # Capture the args in $3
      )
      # The children are more indented in $4.
      ((?:^\1\ .+\n)*)
      
      # The siblings are equally indented in $5.
      ((?:^\1.+\n)*)
     ]{
       my $opcode  = $2;
       my $args     = $3;
       my $children = $4;
       my $siblings = $5;

       ### $siblings

       $opcode =~ s/-/_/g;

       # Unquote the args.
       if ( $args ) {
           $args =~ s/^\s*\'//;
           $args =~ s/\'\s*\z//;
           $args =~ s/'/\\'/g;
       }
       else {
           $args ||= '',
       }
       
       if ( $children ) {
           $children = concise_2prolog( $children, 'CHILD' );
       }
       else {
           ### NO CHILDREN
           $children = '[]';
       }

       if ( $siblings ) {
           $siblings = concise_2prolog( $siblings, 'SIBLING' );
       }
       else {
           ### NO SIBLINGS
           $siblings = '[]';
       }
       
       qq<\nopcode( "$opcode", "$args", $children, $siblings )>;
      }gxem
        or do {
        ### FAILED
        };

    ### $times
    return $_ || '[]';
}
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.