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

Last change on this file since 1146 was 1146, checked in by orlov, 17 years ago
  • Support for references to functions. Including ones with formats other then

e = e.

  • Support for iterative splitting from the right.
  • Composition of clashes left hand side is corrected.
  • Renaming of variables is corrected.
  • Some other small bugs are fixed.
  • A lot of unused code is throwed away, some code is cleaned up, some comments

are added.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.6 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: 1146 $
20// $Date: 2003-08-10 22:36:28 +0000 (Sun, 10 Aug 2003) $
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"; //rfp_asail.rfi
29$use "rfp_as2as";
30$use "rfp_check";
31$use "rfp_helper";
32$use "rfp_format";
33$use "rfp_mangle";
34$use "rfp_asail_optim"; //rfp_asail_optim.rfi
35
36$use StdIO;
37$use Box;
38$use Dos;
39$use Arithm;
40$use Table;
41$use Convert;
42$use Class;
43$use Access;
44$use Compare;
45
46// information about available compiler options
47$box Options;
48
49// put information about compiler options in the &Options box
50$func Init-Options = ;
51
52// display help screen
53$func Display-Help = ;
54
55$func RFP-Parse-Args (e.files) (e.prevarg) s.index = e.files;
56$func RFP-Set-Path = ;
57
58// initialize tables
59$func Get-Ready-To-Work e.Items = ;
60
61$func CPP-Pretty-Print s.inner-call? s.channel (e.indent) e.expr = ;
62
63// print information about compilation stages when -verbose option was
64// supplied on command line
65$func Verbose e.string = ;
66
67$func Open-Channel e.name (e.ext) = s.channel s.need-close?;
68
69$func Find-Includes = e.includes;
70
71
72Main =
73  <Init-Options>,
74  <RFP-Parse-Args () () 1> :: e.files,
75  <RFP-Set-Path>,
76  <Store &Error-Counter 0>,
77  <Store &Warning-Counter 0>,
78//  <PrintLN e.files>,
79  e.files : {
80    /*empty*/ =
81      {
82        <In-Table? &RFP-Options HELP>;
83        <PrintLN 'Refal+ compiler bla-bla-bla'>,
84          'Usage: rfpc' :: e.start,
85          <Length e.start> :: s.st-len,
86          <Print e.start>,
87          <Box> :: s.len,
88          <Store s.len s.st-len>,
89          {
90            <? &Options> : e (((e.next) e) t e.descr) e,
91              {
92                e.descr : (e.arg) e = ' [-' e.next ' <' e.arg '>]';
93                ' [-' e.next ']';
94              } :: e.next,
95              <Length e.next> :: s.n-len,
96              <"+" <To-Int <? s.len>> s.n-len> :: s.new,
97              {
98                <">" (s.new) (70)> =
99                  <Store s.len <"+" s.st-len s.n-len>>,
100                  <PrintLN>,
101                  <Print <Repeat s.st-len ' '>>;
102                <Store s.len s.new>;
103              },
104              <Print e.next>,
105              $fail;
106            <PrintLN ' file ...'>;
107          },
108          <PrintLN>,
109          <PrintLN! &StdErr 'No input files specified'>;
110      };
111    e01 (e.file) e02,
112      {
113        e.file : $r e.basename '.' e.ext = e.basename (' .' e.ext);
114        e.file ();
115      } :: e.in-basename (e.ext),
116      {
117        e01 : /*empty*/, <Lookup &RFP-Options NAME>;
118        e.in-basename;
119      } :: e.basename,
120      {
121        <Channel? e.basename> = e.in-basename;
122        e.basename;
123      } :: e.headname,
124      <Subst (&RFP-Dir-Separator) (('_')) e.headname> :: e.headname,
125      <Rfp2Cpp <To-Word e.headname>> :: e.headname,
126      {
127        e.ext : \{ ' .rf'; ' .rfi'; } =
128          <Verbose "parsing started">,
129          <RFP-Lexer e.file> :: e.tokens,
130          <Store &RFP-Token-Stack e.tokens>,
131          <RFP-Parser> :: t.as,
132          <Verbose "parsing finished">,
133          AS-REFAL t.as;
134        e.ext : ' .asr' =
135          <Channel> :: s.channel,
136          <Open-File s.channel e.file R>,
137          AS-REFAL <Read! s.channel>;
138        e.ext : ' .ast' =
139          <Channel> :: s.channel,
140          <Open-File s.channel e.file R>,
141          AS-TRANSFORMED <Read! s.channel>;
142        e.ext : ' .asi' =
143          <Channel> :: s.channel,
144          <Open-File s.channel e.file R>,
145          AS-AIL (AS-AIL AS-AIL <Read! s.channel> <Read! s.channel>);
146        <PrintLN! &StdErr "Error: unknown extension" e.ext " in " e.file> = $fail;
147      } : s.type (s.tag t.ModuleName e.Items),
148      {
149        s.type : AS-AIL;
150        <Get-Ready-To-Work e.Items>;
151      },
152      s.type e.Items $iter s.type : {
153        AS-REFAL =
154          {
155            <In-Table? &RFP-Options AS-REFAL> =
156              <Open-Channel e.basename ('.asr')> :: s.channel s.need-close?,
157              <RFP-Pretty-Print s.channel () (s.tag t.ModuleName e.Items)>,
158              { s.need-close? : 1 = <Close-Channel s.channel>;; };;
159          },
160          <? &Error-Counter> : 0,
161          {
162            <In-Table? &RFP-Options NO-CHECK>;
163            <Verbose "syntax check started">,
164              <RFP-Check e.Items>,
165              <Verbose "syntax check finished"> =
166              <? &Error-Counter> : 0;
167          },
168          \{
169            <In-Table? &RFP-Options CC>;
170            <In-Table? &RFP-Options AS-AIL>;
171            <In-Table? &RFP-Options AS-TRANSFORMED>;
172            <In-Table? &RFP-Options HH>;
173          },
174          {
175            <In-Table? &RFP-Options NO-TRANSFORM> = e.Items;
176            <Verbose "as-to-as transformation started">,
177              <RFP-As2As-Transform e.Items> :: e.Items,
178              <Verbose "as-to-as transformation finished">,
179              e.Items;
180          } :: e.Items,
181          AS-TRANSFORMED e.Items;
182        AS-TRANSFORMED =
183          {
184            <In-Table? &RFP-Options AS-TRANSFORMED> =
185              <Open-Channel e.basename ('.ast')> :: s.channel s.need-close?,
186              <RFP-Pretty-Print s.channel () (s.tag t.ModuleName e.Items)>,
187              { s.need-close? : 1 = <Close-Channel s.channel>;; };;
188          },
189          \{
190            <In-Table? &RFP-Options CC>;
191            <In-Table? &RFP-Options AS-AIL>;
192            <In-Table? &RFP-Options HH>;
193          },
194          <Verbose "compilation to abstract imperative language started">,
195          <RFP-Compile e.Items> : (INTERFACE e.interf) (MODULE e.module),
196          <Verbose "compilation to abstract imperative language finished">,
197          AS-AIL
198          (INTERFACE t.ModuleName e.interf) (MODULE t.ModuleName e.module);
199        AS-AIL =
200          {
201            <In-Table? &RFP-Options AS-AIL> =
202              <Open-Channel e.basename ('.asi')> :: s.channel s.need-close?,
203              {
204                e.Items : e t.item e,
205                  <RFP-Pretty-Print s.channel () t.item>,
206                  $fail;;
207              },
208              { s.need-close? : 1 = <Close-Channel s.channel>;; };;
209          },
210          \{
211            <In-Table? &RFP-Options HH>,
212              e.Items : (INTERFACE t.asail-mod-name v.headers) e,
213              <Verbose "headers generation started">,
214              <RFP-ASAIL-To-CPP t.asail-mod-name v.headers> :: e.headers,
215              <Verbose "headers generation finished">,
216              <Open-Channel e.basename ('.hh')> :: s.channel s.need-close?,
217              <PrintLN! s.channel '#ifndef __' e.headname '_hh__'>,
218              <PrintLN! s.channel '#define __' e.headname '_hh__'>,
219              <PrintLN! s.channel '\n#include <rf_core.hh>'>,
220              <CPP-Pretty-Print 0 s.channel () e.headers>,
221              <PrintLN! s.channel '\n#endif // __' e.headname '_hh__'>,
222              { s.need-close? : 1 = <Close-Channel s.channel>;; },
223              $fail;
224            <In-Table? &RFP-Options CC>,
225              e.Items : e (MODULE t.asail-mod-name v.module),
226              {
227                <In-Table? &RFP-Options NO-OPTIM> = v.module;
228                <Verbose "optimization as-ail started">,
229                  <ASAIL-Optim v.module> :: e.module,
230                  <Verbose "optimization as-ail finished"> =
231                  e.module;
232              } :: e.module ,
233              <Verbose "compilation from as-ail to c++ started">,
234              <RFP-ASAIL-To-CPP t.asail-mod-name e.module> :: e.module,
235              <Verbose "compilation from as-ail to c++ finished">,
236              <Open-Channel e.basename ('.cc')> :: s.channel s.need-close?,
237              <PrintLN! s.channel '#include <rf_core.hh>'>,
238              {
239                <Find-Includes> : e (e.include) e,
240                  <PrintLN! s.channel '#include ' e.include>,
241                  $fail;;
242              },
243              <CPP-Pretty-Print 0 s.channel () e.module>,
244              { s.need-close? : 1 = <Close-Channel s.channel>;; },
245              $fail;
246          };
247      } :: s.type e.Items,
248      $fail;
249    e.all-files-have-gone;
250  };
251
252Init-Options = <Store &Options
253  ((('I') ('ipath')) IPATH
254    ('dir') "add <dir> to the list of directories to be searched" "for .rfi files")
255  ((('ne') ('no-elaborate')) (BIND NO-ELABORATE))
256  ((('nc') ('no-check')) (BIND NO-CHECK)
257    "don't perform syntax check")
258  ((('nt') ('no-transform')) (BIND NO-TRANSFORM)
259    "don't perform AS-to-AS transformations")
260  ((('c') ('check')) (BIND CHECK)
261    "check only, causes no file creation in the absence"
262    "of other output control options")
263  ((('ci') ('comp-item')) COMP-ITEM
264    ('item') "compile <item> only, not the whole source" "(may be used several times)")
265  ((('h') ('help')) HELP /*"display this help screen"*/)
266  ((('v') ('verbose')) (BIND VERBOSE)
267    "display information about the stages of compilation")
268  ((('u')) (BIND CASE-INSENSITIVE)
269    "convert all symbol-words without surrounding quotes" "to upper case")
270  ((('o')) NAME
271    ('name| - ') "place outputs for file1 into files <name>.* or send" "them to stdout")
272  ((('cc')) (BIND CC)
273    "output C++ code")
274  ((('hh')) (BIND HH)
275    "generate header files")
276  ((('asr') ('as-refal')) (BIND AS-REFAL)
277    "output Refal Abstract Syntax")
278  ((('ast') ('as-transformed')) (BIND AS-TRANSFORMED)
279    "output Refal Abstract Syntax after AS-to-AS" "transformations")
280  ((('asi') ('as-ail')) (BIND AS-AIL)
281    "output Abstract Syntax of Abstract Imperative" "Language")
282  ((('d') ('debug')) (BIND DEBUG))
283  ((('no') ('no-optim')) (BIND NO-OPTIM) "don't perform ASAIL-optimization")
284>;
285
286Display-Help =
287  <Box> :: s.line,
288  '  ' :: e.start1,
289  27 :: s.2nd-col,
290  <Repeat s.2nd-col ' '> :: e.start2,
291  <PrintLN "Refal+ compiler bla-bla-bla">,
292  <PrintLN "Copyright bla-bla-bla">,
293  <PrintLN>,
294  <PrintLN "Usage: rfpc [options] file1 [file2 ...]">,
295  <PrintLN "Options:">,
296  {
297    <? &Options> : e (((e.op) e.opts) t e.descr) e,
298      <Store s.line e.start1 '-' e.op>,
299      {
300        e.opts : e (e.next) e,
301          <Put s.line ', -' e.next>,
302          $fail;;
303      },
304      {
305        e.descr : (e.param) e.rest =
306          <Put s.line ' <' e.param '>'>,
307          e.rest;
308        e.descr;
309      } : \{
310        s.phrase e,
311          <PrintLN
312            <? s.line>
313            <Repeat <"-" s.2nd-col <Length <? s.line>>> ' '>
314            s.phrase
315          >,
316          $fail;
317        e s s.phrase e,
318          <PrintLN e.start2 s.phrase>,
319          $fail;
320      };;
321  };
322
323RFP-Parse-Args (e.files) (e.prevarg) s.index =
324{
325  <Arg s.index> : v.arg, <"+" s.index 1> :: s.index =
326    {
327      e.prevarg : v, e.prevarg :
328        {
329          IPATH = <Store &RFP-Include-Path <? &RFP-Include-Path> (v.arg)>;
330          COMP-ITEM =
331            {
332              <Lookup &RFP-Options ITEMS>;
333              /*empty*/;
334            } :: e.items,
335            <Bind &RFP-Options (ITEMS) (e.items <Make-Name v.arg>)>;
336          NAME =
337            {
338              v.arg : '-' = &StdOut;
339              v.arg;
340            } :: v.arg,
341            <Bind &RFP-Options (NAME) (v.arg)>;
342        },
343        <RFP-Parse-Args (e.files) () s.index>;
344      v.arg : '-' e.opt =
345        {
346          \{
347            <? &Options> : e ((e (e.opt) e) t.action e) e = t.action;
348            e.opt : '-' e.o,
349              <? &Options> : e ((t e (e.o) e) t.action e) e = t.action;
350          } : {
351            (BIND s.option) = <Bind &RFP-Options (s.option) ()>;
352            HELP = <Bind &RFP-Options (HELP) ()>, <Display-Help>;
353            s.other = s.other;
354          } :: e.prevarg,
355            <RFP-Parse-Args (e.files) (e.prevarg) s.index>;
356          <PrintLN! &StdErr "Unknown option \"-" e.opt "\"">,
357            <RFP-Parse-Args (e.files) () s.index>;
358        };
359      <RFP-Parse-Args (e.files (v.arg)) () s.index>;
360    };
361  {
362    \{
363      <In-Table? &RFP-Options CC>;
364      <In-Table? &RFP-Options HH>;
365      <In-Table? &RFP-Options AS-REFAL>;
366      <In-Table? &RFP-Options AS-TRANSFORMED>;
367      <In-Table? &RFP-Options AS-AIL>;
368      <In-Table? &RFP-Options CHECK>;
369    };
370    <Bind &RFP-Options (CC) ()> <Bind &RFP-Options (HH) ()>;
371  },
372    e.files;
373};
374
375RFP-Set-Path =
376  {
377    <In-Table? &RFP-Options CASE-INSENSITIVE> = &RFP-Default-Ci-Include-Path;
378    &RFP-Default-Include-Path;
379  } :: e.def-path,
380  <Store &RFP-Include-Path <? &RFP-Include-Path> e.def-path>;
381
382Get-Ready-To-Work e.Items =
383  <RFP-Clear-Table &Fun>,
384  <RFP-Clear-Table &Fun?>,
385  <RFP-Clear-Table &Const>,
386  <RFP-Clear-Table &Object>,
387  {
388    e.Items : e t.Item e,
389      t.Item : (s.Linkage s.ItemType t.Pragma t.ItemName e.ItemBody),
390      s.ItemType : {
391        FUNC =
392          <Left 0 2 e.ItemBody> : (e.in) (e.out),
393          &Fun (<Format-Exp e.in>) (<Format-Exp e.out>);
394        FUNC? =
395          <Left 0 2 e.ItemBody> : (e.in) (e.out),
396          &Fun? (<Format-Exp e.in>) (<Format-Exp e.out>);
397        CONST = &Const e.ItemBody;
398        s = &Object e.ItemBody;
399      } :: s.tab e.ItemDef,
400      <Bind s.tab (t.ItemName) (s.Linkage s.ItemType t.Pragma e.ItemDef)>,
401      $fail;;
402  };
403
404RFP-Pretty-Print s.channel (e.indent) e.expr = e.expr :
405  {
406    e0 (e1) e2 =
407      <Write! s.channel e0>,
408      { e.indent : v = <PrintLN! s.channel>;; },
409      <Print! s.channel e.indent '('>,
410      <RFP-Pretty-Print s.channel (e.indent '  ') e1>,
411      {
412        e1 : e (e) e =
413          <PrintLN! s.channel>,
414          <Print! s.channel e.indent ')'>;
415        <Print! s.channel ')'>;
416      },
417      {
418        e2 : (e) e = ;
419        e2 : , e.indent : v = ;
420        <PrintLN! s.channel>, <Print! s.channel e.indent>;
421      },
422      <RFP-Pretty-Print s.channel (e.indent) e2>;
423    v1 =
424      <Write! s.channel v1>;
425    =;
426  };
427
428$const Tab = '  ';
429
430CPP-Pretty-Print s.inner-call? s.channel (e.indent) e.expr, e.expr : {
431  e0 (e1) e2 =
432    { s.inner-call? : 0 = <PrintLN! s.channel>;; },
433    {
434      e0 : /*empty*/, {
435        e1 : LABEL e.label =
436          e.indent : e.ind &Tab,
437          <PrintLN! s.channel e.ind e.label>;
438        <CPP-Pretty-Print 1 s.channel (e.indent) e1>;
439      };
440      <PrintLN! s.channel e.indent e0>,
441        <CPP-Pretty-Print 1 s.channel (e.indent &Tab) (e1)>;
442    },
443    <CPP-Pretty-Print s.inner-call? s.channel (e.indent) e2>;
444  v1 = <PrintLN! s.channel e.indent v1>;
445  /*empty*/ = /*empty*/;
446};
447
448Verbose e.string, {
449  <In-Table? &RFP-Options VERBOSE> =
450    <PrintLN <Time> ": " e.string>;;
451};
452
453Open-Channel {
454  symbol (e), <Channel? symbol> = symbol 0;
455  e.name (e.ext) =
456    <Channel> :: s.channel,
457    {
458      <Open-File s.channel e.name e.ext W> =
459        s.channel 0; // When we need to close channel ???
460      <PrintLN! &StdErr "Error: cannot open file " e.name e.ext " for writing">,
461        <Exit 1>, $fail;
462    };
463};
464
465Find-Includes =
466  <Box> :: s.includes,
467  {
468    <Domain &RFP-Sources> : e (s.idx) e,
469      <Lookup &RFP-Sources s.idx> : e.full-name '.rfi',
470      {
471        <? &RFP-Include-Path> : e (e.path) e,
472          e.full-name : e.path &RFP-Dir-Separator e.name =
473          <Put s.includes ('<refal/' e.name '.hh>')>;
474        <RFP-Dir-Name <RFP-Source-File-Name 1>> : e.path,
475          e.full-name : e.path &RFP-Dir-Separator e.name =
476          <Put s.includes ('"' e.name '.hh"')>;
477        <Put s.includes ('"' e.full-name '.hh"')>;
478      },
479      $fail;;
480  },
481  <? s.includes>;
482
Note: See TracBrowser for help on using the repository browser.