#!/usr/bin/perl -w

# script SYNS 

# Switch processing
$Noption = 1000;  #default count for loop execution
$Voption = 0; #default is silent
$Goption = 0;
$Toption = 0; #no trace
$Poption = 0; #create the "system.scf" file when off
# -X option may be passed to SmeasS so that it uses the "theory" files
$allOptions = "";
OPT: for ($i = 0;;$i++) { #over all options
  unless (defined($ARGV[$i])) {last OPT;}
  $allOptions = $allOptions." ".$ARGV[$i];
  if ($ARGV[$i] eq "-V") {
    $Voption = 1;
  }
  if ($ARGV[$i] eq "-G") {
    $Goption = 1;
  }
  if ($ARGV[$i] eq "-X") {
    #$Xoption = 1;  #flag isn't used except to pass to SmeasS
  }
  if ($ARGV[$i] eq "-T") {
    $Toption = 1;
  }
  if ($ARGV[$i] eq "-P") {
    $Poption = 1;
  }
  if ($ARGV[$i] eq "-N") {
    unless(defined($ARGV[$i+1]) && $ARGV[$i+1] =~ /^\d+$/) {
      die "Invalid argument for -N\n";
    }
    $Noption = $ARGV[$i+1];
  }
}
#debug
#print "$Voption $Noption \n";
#print "$allOptions \n";

sub warnmess{ #print warning based on V option
  unless ($Voption && defined($_[0])) {return;}
  $mess = "";
  MLOOP: for ($wm=0;;$wm++) {
    unless (defined($_[$wm])) {last MLOOP;}
    $mess = $mess.$_[$wm];
  }
warn $mess, "\n";  #don't print line from which this came...
}
#debug
#warnmess "foo ", "and baz";

system "rm -f *.state"; #clear any state files

#Get the Polish string
open(SSCF, "system.pscf") || die "no Polish control file";
chop($Polish = <SSCF>);
@PE = split(" ", $Polish);
#Find the largest component number used
$num_comps = 0;
foreach $num (@PE) {
  unless ($num =~ /\D/) {  #if it's a number
    if ($num_comps < $num) {$num_comps = $num ;}
  }
}
#debug
#print "$num_comps \n";

chomp($c = <SSCF>);
$ccftExist = 1;  #assume that there is a good ccft file
for ($i=0; $i<$num_comps; $i++) {
#debug
#print "component .ccf $i: ", $c, "\n" ;
  unless (defined($c)) {
    die "Not enough .ccf files to match Polish in the .pscf file";
  }
  $ccft = $c."t";
  unless (-e $ccft) { #theory file doesn't exist 
    warn "Component $c not approximated\n";
    $ccftExist = 0;
  }
  
  open (CCF, "<".$c) or die "can't read configuration file ", $c ;
  $component[$i] = $c."\n" ;
  chomp($prog[$i] = <CCF>); #read the executable name for messages later
  if (defined($c = <SSCF>)) {
    if ($i == $num_comps - 1) {
      warn "Too many .ccf files to correspond to Polish in .pscf file";
    } else {
      chomp $c;
    }
  }
} #end for going through .ccf files
close (SSCF);
unless ($ccftExist) { 
  die "Component approximations must be measured first";
}

#ready to start

$theory_ccf = 0;  #counter for making unique names for "theory" files

