#!/usr/bin/perl

#
# run_pccts
#
# perl script to drive the PCCTS grammar->{parser,lexer} process.
# Currenly works only in the simple case of a single .g file; also,
# the names of the antlr/dlg spawn are currently hard-coded, but
# that would be easy enough to fix (possibly even by parsing antlr's 
# own options!).
#
# by Greg Ward, late 1996/early 1997
#


# OOPS! dlg doesn't have implicit output; must be redirected

die "usage: run_antlr antlr_opts grammar\n"
   if (@ARGV < 1);

# Global variables
$, = " ";                               # just for convenience when printing
$\ = "\n";
$Verbose = 2;                           # 0 for silence, 2 for very noisy
$TmpDir = "temp";                       # must be in same filesystem as cwd!

# Input arguments
$grammar = pop @ARGV;
@antlr_opts = @ARGV;
@dlg_opts = qw/-C2 -i/;                 # blech!

# PCCTS output files
($parser = $grammar) =~ s/\.g$/.c/;     # generated by antlr
$err = "err.c";                         # by antlr, from the grammar + tokens
$header = "stdpccts.h";                 # by antlr, from the #header
$lexer = "parser.dlg";                  # by antlr, from the token definitions
$tokens = "tokens.h";                   # by antlr, from the token definitions
$scanner = "scan.c";                    # by dlg (from parser.dlg)
$mode = "mode.h";                       # by dlg (from parser.dlg)

@antlr_outputs = ($parser, $err, $header, $lexer, $tokens);
@dlg_outputs = ($scanner, $mode);

unless (-d $TmpDir)
{
   mkdir ($TmpDir, 0755) || die "Couldn't create $TmpDir: $!\n";
}


&check_and_run ("antlr", $grammar, undef, \@antlr_outputs, \@antlr_opts);
&check_and_run ("dlg", $lexer, $scanner, \@dlg_outputs, \@dlg_opts);

&touch_sentinel ("pccts");



rmdir ($TmpDir) || warn "Couldn't rmdir $TmpDir: $!\n";


sub check_and_run
{
   my ($prog, $input, $output, $dependents, $opts) = @_;
   my ($any_missing, $run_prog);

   # First make sure all the output files exist; if any are missing, we will
   # definitely run the program

   $any_missing = &check_files (@$dependents);


   if ($any_missing)
   {
      warn "some output files are missing -- running $prog\n";
      $run_prog = 1;
   }
   else
   {
      # Now check to see if the input is newer than *all* of the files
      # that depend on it -- only run $prog if that's true.  (If it's older
      # than any of them, that means that the grammar hasn't been touched
      # since $prog was last run.)

      my $changed = &check_filetimes
         ($input, $dependents,
          "$input is newer than all of its dependents -- running $prog",
          "$input is older than some of its dependents -- skipping $prog");

      $run_prog = $changed;
   }


   # OK, the input has changed since at least some of its dependents were
   # written -- so save dependents, run $prog, and restore unchanged dependents

   if ($run_prog)
   {
      &run ($prog, $input, $output, $dependents, $opts);
   }
}



sub check_files
{
   my $any_missing = 0;

   foreach (@_)
   {
      ($any_missing = 1, last) unless -e $_
   }
   $any_missing;
}


sub check_filetimes
{
   my ($input, $dependencies, $msg_newer, $msg_older) = @_;
   my $newer = 1;                       # true = newer than *all* dependencies

   foreach $f (@$dependencies)
   {
      # found a dependency that's newer, so $input isn't newer than *all* 

      if ((-M $input) > (-M $f))
      {
         print "$input is older than $f" if $Verbose > 1;
         $newer = 0;
         last;
      }
         
      print "$input is newer than $f" if $Verbose > 1;
   }

   print $newer ? $msg_newer : $msg_older
      if $Verbose;

   $newer;
}

sub run
{
   my ($prog, $input, $output, $dependents, $opts) = @_;

   # Move each of the output files to the temp directory

   foreach $f (@$dependents)
   {
      if (-e $f)
      {
         rename ($f, "$TmpDir/$f") || die "Couldn't move $f to $TmpDir: $!\n";
      }
   }
   
   
   # Run $prog to generate a new version of every output file
   
   @cmd = ($prog, @$opts, $input);
   push (@cmd, $output) if defined $output;
   print @cmd;
   system @cmd;
   die "$prog failed\n" if $?;


   # Now compare the saved copy of each dependent with the version just
   # created.  Those that have not changed are moved back from the temp.
   # directory; those that have changed are just deleted from $TmpDir.
   # Also, we run `expand' on the changed ones to expand tabs to four spaces.

   foreach $f (@$dependents)
   {
      if (-e "$TmpDir/$f")
      {
         system "diff", "-q", $f, "$TmpDir/$f";
         if ($?)                        # there was a change: delete old copy
         {
            print "$f changed" if $Verbose > 1;
            unlink "$TmpDir/$f"
               || warn "Couldn't delete $TmpDir/$f: $!\n";
         }
         else                           # else, restore old copy
         {
            print "$f unchanged" if $Verbose > 1;
            rename ("$TmpDir/$f", $f)
               || die "Couldn't move $TmpDir/$f to $f: $!\n"
         }
      }
   }
}


sub touch_sentinel
{
   my ($prog) = @_;

   my $sentinel = ".${prog}_run";
   open (TMP, ">$sentinel")
      || warn "Unable to create sentinel file \"$sentinel\": $!\n";
   close (TMP);
}
