# DEM to C++ translator  Chris Houser  96.4.25

# Find flow.
sub related {  # List of arcs (with inverted bases) in graph leaving class @_
	map $$_[0] eq $_[0] && $$_[1] ? $_ 
	  : $$_[2] eq $_[0] && ! $$_[1] ? [$$_[2],'',$$_[0]] 
	  : (), @graph }
sub related0 {  # List of arcs in flow leaving class @_
	map $$_[0] eq $_[0] && $$_[1] ? $_ 
	  : $$_[2] eq $_[0] && ! $$_[1] ? [$$_[2],'',$$_[0]] 
	  : (), @flow }
sub samearc { join(':',@{$_[0]}) eq join(':',@{$_[1]}) }
sub arcmatch { my ( $pattern, @arc ) = @_; join( ':', @arc ) =~ /$pattern/ }
sub intersect { 
	( $patterns, @arcs ) = @_;
	map { my $p = $_; grep arcmatch( $p, @$_ ), @arcs } @$patterns }
sub flow {  # read @$T @$I @$X @flow  argument is path: list of (refs to) arcs
	return 0 if 1 < grep samearc( $_[$#_], $_ ), @_;  # loop
	return 0 if grep arcmatch( $_, @{$_[$#_]} ), @$X;  # X arc
	my $next = $_[$#_]->[2];  # target of last arc in path
	my $hit = !@$T || grep $_ eq $next, @$T;  # T class
	$hit = 0 if $hit and @$I and !intersect $I, @_;  # I arc
	map $hit |= &flow( @_, $_ ), related $next;
	push @flow, $_[$#_] if $hit and ! grep samearc( $_[$#_], $_ ), @flow;
	$hit }

# Generate class definition.
sub ownslots { grep $$_[0] eq $_[0] && $$_[1], @graph } # Data members of @_
sub bases { map $$_[2], grep $$_[0] eq $_[0] && !$$_[1], @graph }
sub allslots {  # Data members of @_, included inherited members
	$_[0] && ( map( allslots($_), bases $_[0] ), ownslots $_[0] ) }
sub comma { join ',', @_ } 
sub comma1 { join ', ', @_ } 
sub ctype {  # C++ type of slot @_
	local ($home, $name, $_, $list ) = @{$_[0]};
	s/(^[A-Z]\w*)/ref($1)/;
	s/(.*)/ref(vector<$1>)/ if $list;
	$_ }
sub constructor {  # Code string for C++ constructor for class $_
	my @b = bases $_;
	my $b = comma1 map "$_(" . comma(map " $$_[1]",allslots $_) . ' )', @b;
	my $s = comma1 map "$$_[1]( $$_[1] )", ownslots $_;
	"\t$_(" . comma( map " ${\ctype $_} $$_[1] = 0", allslots $_ )
	. ' )' . ( $b || $s and "\n\t\t: " )
	. $b . ( $b and $s and ",\n\t\t  " ) . "$s { }\n" }
sub declare {  # Emit header for class $_.
	print "class $_ ";
	print ': ', comma1 map "public $_", @b if @b = bases $_;
	print "\n{\npublic:\n", constructor;
	print map { /^void \w+::(.*)/; "\tvirtual void $1;\n" } @{$methods{$_}};
	print "private:\n", map "\t${\ctype $_} $$_[1];\n", ownslots $_;
	print "};\n\n" }
sub call {
	$_[3] ? 
		"for(\tvector<ref($_[2])>::iterator each_$_[2] = ${_[1]}->begin();
		each_$_[2] < ${_[1]}->end();\n\t\t(*each_$_[2]++)->$call )"
	: $_[1] ? "${_[1]}->$call" 
	: "$_[2]::$call" }

# Parse data and event definitions.
while(<>){
	if( /^([A-Z]\w+)/ ){  # data definition
		local ( $class, @related ) = split;
		push @classes, $class;
		for( @related ){
			last if m'//';  # comment
			if( /^[A-Z]\w+$/ ){ push @graph, [$class,'',$_,'']; # base
			} elsif( local ( $name, $_ ) = /^(\w+)(.*)/ ){ # member
				s/#/int/; 
				s/\$/string/;
				s/:(\w+)/$1/;
				/^$/ and $name =~ /(\w+)s$/ and $_ = "\@\u$1"; 
				my $list = s/@(\w+)/$1/;
				push @graph, [$class,$name,$_||"\u$name",$list] }}
	} elsif( /^[a-z]/ ){  # event definition
		chomp;
		local ( $", @flow ) = '';
		my ( $sig, %code, %impl ) = $_;
		while( $_=<> and /([\w ]+)(-> ([\w ]+))(\+ ([\w: ]+))?(- ([\w: ]+))?/ ){
			local ( $F, $T, $I, $X ) = map [split /\s+/, $_], ($1, $3, $5, $7);
			map flow($_), map related($_), @$F }
		while( ( $class, $type, $code ) = /^(\w+)\s+([<=>])\s+(.*)/ ){
			$code .= "\n$&" while $_ = <> and /^\t.*/;
			$code{$class}{$type} = "\t$code\n" }
		( local $call = $sig ) =~ s/ [\w<&*>]+ (\w+,?)/ $1/g;
		@impl{ keys %code, map @$_[0,2], @flow } = 1;
		for( keys %impl ){  # Build methods (member functions) for this event.
			$code{$_}{'='} ||= join '', map "\t${\call @$_};\n", related0 $_;
			push @{$methods{$_}}, 
				"void ${_}::$sig\n{\n@{$code{$_}}{'<','=','>'}}\n\n" }}}

# Emit C++ code.
map print("class $_;\n"), @classes;
print "\n";
map declare, @classes;
map print, map @{$methods{$_}}, @classes;