warnmess "Beginning the system calculation of Polish $Polish";
foreach $op (@PE) { # process the Polish
  if ($op =~ /\D/) { #operator
    $thfpre = "theory".++$theory_ccf;
    $thf = $thfpre.".ccf";

    #create subdirectory, do single calculation there, and bring back to this
    # directory the computed "theory" file under a unique name in $thf
    $subdir = ".SubCalc";  #name of the subdirectory (invisible to most)
    `rm -r -f $subdir`; #destroy directory so it can be used repeatedly
    mkdir $subdir;
    `cp * $subdir`;
    chdir $subdir; #shift to new directory
#debug -- where are we?
#print `pwd`;
    #build a proper .sscf file
    open (SSCF, ">system.sscf") || die "can't create .sscf file for calculation";
#end common setup stuff
    if ($op eq "S") { # series of 2 components
      if ($#ccfStack < 1) {
        die "Not enough operands for a series (S) combination";
      }
      chomp($C2 = pop @ccfStack);
      chomp($C1 = pop @ccfStack);
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      warnmess "Series: ",$p1,";",$p2," -> ",$thfpre;
      print SSCF "series\n";
      print SSCF "$C1\n";
      print SSCF "$C2\n";
    }
    elsif ($op eq "C") { #conditional, 3 components
#debug
#print "$#ccfStack  @ccfStack \n";
      if ($#ccfStack < 2) {
        die "Not enough operands for a conditional (C) combination";
      }
      chomp($Cfalse = pop @ccfStack);
      chomp($Ctrue = pop @ccfStack);
      chomp($Ctest = pop @ccfStack);
      $p3 = pop @ProgStack;
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      warnmess "Conditional:  IF ",$p1," THEN ",$p2," ELSE ",$p3," FI -> ",$thfpre;
      print SSCF "conditional\n";
      print SSCF "$Ctest\n";
      print SSCF "$Ctrue\n";
      print SSCF "$Cfalse\n";
    }
    elsif ($op eq "L") { #loop, 2 components
      if ($#ccfStack < 1) {
        die "Not enough operands for a loop (L) combination";
      }
      chomp($Cbody = pop @ccfStack);
      chomp($Ctest = pop @ccfStack);
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      warnmess "Loop:  WHILE ",$p1," DO ",$p2," OD -> ",$thfpre;
      print SSCF "loop\n";
      print SSCF "$Ctest\n";
      print SSCF "$Cbody\n";
    }
    else {
      die "Illegal operand `$op' in Polish system description";
    }
#common cleanup operations
    close SSCF;
#debug
#print `cat system.sscf`;
    system "rm -f ../".$thfpre;
    system "cp system.sscf ../".$thfpre;  #save the system structure as a series of files
    if (system "./CalcS ".$allOptions) {die "`CalcS' script failed";}
    if (-e "theory.ccfc") { #result synthesized component has state
      $thf = $thfpre.".ccfc";
      $synF = "theory.ccfc";
    } else {
      $synF = "theory.ccf";
    }
    $cmd = "mv -f $synF ../".$thf;
    `$cmd`;
    chdir ".."; #back to parent directory
    push @ccfStack, $thf;
    push @ProgStack, $thfpre;
  } #end of processing operator
  else { #operand number, stack it, the index to @component and @prog
    push @ccfStack, $component[$op-1];
    if ($prog[$op-1] !~ /^theory/) { #adjust name for messages
      @tmp = split(/\./,$prog[$op-1]);
      $prog[$op-1] = $tmp[0];  #drop extension from print name
    }
    push @ProgStack, $prog[$op-1];
  }
} # end foreach op in Polish

if ($#ccfStack != 0) {
  warn $#ccfStack," too many operands in the Polish system description";
}
#What is now left on the stack is the "theory" file for the complete system

chomp($thf = pop @ccfStack);

@sfile = split(/\./,$thf);
$ext = $sfile[scalar(@sfile) -1];
$stateless = ($ext eq "ccf");
#TBD  Not sure what is needed for system.scf in the state case...
if ($stateless) {
  if ($Poption) { #use existing file
    unless (-e "system.scf") {
      die "-P option requires `system.scf' file";
    }
    warnmess "Using existing measurement/profile description";
  }
  else {
  #Write a system.scf using the subdomains of the theory
    open(SCF, ">system.scf") || die "can't write `system.scf' file";
    open(TH, $thf) || die "can't open the final theory file";
    $line = <TH>;  #discard name
    print SCF "$thf\n"; #name of the final theory file
    while ($line = <TH>) {
      @lineS = split(" ",$line);
      $HowMany = 3;
      print SCF $lineS[0]." ".$lineS[1]." ".$HowMany."\n";
    }
    close(TH);
    close(SCF);
    warnmess "File system.scf written to correspond to calculated subdomains";
  }
  if (system "./SmeasF ".$allOptions) {die "`SmeasF' script failed";}
  # display the system graph
  if ($Goption) {
    warnmess "Graphing system ...";
    system "./XcompF -G";
  }
} else { #has state
  #see TBD above about system.scf
  #create SystemCode actual system code
  if (system "./SmeasS ".$allOptions) {die "`SmeasS' script failed";}
  
  # display the system graph
  if ($Goption) {
    warnmess "Comparing actual system ...";
    system "./compR -O -I SystemCode";
    system "./XcompN $thf";
  }
}
