#!/usr/bin/perl -s

use strict;
our($m);
use Lingua::Treebank::SimTreeML dir=> "../F", id => "test";

my $word=shift || undef; ##  or die("Error\nUsage: $0 word\n");

my %expand = (
  prp         => 1,
  adv         => 1,
  "pron-indp" => 1);

my %aux = (
  ser           => 1,
  ter           => 1,
  haver         => 1,
  ir            => 1,
  ficar         => 1,
  estar         => 1,
  poder         => 1,
  );

my %prod=();
my %lhsc=();

downTr({
   (defined $word ? (-patt => "$word") : ()) ,
   -max => ($m || 50000),
   tree => sub{ $c =~ s/\s*\n\s*/ /g;
                my $lhs=$v{cat};
                if($lhs eq "pp" && defined $v{prp}){$lhs .= "($v{prp})"}
                $prod{"$lhs -> $c"}++ if (!$word or $c =~ /\b$word\b/);
		$lhsc{$lhs}++;
                $lhs},
   t   => sub{  if($v{cat} eq "prp"){ $attributes[1]{prp} = $v{lemma} } 
                if($v{lemma} eq $word){
                   if($v{cat} =~  /^v-(.*)/){ "[$word-$1]"}
                   else                     { "[$c]"}}
                elsif($expand{$v{cat}}){"[$v{lemma}]"}
                elsif($v{cat} =~ /^v-/ && $aux{$v{lemma}}){ 
                                  "[$v{lemma}-$v{cat}]"}
                else{"[$v{cat}]"}},
   punct => sub {$v{ort} } 
});

sub f { 
  my ($lhs1,$lhs2);
  ($lhs1,$lhs2) = ($a,$b);
  $lhs1 =~ s/\s+->.*// ;
  $lhs2 =~ s/\s+->.*// ;
  return ($lhsc{$lhs2} <=> $lhsc{$lhs1}) 
         || ($lhs1 cmp $lhs2) 
         || ($prod{$b} <=> $prod{$a})
}

for(sort f ( keys %prod))
   { print "$_ ## $prod{$_}\n";}