#!/usr/bin/perl -w

# script SYNF 
# version that requires components to already be measured

# 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 SmeasF 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 SmeasF
  }
  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";

#Get the Polish string
open(SSCF, "system.pscf") || die "no Polish control file";
chop($Polish = <SSCF>);
warnmess "Attempting the system calculation of Polish $Polish";
@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";

$Wrong = 0;  #if TRUE, found something wrong with .ccf file
chop($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;
  }
  
  #Rough check of the .ccf file contents
  # might be better to put this all in COMPF...
  
  open (CCF, "<".$c) or die "can't read configuration file ", $c ;
  $component[$i] = $c." \n" ;
  chop($prog[$i] = <CCF>); #read the executable name for messages later
  #DEBUG
  #print '$prog[$i]: ', $prog[$i], "\nc: $c\n";
  #can component be executed?
#TBD:  remove code down to END?
  unless ($prog[$i] =~ /^theory/ ||-x $prog[$i]) {
    warn "Component file ",$prog[$i]," in ",$c, " is not executable";
    #should do better than this -- actually try to execute it...
    $Wrong = 1;
  }
  $FirstInterval = 1;
  #Comments indicate the check being made
  #  Wrong==2 means a problem that precludes some further checking
  while ($line = <CCF>) {
    @bits = split(" ",$line);
    #debug
    #print $bits[2];
    unless (defined($bits[0])) { 
      warn $c," contains a blank line";
      $Wrong = 2;  #but keep going...
    }
    elsif ($bits[0] > $bits[1]) {
      warn $c,", Line ",qq{$line}," has empty interval [",$bits[0],",",$bits[1],"]";
      $Wrong = 2;  #but keep going...
    } 
    elsif ($prog[$i] !~ /^theory/ && ((not defined($bits[2])) || $bits[2] == 0)) {
      warn "Count missing in ",$c;
      $Wrong = 1;
    }
    if ($Wrong < 2) { #OK to make check for interval coverage
      if ($FirstInterval) { #left-most
        $FirstInterval = 0;
        $Right = $bits[0];
      }
      unless ($Right == $bits[0]) {
        warn "Intervals overlap or are not contiguous in ",$c;
        $Wrong = 2;
      }
      else {
        $Right = $bits[1];
      }
    }
  } #end while going through one file
  close (CCF);
#END TBD above
  if (defined($c = <SSCF>)) {
    if ($i == $num_comps - 1) {
      warn "Too many .ccf files to correspond to Polish in .pscf file";
    } else {
      chop $c;
    }
  }
} #end for going through all files

#if (defined(<SSCF>)) {
#  warn "Too many .ccf files to correspond to Polish in .pscf file";
#}
close (SSCF);
if ($Wrong) {die "Please fix .ccf file(s) and try again";}
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\n";

    #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";
    @thfpre = split(/\./,$thf);  #name without the ".ccf" in [0]
#end common setup stuff
    if ($op eq "S") { # series of 2 components
      if ($#ccfStack < 1) {
        die "Not enough operands for a series (S) combination";
      }
      chop($C2 = pop @ccfStack);
      chop($C1 = pop @ccfStack);
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      #later, just the right files
      #$fileList = $fileList . $C1." ".$C2." ".$p1." ".$p2;
      warnmess "Series: ",$p1,";",$p2," -> ",$thfpre[0];
      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";
      }
      chop($Cfalse = pop @ccfStack);
      chop($Ctrue = pop @ccfStack);
      chop($Ctest = pop @ccfStack);
      $p3 = pop @ProgStack;
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
      #$fileList = $fileList . $Ctrue." ".$Cfalse." ".$Ctest." ".$p1." ".$p2." ".$p3;
      warnmess "Conditional:  IF ",$p1," THEN ",$p2," ELSE ",$p3," FI -> ",$thfpre[0];
      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";
      }
      chop($Cbody = pop @ccfStack);
      chop($Ctest = pop @ccfStack);
      $p2 = pop @ProgStack;
      $p1 = pop @ProgStack;
  
      #$fileList = $fileList . $Cbody." ".$Ctest." ".$p1." ".$p2." ident.ccfl ident.bin";
      warnmess "Loop:  WHILE ",$p1," DO ",$p2," OD -> ",$thfpre[0];
      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[0];
    system "cp system.sscf ../".$thfpre[0];  #save the system structure as a series of files
    if (system "./CalcF ".$allOptions) {die "`CalcF' script failed";}
    $cmd = "mv -f theory.ccf ../".$thf;
    `$cmd`;
    chdir ".."; #back to parent directory
    push @ccfStack, $thf;
    push @ProgStack, $thfpre[0];
  } #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

chop($thf = pop @ccfStack);
#`mv -f $thf theory.ccf`;  #rename as the result of this run
#warnmess "Result in `theory.ccf' is ",$thf," from above";

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";
}

#}else{
#  $thf="theory".$numtheory.".ccf";
#}  #end of UPDATE test above?

if (system "./SmeasF ".$allOptions) {die "`SmeasF' script failed";}

# display the system graph
if ($Goption) {
  warnmess "Graphing system ...";
  system "./XcompF -G";
}
