diff --git a/src/dgc/dgc b/src/dgc/dgc index 3324ea6..49b3242 100755 --- a/src/dgc/dgc +++ b/src/dgc/dgc @@ -294,7 +294,7 @@ for my $x (@{$in{link}}) my $dflagconstr = @{$x->{dflagconstr}} ? "//@{$x->{dflagconstr}}" : ""; my $props = join('',map("\&$_", @{$x->{props}})); - print_outin("LINK $head->{cat}$hflagconstr $dep->{cat}$dflagconstr $x->{role} $props",$x, @agrs, @govs); + print_outin("LINK $head->{cat}$hflagconstr $dep->{cat}$dflagconstr $x->{role}$props",$x, @agrs, @govs); } } } @@ -367,164 +367,3 @@ sub union { [ uniq( map { @{$_} } @_ ) ] } sub intersection { my $n=@_; my %seen; [ grep { ++$seen{$_} == $n } map { @{$_} } @_ ] } sub complement { my %exclude; for $c (@{shift()}) { $exclude{$c}++ }; [ grep { ! $exclude{$_} } @{$in{cat}} ] } -# printf STDERR "%6d CAT statements\n", 0+keys(%cats); -# printf STDERR "%6d ROLE statements\n", 0+keys(%role); -# printf STDERR "%6d SGL statements\n", @sgl+0; -# printf STDERR "%6d REQ statements\n", @req+0; -# printf STDERR "%6d LEFT statements\n", $nleft; -# printf STDERR "%6d RIGHT statements\n", $nright; -# printf STDERR "%6d INITR statements\n", $ninitr; -# printf STDERR "%6d FINR statements\n", $nfinr; -# printf STDERR "%6d INITF statements\n", $ninitf; -# printf STDERR "%6d FINF statements\n", $nfinf; -# printf STDERR "%6d INITC statements\n", $ninitc; -# printf STDERR "%6d FINC statements\n", $nfinc; -# printf STDERR "%6d LINK statements\n", $nlink; -# printf STDERR "%6d CLASS statements\n", $nclass; -# printf STDERR "%6d FLAG statements\n", $nflag; -# printf STDERR "%6d SET statements\n", $nset; -# printf STDERR "%6d PASS statements\n", $npass; - - -################################################################################## - -# while() -# { -# $inputlineno++; -# s/#.*//; -# s/^\s+//; -# s/\s+$//; -# s/\s+/ /g; -# if (/^CAT ($cat_re)$/) { register('cat', {src=>$&, cat=>attr::parse($1)}, $1); } -# elsif(/^FLAG (\S+)$/) { register('flag', {src=>$&, flag=>$1}, $1); } -# elsif(/^ROLE (\S+)$/) { register('role', {src=>$&, role=>$1}, $1); } -# elsif(/^LEFT (\S+)$/) { register('left', {src=>$&, role=>$1}, 0); } -# elsif(/^RIGHT (\S+)$/) { register('right', {src=>$&, role=>$1}, 0); } -# elsif(/^SGL (\S+)$/) { register('sgl', {src=>$&, role=>$1}, 0); } -# elsif(/^REQ (\S+) (\S+)$/) { register('req', {src=>$&, cat=>$1, role=>$2}, 0); } -# elsif(/^AGR (\S+) (\S+)$/) { register('agr', {src=>$&, role=>$1, attr=>$2}, $1); } -# elsif(/^GOV (\S+) (\S+)$/) { register('gov', {src=>$&, role=>$1, cat=>$2, catexp=>attr::parse($2)}, $1); } -# elsif(/^INIT ($role_re)$/) { register('initr', {src=>$&, role=>$1}, 0); } -# elsif(/^FIN ($role_re)$/) { register('finr', {src=>$&, role=>$1}, 0); } -# elsif(/^INIT ($av_re)$/) { register('initf', {src=>$&, flag=>$1}, 0); } -# elsif(/^FIN ($av_re)$/) { register('finf', {src=>$&, flag=>$1}, 0); } -# elsif(/^SET ($cat_re)\s+(\S+)$/) { register('set', {src=>$&, cat=>$1, flag=>$2}, 0); } -# elsif(/^PASS (\S+)\s+(\S+)$/) { register('pass', {src=>$&, role=>$1, flag=>$2}, 0); } -# elsif(/^CONSTRE (\S+)\s+(\S+)$/) { register('constre', {src=>$&, role1=>$1, role2=>$2}, 0); } -# elsif(/^CONSTRI (\S+)\s+(\S+)$/) { register('constri', {src=>$&, role1=>$1, role2=>$2}, 0); } - -# elsif(my ($hs,$hfs,$ds,$dfs,$r,$rprops) = /^LINK\s+($cats_re)((?:;$avlist_re)?)\s+($cats_re)((?:;$avlist_re)?)\s+($role_re)((?:$proplist_re)?)$/) -# { register('link', {src=>$&, hs=>$hs, hfs=>$hfs, ds=>$ds, dfs=>$dfs, r=>$r, props=>$rprops},0) } -# elsif(/^LONG\s+(\S+)((\s+<\S+)*)((\s+\S+>)*)$/) -# { -# my $rel = $1; -# my $ups = $2; -# my $downs = $4; - -# $ups =~ s///g; -# $downs =~ s/^\s+//; -# my @down = split(/\s+/,$downs) or (); - -# register('long', {src=>$&, rel=>$rel, up=>\@up, down=>\@down},0); - -# print OUTPUT "LONG $rel " . join(",",@up) . "^" . join(",",@down) . "\n"; -# } -# elsif(my ($cl,$cs) = /^CLASS\s+(\S+)\s*\=(.*)$/) -# { -# $class{$1} = $classparser->classexpr($2); -# } -# elsif(/^$/) -# { -# # pomijamy puste linie oraz komentarze -# } -# else -# { -# print STDERR "Illegal format: $_\n"; -# } -# } - - - -# sub is_cat { shift =~ /$attr::cat_re/; } -# sub is_role { $role{shift}; } -# sub is_flag { $flag{shift}; } - - -# sub print_in -# { -# my $data = shift(); -# printf "in@%04d ", $data->{line}; -# print $data->{src}; -# } - -# sub print_out -# { -# printf "out@%08d ", $outline++; -# print @_; -# } - -# sub addlinks -# { -# my ($l, $h,$hfs,$d,$dfs,$r,$rprops) = @_; - -# my @heads = extension($h); -# my @deps = extension($d); - -# my @deps_gov; -# DEP_GOV: -# for my $dep (@deps) -# { -# for my $gov (@govs) -# { -# next DEP_GOV unless attr::match(@{$dep->{catexp}},@{$gov->{catexp}}); -# } -# push @deps_gov, $dep; -# } - -# for my $head (@heads) -# { -# DEP: -# for my $dep (@deps_gov) -# { -# for my $agr (@agrs) -# { -# next DEP unless attr::agree(@{$head->{catexp}},@{$dep->{catexp}},$agr->{attr}); -# } -# print_outin("LINK $head->{cat}$hfs $dep->{cat}$dfs $r$rprops",$l, @agrs,@govs); -# } -# } -# } - - - - - # elsif(/^INIT\s+([[:upper:]]\S*)$/) - # { - # print OUTPUT "#$_\n"; - # my $cat = attr::parse $1; - # for my $atomcat (keys %cats) - # { - # if(attr::match @$cat, @{$cats{$atomcat}}) - # { - # print OUTPUT "INITC ".$atomcat."\n"; - # ++$ninitc; - # } - # } - # } - # elsif(/^FIN\s+([[:upper:]]\S*)$/) - # { - # print OUTPUT "#$_\n"; - # my $cat = attr::parse $1; - # for my $atomcat (keys %cats) - # { - # if(attr::match @$cat, @{$cats{$atomcat}}) - # { - # print OUTPUT "FINC ".$atomcat."\n"; - # ++$nfinc; - # } - # } - # }