# Recognition of the end of strings and re could be better ...

NODE:
while (<>) {
  if (/^(\s*)\{\s*$/) {
    $level = length $1;
    die "Strange indent $level of\n$_" unless $level % 4 == 0;
    $level /= 4;
    defined ($_ = <>) or die "Unexpected EOF before node at level $level";
    $dead = 0;
    /
      ^ \s* 
      (
	\d+			# 1: Id of the node
      )
      \s+ TYPE \s* = \s* 
      (
	\w+			# 2: Type of the node
      )
      \s* 
      (
	=+
      )
      > \s* 
      (
	\d+	| DONE		# 4: Id of the next node
      )
      \s* $
    /x
      or /
	   ^ \s* TYPE \s* = \s*
	   (
	     \w+			# 2: Type of the node
      )
	   \s* 
	   (
	     =+
      )
	   > \s* 
	   (
	     \( \d+ \)			# 4: Id of the next node
      )
	 /x and $dead = 1
      or die "Unexpected format of a node header:\n$_,";
    $id = $1;
    print unless $id;
    
    $ids{$id} = { nextid => $4, type => $2, 
		  level => $level, subtype => '', comment => '' } unless $dead;

  attrs:    
    while (<>) {
      next if /^\s*((FLAGS|LINE|TARG|PRIVATE)\s*=|\(was\b)/;
      redo NODE if /^\s*\{/ and ($dead or $ids{$id}{type} ne 'match');
      next if /^\s*\{/;
      if (/^\s*([SG]V|PMf_PRE)\s*=+>?\s*(.*)$/) {
	@{$ids{$id}}{'subtype','comment'} = ($1, $2) unless $dead;
	if (/^\s*SV\s*=\s*PV\w*\(\"/ and !/\"\)\s*$/) {
	  while (<>) {
	    next unless /\"\)\s*$/;
	    next attrs;
	  }
	  last attrs;
	}
	next;
      }
      if (/^\s*(PMf_PRE)\s*(.*)$/) {
	$ids{$id}{targets}{$1} = $2 unless $dead;
	while (<>) {
	  next unless /^\s*((PMf_SHORT|PMFLAGS)\s*=|\}\s*$)/;
	  redo attrs;
	}
	last attrs;
      }
      if (/^\s*(OTHER|LABEL|REDO|NEXT|LAST|TRUE|FALSE|PMf_SHORT|PMFLAGS)\s*=+>?\s*(.*)$/) {
	$ids{$id}{targets}{$1} = $2 unless $dead;
	next;
      }
      next NODE if /^\s*\}/;
      die "Puzzled by descriptor\n$_,";
    }
    last NODE;
  } elsif (/^SUB\b/) {
    last;
  } elsif (/^\s*\}/) {
    next;
  } elsif (/^\s*$/) {
    next;
  } else {
    die "Puzzled by leader\n$_";
  }
}

@ids = sort {$a <=> $b} keys %ids;
for $id (@ids) {
  $next = ($id + 1 == $ids{$id}{nextid} ? "" : " => $ids{$id}{nextid}");
  $targets = '';
  for $t (sort keys %{$ids{$id}{targets}}) {
    $targets .= " $t => $ids{$id}{targets}{$t}"
  }
  $targets = "($targets )" if $targets;

  printf "%4d ", $id;
  print " " x $ids{$id}{level}, <<EOP;
$ids{$id}{type} $ids{$id}{comment}$targets$next
EOP
}