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

Last change on this file since 2034 was 2034, checked in by orlov, 14 years ago
  • Proper generation of debug info for use with Debug library (-dbg option).
  • Result expressions can contain blocks.
  • 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: 2034 $
20// $Date: 2006-07-27 04:40:44 +0000 (Thu, 27 Jul 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: 2034 $') ('$Date: 2006-07-27 04:40:44 +0000 (Thu, 27 Jul 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                  <ASAIL-Optim e.module> :: e.module,
278                  <Verbose "as-ail optimization finished"> =
279                  e.module;
280              } :: e.module ,
281              <Verbose "compilation from as-ail to c++ started">,
282              <RFP-ASAIL-To-CPP t.asail-mod-name e.module> :: e.module,
283              <Verbose "compilation from as-ail to c++ finished">,
284              <Open-Channel e.basename ('.cc')> :: s.channel s.need-close?,
285              <PrintLN! s.channel '#include <rf_core.hh>'>,
286              {
287                <Domain &Includes> : e (e.include) e,
288                  <Lookup &Includes e.include> : \{
289                    BOOT e = '<refal/'e.include'.hh>';
290                    LOCAL e.path = '"'e.path e.include'.hh"';
291                  } :: e.include,
292                  <PrintLN! s.channel '#include 'e.include>,
293                  $fail;;
294              },
295              <CPP-Pretty-Print 0 s.channel () e.module>,
296              { s.need-close? : 1 = <Close-Channel s.channel>;; },
297              $fail;
298            <In-Table? &RFP-Options TPP>,
299              e.Items : e (MODULE t.asail-mod-name v.module),
300              <Extract-Inputs v.module> :: e.module,
301              {
302                <In-Table? &RFP-Options NO-OPTIM> = e.module;
303                <Verbose "as-ail optimization started">,
304                  <ASAIL-Optim e.module> :: e.module,
305                  <Verbose "as-ail optimization finished"> =
306                  e.module;
307              } :: e.module ,
308              <Verbose "compilation from as-ail to T++ started">,
309              <RFP-ASAIL-To-TPP t.asail-mod-name e.module> :: e.module,
310              <Verbose "compilation from as-ail to T++ finished">,
311              <Open-Channel e.basename ('.tpp')> :: s.channel s.need-close?,
312              <PrintLN! s.channel '#include <rf_core.hh>'>,
313              {
314                <Domain &Includes> : e (e.include) e,
315                  <Lookup &Includes e.include> : \{
316                    BOOT e = '<refal/'e.include'.hh>';
317                    LOCAL e.path = '"'e.path e.include'.hh"';
318                  } :: e.include,
319                  <PrintLN! s.channel '#include 'e.include>,
320                  $fail;;
321              },
322              <CPP-Pretty-Print 0 s.channel () e.module>,
323              { s.need-close? : 1 = <Close-Channel s.channel>;; },
324              $fail;                   
325            <In-Table? &RFP-Options JAVA>,
326              e.Items : (INTERFACE t.asail-mod-name e.headers) (MODULE t e.module),
327              <Extract-Inputs e.module> :: e.module,
328              {
329                <In-Table? &RFP-Options NO-OPTIM> = e.module;
330                <Verbose "as-ail optimization started">,
331//                  <ASAIL-Optim e.module> :: e.module,
332                  <Simplify-ASAIL e.module> :: e.module,
333                  {
334                    e.module : e t.item e,
335//                      <RFP-Pretty-Print &StdOut () t.item>,
336                      $fail;;
337                  },
338                  <Verbose "as-ail optimization finished"> =
339                  e.module;
340              } :: e.module,
341              <Verbose "compilation from as-ail to java started">,
342              {
343                e.headers (/*e.exports*/) $iter {
344                  e.headers : (s.decl t.name) e.rest =
345                    e.rest (e.exports t.name);
346                } :: e.headers (e.exports),
347                  e.headers : /*empty*/ =
348                  e.exports;
349              } :: e.exports,
350              <RFP-ASAIL-To-Java t.asail-mod-name (e.exports) e.module>
351                :: (e.java-module-name) (e.inputs) e.module,
352              <Verbose "compilation from as-ail to java finished">,
353              {
354                <In-Table? &RFP-Options NAME> = e.basename;
355                e.dirname : v = e.dirname &RFP-Dir-Separator e.java-module-name;
356                e.java-module-name;
357              } :: e.java-module-name,
358              <Open-Channel e.java-module-name ('.java')> :: s.channel s.need-close?,
359              {
360                e.dirname : v =
361                  <PrintLN! s.channel
362                  'package '<Subst (&RFP-Dir-Separator) (('.')) e.dirname>';\n'>;;
363              },
364              <PrintLN! s.channel 'import org.refal.plus.*;'>,
365              {
366                e.inputs : e (v.java-module) e, \{
367                  <Lookup &Includes v.java-module> : \{
368                    BOOT e = 'org.refal.plus.library.'v.java-module;
369//                    LOCAL e.path =
370//                      {
371//                        e.path : '.' &RFP-Dir-Separator e.rest-path = e.rest-path;
372//                        e.path;
373//                      } :: e.path,
374//                      <Subst (&RFP-Dir-Separator) (('.')) e.path> e.java-module;
375                  };
376                  v.java-module : e '.' e = v.java-module;
377                } :: e.java-module,
378                  <PrintLN! s.channel 'import 'e.java-module';'>,
379                  $fail;;
380              },
381              <CPP-Pretty-Print 0 s.channel () e.module>,
382              { s.need-close? : 1 = <Close-Channel s.channel>;; },
383              $fail;
384          };
385      } :: s.type e.Items,
386      $fail;
387    e.all-files-have-gone;
388  };
389
390Init-Options = <Store &Options
391  ((('I') ('ipath')) IPATH
392    ("dir") "add <dir> to the list of directories to be searched" "for .rfi files")
393  ((('B') ('bootpath')) BPATH
394    ("dir") "add <dir> to the list of directories to be searched" "for standard library .rfi files")
395  ((('ne') ('no-elaborate')) (BIND NO-ELABORATE))
396  ((('nc') ('no-check')) (BIND NO-CHECK)
397    "don't perform syntax check")
398  ((('nt') ('no-transform')) (BIND NO-TRANSFORM)
399    "don't perform AS-to-AS transformations")
400  ((('c') ('check')) (BIND CHECK)
401    "check only, causes no file creation in the absence"
402    "of other output control options")
403  ((('no') ('no-optim')) (BIND NO-OPTIM) "don't perform ASAIL-optimization")
404  ((('ci') ('comp-item')) COMP-ITEM
405    ("item") "compile <item> only, not the whole source" "(may be used several times)")
406  ((('h') ('help')) HELP /*"display this help screen"*/)
407  ((('v') ('verbose')) (BIND VERBOSE)
408    "display information about the stages of compilation")
409  ((('u')) (BIND CASE-INSENSITIVE)
410    "convert all symbol-words without surrounding quotes" "to upper case")
411  ((('o')) NAME
412    ("name| - ") "place outputs for file1 into files <name>.* or send" "them to stdout")
413  ((('cc')) (BIND CC)
414    "output C++ code")
415  ((('hh')) (BIND HH)
416    "generate header files")
417  ((('j') ('java')) (BIND JAVA)
418    "output Java code")
419  ((('t') ('t++')) (BIND TPP)
420    "output T++ code")
421  ((('asr') ('as-refal')) (BIND AS-REFAL)
422    "output Refal Abstract Syntax")
423  ((('ast') ('as-transformed')) (BIND AS-TRANSFORMED)
424    "output Refal Abstract Syntax after AS-to-AS" "transformations")
425  ((('asi') ('as-ail')) (BIND AS-AIL)
426    "output Abstract Syntax of Abstract Imperative" "Language")
427  ((('int')) INT ("class_name") "class to use for literal integers")
428  ((('replace-module')) REPLACE-MODULE ("m1" "m2") "use module <m2> instead of <m1>")
429  ((('d') ('debug')) (BIND DEBUG))
430  ((('dbg')) (BIND DBG) "generate text for debugger")
431  ((('trace')) TRACE
432    ("fname") "trace function <fname> (may be used several times)")
433  ((('traceall')) (BIND TRACEALL) "trace all functions")
434>;
435
436Display-Help =
437  <Box> :: s.line,
438  ' ' :: e.start1,
439  29 :: s.2nd-col,
440  <Repeat s.2nd-col ' '> :: e.start2,
441  <PrintLN "Refal+ compiler " <Version>>,
442  <PrintLN "Copyright blah-blah-blah">,
443  <PrintLN>,
444  <PrintLN "Usage: rfpc [options] file1 [file2 ...]">,
445  <PrintLN "Options:">,
446  {
447    <? &Options> : e (((e.op) e.opts) t e.descr) e,
448      <Store s.line e.start1 '-' e.op>,
449      {
450        e.opts : e (e.next) e,
451          <Put s.line ', -' e.next>,
452          $fail;;
453      },
454      {
455        e.descr : (e.params) e.rest =
456          {
457            e.params : e s.par e,
458              <Put s.line ' <' <To-Chars s.par> '>'>,
459              $fail;
460            e.rest;
461          };
462        e.descr;
463      } : \{
464        s.phrase e,
465          <PrintLN
466            <? s.line>
467            <Repeat <"-" s.2nd-col <Length <? s.line>>> ' '>
468            s.phrase
469          >,
470          $fail;
471        e s s.phrase e,
472          <PrintLN e.start2 s.phrase>,
473          $fail;
474      };;
475  };
476
477RFP-Parse-Args (e.files) (e.prevarg) s.index =
478{
479  <Arg s.index> : v.arg, <"+" s.index 1> :: s.index =
480    {
481      e.prevarg : v, e.prevarg :
482        {
483          IPATH =
484            <Store &RFP-Include-Path <? &RFP-Include-Path> (v.arg)>,
485            {
486              $iter
487                # \{
488                  <? &RFP-Include-Path> : e1 (e2 &RFP-Dir-Separator),
489                    <Store &RFP-Include-Path e1 (e2)>;
490                };
491            };
492          BPATH =
493            <Store &RFP-Boot-Path <? &RFP-Boot-Path> (v.arg)>,
494            {
495              $iter
496                # \{
497                  <? &RFP-Boot-Path> : e1 (e2 &RFP-Dir-Separator),
498                    <Store &RFP-Boot-Path e1 (e2)>;
499                };
500            };
501          COMP-ITEM =
502            {
503              <Lookup &RFP-Options ITEMS>;
504              /*empty*/;
505            } :: e.items,
506            <Bind &RFP-Options (ITEMS) (e.items <Make-Name v.arg>)>;
507          TRACE =
508            <Bind &RFP-Trace (<Make-Name v.arg>) ()>;
509          NAME =
510            {
511              v.arg : '-' = &StdOut;
512              v.arg;
513            } :: v.arg,
514            <Bind &RFP-Options (NAME) (v.arg)>;
515          INT =
516            <Bind &RFP-Options (INT) (v.arg)>;
517          REPLACE-MODULE = REPLACE-MODULE-2 v.arg;
518          REPLACE-MODULE-2 e.mod1 =
519            <Bind &RFP-Module-Subst (e.mod1) (v.arg)>;
520        } :: e.prevarg,
521        <RFP-Parse-Args (e.files) (e.prevarg) s.index>;
522      v.arg : '-' e.opt =
523        {
524          \{
525            <? &Options> : e ((e (e.opt) e) t.action e) e = t.action;
526            e.opt : '-' e.o,
527              <? &Options> : e ((e (e.o) e) t.action e) e = t.action;
528          } : {
529            (BIND s.option) = <Bind &RFP-Options (s.option) ()>;
530            HELP = <Bind &RFP-Options (HELP) ()>, <Display-Help>;
531            s.other = s.other;
532          } :: e.prevarg,
533            <RFP-Parse-Args (e.files) (e.prevarg) s.index>;
534          <PrintLN! &StdErr "Unknown option \"-" e.opt "\"">,
535            <RFP-Parse-Args (e.files) () s.index>;
536        };
537      <RFP-Parse-Args (e.files (v.arg)) () s.index>;
538    };
539  {
540    \{
541      <In-Table? &RFP-Options CC>;
542      <In-Table? &RFP-Options HH>;
543      <In-Table? &RFP-Options TPP>;
544      <In-Table? &RFP-Options JAVA>;
545      <In-Table? &RFP-Options AS-REFAL>;
546      <In-Table? &RFP-Options AS-TRANSFORMED>;
547      <In-Table? &RFP-Options AS-AIL>;
548      <In-Table? &RFP-Options CHECK>;
549    };
550    <Bind &RFP-Options (CC) ()> <Bind &RFP-Options (HH) ()>;
551  },
552    e.files;
553};
554
555RFP-Set-Path =
556  <Store &RFP-Boot-Path <? &RFP-Boot-Path> &RFP-Default-Include-Path>,
557  <Store &RFP-Include-Path <? &RFP-Include-Path> <? &RFP-Boot-Path>>;
558
559Get-Ready-To-Work e.Items =
560  <RFP-Clear-Table &Includes>,
561  <RFP-Clear-Table &Fun>,
562  <RFP-Clear-Table &Fun?>,
563  <RFP-Clear-Table &Const>,
564  <RFP-Clear-Table &Object>,
565  {
566    e.Items : e t.Item e, t.Item : \{
567      (s.Linkage s.ItemType t.Pragma t.ItemName e.ItemBody),
568        s.ItemType : {
569          FUNC =
570            <Left 0 2 e.ItemBody> : (e.in) (e.out),
571            &Fun (<Format-Exp e.in>) (<Format-Exp e.out>);
572          TFUNC =
573            <Left 0 2 e.ItemBody> : (e.in) (e.out),
574            &Fun (<Format-Exp e.in>) (<Format-Exp e.out>);
575          FUNC? =
576            <Left 0 2 e.ItemBody> : (e.in) (e.out),
577            &Fun? (<Format-Exp e.in>) (<Format-Exp e.out>);
578          CONST = &Const e.ItemBody;
579          s = &Object e.ItemBody;
580        } :: s.tab e.ItemDef,
581        <Bind s.tab (t.ItemName) (s.Linkage s.ItemType t.Pragma e.ItemDef)>;
582      (EXTERN t.Pragma t.FName) =
583        <Bind &Fun? (t.FName) (IMPORT FUNC? t.Pragma ((EVAR)) ((EVAR)))>;
584    },
585      $fail;
586    {
587      <In-Table? &RFP-Options DBG> =
588        <Bind &Fun? ((Debug Stop?)) (IMPORT FUNC? (PRAGMA) ((EVAR)) ())>,
589        <Bind &Fun  ((Debug Debug)) (IMPORT FUNC  (PRAGMA) ((EVAR)) ())>;;
590    };
591  };
592
593RFP-Pretty-Print s.channel (e.indent) e.expr = e.expr :
594  {
595    e0 (e1) e2 =
596      <Write! s.channel e0>,
597      { e.indent : v = <PrintLN! s.channel>;; },
598      <Print! s.channel e.indent '('>,
599      <RFP-Pretty-Print s.channel (e.indent '  ') e1>,
600      {
601        e1 : e (e) e =
602          <PrintLN! s.channel>,
603          <Print! s.channel e.indent ')'>;
604        <Print! s.channel ')'>;
605      },
606      {
607        e2 : (e) e = ;
608        e2 : , e.indent : v = ;
609        <PrintLN! s.channel>, <Print! s.channel e.indent>;
610      },
611      <RFP-Pretty-Print s.channel (e.indent) e2>;
612    v1 =
613      <Write! s.channel v1>;
614    =;
615  };
616
617$const Tab = '  ';
618
619CPP-Pretty-Print s.inner-call? s.channel (e.indent) e.expr, e.expr : {
620  e0 (e1) e2 =
621    { s.inner-call? : 0 = <PrintLN! s.channel>;; },
622    {
623      e0 : /*empty*/, {
624        e1 : LABEL e.label =
625          e.indent : e.ind &Tab,
626          <PrintLN! s.channel e.ind e.label>;
627        e1 : /*empty*/ =
628          <PrintLN! s.channel>;
629        <CPP-Pretty-Print 1 s.channel (e.indent) e1>;
630      };
631      <PrintLN! s.channel e.indent e0>,
632        <CPP-Pretty-Print 1 s.channel (e.indent &Tab) (e1)>;
633    },
634    <CPP-Pretty-Print s.inner-call? s.channel (e.indent) e2>;
635  v1 = <PrintLN! s.channel e.indent v1>;
636  /*empty*/ = /*empty*/;
637};
638
639Verbose e.string, {
640  <In-Table? &RFP-Options VERBOSE> =
641    <PrintLN <Time> ": " e.string>;;
642};
643
644Open-Channel {
645  symbol (e), <Channel? symbol> = symbol 0;
646  e.name (e.ext) =
647    <Channel> :: s.channel,
648    {
649      <Open-File s.channel e.name e.ext W> =
650        s.channel 1; // When we need to close channel ???
651      <PrintLN! &StdErr "Error: cannot open file " e.name e.ext " for writing">,
652        <Exit 1>, $fail;
653    };
654};
655
656Extract-Inputs {
657  (INPUT (e.mod-name) e.file-name) e.items, {
658    e.file-name : $r e.path &RFP-Dir-Separator e.name, {
659      <? &RFP-Boot-Path> : e (e.path e.rest) e \?
660        {
661          e.rest : e1 s2 e3 \?
662            {
663              s2 : &RFP-Dir-Separator \! $fail;
664              \!\! $fail;
665            };
666          <Bind &Includes (e.mod-name) (BOOT e.path &RFP-Dir-Separator)>;
667        };
668      {
669        e.path : '.' = /*empty*/;
670        e.path : '.' &RFP-Dir-Separator e.rest, {
671          e.rest : e1 s2 e3, # \{ s2 : &RFP-Dir-Separator; } =
672            s2 e3 &RFP-Dir-Separator;
673          /*empty*/;
674        };
675        e.path &RFP-Dir-Separator;
676      } :: e.path,
677        <Bind &Includes (e.mod-name) (LOCAL e.path)>;
678    };
679    <Bind &Includes (e.mod-name) (LOCAL)>;
680  },
681    <Extract-Inputs e.items>;
682  e.items =
683    {
684      <In-Table? &RFP-Options DBG> = <Bind &Includes (Debug) (BOOT)>;;
685    },
686    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.