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 $_ || '[]';
}