#!/usr/local/bin/perl -w

my %names = (
      t=>'label',
      l=>'parent label',
      u=>'head POS',
      h=>'head',
      i=>'parent head',
      T=>'true',
      v=>'parent head POS',
      b=>'preceding label',
      a=>'succeeding label',
      m=>'grandparent label',
      w=>'grandparent head POS',
      j=>'grandparent head',
      c=>'parent cc-label',
      L1=>'left1',
      L1=>'left2',
      R1=>'right1',
      R1=>'right2',
      Qr=>'noopenQr',
      L0=>'left0',
      L3=>'left3',
      R3=>'right3',
      Qr=>'noopenQl',
      Bl=>'Bl',
      Br=>'Br',
      C=>'complement',
      g=>'grammatical function',
      f=>'form/function',
      TP=>'topicalised',
      M=>'misc function',
      U=>'secondary head POS',
      H=>'secondary head',
      HC=>'head-containing child',
      pf=>'parent form/function',
      T=>'label supertag',
      L=>'parent label supertag',
      M=>'grandparent label supertag',
      x=>'head cluster',
      X=>'secondary head cluster',
      y=>'parent head cluster',
      z=>'grandparent head cluster',
);

chomp(my $target = <>);
<>; #blank line

print "<target id='$target'>\n";

my @parents;
while (<>) {
  # Feature lines
  last if /^\s*$/; #end on a blank line
  s/^\s+//;
  my ($n, $name, $subf, $parent, $other) = split /\s+/;
  $n == @parents + 1 or die "Inconsistent feature numbering on line $..\n";
  $subf == @parents or die "Out-of-order subfeat number on line $..\n";
  $parent < $n or die "Incorrect tree form on line $..\n";
  push @parents, $parent;
}

<>; #--
<>; #blank line

my @path = ();
my $current = 0;
while (<>) {
  #Subfeature lines
  last if /^\s*$/; #end on a blank line
  s/^\s+//;
  my ($subf, $abbrev, $feat, $other) = split /\s+/;
  my $name = $names{$abbrev} || $abbrev;
  my $parent = shift @parents;
  $current == $subf or die "Out-of-order subfeature numbering on line $..\n";
  while (@path and $parent != $path[-1]) {
    print "  "x@path, "</feature>\n";
    pop @path;
  }
  push @path, ++$current;
  print "  "x@path, "<feature name='$name' id='$feat'>\n";
}

while (@path) {
  print "  "x@path, "</feature>\n";
  pop @path;
}
print "</target>\n";
