#!/usr/bin/perl
# SCCS $Id: make-fermat,v 1.36 2003/07/17 10:21:48 dcs0mpw Exp dcs0mpw $
# Build FermaT using chicken
#

BEGIN {
  $FermaT = $ENV{'FermaT'} || "/usr/local/fermat2";
  $FermaT =~ s/"//g; #"
  unshift(@INC, "$FermaT/config");
}

use fermat;
use warnings;

sub read_dir($);

# chicken options:
$opts = "-optimize-level 2 -debug-level 0 -disable-interrupts -fixnum-arithmetic";
$opts .= " -unsafe";


@dirs = ("scheme", "adt", "trans", "wslib");

# Add the Scheme files to @src and get the list of global variables:
@src = ();
@modules = ();
foreach $dir (@dirs) {
  foreach $file (grep(/\.scm$/, read_dir($dir))) {
    next if ($file eq "patch.scm");
    my $base = $file;
    $base =~ s/\.scm$//;
    push(@modules, $base);
    my $out = "$base.c";
    push(@src, "$dir/$out");
    next if newer("$dir/$out", "$dir/$file");
    print "chicken compiling $dir/$file\n";
    open(OUT, "|chicken - -output-file $dir/$out $opts") or die "Can't run chicken: $!\n";
    print OUT "(declare (unit $base))\n";
    foreach  my $init (qw(init macros)) {
      open(IN, "$init.scm") or die "Can't read $init.scm: $!\n";
      print OUT <IN>;
      close(IN);
    }
    open(IN, "$dir/$file") or die "Can't open file `$dir/$file': $!\n";
    print OUT <IN>;
    close(IN);
    close(OUT);
  } # next file
} # next dir

my $flags = `chicken-config -cflags`;
chomp($flags);
$flags .= " -fno-strict-aliasing";

$objs = "";
foreach $src (@src) {
  my $obj = $src;
  $obj =~ s/\.c$/.o/;
  $objs .= " $obj";
  next if newer($obj, $src);
  print "gcc $src... ";
  mysystem qq[gcc -O2 -c "$src" -o "$obj" $flags];
  print "\n";
}

if (!-f "main.c") {
  open(OUT, ">main.scm") or die "Can't write main.scm: $!\n";
  foreach my $module (@modules) {
    print OUT "(declare (uses $module))\n";
  }
  open(IN, "csi.scm") or die "Can't read csi.scm: $!\n";
  print OUT <IN>;
  close(IN);
  close(OUT);

  system qq[chicken main.scm];
  system qq[gcc -c main.c $flags];
}

print "objects = $objs\n";

system qq[gcc -o scmfmt main.o $objs `chicken-config -extra-libs -libs`];

print "scmfmt written\n";


sub read_dir($) {
  my ($dir) = @_;
  my @files = ();
  local(*DIR);
  opendir(DIR, $dir) or die "Can't read directory `$dir': $!\n";
  @files = sort grep { !/^\./ && !/^,/ } readdir(DIR);
  closedir(DIR);
  return(@files);
}

