source: to-imperative/trunk/compiler/rfpc.rf @ 1960

Last change on this file since 1960 was 1960, checked in by orlov, 15 years ago
  • (Java) Fixed assignments to Result variables.
  • Close files after use.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 24.3 KB
Line 
1//
2// Copyright (C) 1999, 2000 Refal+ Development Group
3//
4// Refal+ is free software; you can redistribute it and/or modify
5// it under the terms of the GNU General Public License as published by
6// the Free Software Foundation; either version 2 of the License, or
7// (at your option) any later version.
8//
9// Refal+ is distributed in the hope that it will be useful,
10// but WITHOUT ANY WARRANTY; without even the implied warranty of
11// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12// GNU General Public License for more details.
13//
14// You should have received a copy of the GNU General Public License
15// along with Refal+; if not, write to the Free Software
16// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
17//
18// $Source$
19// $Revision: 1960 $
20// $Date: 2006-05-15 01:50:12 +0000 (Mon, 15 May 2006) $
21
22// rfpc.rfi
23$use "rfp_src"; // rfp_src.rfi
24$use "rfp_err"; // rfp_err.rfi
25$use "rfp_lex"; // rfp_lex.rfi
26$use "rfp_parse"; // rfp_parse.rfi
27$use "rfp_debug"; // rfp_debug.rfi
28$use "rfp_compile"; // rfp_compile.rfi
29$use "rfp_asail_cpp"; //rfp_asail_cpp.rfi
30$use "rfp_asail_java"; //rfp_asail_java.rfi
31$use "rfp_asail_tpp"; //rfp_asail_tpp.rfi
32$use "rfp_as2as";
33$use "rfp_check";
34$use "rfp_helper";
35$use "rfp_format";
36$use "rfp_asail_optim"; //rfp_asail_optim.rfi
37$use "rfp_asail2asail";
38
39$use StdIO;
40$use Box;
41$use Dos;
42$use Arithm;
43$use Table;
44$use Convert;
45$use Class;
46$use Access;
47$use Compare;
48$use CppMangle;
49
50$const RevDate = ('$Revision: 1960 $') ('$Date: 2006-05-15 01:50:12 +0000 (Mon, 15 May 2006) $');
51$func Version = e.version;
52
53// information about available compiler options
54$box Options;
55
56// put information about compiler options in the &Options box
57$func Init-Options = ;
58
59// display help screen
60$func Display-Help = ;
61
62$func RFP-Parse-Args (e.files) (e.prevarg) s.index = e.files;
63$func RFP-Set-Path = ;
64
65// initialize tables
66$func Get-Ready-To-Work e.Items = ;
67
68$func CPP-Pretty-Print s.inner-call? s.channel (e.indent) e.expr = ;
69
70// print information about compilation stages when -verbose option was
71// supplied on command line
72$func Verbose e.string = ;
73
74$func Open-Channel e.name (e.ext) = s.channel s.need-close?;
75
76$table Includes;
77
78$func Extract-Inputs e.items = e.items;
79
80$func? Compilation-Failed = ;
81
82
83Main =
84  <Init-Options>,
85  <RFP-Parse-Args () () 1> :: e.files,
86  <RFP-Set-Path>,
87  <Store &Error-Counter 0>,
88  <Store &Warning-Counter 0>,
89//  <PrintLN e.files>,
90  e.files : {
91    /*empty*/ =
92      {
93        <In-Table? &RFP-Options HELP>;
94        <PrintLN 'Refal+ compiler ' <Version>>,
95          'Usage: rfpc' :: e.start,
96          <Length e.start> :: s.st-len,
97          <Print e.start>,
98          <Box> :: s.len,
99          <Store s.len s.st-len>,
100          {
101            <? &Options> : e (((e.next) e) t e.descr) e,
102              <"<=" (<Length e.next>) (3)>,
103              {
104                e.descr : (e.arg) e = ' [-' e.next ' <' e.arg '>]';
105                ' [-' e.next ']';
106              } :: e.next,
107              <Length e.next> :: s.n-len,
108              <"+" <To-Int <? s.len>> s.n-len> :: s.new,
109              {
110                <">" (s.new) (64)> =
111                  <Store s.len <"+" s.st-len s.n-len>>,
112                  <PrintLN>,
113                  <Print <Repeat s.st-len ' '>>;
114                <Store s.len s.new>;
115              },
116              <Print e.next>,
117              $fail;
118            <PrintLN ' file ...'>;
119          },
120          <PrintLN>,
121          <PrintLN! &StdErr 'No input files specified'>;
122      };
123    e01 (e.file) e02,
124      {
125        e.file : $r e.basename '.' e.ext = e.basename (' .' e.ext);
126        e.file ();
127      } :: e.in-basename (e.ext),
128      {
129        e01 : /*empty*/, <Lookup &RFP-Options NAME>;
130        e.in-basename;
131      } :: e.basename,
132      {
133        e.basename : $r e.dirname &RFP-Dir-Separator e.filename =
134          (e.dirname) e.filename;
135        () e.basename;
136      } :: (e.dirname) e.filename,
137      {
138        <Channel? e.basename> = e.in-basename;
139        e.basename;
140      } :: e.headname,
141      <Subst (&RFP-Dir-Separator) (('_')) e.headname> :: e.headname,
142      <Rfp2Cpp <To-Word e.headname>> :: e.headname,
143      {
144        e.ext : \{ ' .rf'; ' .rfi'; } =
145          <Verbose e.filename ": parsing started" >,
146          <RFP-Lexer e.file> :: e.tokens,
147          <Store &RFP-Token-Stack e.tokens>,
148          <RFP-Parser> :: t.as,
149          <Verbose e.filename ": parsing finished">,
150          AS-REFAL t.as;
151        e.ext : ' .asr' =
152          <Channel> :: s.channel,
153          <Open-File s.channel e.file R>,
154          AS-REFAL <Read! s.channel>;
155        e.ext : ' .ast' =
156          <Channel> :: s.channel,
157          <Open-File s.channel e.file R>,
158          AS-TRANSFORMED <Read! s.channel>;
159        e.ext : ' .asi' =
160          <Channel> :: s.channel,
161          <Open-File s.channel e.file R>,
162          AS-AIL (AS-AIL AS-AIL <Read! s.channel> <Read! s.channel>);
163        <PrintLN! &StdErr "Error: unknown extension" e.ext " in " e.file> =
164          <Compilation-Failed>;
165      } : s.type (s.tag t.ModuleName e.Items),
166      {
167        s.type : AS-AIL;
168        <Get-Ready-To-Work e.Items>;
169      },
170      s.type e.Items $iter s.type : {
171        AS-REFAL =
172          {
173            <In-Table? &RFP-Options AS-REFAL> =
174              <Open-Channel e.basename ('.asr')> :: s.channel s.need-close?,
175              <RFP-Pretty-Print s.channel () (s.tag t.ModuleName e.Items)>,
176              { s.need-close? : 1 = <Close-Channel s.channel>;; };;
177          },
178          \{
179            <? &Error-Counter> : 0;
180            <Compilation-Failed>;
181          },
182          {
183            <In-Table? &RFP-Options NO-CHECK>;
184            <Verbose "syntax check started">,
185              <RFP-Check e.Items>,
186              <Verbose "syntax check finished"> =
187              \{
188                <? &Error-Counter> : 0;
189                <Compilation-Failed>;
190              };
191          },
192          \{
193            <In-Table? &RFP-Options CC>;
194            <In-Table? &RFP-Options HH>;
195            <In-Table? &RFP-Options JAVA>;
196            <In-Table? &RFP-Options TPP>;
197            <In-Table? &RFP-Options AS-AIL>;
198            <In-Table? &RFP-Options AS-TRANSFORMED>;
199          },
200          {
201            <In-Table? &RFP-Options DBG> =
202              <Verbose "debug-text generation started">,
203              <RFP-Debug e.Items> :: e.Items,
204              <Verbose "debug-text generation finished">,
205              e.Items;
206            e.Items;
207          } :: e.Items,   
208          {
209            <In-Table? &RFP-Options NO-TRANSFORM> = e.Items;
210            <Verbose "as-to-as transformation started">,
211              <RFP-As2As-Transform e.Items> :: e.Items,
212              <Verbose "as-to-as transformation finished">,
213              e.Items;
214          } :: e.Items,
215          AS-TRANSFORMED e.Items;
216        AS-TRANSFORMED =
217          {
218            <In-Table? &RFP-Options AS-TRANSFORMED> =
219              <Open-Channel e.basename ('.ast')> :: s.channel s.need-close?,
220              <RFP-Pretty-Print s.channel () (s.tag t.ModuleName e.Items)>,
221              { s.need-close? : 1 = <Close-Channel s.channel>;; };;
222          },
223          \{
224            <In-Table? &RFP-Options CC>;
225            <In-Table? &RFP-Options HH>;
226            <In-Table? &RFP-Options JAVA>;
227            <In-Table? &RFP-Options TPP>;
228            <In-Table? &RFP-Options AS-AIL>;
229          },
230          <Verbose "compilation to abstract imperative language started">,
231          <RFP-Compile e.Items> : (INTERFACE e.interf) (MODULE e.module),
232          <Verbose "compilation to abstract imperative language finished">,
233          AS-AIL
234          (INTERFACE t.ModuleName e.interf) (MODULE t.ModuleName e.module);
235        AS-AIL =
236          {
237            <In-Table? &RFP-Options AS-AIL> =
238              <Open-Channel e.basename ('.asi')> :: s.channel s.need-close?,
239              {
240                e.Items : e t.item e,
241                  <RFP-Pretty-Print s.channel () t.item>,
242                  $fail;;
243              },
244              { s.need-close? : 1 = <Close-Channel s.channel>;; };;
245          },
246          \{
247            <In-Table? &RFP-Options HH>,
248              e.Items : (INTERFACE t.asail-mod-name v.headers) e,
249              <Verbose "headers generation started">,
250              <RFP-ASAIL-To-CPP t.asail-mod-name v.headers> :: e.headers,
251              <Verbose "headers generation finished">,
252              <Open-Channel e.basename ('.hh')> :: s.channel s.need-close?,
253              <PrintLN! s.channel '#ifndef __' e.headname '_hh__'>,
254              <PrintLN! s.channel '#define __' e.headname '_hh__'>,
255              <PrintLN! s.channel '\n#include <rf_core.hh>'>,
256              <CPP-Pretty-Print 0 s.channel () e.headers>,
257              <PrintLN! s.channel '\n#endif // __' e.headname '_hh__'>,
258              { s.need-close? : 1 = <Close-Channel s.channel>;; },
259              {
260                <In-Table? &RFP-Options CASE-INSENSITIVE>,
261                  # <Channel? e.basename>,
262                  <To-Lower e.filename> :: e.lowname,
263                  # \{ e.filename : e.lowname; } =
264                  e.basename : e.dir e.filename,
265                  e.dir e.lowname :: e.lowbase,
266                  <Open-Channel e.lowbase ('.hh')> :: s.channel s.need-close?,
267                  <Subst (&RFP-Dir-Separator) (('_')) e.lowbase> :: e.headname,
268                  <Rfp2Cpp <To-Word e.headname>> :: e.headname,
269                  <PrintLN! s.channel '#ifndef __' e.headname '_hh__'>,
270                  <PrintLN! s.channel '#define __' e.headname '_hh__'>,
271                  <PrintLN! s.channel '\n#include <' e.basename '.hh>'>,
272                  <PrintLN! s.channel '\nnamespace refal\n{'>,
273                  <PrintLN! s.channel '\nnamespace ' e.lowname
274                            ' = ' e.filename ';'>,
275                  <PrintLN! s.channel '\n}'>,
276                  <PrintLN! s.channel '\n#endif // __' e.headname '_hh__'>,
277                  { s.need-close? : 1 = <Close-Channel s.channel>;; };;
278              },
279              $fail;
280            <In-Table? &RFP-Options CC>,
281              e.Items : e (MODULE t.asail-mod-name v.module),
282              <Extract-Inputs v.module> :: e.module,
283              {
284                <In-Table? &RFP-Options NO-OPTIM> = e.module;
285                <Verbose "as-ail optimization started">,
286                  <ASAIL-Optim e.module> :: e.module,
287                  <Verbose "as-ail optimization finished"> =
288                  e.module;
289              } :: e.module ,
290              <Verbose "compilation from as-ail to c++ started">,
291              <RFP-ASAIL-To-CPP t.asail-mod-name e.module> :: e.module,
292              <Verbose "compilation from as-ail to c++ finished">,
293              <Open-Channel e.basename ('.cc')> :: s.channel s.need-close?,
294              <PrintLN! s.channel '#include <rf_core.hh>'>,
295              {
296                <Domain &Includes> : e (e.include) e,
297                  <Lookup &Includes e.include> : \{
298                    BOOT e = '<refal/'e.include'.hh>';
299                    LOCAL e.path = '"'e.path e.include'.hh"';
300                  } :: e.include,
301                  <PrintLN! s.channel '#include 'e.include>,
302                  $fail;;
303              },
304              <CPP-Pretty-Print 0 s.channel () e.module>,
305              { s.need-close? : 1 = <Close-Channel s.channel>;; },
306              $fail;
307            <In-Table? &RFP-Options TPP>,
308              e.Items : e (MODULE t.asail-mod-name v.module),
309              <Extract-Inputs v.module> :: e.module,
310              {
311                <In-Table? &RFP-Options NO-OPTIM> = e.module;
312                <Verbose "as-ail optimization started">,
313                  <ASAIL-Optim e.module> :: e.module,
314                  <Verbose "as-ail optimization finished"> =
315                  e.module;
316              } :: e.module ,
317              <Verbose "compilation from as-ail to T++ started">,
318              <RFP-ASAIL-To-TPP t.asail-mod-name e.module> :: e.module,
319              <Verbose "compilation from as-ail to T++ finished">,
320              <Open-Channel e.basename ('.tpp')> :: s.channel s.need-close?,
321              <PrintLN! s.channel '#include <rf_core.hh>'>,
322              {
323                <Domain &Includes> : e (e.include) e,
324                  <Lookup &Includes e.include> : \{
325                    BOOT e = '<refal/'e.include'.hh>';
326                    LOCAL e.path = '"'e.path e.include'.hh"';
327                  } :: e.include,
328                  <PrintLN! s.channel '#include 'e.include>,
329                  $fail;;
330              },
331              <CPP-Pretty-Print 0 s.channel () e.module>,
332              { s.need-close? : 1 = <Close-Channel s.channel>;; },
333              $fail;                   
334            <In-Table? &RFP-Options JAVA>,
335              e.Items : (INTERFACE t.asail-mod-name e.headers) (MODULE t e.module),
336              <Extract-Inputs e.module> :: e.module,
337              {
338                <In-Table? &RFP-Options NO-OPTIM> = e.module;
339                <Verbose "as-ail optimization started">,
340//                  <ASAIL-Optim e.module> :: e.module,
341                  <Simplify-ASAIL e.module> :: e.module,
342                  {
343                    e.module : e t.item e,
344//                      <RFP-Pretty-Print &StdOut () t.item>,
345                      $fail;;
346                  },
347                  <Verbose "as-ail optimization finished"> =
348                  e.module;
349              } :: e.module,
350              <Verbose "compilation from as-ail to java started">,
351              {
352                e.headers (/*e.exports*/) $iter {
353                  e.headers : (s.decl t.name) e.rest =
354                    e.rest (e.exports t.name);
355                } :: e.headers (e.exports),
356                  e.headers : /*empty*/ =
357                  e.exports;
358              } :: e.exports,
359              <RFP-ASAIL-To-Java t.asail-mod-name (e.exports) e.module>
360                :: (e.java-module-name) (e.inputs) e.module,
361              <Verbose "compilation from as-ail to java finished">,
362              {
363                <In-Table? &RFP-Options NAME> = e.basename;
364                e.dirname : v = e.dirname &RFP-Dir-Separator e.java-module-name;
365                e.java-module-name;
366              } :: e.java-module-name,
367              <Open-Channel e.java-module-name ('.java')> :: s.channel s.need-close?,
368              {
369                e.dirname : v =
370                  <PrintLN! s.channel
371                  'package '<Subst (&RFP-Dir-Separator) (('.')) e.dirname>';\n'>;;
372              },
373              <PrintLN! s.channel 'import org.refal.plus.*;'>,
374              {
375                e.inputs : e (v.java-module) e, \{
376                  <Lookup &Includes v.java-module> : \{
377                    BOOT e = 'org.refal.plus.library.'v.java-module;
378//                    LOCAL e.path =
379//                      {
380//                        e.path : '.' &RFP-Dir-Separator e.rest-path = e.rest-path;
381//                        e.path;
382//                      } :: e.path,
383//                      <Subst (&RFP-Dir-Separator) (('.')) e.path> e.java-module;
384                  };
385                  v.java-module : e '.' e = v.java-module;
386                } :: e.java-module,
387                  <PrintLN! s.channel 'import 'e.java-module';'>,
388                  $fail;;
389              },
390              <CPP-Pretty-Print 0 s.channel () e.module>,
391              { s.need-close? : 1 = <Close-Channel s.channel>;; },
392              $fail;
393          };
394      } :: s.type e.Items,
395      $fail;
396    e.all-files-have-gone;
397  };
398
399Init-Options = <Store &Options
400  ((('I') ('ipath')) IPATH
401    ("dir") "add <dir> to the list of directories to be searched" "for .rfi files")
402  ((('B') ('bootpath')) BPATH
403    ("dir") "add <dir> to the list of directories to be searched" "for standard library .rfi files")
404  ((('ne') ('no-elaborate')) (BIND NO-ELABORATE))
405  ((('nc') ('no-check')) (BIND NO-CHECK)
406    "don't perform syntax check")
407  ((('nt') ('no-transform')) (BIND NO-TRANSFORM)
408    "don't perform AS-to-AS transformations")
409  ((('c') ('check')) (BIND CHECK)
410    "check only, causes no file creation in the absence"
411    "of other output control options")
412  ((('no') ('no-optim')) (BIND NO-OPTIM) "don't perform ASAIL-optimization")
413  ((('ci') ('comp-item')) COMP-ITEM
414    ("item") "compile <item> only, not the whole source" "(may be used several times)")
415  ((('h') ('help')) HELP /*"display this help screen"*/)
416  ((('v') ('verbose')) (BIND VERBOSE)
417    "display information about the stages of compilation")
418  ((('u')) (BIND CASE-INSENSITIVE)
419    "convert all symbol-words without surrounding quotes" "to upper case")
420  ((('o')) NAME
421    ("name| - ") "place outputs for file1 into files <name>.* or send" "them to stdout")
422  ((('cc')) (BIND CC)
423    "output C++ code")
424  ((('hh')) (BIND HH)
425    "generate header files")
426  ((('j') ('java')) (BIND JAVA)
427    "output Java code")
428  ((('t') ('t++')) (BIND TPP)
429    "output T++ code")
430  ((('asr') ('as-refal')) (BIND AS-REFAL)
431    "output Refal Abstract Syntax")
432  ((('ast') ('as-transformed')) (BIND AS-TRANSFORMED)
433    "output Refal Abstract Syntax after AS-to-AS" "transformations")
434  ((('asi') ('as-ail')) (BIND AS-AIL)
435    "output Abstract Syntax of Abstract Imperative" "Language")
436  ((('int')) INT ("class_name") "class to use for literal integers")
437  ((('replace-module')) REPLACE-MODULE ("m1" "m2") "use module <m2> instead of <m1>")
438  ((('d') ('debug')) (BIND DEBUG))
439  ((('dbg')) (BIND DBG) "generate text for debugger")
440  ((('trace')) TRACE
441    ("fname") "trace function <fname> (may be used several times)")
442  ((('traceall')) (BIND TRACEALL) "trace all functions")
443>;
444
445Display-Help =
446  <Box> :: s.line,
447  ' ' :: e.start1,
448  29 :: s.2nd-col,
449  <Repeat s.2nd-col ' '> :: e.start2,
450  <PrintLN "Refal+ compiler " <Version>>,
451  <PrintLN "Copyright blah-blah-blah">,
452  <PrintLN>,
453  <PrintLN "Usage: rfpc [options] file1 [file2 ...]">,
454  <PrintLN "Options:">,
455  {
456    <? &Options> : e (((e.op) e.opts) t e.descr) e,
457      <Store s.line e.start1 '-' e.op>,
458      {
459        e.opts : e (e.next) e,
460          <Put s.line ', -' e.next>,
461          $fail;;
462      },
463      {
464        e.descr : (e.params) e.rest =
465          {
466            e.params : e s.par e,
467              <Put s.line ' <' <To-Chars s.par> '>'>,
468              $fail;
469            e.rest;
470          };
471        e.descr;
472      } : \{
473        s.phrase e,
474          <PrintLN
475            <? s.line>
476            <Repeat <"-" s.2nd-col <Length <? s.line>>> ' '>
477            s.phrase
478          >,
479          $fail;
480        e s s.phrase e,
481          <PrintLN e.start2 s.phrase>,
482          $fail;
483      };;
484  };
485
486RFP-Parse-Args (e.files) (e.prevarg) s.index =
487{
488  <Arg s.index> : v.arg, <"+" s.index 1> :: s.index =
489    {
490      e.prevarg : v, e.prevarg :
491        {
492          IPATH =
493            <Store &RFP-Include-Path <? &RFP-Include-Path> (v.arg)>,
494            {
495              $iter
496                # \{
497                  <? &RFP-Include-Path> : e1 (e2 &RFP-Dir-Separator),
498                    <Store &RFP-Include-Path e1 (e2)>;
499                };
500            };
501          BPATH =
502            <Store &RFP-Boot-Path <? &RFP-Boot-Path> (v.arg)>,
503            {
504              $iter
505                # \{
506                  <? &RFP-Boot-Path> : e1 (e2 &RFP-Dir-Separator),
507                    <Store &RFP-Boot-Path e1 (e2)>;
508                };
509            };
510          COMP-ITEM =
511            {
512              <Lookup &RFP-Options ITEMS>;
513              /*empty*/;
514            } :: e.items,
515            <Bind &RFP-Options (ITEMS) (e.items <Make-Name v.arg>)>;
516          TRACE =
517            <Bind &RFP-Trace (<Make-Name v.arg>) ()>;
518          NAME =
519            {
520              v.arg : '-' = &StdOut;
521              v.arg;
522            } :: v.arg,
523            <Bind &RFP-Options (NAME) (v.arg)>;
524          INT =
525            <Bind &RFP-Options (INT) (v.arg)>;
526          REPLACE-MODULE = REPLACE-MODULE-2 v.arg;
527          REPLACE-MODULE-2 e.mod1 =
528            <Bind &RFP-Module-Subst (e.mod1) (v.arg)>;
529        } :: e.prevarg,
530        <RFP-Parse-Args (e.files) (e.prevarg) s.index>;
531      v.arg : '-' e.opt =
532        {
533          \{
534            <? &Options> : e ((e (e.opt) e) t.action e) e = t.action;
535            e.opt : '-' e.o,
536              <? &Options> : e ((e (e.o) e) t.action e) e = t.action;
537          } : {
538            (BIND s.option) = <Bind &RFP-Options (s.option) ()>;
539            HELP = <Bind &RFP-Options (HELP) ()>, <Display-Help>;
540            s.other = s.other;
541          } :: e.prevarg,
542            <RFP-Parse-Args (e.files) (e.prevarg) s.index>;
543          <PrintLN! &StdErr "Unknown option \"-" e.opt "\"">,
544            <RFP-Parse-Args (e.files) () s.index>;
545        };
546      <RFP-Parse-Args (e.files (v.arg)) () s.index>;
547    };
548  {
549    \{
550      <In-Table? &RFP-Options CC>;
551      <In-Table? &RFP-Options HH>;
552      <In-Table? &RFP-Options TPP>;
553      <In-Table? &RFP-Options JAVA>;
554      <In-Table? &RFP-Options AS-REFAL>;
555      <In-Table? &RFP-Options AS-TRANSFORMED>;
556      <In-Table? &RFP-Options AS-AIL>;
557      <In-Table? &RFP-Options CHECK>;
558    };
559    <Bind &RFP-Options (CC) ()> <Bind &RFP-Options (HH) ()>;
560  },
561    e.files;
562};
563
564RFP-Set-Path =
565  <Store &RFP-Boot-Path <? &RFP-Boot-Path> &RFP-Default-Include-Path>,
566  <Store &RFP-Include-Path <? &RFP-Include-Path> <? &RFP-Boot-Path>>;
567
568Get-Ready-To-Work e.Items =
569  <RFP-Clear-Table &Includes>,
570  <RFP-Clear-Table &Fun>,
571  <RFP-Clear-Table &Fun?>,
572  <RFP-Clear-Table &Const>,
573  <RFP-Clear-Table &Object>,
574  {
575    e.Items : e t.Item e, t.Item : \{
576      (s.Linkage s.ItemType t.Pragma t.ItemName e.ItemBody),
577        s.ItemType : {
578          FUNC =
579            <Left 0 2 e.ItemBody> : (e.in) (e.out),
580            &Fun (<Format-Exp e.in>) (<Format-Exp e.out>);
581          TFUNC =
582            <Left 0 2 e.ItemBody> : (e.in) (e.out),
583            &Fun (<Format-Exp e.in>) (<Format-Exp e.out>);
584          FUNC? =
585            <Left 0 2 e.ItemBody> : (e.in) (e.out),
586            &Fun? (<Format-Exp e.in>) (<Format-Exp e.out>);
587          CONST = &Const e.ItemBody;
588          s = &Object e.ItemBody;
589        } :: s.tab e.ItemDef,
590        <Bind s.tab (t.ItemName) (s.Linkage s.ItemType t.Pragma e.ItemDef)>;
591      (EXTERN t.Pragma t.FName) =
592        <Bind &Fun? (t.FName) (IMPORT FUNC? t.Pragma ((EVAR)) ((EVAR)))>;
593    },
594      $fail;;
595  };
596
597RFP-Pretty-Print s.channel (e.indent) e.expr = e.expr :
598  {
599    e0 (e1) e2 =
600      <Write! s.channel e0>,
601      { e.indent : v = <PrintLN! s.channel>;; },
602      <Print! s.channel e.indent '('>,
603      <RFP-Pretty-Print s.channel (e.indent '  ') e1>,
604      {
605        e1 : e (e) e =
606          <PrintLN! s.channel>,
607          <Print! s.channel e.indent ')'>;
608        <Print! s.channel ')'>;
609      },
610      {
611        e2 : (e) e = ;
612        e2 : , e.indent : v = ;
613        <PrintLN! s.channel>, <Print! s.channel e.indent>;
614      },
615      <RFP-Pretty-Print s.channel (e.indent) e2>;
616    v1 =
617      <Write! s.channel v1>;
618    =;
619  };
620
621$const Tab = '  ';
622
623CPP-Pretty-Print s.inner-call? s.channel (e.indent) e.expr, e.expr : {
624  e0 (e1) e2 =
625    { s.inner-call? : 0 = <PrintLN! s.channel>;; },
626    {
627      e0 : /*empty*/, {
628        e1 : LABEL e.label =
629          e.indent : e.ind &Tab,
630          <PrintLN! s.channel e.ind e.label>;
631        e1 : /*empty*/ =
632          <PrintLN! s.channel>;
633        <CPP-Pretty-Print 1 s.channel (e.indent) e1>;
634      };
635      <PrintLN! s.channel e.indent e0>,
636        <CPP-Pretty-Print 1 s.channel (e.indent &Tab) (e1)>;
637    },
638    <CPP-Pretty-Print s.inner-call? s.channel (e.indent) e2>;
639  v1 = <PrintLN! s.channel e.indent v1>;
640  /*empty*/ = /*empty*/;
641};
642
643Verbose e.string, {
644  <In-Table? &RFP-Options VERBOSE> =
645    <PrintLN <Time> ": " e.string>;;
646};
647
648Open-Channel {
649  symbol (e), <Channel? symbol> = symbol 0;
650  e.name (e.ext) =
651    <Channel> :: s.channel,
652    {
653      <Open-File s.channel e.name e.ext W> =
654        s.channel 1; // When we need to close channel ???
655      <PrintLN! &StdErr "Error: cannot open file " e.name e.ext " for writing">,
656        <Exit 1>, $fail;
657    };
658};
659
660Extract-Inputs {
661  (INPUT (e.mod-name) e.file-name) e.items, {
662    e.file-name : $r e.path &RFP-Dir-Separator e.name, {
663      <? &RFP-Boot-Path> : e (e.path e.rest) e \?
664        {
665          e.rest : e1 s2 e3 \?
666            {
667              s2 : &RFP-Dir-Separator \! $fail;
668              \!\! $fail;
669            };
670          <Bind &Includes (e.mod-name) (BOOT e.path &RFP-Dir-Separator)>;
671        };
672      {
673        e.path : '.' = /*empty*/;
674        e.path : '.' &RFP-Dir-Separator e.rest, {
675          e.rest : e1 s2 e3, # \{ s2 : &RFP-Dir-Separator; } =
676            s2 e3 &RFP-Dir-Separator;
677          /*empty*/;
678        };
679        e.path &RFP-Dir-Separator;
680      } :: e.path,
681        <Bind &Includes (e.mod-name) (LOCAL e.path)>;
682    };
683    <Bind &Includes (e.mod-name) (LOCAL)>;
684  },
685    <Extract-Inputs e.items>;
686  e.items = e.items;
687};
688
689Compilation-Failed = <Exit 1>;
690
691Version = {
692  &RevDate : (e ' ' v.rev ' ' e) (e ' ' v.date ' ' e) = '2.0-beta-' v.rev ', ' v.date;
693  '2.0-unknown-beta';
694};
695
Note: See TracBrowser for help on using the repository browser.