// $Id$

$use Access Apply Arithm Box Compare Convert Dir File JavaMangle List StdIO System Table;

$use "rfp_lex";

$table RFPJ-Opts;

$box RFPATH LIBRFI;

$func Parse-Arguments = e.module-name-and-arguments;

$func Print-Help e = ;

$func Print-Usage e = ;

$func Build (e.make) (e.keep) (e.force) e.module-name = ;

$func Compute-Deps (e.make) e.module-name = ;

$func Run-rfpc  e.files = ;
$func Run-javac e.files = ;

$func? Search e.files = s.path-group (e.dir) e.file;

$func Parse-Path e.path = e.dir-list;

$func Subst (e.patterns) (e.replaces) term = term;

$box Verb-Level;
$func Verbose s.N e.msg = ;

$func Default-Handler s.N s.param e = s.N;
Default-Handler s.N s.param e = <Bind &RFPJ-Opts (s.param) (s.param)>, <"+" s.N 1>;

$func Path-Handler s.N s.param (e.opt) = s.N;
Path-Handler s.N s.param (e.opt) =
  <Arg <"+" s.N 1>> : {
    /*empty*/ =
      $error ("Option -"e.opt" requires an argument:")
          ("'" <? &Path-Separator> "'-separated list of directories");
    e.dirs =
      { <Lookup &RFPJ-Opts s.param>;; } :: e.path,
      <Bind &RFPJ-Opts (s.param) (e.path <Parse-Path e.dirs>)>,
      <"+" s.N 2>;
  };

$func File-Handler s.N s.param (e.opt) = s.N;
File-Handler s.N s.param (e.opt) =
  <Arg <"+" s.N 1>> : {
    /*empty*/ =
      $error ("Option -"e.opt" requires a pathname argument");
    e.file =
      <Bind &RFPJ-Opts (s.param) (e.file)>,
      <"+" s.N 2>;
  };

$func Flags-Handler s.N s.param (e.opt) = s.N;
Flags-Handler s.N s.param (e.opt) =
  <Arg <"+" s.N 1>> : {
    /*empty*/ =
      $error ("Option -"e.opt" requires an argument");
    e.file =
      <Bind &RFPJ-Opts (s.param) (e.file)>,
      <"+" s.N 2>;
  };

$func Verb-Handler s.N e = s.N;
Verb-Handler s.N e =
  <? &Verb-Level> : s.L,
  <Store &Verb-Level <"+" s.L 1>>,
  <"+" s.N 1>;

$func Version-Handler s.N e = s.N;
Version-Handler s.N e =
  <PrintLN "$Revision$">,
  <PrintLN "FIXME: print rfpc and R+-runtime versions.">,
  <PrintLN>,
  <"+" s.N 1>;

$func EndOpt-Handler s.N e = s.N e.module-name-and-arguments;
EndOpt-Handler s.N e =
  <Length <Args>> <Middle <"+" s.N 1> 0 <Args>>;

$const Options =
  ((('c')) (&Default-Handler COMPILE) ()
    "compile to class-file(s), but don't run the program")
  ((('m') ('-make')) (&Default-Handler MAKE) ()
    "build a program by following module dependencies"
    "(recompile all needed modules)")
  ((('k') ('-keep')) (&Default-Handler KEEP) ()
    "keep intermediate java files")
  ((('f') ('-force')) (&Default-Handler FORCE) ()
    "force compilation even if class-files are up to date")
  ((('i')) (&Path-Handler RFPATH) ('<dirs>')
    "set the refal modules search path")
  ((('v') ('-verbose')) (&Verb-Handler) ()
    "be verbose, more -v = more verbosity")
  ((('-rfpdir')) (&File-Handler RFPDIR) ('<dir>')
    "Refal+ installation directory"
    "(overrides RFPDIR environment variable)")
  ((('-rfpc')) (&File-Handler RFPC) ('<file>')
    "Refal+ compiler")
  ((('-rfpc-flags')) (&Flags-Handler RFPC-FLAGS) ('<flags>')
    "Refal+ compiler options")
  ((('-librfi')) (&Path-Handler LIBRFI) ('<dirs>')
    "set path to the Refal+ library rfi-files")
  ((('-javac')) (&File-Handler JAVAC) ('<file>')
    "Java compiler")
  ((('-java')) (&File-Handler JAVA) ('<file>')
    "JVM executable")
  ((('-')) (&EndOpt-Handler) ()
    "end of rfpj options, refal module name should follow")
  ((('-version')) (&Version-Handler) ()
    "print version info")
  ((('h') ('-help')) (&Print-Help) ());

