| #! /usr/bin/perl |
| require 'getopts.pl'; |
| use strict; |
| use Getopt::Long; |
| |
| # options |
| my @optlist = ("h|help!","v|verbose!","copts=s","O!","J=s"); |
| my $result = GetOptions @optlist; |
| our ($opt_h, $opt_v, $opt_copts, $opt_O, $opt_J); |
| |
| # -h option || check the number of arguments |
| if ($opt_h || @ARGV != 2 ) { |
| usage(); |
| exit 1; |
| } |
| |
| # local variables |
| my $echo = "/bin/echo"; |
| my $copts = "[]"; |
| my $prolog_file = $ARGV[0]; |
| my $am_file = $ARGV[1]; |
| |
| my %env; |
| &init(); |
| |
| # -copts option |
| if ($opt_copts) { |
| my @x = split(":", $opt_copts); |
| foreach (@x) { |
| s/^\s+//; |
| s/\s+$//; |
| } |
| foreach my $op (@x) { |
| if ($op !~ /^ed|ac|ie|rc|idx|clo$/) { |
| &error("invalid option found, $op."); |
| } |
| } |
| $copts = "[" . join(",", @x) . "]"; |
| } |
| |
| # -O option |
| if ($opt_O) { |
| # $copts = "[ed,ac,ie,rc,idx,clo]"; |
| $copts = "[ed,ac,ie,rc,idx]"; |
| # $copts = "[ed,ac,ie,rc]"; |
| } |
| |
| # -J option |
| if ($opt_J) { |
| if ($opt_J =~ /(-cp|-classpath)\s+/) { |
| &error("can not use $1 in -J option"); |
| } |
| $env{"system_opts"} .= " $opt_J"; |
| } |
| |
| # main |
| if (! -e $prolog_file) { |
| &error("file $prolog_file does not exist."); |
| } |
| |
| my $arg; |
| if ($env{"goal"}) { |
| $arg .= $env{"goal"} . " "; |
| } |
| $arg .= "[\'$prolog_file\', \'$am_file\', $copts]."; |
| my $cmd = "$echo \"$arg\" | " . $env{"system"}; |
| if ($env{"system_opts"}) { |
| $cmd .= " " . $env{"system_opts"}; |
| } |
| if ($env{"system_args"}) { |
| $cmd .= " " . $env{"system_args"}; |
| } |
| if (! $opt_v) {# check -v option |
| $cmd .= " 2> /dev/null"; |
| } |
| |
| &message("{START translating $prolog_file --> $am_file}"); |
| &message($cmd); |
| system($cmd) && error("translation fails"); |
| &message("{END translating $prolog_file --> $am_file}\n"); |
| |
| exit 0; |
| |
| # sub |
| sub usage { |
| print "\nUsage: $0 [-options] prolog_file am_file\n"; |
| print "\n where options include:\n"; |
| print "\t-h -help : print this help message\n"; |
| print "\t-v -verbose : enable verbose output\n"; |
| print "\t-copts[:ed|ac|rc|ie|idx|clo]\n"; |
| print "\t : enable each optimised compilation\n"; |
| print "\t : ed = eliminate disjunctions\n"; |
| print "\t : ac = arithmetic compilation\n"; |
| print "\t : rc = optimise recursive call\n"; |
| print "\t : ie = inline expansion\n"; |
| print "\t : idx = switch_on_hash (2nd. level indexing) \n"; |
| print "\t : clo = generate closure for meta predicates\n"; |
| print "\t-O : enable all optimised compilation\n"; |
| print "\t-J option : option must be enclosed by '.\n"; |
| print "\t : pass option to the Java Virtual Machine\n"; |
| print "\t : (ex. -J '-Xmx100m -verbose:gc')\n"; |
| print "\n"; |
| } |
| |
| sub message { |
| my ($x) = @_; |
| if ($opt_v) { # check -v option |
| print "\% $x\n"; |
| } |
| } |
| |
| sub error { |
| my ($x) = @_; |
| print "\% ERROR: $x: $0\n"; |
| exit 1; |
| } |
| |
| #sub init { |
| # %env = ( |
| # "goal", "", |
| # "system", "/Users/banbara/prog/plcafe/PrologCafe095/src/compiler/pl2am.sav", |
| # "system_opts", "", |
| # "system_args", "", |
| # ); |
| # %env = ( |
| # "goal", "load('/Users/banbara/prog/plcafe/PrologCafe095/src/compiler/pl2am.ql'), main.", |
| # "system", "sicstus", |
| # "system_opts", "", |
| # "system_args", "", |
| # ); |
| # %env = ( |
| # "goal", "", |
| # "system", "java", |
| # "system_opts", "-cp \$PLCAFEDIR/plcafe.jar:\$CLASSPATH", |
| # "system_args", "com.googlecode.prolog_cafe.lang.PrologMain com.googlecode.prolog_cafe.compiler.pl2am:main", |
| # ); |
| #} |
| |