package main;

  use strict;
  use Getopt::Long;
  use English;

# Global variables
  my $SCRIPTNAME = 'htmlifyer';
  my $VERSION = '0.1';
  my $VERBOSE = 0;
  my $SHOW_HELP = 0;
  my $SHOW_VERSION = 0;
  my $NOP = 0;
  my $GRAPHICS = 0;
  my $DATAFLOWIN = '';
  my $DATAFLOWOUT = '';
  my $TESTCASESOUT = '';
  my $GUARDSOUT = '';
  my $UPDATESPEC = '';
  my $TESTCASES = '';
  my $updateSpec = '';
  my $dataflow = '';
  my $testCases = '';
  my @FlowRules = ();
  my @GuardRules = ();

  my %Rules = ();
  my $ruleCount = 1;
  my %Graph = ();
  my %Binds = ();
  my %Heads = ();

  &ParseCommandLine();

  # slurp the dataflow spec
  open (FILE, "<$DATAFLOWIN") or die "could not open file $DATAFLOWIN";
  while (<FILE>) { $dataflow.= $_ unless /^%/; }
  close FILE; 
  open (UPSPEC, "<$UPDATESPEC") or die "could not open file $UPDATESPEC";
  while (<UPSPEC>) { $updateSpec .= $_ unless /^%/; }
  close UPSPEC; 
  open (TESTCASES, "<$TESTCASES") or die "could not open file $TESTCASES";
  while (<TESTCASES>) { $testCases .= $_ unless /^%/; }
  close TESTCASES; 

  my @s = split(/\s*\*\s*/, "*" . $dataflow);
  shift @s; shift @s;
  my %Flow = @s;
  @s = split(/\s*\*\s*/, "*" . $updateSpec);
  shift @s; shift @s;
  my %Update = @s;