Parse-Arguments =
  1 $iter <Arg s.N> : {
    '-' e.opt = {
      &Options : e ((e (e.opt) e) (s.func e.args) e.descr) e =
        <Apply s.func s.N e.args (e.opt)> : s.Next e.maybe-mod,
        s.Next e.maybe-mod;
      $error ("Unknown option: -"e.opt);
    };
    v.module-name =
      0 <Middle s.N 0 <Args>>;
    empty =
      <Print-Usage>, $fail;
  } :: s.N e.module,
  e.module : v =
  e.module;

Print-Help e =
  <PrintLN "Refal+ through Java launcher">,
  <PrintLN>,
  <PrintLN "Usage: rfpj [options] ModuleName [program-arguments]">,
  <PrintLN "Possible options:">,
  <Concat <Map! &L 0 (&Options)>> :: e.opt-list,
  <Map! &Concat (<Map! &Intersperse ((', -')) (e.opt-list)>)> :: e.opt-list,
  <Map! &Concat (<Map! &L 2 (&Options)>)> :: e.param-list,
  <Zip (<Map! &Id ' -' (e.opt-list)>) (<Map! &Id ' ' (e.param-list)>)> :: e.1st-col,
  <Map! &Concat (e.1st-col)> :: e.1st-col,
  <Foldr1 &Max (<Concat <Map! &Length (e.1st-col)>>)> : s.1st-col-end,
  <"+" s.1st-col-end 2> :: s.2nd-col-start,
  <Replicate s.2nd-col-start ' '> :: e.1st-fill,
  {
    &Options : e1 ((e.opts) (e.handler) (e.params) t.descr1 e.descr2) e2,
      <L <Length e1> e.1st-col> : (e.1st),
      <PrintLN e.1st <Replicate <"-" s.2nd-col-start <Length e.1st>> ' '> t.descr1>,
      {
        e.descr2 : e t.d e,
          <PrintLN e.1st-fill t.d>, $fail;;
      },
      $fail;
    <Exit 1>;
  };

Print-Usage e =
  <PrintLN "Refal+ through Java launcher">,
  <PrintLN>,
  <PrintLN "Usage: rfpj [options] ModuleName [program-arguments]">,
  <PrintLN "Try 'rfpj -h' for information on accepted options.">,
  <Exit 1>;

Main =
  <Store &Verb-Level 0>,
  <Bind &RFPJ-Opts (JAVA) ("java")>,
  <Bind &RFPJ-Opts (JAVAC) ("javac")>,
  <Bind &RFPJ-Opts (JAVA-FLAGS) ()>,
  <Bind &RFPJ-Opts (RFPDIR) (<GetEnv RFPDIR>)>,
  $trap {
    <Parse-Arguments> : (e.module-name) e.module-args,
      <Lookup &RFPJ-Opts RFPDIR> :: e.rfpdir,
      {
        e.rfpdir : v;
        $error ("Please set RFPDIR environment variable to Refal+ installation directory")
            ("or use --rfpdir option");
      },
      <? &Dir-Separator> : s.dir-sep,
      {
        <Lookup &RFPJ-Opts LIBRFI>;
        e.rfpdir s.dir-sep "lib";
      } :: e.librfi,
      <Store &LIBRFI (e.librfi)>,
      {
        <Bind &RFPJ-Opts (RFPC-FLAGS) ("-B "e.librfi" "<Lookup &RFPJ-Opts RFPC-FLAGS>)>;
        <Bind &RFPJ-Opts (RFPC-FLAGS) ("-B "e.librfi" -j")>;
      },
      {
        <In-Table? &RFPJ-Opts JAVA-CP>;
        <Bind &RFPJ-Opts (JAVA-CP) (
          { <GetEnv CLASSPATH> : v1 = v1 <? &Path-Separator>;; }
          e.rfpdir s.dir-sep "java" <? &Path-Separator>
          e.rfpdir s.dir-sep "rfp.jar")>;
      },
      {
        <Store &RFPATH <Lookup &RFPJ-Opts RFPATH>>;
        <Store &RFPATH ('.') <Parse-Path <GetEnv RFPATH>>>;
      },
      <Map &Subst ('.') (s.dir-sep) (e.module-name)> : {
        $r e.path s.dir-sep e.name = (e.path s.dir-sep) e.name;
        e.name = () e.name;
      } :: (e.path) e.name,
      <Rfp2Java <To-Word e.name>> :: e.java-name,
      { <Lookup &RFPJ-Opts MAKE>;; } :: e.make,
      { <Lookup &RFPJ-Opts KEEP>;; } :: e.keep,
      { <Lookup &RFPJ-Opts FORCE>;; } :: e.force,
      { <Lookup &RFPJ-Opts COMPILE>;; } :: e.comp,
      {
        e.make : /*empty*/, e.force : /*empty*/, e.comp : /*empty*/,
          <Search (e.path e.java-name".class")> : e;
        <Build (e.make) (e.keep) (e.force) e.path e.name>;
      },
      <Concat <Intersperse (<? &Path-Separator>) <? &RFPATH>>> :: e.rfpath,
      <Lookup &RFPJ-Opts JAVA>
        " -classpath "e.rfpath<? &Path-Separator><Lookup &RFPJ-Opts JAVA-CP>
        " "<Lookup &RFPJ-Opts JAVA-FLAGS>
        " "<Map &Subst (s.dir-sep) ('.') (e.path)> e.java-name
        " "<Concat <Intersperse (" ") e.module-args>> :: e.java-cmd,
      {
        e.comp : v;
        <Verbose 1 " + "e.java-cmd>,
          <Exit <System e.java-cmd>>;
      };
  }
  $with {
    v.err, {
      v.err : e1 t2 e3 \? {
        t2 : (e) \! $fail;
        = $fail;
      };;
    }, 
      v.err : (err1) err2,
      <PrintLN "rfpj: " err1>,
      {
        err2 : e1 (e2) e3, <PrintLN "      "e2>, $fail;
        <Exit 2>;
      };
    err = $error err;
  };

