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

Last change on this file since 2043 was 2043, checked in by orlov, 14 years ago
  • Improved block extraction from result expressions.
  • Use asail2asail when converting to C++.
  • Remove duplicate declarations after cleanup of blocks

(rfp_asail2asail.Remove-Dupl-Decl).

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