#  foreach my $key (sort keys %Flow) {
#    print "x{$key}{$Flow{$key}}x\n";
#    }

  # parse each rule into head and body
  foreach my $key (sort keys %Flow) {
    my @rules = split(/\s*\.\s*/, $Flow{$key});
    my $ai = 1;
    my $aj = 2;
    my $si = 1;
    my $sj = 2;
    foreach my $rule (@rules) {
      my @newBindings = ();
      my %VariableMap = ();

      # Identify the head and the body
      my ($head, $body) = split(/\)\s*:-\s*/, $rule);

      # Add the head variables to the variable map
      &addToMap($head, \%VariableMap, "_$key");
      $head = &mapVars($head, \%VariableMap);

      ## iterate through the body predicates
      #my @predicates = split(/\s*\)\s*,\s*/, $body);
      #foreach my $predicate (@predicates) {

      # We'll compute a new body for this rule
      my @newBody = ();
      my @guardBody = ();

      # Fix up the body, determine if the rule has an update rule
      if (defined $Update{$key}) {

        # Iterate through the predicates in the current body
        my @predicates = split(/\s*\)\s*,\s*/, $body);
        foreach my $predicate (@predicates) {
          $predicate =~ s/\)//;
          my $mappedPredicate = &mapVars($predicate, \%VariableMap);

          # If it pulls data from the AD, append the initial AD
          if ($predicate =~ /^ad_/) { 
            push @newBody, $mappedPredicate . ", A$ai)"; 
            push @guardBody, $mappedPredicate . ")"; 
            }

          # If it pulls data from the SD, append the initial SD
          elsif ($predicate =~ /^sd_/) { 

            # If it pulls data from the SD, delete the data from the SD
            push @newBody, $mappedPredicate . ", S$si)"; 
            push @guardBody, $mappedPredicate . ")"; 
            push @newBody, "delete_sd($mappedPredicate), S$si, S$sj)";
            $si++; $sj++;
            }

          else { 
            push @newBody, $mappedPredicate . ")"; 
            }
          }

        # Append the body of the update rules to the body of the dataflow rule
        my @updateRules = split(/\.\s*/, $Update{$key});
        foreach my $upRule (@updateRules) {
          my %AddToHead = ();
          my %UpdateMap = ();
          my ($upHead, $upBody) = split(/\)\s*:-\s*/, $upRule);
          $ruleCount++;

          # Create the initial update map
          &addToMap($upHead, \%UpdateMap, "_$key" . "_$ruleCount");

          # Deal with the body
          my @upPredicates = split(/\s*\)\s*,\s*/, $upBody);
          foreach my $predicate (@upPredicates) {
            $predicate =~ s/\)//;
            my $mappedPredicate = &mapVars($predicate, \%UpdateMap);
            if ($predicate =~ /^ad_/) { 
              push @guardBody, $mappedPredicate . ")"; 
              $mappedPredicate .= ", A$ai)"; 
              push @newBody, $mappedPredicate;
              }
            elsif ($predicate =~ /^sd_/) { 
              push @newBody, "delete_sd($mappedPredicate), S$si, S$sj)";
              push @guardBody, $mappedPredicate . ")"; 
              $mappedPredicate .= ", S$si)"; 
              push @newBody, $mappedPredicate;
              }

            # If it concerns input, we need to add to the data flow graph
            elsif ($predicate =~ /^\s*input(\d+)\s*\(/) {

              # Which input predicate is it?
              my $predNumber = $1;
              my $rest= $';

              # If it is this one, then we have to match the vars to the head
              if ($key == $predNumber) {
                foreach my $var (split(/\s*,\s*/, $rest)) {
                  $UpdateMap{$var} = $VariableMap{$var};
                  }
                }

              # need to generate binds in the graph
              else {
                my $count = 0;
                my $headCount = scalar(split(",", $head));
                my $varCount = 1;
                foreach my $var (split(/\s*,\s*/, $rest)) {
                  $count++;
                  next if $var eq "_";
                  $UpdateMap{$var} = $var;
                  if (!defined $AddToHead{$var}) {
                    $AddToHead{$var} = 1;
                    push @newBindings, $var;
                    $varCount = $headCount + scalar(@newBindings);
                    }
                  my $a = $Binds{$key} || {};
                  $$a{"$predNumber,$count,$varCount"} = 1;
                  $Binds{$key} = $a;
                  }
                }
 
              }
            else { 
              $mappedPredicate .= ')'; 
              push @newBody, $mappedPredicate;
              }
            }

          # Add the head to the new body
          if ($upHead =~ /^\s*delete_ad_/) { 
             my $mappedHead = &mapVars($', \%UpdateMap);
             push @newBody, "delete_ad(ad_$mappedHead), A$ai, A$aj)";
             $ai++; $aj++;
             }
          elsif ($upHead =~ /^\s*insert_ad_/) { 
             my $mappedHead = &mapVars($', \%UpdateMap);
             push @newBody, "insert_ad(ad_$mappedHead), A$ai, A$aj)";
             $ai++; $aj++;
             }
          else { die "error: update rule head is $upHead"; }
          
          }
        }  
      else {
        my @predicates = split(/\s*\)\s*,\s*/, $body);
        foreach my $predicate (@predicates) {
          $predicate =~ s/\)//;
          my $mappedPredicate = &mapVars($predicate, \%VariableMap);
          if ($predicate =~ /^ad_/) { $mappedPredicate .= ", A$ai)"; }
          elsif ($predicate =~ /^sd_/) { $mappedPredicate .= ", S$si)"; }
          else { $mappedPredicate .= ')'; }
          push @newBody, $mappedPredicate;
          }
        #push @newBody, "A$ai = A$aj";
        #push @newBody, "S$si = S$sj";
        }

      # Now let's prepare the head, default input databases are version 1
      my $rest = "";
      $rest = join(", ", @newBindings) . ", " if scalar(@newBindings);
      $Heads{$key} = $head . ", $rest)";
      my $guardHead = $head;
      $guardHead .= ", " . join(", ", @newBindings) if scalar(@newBindings);
      $guardHead .= ")";
      $guardHead =~ s/^input/guard/;
      $guardHead =~ s/\(\s*\)//;

      $aj--; $sj--;
      $rest .= "A1, A$aj, S1, S$sj)";
      if ($head =~ /\(\s*$/) {
        $head .= $rest;
        }
      else {
        $head .= ", $rest";
        }

      $Rules{$key} = [$head, join(",\n     ", @newBody)];
      push @FlowRules, "$head :-\n     " . join(",\n     ", @newBody) . ".\n";
      my $guardBody = ".\n";
      $guardBody = " :-\n     " . join(",\n     ", @guardBody) . $guardBody 
        if scalar(@guardBody);
      push @GuardRules, "$guardHead$guardBody";
      }
    }

  open (DATAFLOWOUT, ">$DATAFLOWOUT") or die "could not open file $DATAFLOWOUT";
  print DATAFLOWOUT join("\n", @FlowRules);
  close DATAFLOWOUT;

  open (GUARDSOUT, ">$GUARDSOUT") or die "could not open file $GUARDSOUT";
  print GUARDSOUT join("\n", @GuardRules);
  close GUARDSOUT;

  open (TESTCASESOUT, ">$TESTCASESOUT") or die "could not open file $TESTCASESOUT";
  my $caseCount = 1;
  foreach my $case (split("\n", $testCases)) {
    my %VarMap = ();
    my $writeHead = "";
    my $vc = 1;
    my $ai = 1;
    my $aj = 2;
    my $si = 1;
    my $sj = 2;
    my @TestCases = ();
    foreach my $transition (split(/\s*,\s*/, $case)) {
      $transition =~ s/\s*//g;
      my $head = $Heads{$transition}; 

      # Reload the variable map for this transition
      my $h = {};
      my $count = 0;
      $VarMap{"$transition"} = $h;
      my %vars = ();
      foreach my $var (@{&getVars($head)}) {
        $count++;
        if (!defined $vars{"$var"}) {
          $vc++;
          $vars{"$var"} = "V_$vc";
          }
        $$h{"$count"} = "V_$vc";
        }
      $head = &mapVars($head, \%vars);
      $writeHead = "write($head)";
      $writeHead =~ s/\(\s*\)//;      
      $head =~ s/\)/, /;      
      $head =~ s/\(, /\(/;      
      if ($ai == 1) {
        $head .= "ad([],[]), A$aj, [], S$sj)";
        $ai++; $aj++; $si++; $sj++;
        }
      else {
        $head .= "A$ai, A$aj, S$si, S$sj)";
        $ai++; $aj++; $si++; $sj++;
        }

      # If there are any bindings, let's print them
      if (defined $Binds{"$transition"}) {
        my $x = $Binds{"$transition"};
        foreach my $binding (sort keys %$x) {
          my ($predNumber, $count, $varCount) = split(",", $binding);
          my $h = $VarMap{"$transition"} || die "must first defined trans.";
          $varCount = $$h{"$varCount"};
          my $f = $VarMap{"$predNumber"} || die "must first defined trans. $predNumber $transition";
          push @TestCases, "bind($varCount," . $$f{"$count"} . ")";
          }
        }
      push @TestCases, "$head";
      push @TestCases, "$writeHead";
      push @TestCases, "nl";
      }
    push @TestCases, "!";
    push @TestCases, "update_ad(A$ai)";
    push @TestCases, "!";
    push @TestCases, "update_sd(S$si)";
    print TESTCASESOUT "test$caseCount :- " . join(",\n", @TestCases) . ".\n";
    $caseCount++;
    }

  close TESTCASESOUT;

sub getVars {
  my ($predicate) = @_;
  my $vars = [];
  if ($predicate =~ /\(/) {
    $predicate = $';
    }
  $predicate =~ s/\)//;
  foreach my $var (split(/\s*,\s*/, $predicate)) {
    push @$vars, $var;
    }
  return $vars;
  }

# change the variables in a predicate using a map
sub mapVars {
  my ($predicate, $varMap) = @_;
  my @vars = ();
  my $pre = '';
  my $tail = '';
  if ($predicate =~ /\(/) {
    $pre = $` . '(';
    $predicate = $';
    }
  if ($predicate =~ /\)/) {
    $tail = ")";
    $predicate =~ s/\)//;
    }
  foreach my $var (split(/\s*,\s*/, $predicate)) {
    push @vars, $$varMap{$var} || $var;
    }
  return $pre . join(", ", @vars) . $tail;
  }

# change the variables in a predicate using a map
sub addToMap {
  my ($predicate, $varMap, $suffix) = @_;
  $predicate =~ /.*\(/;
  my @vars = split(/\s*,\s*/, $');
  my $count = 0;
  foreach my $var (@vars) {
    $count++; 
    $$varMap{$var} = $var . $suffix unless defined $$varMap{$var};
    }
  }

# slurp input
sub tokenize {
  my ($t) = @_;
  my $input = '';
  open (FILE, "<$t.ced") or die "could not open file $t.ced";
  while (<FILE>) { $input .= $_ unless /^%/; }
  close FILE;
  $input =~ s/\n\s*\n/\n:PARAGRAPH\n/g;
  my @other = split(/(\w+|\W)/, $input);
  my @tokens = ();
  foreach (@other) { if ($_ ne '') { push @tokens, $_; } }
  return \@tokens;
  }

sub substitute {
  my ($s, $t) = @_;
  $s =~ s/ARG/$t/g;
  return $s;
  }

#------------------------------------------------------------------------
sub ParseCommandLine {
  my @switches = (
    'version',      \$SHOW_VERSION,
    'help',         \$SHOW_HELP,
    'verbose',      \$VERBOSE,
    'graphics',   \$GRAPHICS,
    'nop',        \$NOP,
    );
 
  &GetOptions(@switches) || die "use -help switch to display brief help\n";
 
  if ($SHOW_VERSION) {
    print "This is $SCRIPTNAME, version $VERSION\n\n";
    exit 0;
    }
 
  if ($SHOW_HELP) {
    print <<EofHelp;
    $SCRIPTNAME, version $VERSION - Generate test case code and guards.

    Usage: 

      $SCRIPTNAME  \
         [-help] \
         [-version] \
         [-verbose] \
         [-nop ] \
         < input
 
    Options: 
 
        -help            : display this message
        -verbose         : display verbose information as running
        -version         : display the version of $SCRIPTNAME
        -nop             : turn off <P> 
EofHelp
    exit 0;
    }
 
 if (scalar(@ARGV) != 6) { die "$SCRIPTNAME needs six arguments.\n"; }
 $DATAFLOWIN = $ARGV[0];
 $UPDATESPEC = $ARGV[1];
 $TESTCASES = $ARGV[2];
 $DATAFLOWOUT = $ARGV[3];
 $TESTCASESOUT = $ARGV[4];
 $GUARDSOUT = $ARGV[5];
}


