source: to-imperative/trunk/rfp/rfpj.rf

Last change on this file was 2301, checked in by orlov, 14 years ago
  • Corrections for work in Windows.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.1 KB
Line 
1// $Id: rfpj.rf 2301 2007-01-31 19:00:54Z yura $
2
3$use Access Apply Arithm Box Compare Convert Dir File JavaMangle List StdIO System Table;
4
5$use "rfp_lex";
6
7$table RFPJ-Opts;
8
9$box RFPATH LIBRFI;
10
11$func Parse-Arguments = e.module-name-and-arguments;
12
13$func Print-Help e = ;
14
15$func Print-Usage e = ;
16
17$func Build (e.make) (e.keep) (e.force) e.module-name = ;
18
19$func Compute-Deps (e.make) e.module-name = ;
20
21$func Run-rfpc  e.files = ;
22$func Run-javac e.files = ;
23
24$func? Search e.files = s.path-group (e.dir) e.file;
25
26$func Parse-Path e.path = e.dir-list;
27
28$func Subst (e.patterns) (e.replaces) term = term;
29
30$box Verb-Level;
31$func Verbose s.N e.msg = ;
32
33$func Default-Handler s.N s.param e = s.N;
34Default-Handler s.N s.param e = <Bind &RFPJ-Opts (s.param) (s.param)>, <"+" s.N 1>;
35
36$func Path-Handler s.N s.param (e.opt) = s.N;
37Path-Handler s.N s.param (e.opt) =
38  <Arg <"+" s.N 1>> : {
39    /*empty*/ =
40      $error ("Option -"e.opt" requires an argument:")
41          ("'" <? &Path-Separator> "'-separated list of directories");
42    e.dirs =
43      { <Lookup &RFPJ-Opts s.param>;; } :: e.path,
44      <Bind &RFPJ-Opts (s.param) (e.path <Parse-Path e.dirs>)>,
45      <"+" s.N 2>;
46  };
47
48$func File-Handler s.N s.param (e.opt) = s.N;
49File-Handler s.N s.param (e.opt) =
50  <Arg <"+" s.N 1>> : {
51    /*empty*/ =
52      $error ("Option -"e.opt" requires a pathname argument");
53    e.file =
54      <Bind &RFPJ-Opts (s.param) (e.file)>,
55      <"+" s.N 2>;
56  };
57
58$func Flags-Handler s.N s.param (e.opt) = s.N;
59Flags-Handler s.N s.param (e.opt) =
60  <Arg <"+" s.N 1>> : {
61    /*empty*/ =
62      $error ("Option -"e.opt" requires an argument");
63    e.file =
64      <Bind &RFPJ-Opts (s.param) (e.file)>,
65      <"+" s.N 2>;
66  };
67
68$func Verb-Handler s.N e = s.N;
69Verb-Handler s.N e =
70  <? &Verb-Level> : s.L,
71  <Store &Verb-Level <"+" s.L 1>>,
72  <"+" s.N 1>;
73
74$func Version-Handler s.N e = s.N;
75Version-Handler s.N e =
76  <PrintLN "$Revision: 2301 $">,
77  <PrintLN "FIXME: print rfpc and R+-runtime versions.">,
78  <PrintLN>,
79  <"+" s.N 1>;
80
81$func EndOpt-Handler s.N e = s.N e.module-name-and-arguments;
82EndOpt-Handler s.N e =
83  <Length <Args>> <Middle <"+" s.N 1> 0 <Args>>;
84
85$const Options =
86  ((('c')) (&Default-Handler COMPILE) ()
87    "compile to class-file(s), but don't run the program")
88  ((('m') ('-make')) (&Default-Handler MAKE) ()
89    "build a program by following module dependencies"
90    "(recompile all needed modules)")
91  ((('k') ('-keep')) (&Default-Handler KEEP) ()
92    "keep intermediate java files")
93  ((('f') ('-force')) (&Default-Handler FORCE) ()
94    "force compilation even if class-files are up to date")
95  ((('i')) (&Path-Handler RFPATH) ('<dirs>')
96    "set the refal modules search path")
97  ((('v') ('-verbose')) (&Verb-Handler) ()
98    "be verbose, more -v = more verbosity")
99  ((('-rfpdir')) (&File-Handler RFPDIR) ('<dir>')
100    "Refal+ installation directory"
101    "(overrides RFPDIR environment variable)")
102  ((('-rfpc')) (&File-Handler RFPC) ('<file>')
103    "Refal+ compiler")
104  ((('-rfpc-flags')) (&Flags-Handler RFPC-FLAGS) ('<flags>')
105    "Refal+ compiler options")
106  ((('-librfi')) (&Path-Handler LIBRFI) ('<dirs>')
107    "set path to the Refal+ library rfi-files")
108  ((('-javac')) (&File-Handler JAVAC) ('<file>')
109    "Java compiler")
110  ((('-java')) (&File-Handler JAVA) ('<file>')
111    "JVM executable")
112  ((('-')) (&EndOpt-Handler) ()
113    "end of rfpj options, refal module name should follow")
114  ((('-version')) (&Version-Handler) ()
115    "print version info")
116  ((('h') ('-help')) (&Print-Help) ());
117
118Parse-Arguments =
119  1 $iter <Arg s.N> : {
120    '-' e.opt = {
121      &Options : e ((e (e.opt) e) (s.func e.args) e.descr) e =
122        <Apply s.func s.N e.args (e.opt)> : s.Next e.maybe-mod,
123        s.Next e.maybe-mod;
124      $error ("Unknown option: -"e.opt);
125    };
126    v.module-name =
127      0 <Middle s.N 0 <Args>>;
128    empty =
129      <Print-Usage>, $fail;
130  } :: s.N e.module,
131  e.module : v =
132  e.module;
133
134Print-Help e =
135  <PrintLN "Refal+ through Java launcher">,
136  <PrintLN>,
137  <PrintLN "Usage: rfpj [options] ModuleName [program-arguments]">,
138  <PrintLN "Possible options:">,
139  <Concat <Map! &L 0 (&Options)>> :: e.opt-list,
140  <Map! &Concat (<Map! &Intersperse ((', -')) (e.opt-list)>)> :: e.opt-list,
141  <Map! &Concat (<Map! &L 2 (&Options)>)> :: e.param-list,
142  <Zip (<Map! &Id ' -' (e.opt-list)>) (<Map! &Id ' ' (e.param-list)>)> :: e.1st-col,
143  <Map! &Concat (e.1st-col)> :: e.1st-col,
144  <Foldr1 &Max (<Concat <Map! &Length (e.1st-col)>>)> : s.1st-col-end,
145  <"+" s.1st-col-end 2> :: s.2nd-col-start,
146  <Replicate s.2nd-col-start ' '> :: e.1st-fill,
147  {
148    &Options : e1 ((e.opts) (e.handler) (e.params) t.descr1 e.descr2) e2,
149      <L <Length e1> e.1st-col> : (e.1st),
150      <PrintLN e.1st <Replicate <"-" s.2nd-col-start <Length e.1st>> ' '> t.descr1>,
151      {
152        e.descr2 : e t.d e,
153          <PrintLN e.1st-fill t.d>, $fail;;
154      },
155      $fail;
156    <Exit 1>;
157  };
158
159Print-Usage e =
160  <PrintLN "Refal+ through Java launcher">,
161  <PrintLN>,
162  <PrintLN "Usage: rfpj [options] ModuleName [program-arguments]">,
163  <PrintLN "Try 'rfpj -h' for information on accepted options.">,
164  <Exit 1>;
165
166Main =
167  <Store &Verb-Level 0>,
168  <Bind &RFPJ-Opts (JAVA) ("java")>,
169  <Bind &RFPJ-Opts (JAVAC) ("javac")>,
170  <Bind &RFPJ-Opts (JAVA-FLAGS) ()>,
171  <Bind &RFPJ-Opts (RFPDIR) (<GetEnv RFPDIR>)>,
172  $trap {
173    <Parse-Arguments> : (e.module-name) e.module-args,
174      <Lookup &RFPJ-Opts RFPDIR> :: e.rfpdir,
175      {
176        e.rfpdir : v;
177        $error ("Please set RFPDIR environment variable to Refal+ installation directory")
178            ("or use --rfpdir option");
179      },
180      <? &Dir-Separator> : s.dir-sep,
181      {
182        <Lookup &RFPJ-Opts LIBRFI>;
183        e.rfpdir s.dir-sep "lib";
184      } :: e.librfi,
185      <Store &LIBRFI (e.librfi)>,
186      {
187        <Bind &RFPJ-Opts (RFPC-FLAGS) ("-B "e.librfi" "<Lookup &RFPJ-Opts RFPC-FLAGS>)>;
188        <Bind &RFPJ-Opts (RFPC-FLAGS) ("-B "e.librfi" -j")>;
189      },
190      {
191        <In-Table? &RFPJ-Opts JAVA-CP>;
192        <Bind &RFPJ-Opts (JAVA-CP) (
193          { <GetEnv CLASSPATH> : v1 = v1 <? &Path-Separator>;; }
194          e.rfpdir s.dir-sep "java" <? &Path-Separator>
195          e.rfpdir s.dir-sep "rfp.jar")>;
196      },
197      {
198        <Store &RFPATH <Lookup &RFPJ-Opts RFPATH>>;
199        <Store &RFPATH ('.') <Parse-Path <GetEnv RFPATH>>>;
200      },
201      <Map &Subst ('.') (s.dir-sep) (e.module-name)> : {
202        $r e.path s.dir-sep e.name = (e.path s.dir-sep) e.name;
203        e.name = () e.name;
204      } :: (e.path) e.name,
205      <Rfp2Java <To-Word e.name>> :: e.java-name,
206      { <Lookup &RFPJ-Opts MAKE>;; } :: e.make,
207      { <Lookup &RFPJ-Opts KEEP>;; } :: e.keep,
208      { <Lookup &RFPJ-Opts FORCE>;; } :: e.force,
209      { <Lookup &RFPJ-Opts COMPILE>;; } :: e.comp,
210      {
211        e.make : /*empty*/, e.force : /*empty*/, e.comp : /*empty*/,
212          <Search (e.path e.java-name".class")> : e;
213        <Build (e.make) (e.keep) (e.force) e.path e.name>;
214      },
215      <Concat <Intersperse (<? &Path-Separator>) <? &RFPATH>>> :: e.rfpath,
216      <Lookup &RFPJ-Opts JAVA>
217        " -classpath "e.rfpath<? &Path-Separator><Lookup &RFPJ-Opts JAVA-CP>
218        " "<Lookup &RFPJ-Opts JAVA-FLAGS>
219        " "<Map &Subst (s.dir-sep) ('.') (e.path)> e.java-name
220        " "<Concat <Intersperse (" ") e.module-args>> :: e.java-cmd,
221      {
222        e.comp : v;
223        <Verbose 1 " + "e.java-cmd>,
224          <Exit <System e.java-cmd>>;
225      };
226  }
227  $with {
228    v.err, {
229      v.err : e1 t2 e3 \? {
230        t2 : (e) \! $fail;
231        = $fail;
232      };;
233    },
234      v.err : (err1) err2,
235      <PrintLN "rfpj: " err1>,
236      {
237        err2 : e1 (e2) e3, <PrintLN "      "e2>, $fail;
238        <Exit 2>;
239      };
240    err = $error err;
241  };
242
243$table Deps;
244
245$func Get-Src e = e;
246$func Get-Needed-Src e = e;
247$func Get-Needed-Java e = e;
248
249Build (e.make) (e.keep) (e.force) e.module-name =
250  <Clear-Table &Deps>,
251  <Compute-Deps (e.make) e.module-name>,
252  <Entries &Deps> :: e.deps,
253  <Verbose 3 "rfpj dependencies: "e.deps>,
254  {
255    e.keep : v, e.force : /*empty*/ =
256      <Run-rfpc <Concat <Map! &L 0 (<Map &Get-Needed-Src ".java" (e.deps)>)>>>,
257      <Run-javac <Map &Get-Needed-Java (e.deps)>>;
258    {
259      e.force : v = <Map &Get-Src (e.deps)>;
260      <Map &Get-Needed-Src ".class" (e.deps)>;
261    } :: e.src-list,
262      <Concat <Map! &L 0 (e.src-list)>> :: e.rf-list,
263      <Concat <Map! &L 1 (e.src-list)>> :: e.java-list,
264      <Run-rfpc e.rf-list> <Run-javac e.java-list>,
265      {
266        e.keep : v;
267        <Map! &Delete (e.java-list)> : e;
268        <PrintLN! &StdErr "rfpj: Error while deleting files:">,      // Paranoia
269          <Map! &PrintLN! &StdErr "      " (e.java-list)> : e;
270      };
271  };
272
273Compute-Deps (e.make) e.module-name =
274  {
275    <In-Table? &Deps e.module-name>;
276    <Search (e.module-name".rf") (e.module-name".rfi")> :: s.path-grp (e.path) e.file =
277      <? &Dir-Separator> : s.dir-sep,
278      e.path s.dir-sep e.module-name :: e.mod,
279      <Verbose 3 " +++ "e.mod>,
280      {
281        e.file : e.f ".rf", s.path-grp : RFPATH =
282          {
283            e.f : $r e.p s.dir-sep e.n = (e.path s.dir-sep e.p s.dir-sep) e.n;
284            (e.path s.dir-sep) e.f;
285          } :: (e.path) e.f,
286          e.path <Rfp2Java <To-Word e.f>> :: e.java-mod,
287          {
288            e.make : v = <Find-Includes e.mod".rf">;
289            /*empty*/;
290          } :: e.includes,
291          <Bind &Deps (e.module-name) (<Last-Modified e.mod".rfi"> (e.mod) (e.java-mod) e.includes)>,
292          <Map! &Compute-Deps (e.make) (e.includes)> : e;
293        <Bind &Deps (e.module-name) (<Last-Modified e.mod".rfi">)>;
294      };
295    $error ("Can't find refal module "e.module-name)
296        ("Searched in:")
297        <Map! &Id " - " (<? &RFPATH> <? &LIBRFI>)>;
298  };
299
300Get-Src {
301  ((e.module-name) (s.rfi-time (e.mod) (e.java-mod) e.includes)) = ((e.mod ".rf") (e.java-mod ".java"));
302  e = /*empty*/;
303};
304
305Get-Needed-Src {
306  s.ext ((e.module-name) (s.rfi-time (e.mod) (e.java-mod) e.includes)),
307    <Last-Modified e.java-mod s.ext> :: s.java-time,
308    \{
309      <">" (s.rfi-time) (s.java-time)>;
310      <">" (<Last-Modified e.mod ".rf">) (s.java-time)>;
311      e.includes : e (e.inc-mod) e,
312        <Lookup &Deps e.inc-mod> : s.inc-time e,
313        <">" (s.inc-time) (s.java-time)>;
314    } =
315    ((e.mod ".rf") (e.java-mod ".java"));
316  s.ext e = /*empty*/;
317};
318
319Get-Needed-Java {
320  ((e.module-name) (s.rfi-time (e.mod) (e.java-mod) e.includes)),
321    <">" (<Last-Modified e.java-mod ".java">) (<Last-Modified e.java-mod ".class">)> =
322    (e.java-mod ".java");
323  e = /*empty*/;
324};
325
326Run-rfpc {
327  v.files =
328    <Concat <Intersperse (" ") v.files>> :: e.files,
329    {
330      <Lookup &RFPJ-Opts RFPC>;
331      <Lookup &RFPJ-Opts RFPDIR><? &Dir-Separator>"compiler"<? &Dir-Separator>"rfpc" :: e.rfpc,
332        \{
333          <Can-Exec? e.rfpc> = e.rfpc;
334          e.rfpc ".exe" :: e.rfcp,
335            <Can-Exec? e.rfpc> = e.rfpc;
336        };
337      <Lookup &RFPJ-Opts JAVA>" -classpath "<Lookup &RFPJ-Opts JAVA-CP>
338        " "<Lookup &RFPJ-Opts JAVA-FLAGS>" org.refal.plus.compiler.rfpc";
339    } :: e.rfpc,
340    e.rfpc" "<Lookup &RFPJ-Opts RFPC-FLAGS>
341         <Concat <Map! &Id " -I " (<? &RFPATH>)>>" "e.files :: e.rfpc-cmd,
342    <PrintLN " + "e.rfpc-cmd>,
343    $trap {
344      <System e.rfpc-cmd> : {
345        0;
346        s.N =
347          <PrintLN! &StdErr "rfpj: Refal+ compiler exited with code "s.N>,
348          <Exit s.N>;
349      };
350    }
351    $with {
352      "System" err =
353        <WriteLN err>,
354        $error ("Can't run Refal+ compiler because something goes utterly wrong.")
355            ("Does RFPDIR correctly point to Refal+ installation directory?")
356            ("  RFPDIR="<Lookup &RFPJ-Opts RFPDIR>)
357            ("Command to run Refal+ compiler was:")
358            ("  "e.rfpc-cmd)
359            ("If it is wrong, try setting --rfpc, --rfpc-flags,")
360            ("  --java, and --java-flags options.");
361      err = $error err;
362    };
363  /*empty*/ = /*empty*/;
364};
365
366Run-javac {
367  v.files =
368    <Concat <Intersperse (" ") v.files>> :: e.files,
369    <Concat <Map! &Append (<? &Path-Separator>) (<? &RFPATH>)>> :: e.rfpath,
370    <Lookup &RFPJ-Opts JAVAC>" -classpath "e.rfpath<Lookup &RFPJ-Opts JAVA-CP>
371      " "<Lookup &RFPJ-Opts JAVA-FLAGS>" "e.files
372    :: e.javac-cmd,
373    <PrintLN " + "e.javac-cmd>,
374    $trap {
375      <System e.javac-cmd> : {
376        0;
377        s.N =
378          <PrintLN! &StdErr "rfpj: Java compiler exited with code "s.N>,
379          <Exit s.N>;
380      };
381    }
382    $with {
383      "System" err =
384        <WriteLN err>,
385        $error ("Can't run Java compiler because something goes utterly wrong.")
386            ("Command to run Java compiler was:")
387            ("  "e.javac-cmd)
388            ("Try setting --javac option to Java compiler executable.");
389      err = $error err;
390    };
391  /*empty*/ = /*empty*/;
392};
393
394$func? Search-In-Path (e.path) e.files = (e.dir) e.file;
395
396Search e.files =
397  \{
398    RFPATH <Search-In-Path (<? &RFPATH>) e.files>;
399    LIBRFI <Search-In-Path (<? &LIBRFI>) e.files>;
400  };
401
402Search-In-Path (e.path) e.files =
403  e.path : e (e.dir) e,
404  e.files : e (e.f) e,
405  <Exists? e.dir <? &Dir-Separator> e.f> =
406  (e.dir) e.f;
407
408Parse-Path e.path =
409  <? &Path-Separator> : s.sep,
410  e.path : {
411    e1 s.sep e2 = {
412      e1 : v = (e1) <Parse-Path e2>;
413      <Parse-Path e2>;
414    };
415    v1 = (v1);
416    /*empty*/ = /*empty*/;
417  };
418
419Subst (e.patterns) (e.replaces) term = {
420  e.patterns : e1 term e2 = <L <Length e1> e.replaces>;
421  term;
422};
423
424Verbose s.N e.msg = {
425  <? &Verb-Level> : s.L, <">=" (s.L) (s.N)> =
426    <PrintLN e.msg>;;
427};
428
Note: See TracBrowser for help on using the repository browser.