#!/usr/bin/perl
# SCCS $Id: wsl,v 1.20 2004/09/15 13:02:07 dcs0mpw Exp $
#############################################################################
## FermaT Transformation System
## Copyright (C) 2001 Software Migrations Limited.
## Email: Martin.Ward@durham.ac.uk
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#############################################################################
#
##########
##########   wsl file[.wsl]
##########
##########   Loads and executes a WSL program.
#

BEGIN {
  $FermaT = $ENV{'FermaT'} || "/usr/local/fermat2";
  $FermaT =~ s/\"//g;
  $ds = "/"; $ds = "\\" if ($^O eq "MSWin32");
  unshift(@INC, "$FermaT${ds}config");
}

use fermat;

$proc_num = ($$ % 32768);
$tmpfile1 = "${tmpdir}t1$proc_num.scm";
$tmpfile2 = "${tmpdir}t1$proc_num-mac.scm";

push(@goners, $tmpfile1, $tmpfile2);

($myname = $0) =~ s|(.*/)*||;   # strip path component from name
$Usage = "Usage: $myname file.wsl\n";

# Check for one argument:
die $Usage if ($#ARGV < 0);
$ARGV[0] .= ".wsl" if (!-f $ARGV[0] && -f "$ARGV[0].wsl");
&parse_args();

($base = $input) =~ s/\.wsl$//;
$base =~ s/\s+/_/g;

# TODO: Don't use gambit to do the WSL to Scheme translation?

$cmds = <<END_OF_INPUT;
  (if (file-exists? "patch.scm")
      (load "patch.scm")
      (if (file-exists? "patch.tr")
	  (load "patch.tr")))
  (\@WSL_To_Scheme (\@Parse_File "$input" //T_/Statements) "$tmpfile1" "$base")
  (display-list "Starting Execution... ")
  (define tr-runtime (get-internal-run-time))
  (newline)

  (load "$tmpfile1")

  (newline)
  (display-list "Execution time: " (- (get-internal-run-time) tr-runtime))
END_OF_INPUT

&fermat($cmds);

exit(0);