$table Deps;

$func Get-Src e = e;
$func Get-Needed-Src e = e;
$func Get-Needed-Java e = e;

Build (e.make) (e.keep) (e.force) e.module-name =
  <Clear-Table &Deps>,
  <Compute-Deps (e.make) e.module-name>,
  <Entries &Deps> :: e.deps,
  <Verbose 3 "rfpj dependencies: "e.deps>,
  {
    e.keep : v, e.force : /*empty*/ =
      <Run-rfpc <Concat <Map! &L 0 (<Map &Get-Needed-Src ".java" (e.deps)>)>>>,
      <Run-javac <Map &Get-Needed-Java (e.deps)>>;
    {
      e.force : v = <Map &Get-Src (e.deps)>;
      <Map &Get-Needed-Src ".class" (e.deps)>;
    } :: e.src-list,
      <Concat <Map! &L 0 (e.src-list)>> :: e.rf-list,
      <Concat <Map! &L 1 (e.src-list)>> :: e.java-list,
      <Run-rfpc e.rf-list> <Run-javac e.java-list>,
      {
        e.keep : v;
        <Map! &Delete (e.java-list)> : e;
        <PrintLN! &StdErr "rfpj: Error while deleting files:">,      // Paranoia
          <Map! &PrintLN! &StdErr "      " (e.java-list)> : e;
      };
  };

Compute-Deps (e.make) e.module-name =
  {
    <In-Table? &Deps e.module-name>;
    <Search (e.module-name".rf") (e.module-name".rfi")> :: s.path-grp (e.path) e.file =
      <? &Dir-Separator> : s.dir-sep,
      e.path s.dir-sep e.module-name :: e.mod,
      <Verbose 3 " +++ "e.mod>,
      {
        e.file : e.f ".rf", s.path-grp : RFPATH =
          {
            e.f : $r e.p s.dir-sep e.n = (e.path s.dir-sep e.p s.dir-sep) e.n;
            (e.path s.dir-sep) e.f;
          } :: (e.path) e.f,
          e.path <Rfp2Java <To-Word e.f>> :: e.java-mod,
          {
            e.make : v = <Find-Includes e.mod".rf">;
            /*empty*/;
          } :: e.includes,
          <Bind &Deps (e.module-name) (<Last-Modified e.mod".rfi"> (e.mod) (e.java-mod) e.includes)>,
          <Map! &Compute-Deps (e.make) (e.includes)> : e;
        <Bind &Deps (e.module-name) (<Last-Modified e.mod".rfi">)>;
      };
    $error ("Can't find refal module "e.module-name)
        ("Searched in:")
        <Map! &Id " - " (<? &RFPATH> <? &LIBRFI>)>;
  };

Get-Src {
  ((e.module-name) (s.rfi-time (e.mod) (e.java-mod) e.includes)) = ((e.mod ".rf") (e.java-mod ".java"));
  e = /*empty*/;
};

Get-Needed-Src {
  s.ext ((e.module-name) (s.rfi-time (e.mod) (e.java-mod) e.includes)),
    <Last-Modified e.java-mod s.ext> :: s.java-time,
    \{
      <">" (s.rfi-time) (s.java-time)>;
      <">" (<Last-Modified e.mod ".rf">) (s.java-time)>;
      e.includes : e (e.inc-mod) e,
        <Lookup &Deps e.inc-mod> : s.inc-time e,
        <">" (s.inc-time) (s.java-time)>;
    } =
    ((e.mod ".rf") (e.java-mod ".java"));
  s.ext e = /*empty*/;
};

