Index: app/src/dgp/dgc
===================================================================
--- app/src/dgp/dgc	(revision 0214596e4d70b25df913a24f19d50cb0f1b4a69f)
+++ app/src/dgp/dgc	(revision 0214596e4d70b25df913a24f19d50cb0f1b4a69f)
@@ -0,0 +1,206 @@
+#!/usr/bin/perl
+
+#package:	UAM Text Tools
+#component:	dgc (dg compiler)
+#version:	1.0
+#author:	Tomasz Obrebski
+
+#use lib "ENV{HOME}/.utt/lib/perl";
+#use strict;
+use Getopt::Long;
+use Data::Dumper;
+
+use attr;
+#use File::HomeDir;
+
+my $help=0;
+my $catfile=0;
+my $dicfile=0;
+my $gramfile=0;
+
+my $ncat=0;
+my $nrole=0;
+my $nsgl=0;
+my $nleft=0;
+my $nright=0;
+my $nreq=0;
+my $nlink=0;
+
+GetOptions("help|h" => \$help,
+	   "catfile|c=s" => \$catfile,
+	   "dicfile|d=s" => \$dicfile,
+	   "gramfile|g=s" => \$gramfile);
+
+if($help)
+{
+    print <<'END'
+Usage: dgpcompile [OPTIONS]
+
+Options:
+   --cats -c filename		List of syntactic categories.
+   --dic  -d filename           Dictionary.
+   --help -h			Help.
+END
+;
+    exit 0;
+}
+
+die("At least one of --cats and --dic must be given.\n") if !$catfile && !$dicfile;
+
+my %cats;
+my %roles;
+my %agr;
+my %gov;
+
+loadcats($catfile) if $catfile;
+extractcats($dicfile) if $dicfile;
+
+
+$cats_re = qr/(?:$attr::cat_re\s*(?:,\s*$attr::cat_re)*)/;
+
+# class parse_class:
+# /$attr::cat_re/g;
+
+while(<>)
+{
+    if(/^\s*AGR\s+(\S+)\s+(\S+)\s*$/)
+    {
+	push @{$agr{$1}}, $2;
+    }
+    elsif(/^\s*GOV\s+(\S+)\s+(\S+)\s*$/)
+    {
+	push @{$gov{$1}}, attr::parse($2);
+    }
+    elsif(/^\s*ROLE\s+\S+\s*$/)
+    {
+	$roles{$_}=1;
+	print;
+    }
+    elsif(/^\s*SGL\s+\S+\s*$/)
+    {
+	++$nsgl;
+	print;
+    }
+    elsif(/^\s*REQ\s+(\S+)\s+(\S+)\s*$/)
+    {
+	print "#$_";
+	my $cat = attr::parse $1;
+	for my $atomcat (keys %cats)
+	{
+	    if(attr::match @$cat, @{$cats{$atomcat}})
+	    {
+		print "REQ ".$atomcat." $2\n";
+		++$nreq;
+	    }
+	}
+    }
+    elsif(/^\s*LEFT\s+\S+\s*$/)
+    {
+	++$nleft;
+	print;
+    }
+    elsif(/^\s*RIGHT\s+\S+\s*$/)
+    {
+	++$nright;
+	print;
+    }
+    elsif(($hs,$ds,$r) = /^\s*LINK\s+($cats_re)\s+($cats_re)\s+(\S+)\s*$/)
+    {
+	print "#$_";
+	for $h ($hs =~ /$attr::cat_re/g)
+	{
+	    for $d ($ds =~ /$attr::cat_re/g)
+	    {
+		addlinks($h,$d,$r);
+	    }
+	}
+    }
+    
+    else
+    {
+	print;
+    }
+}
+
+
+sub addlinks
+{
+    ($h,$d,$r) = @_;
+
+    for my $a (@{$agr{$r}}) { print "#AGR $r $a\n"; }
+    for my $c (@{$gov{$r}}) { print "#GOV $r ".attr::unparse(@$c)."\n"; }
+    my $head = attr::parse $h;
+    my $dep = attr::parse $d;
+    
+    for my $atomhead (keys %cats)
+    {
+	if(attr::match @$head, @{$cats{$atomhead}})
+	{
+	  DEP:
+	    for my $atomdep (keys %cats)
+	    {
+		next DEP if ! attr::match @$dep, @{$cats{$atomdep}};
+		
+		for my $a (@{$agr{$r}})
+		{
+		    next DEP if ! attr::agree(@{$cats{$atomhead}},@{$cats{$atomdep}},$a);
+		}
+		
+		for my $c (@{$gov{$r}})
+		{
+		    next DEP if ! attr::match(@$c,@{$cats{$atomdep}});
+		}
+		
+		print "LINK ";
+		print $atomhead." ";
+		print $atomdep." $r\n";
+		++$nlink;
+		
+	    }
+	}
+    }
+}
+
+
+printf STDERR "%6d CAT   statements\n", 0+keys(%cats);
+printf STDERR "%6d ROLE  statements\n", 0+keys(%roles);
+printf STDERR "%6d SGL   statements\n", $nsgl;
+printf STDERR "%6d REQ   statements\n", $nreq;
+printf STDERR "%6d LEFT  statements\n", $nleft;
+printf STDERR "%6d RIGHT statements\n", $nright;
+printf STDERR "%6d LINK  statements\n", $nlink;
+
+
+sub extractcats
+{
+    my $file = shift;
+    open DICFILE, "canonize $file |";
+    while(<DICFILE>)
+    {
+	while(/,([^[:space:];]+)/g)
+	{
+	    $cat=$1;
+	    next if !$cat || exists $cats{$cat};
+	    $ncat++;
+	    print "CAT $1\n";
+	    $cats{$cat}=attr::parse($cat);
+	}
+    }
+    close DICFILE;
+}
+
+
+sub loadcats
+{
+    my $file = shift;
+    open CATFILE, "canonize $file |";
+    while(<CATFILE>)
+    {
+	tr/ \t\n//d;
+	next if !$_ || exists $cats{$_};
+	print "CAT $_\n";
+	++$ncat;
+	$cats{$_}=attr::parse($_);
+    }
+    close CATFILE;
+}