Get-Needed-Java {
  ((e.module-name) (s.rfi-time (e.mod) (e.java-mod) e.includes)),
    <">" (<Last-Modified e.java-mod ".java">) (<Last-Modified e.java-mod ".class">)> =
    (e.java-mod ".java");
  e = /*empty*/;
};

Run-rfpc {
  v.files =
    <Concat <Intersperse (" ") v.files>> :: e.files,
    {
      <Lookup &RFPJ-Opts RFPC>;
      <Lookup &RFPJ-Opts RFPDIR><? &Dir-Separator>"compiler"<? &Dir-Separator>"rfpc" :: e.rfpc,
        \{
          <Can-Exec? e.rfpc> = e.rfpc;
          e.rfpc ".exe" :: e.rfcp,
            <Can-Exec? e.rfpc> = e.rfpc;
        };
      <Lookup &RFPJ-Opts JAVA>" -classpath "<Lookup &RFPJ-Opts JAVA-CP>
        " "<Lookup &RFPJ-Opts JAVA-FLAGS>" org.refal.plus.compiler.rfpc";
    } :: e.rfpc,
    e.rfpc" "<Lookup &RFPJ-Opts RFPC-FLAGS>
         <Concat <Map! &Id " -I " (<? &RFPATH>)>>" "e.files :: e.rfpc-cmd,
    <PrintLN " + "e.rfpc-cmd>,
    $trap {
      <System e.rfpc-cmd> : {
        0;
        s.N =
          <PrintLN! &StdErr "rfpj: Refal+ compiler exited with code "s.N>,
          <Exit s.N>;
      };
    }
    $with {
      "System" err =
        <WriteLN err>,
        $error ("Can't run Refal+ compiler because something goes utterly wrong.")
            ("Does RFPDIR correctly point to Refal+ installation directory?")
            ("  RFPDIR="<Lookup &RFPJ-Opts RFPDIR>)
            ("Command to run Refal+ compiler was:")
            ("  "e.rfpc-cmd)
            ("If it is wrong, try setting --rfpc, --rfpc-flags,")
            ("  --java, and --java-flags options.");
      err = $error err;
    };
  /*empty*/ = /*empty*/;
};

Run-javac {
  v.files =
    <Concat <Intersperse (" ") v.files>> :: e.files,
    <Concat <Map! &Append (<? &Path-Separator>) (<? &RFPATH>)>> :: e.rfpath,
    <Lookup &RFPJ-Opts JAVAC>" -classpath "e.rfpath<Lookup &RFPJ-Opts JAVA-CP>
      " "<Lookup &RFPJ-Opts JAVA-FLAGS>" "e.files
    :: e.javac-cmd,
    <PrintLN " + "e.javac-cmd>,
    $trap {
      <System e.javac-cmd> : {
        0;
        s.N =
          <PrintLN! &StdErr "rfpj: Java compiler exited with code "s.N>,
          <Exit s.N>;
      };
    }
    $with {
      "System" err =
        <WriteLN err>,
        $error ("Can't run Java compiler because something goes utterly wrong.")
            ("Command to run Java compiler was:")
            ("  "e.javac-cmd)
            ("Try setting --javac option to Java compiler executable.");
      err = $error err;
    };
  /*empty*/ = /*empty*/;
};

$func? Search-In-Path (e.path) e.files = (e.dir) e.file;

Search e.files =
  \{
    RFPATH <Search-In-Path (<? &RFPATH>) e.files>;
    LIBRFI <Search-In-Path (<? &LIBRFI>) e.files>;
  };

Search-In-Path (e.path) e.files =
  e.path : e (e.dir) e,
  e.files : e (e.f) e,
  <Exists? e.dir <? &Dir-Separator> e.f> =
  (e.dir) e.f;

Parse-Path e.path =
  <? &Path-Separator> : s.sep,
  e.path : {
    e1 s.sep e2 = {
      e1 : v = (e1) <Parse-Path e2>;
      <Parse-Path e2>;
    };
    v1 = (v1);
    /*empty*/ = /*empty*/;
  };

Subst (e.patterns) (e.replaces) term = {
  e.patterns : e1 term e2 = <L <Length e1> e.replaces>;
  term;
};

Verbose s.N e.msg = {
  <? &Verb-Level> : s.L, <">=" (s.L) (s.N)> =
    <PrintLN e.msg>;;
};