// // Copyright (C) 1999, 2000 Refal+ Development Group // // Refal+ is free software; you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation; either version 2 of the License, or // (at your option) any later version. // // Refal+ is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with Refal+; if not, write to the Free Software // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA // // $Source$ // $Revision$ // $Date$ // rfpc.rfi $use "rfp_src"; // rfp_src.rfi $use "rfp_err"; // rfp_err.rfi $use "rfp_lex"; // rfp_lex.rfi $use "rfp_parse"; // rfp_parse.rfi $use "rfp_compile"; // rfp_compile.rfi $use "rfp_asail_cpp"; //rfp_asail_cpp.rfi $use "rfp_asail_java"; //rfp_asail_java.rfi $use "rfp_asail_tpp"; //rfp_asail_tpp.rfi $use "rfp_as2as"; $use "rfp_check"; $use "rfp_helper"; $use "rfp_format"; $use "rfp_asail_optim"; //rfp_asail_optim.rfi $use "rfp_asail2asail"; $use Access Arithm Box Class Compare Convert CppMangle File JavaMangle Dos List Table StdIO; $const RevDate = ('$Revision$') ('$Date$'); $func Version = e.version; // information about available compiler options $box Options; // put information about compiler options in the &Options box $func Init-Options = ; // display help screen $func Display-Help = ; $func RFP-Parse-Args (e.files) (e.prevarg) s.index = e.files; $func RFP-Set-Path = ; // initialize tables $func Get-Ready-To-Work e.Items = ; $func CPP-Pretty-Print s.inner-call? s.channel (e.indent) e.expr = ; // print information about compilation stages when -verbose option was // supplied on command line $func Verbose e.string = ; $func Open-Channel e.name (e.ext) = s.channel s.need-close?; $table Includes; $func Extract-Inputs e.items = e.items; $func? Compilation-Failed = ; Main = , :: e.files, , , , : s.dir-separator, // , e.files : { /*empty*/ = { ; >, 'Usage: rfpc' :: e.start, :: s.st-len, , :: s.len, , { : e (((e.next) e) t e.descr) e, <"<=" () (3)>, { e.descr : (e.arg) e = ' [-' e.next ' <' e.arg '>]'; ' [-' e.next ']'; } :: e.next, :: s.n-len, <"+" > s.n-len> :: s.new, { <">" (s.new) (64)> = >, , >; ; }, , $fail; ; }, , ; }; e01 (e.file) e02, { e.file : $r e.basename '.' e.ext = e.basename (' .' e.ext); e.file (); } :: e.in-basename (e.ext), { e01 : /*empty*/, ; e.in-basename; } :: e.basename, { e.basename : $r e.dirname s.dir-separator e.filename = (e.dirname) e.filename; () e.basename; } :: (e.dirname) e.filename, { = e.in-basename; e.basename; } :: e.headname, :: e.headname, > :: e.headname, { e.ext : \{ ' .rf'; ' .rfi'; } = , :: e.tokens, , :: t.as, , AS-REFAL t.as; e.ext : ' .asr' = :: s.channel, , AS-REFAL ; e.ext : ' .ast' = :: s.channel, , AS-TRANSFORMED ; e.ext : ' .asi' = :: s.channel, , AS-AIL (AS-AIL AS-AIL ); = ; } : s.type (s.tag t.ModuleName e.Items), { s.type : AS-AIL; ; }, s.type e.Items $iter s.type : { AS-REFAL = { = :: s.channel s.need-close?, , { s.need-close? : 1 = ;; };; }, \{ : 0; ; }, { ; , , = \{ : 0; ; }; }, \{ ; ; ; ; ; ; }, { = e.Items; , :: e.Items, , e.Items; } :: e.Items, AS-TRANSFORMED e.Items; AS-TRANSFORMED = { = :: s.channel s.need-close?, , { s.need-close? : 1 = ;; };; }, \{ ; ; ; ; ; }, , : (INTERFACE e.interf) (MODULE e.module), , AS-AIL (INTERFACE t.ModuleName e.interf) (MODULE t.ModuleName e.module); AS-AIL = { = :: s.channel s.need-close?, { e.Items : e t.item e, , $fail;; }, { s.need-close? : 1 = ;; };; }, \{ , e.Items : (INTERFACE t.asail-mod-name v.headers) e, , :: e.headers, , :: s.channel s.need-close?, , , '>, , , { s.need-close? : 1 = ;; }, { , # , :: e.lowname, # \{ e.filename : e.lowname; } = e.basename : e.dir e.filename, e.dir e.lowname :: e.lowbase, :: s.channel s.need-close?, :: e.headname, > :: e.headname, , , '>, , , , , { s.need-close? : 1 = ;; };; }, $fail; , e.Items : e (MODULE t.asail-mod-name v.module), :: e.module, { = e.module; , :: e.module, // :: e.module, = e.module; } :: e.module , , :: e.module, , :: s.channel s.need-close?, '>, { : e (e.include) e, : \{ BOOT e = ''; LOCAL e.path = '"'e.path e.include'.hh"'; } :: e.include, , $fail;; }, , { s.need-close? : 1 = ;; }, $fail; , e.Items : e (MODULE t.asail-mod-name v.module), :: e.module, { = e.module; , :: e.module, // :: e.module, = e.module; } :: e.module , , :: e.module, , :: s.channel s.need-close?, '>, { : e (e.include) e, : \{ BOOT e = ''; LOCAL e.path = '"'e.path e.include'.hh"'; } :: e.include, , $fail;; }, , { s.need-close? : 1 = ;; }, $fail; , e.Items : (INTERFACE t.asail-mod-name e.headers) (MODULE t e.module), :: e.module, { = e.module; , // :: e.module, :: e.module, { e.module : e t.item e, // , $fail;; }, = e.module; } :: e.module, , { e.headers (/*e.exports*/) $iter { e.headers : (s.decl t.name) e.rest = e.rest (e.exports t.name); } :: e.headers (e.exports), e.headers : /*empty*/ = e.exports; } :: e.exports, :: (e.java-module-name) (e.inputs) e.module, , { = e.basename; e.dirname : v = e.dirname s.dir-separator e.java-module-name; e.java-module-name; } :: e.java-module-name, :: s.channel s.need-close?, { : e (e.dir) e, e.dirname : \{ e.dir = /*empty*/; e.dir s.dir-separator e.package = e.package; }; e.dirname; } :: e.package, { e.package : v = ';\n'>;; }, , { e.inputs : e (v.java-module) e, \{ : \{ BOOT e = 'org.refal.plus.library.'v.java-module; LOCAL e.path, : e (e.dir) e, e.path : \{ e.dir = /*empty*/; e.dir s.dir-separator e.p = e.p; } :: e.p, >; }; v.java-module; } :: e.java-module, \{ e.java-module : e '.' e; }, , $fail;; }, , { s.need-close? : 1 = ;; }, $fail; }; } :: s.type e.Items, $fail; e.all-files-have-gone; }; Init-Options = to the list of directories to be searched" "for .rfi files") ((('B') ('bootpath')) BPATH ("dir") "add to the list of directories to be searched" "for standard library .rfi files") ((('ne') ('no-elaborate')) (BIND NO-ELABORATE)) ((('nc') ('no-check')) (BIND NO-CHECK) "don't perform syntax check") ((('nt') ('no-transform')) (BIND NO-TRANSFORM) "don't perform AS-to-AS transformations") ((('c') ('check')) (BIND CHECK) "check only, causes no file creation in the absence" "of other output control options") ((('no') ('no-optim')) (BIND NO-OPTIM) "don't perform ASAIL-optimization") ((('ci') ('comp-item')) COMP-ITEM ("item") "compile only, not the whole source" "(may be used several times)") ((('e') ('entry')) ENTRY ("func") "use function as an entry to the program") ((('h') ('help')) HELP /*"display this help screen"*/) ((('v') ('verbose')) (BIND VERBOSE) "display information about the stages of compilation") ((('u')) (BIND CASE-INSENSITIVE) "convert all symbol-words without surrounding quotes" "to upper case") ((('o')) NAME ("name| - ") "place outputs for file1 into files .* or send" "them to stdout") ((('cc')) (BIND CC) "output C++ code") ((('hh')) (BIND HH) "generate header files") ((('j') ('java')) (BIND JAVA) "output Java code") ((('t') ('t++')) (BIND TPP) "output T++ code") ((('asr') ('as-refal')) (BIND AS-REFAL) "output Refal Abstract Syntax") ((('ast') ('as-transformed')) (BIND AS-TRANSFORMED) "output Refal Abstract Syntax after AS-to-AS" "transformations") ((('asi') ('as-ail')) (BIND AS-AIL) "output Abstract Syntax of Abstract Imperative" "Language") ((('int')) INT ("class_name") "class to use for literal integers") ((('replace-module')) REPLACE-MODULE ("m1" "m2") "use module instead of ") ((('d') ('debug')) (BIND DEBUG)) ((('dbg')) (BIND DBG) "generate text for debugger") ((('trace')) TRACE ("fname") "trace function (may be used several times)") ((('traceall')) (BIND TRACEALL) "trace all functions") >; Display-Help = :: s.line, ' ' :: e.start1, 29 :: s.2nd-col, :: e.start2, >, , , , , { : e (((e.op) e.opts) t e.descr) e, , { e.opts : e (e.next) e, , $fail;; }, { e.descr : (e.params) e.rest = { e.params : e s.par e, '>'>, $fail; e.rest; }; e.descr; } : \{ s.phrase e, >> ' '> s.phrase >, $fail; e s s.phrase e, , $fail; };; }; RFP-Parse-Args (e.files) (e.prevarg) s.index = { : v.arg, <"+" s.index 1> :: s.index = : s.dir-separator, { e.prevarg : v, e.prevarg : { IPATH = (v.arg)>, { $iter # \{ : e1 (e2 s.dir-separator), ; }; }; BPATH = (v.arg)>, { $iter # \{ : e1 (e2 s.dir-separator), ; }; }; COMP-ITEM = { ; /*empty*/; } :: e.items, )>; ENTRY = { ; /*empty*/; } :: e.entries, )>; TRACE = ) ()>; NAME = { v.arg : '-' = &StdOut; v.arg; } :: v.arg, ; INT = ; REPLACE-MODULE = REPLACE-MODULE-2 v.arg; REPLACE-MODULE-2 e.mod1 = ; } :: e.prevarg, ; v.arg : '-' e.opt = { \{ : e ((e (e.opt) e) t.action e) e = t.action; e.opt : '-' e.o, : e ((e (e.o) e) t.action e) e = t.action; } : { (BIND s.option) = ; HELP = , ; s.other = s.other; } :: e.prevarg, ; , ; }; ; }; e.prevarg : v = , ; { \{ ; ; ; ; ; ; ; ; }; ; }, e.files; }; RFP-Set-Path = &RFP-Default-Include-Path>, >; Get-Ready-To-Work e.Items = , , , , , { e.Items : e t.Item e, t.Item : \{ (s.Linkage s.ItemType t.Pragma t.ItemName e.ItemBody), s.ItemType : { FUNC = : (e.in) (e.out), &Fun () (); TFUNC = : (e.in) (e.out), &Fun () (); FUNC? = : (e.in) (e.out), &Fun? () (); CONST = &Const e.ItemBody; s = &Object e.ItemBody; } :: s.tab e.ItemDef, ; (EXTERN t.Pragma t.FName) = ; }, $fail; { = , ;; }; }; RFP-Pretty-Print s.channel (e.indent) e.expr = e.expr : { e0 (e1) e2 = , { e.indent : v = ;; }, , , { e1 : e (e) e = , ; ; }, { e2 : (e) e = ; e2 : , e.indent : v = ; , ; }, ; v1 = ; =; }; $const Tab = ' '; CPP-Pretty-Print s.inner-call? s.channel (e.indent) e.expr, e.expr : { e0 (e1) e2 = { s.inner-call? : 0 = ;; }, { e0 : /*empty*/, { e1 : LABEL e.label = e.indent : e.ind &Tab, ; e1 : /*empty*/ = ; ; }; , ; }, ; v1 = ; /*empty*/ = /*empty*/; }; Verbose e.string, { = ": " e.string>;; }; Open-Channel { symbol (e), = symbol 0; e.name (e.ext) = :: s.channel, { = s.channel 1; // When we need to close channel ??? , , $fail; }; }; Extract-Inputs { (INPUT (e.mod-name) e.file-name) e.items, : s.dir-separator, { e.file-name : $r e.path s.dir-separator e.name, { : e (e.path e.rest) e \? { e.rest : e1 s2 e3 \? { s2 : s.dir-separator \! $fail; \!\! $fail; }; ; }; { e.path : '.' = /*empty*/; e.path : '.' s.dir-separator e.rest, { e.rest : e1 s2 e3, # \{ s2 : s.dir-separator; } = s2 e3 s.dir-separator; /*empty*/; }; e.path s.dir-separator; } :: e.path, ; }; ; }, ; e.items = { = ;; }, e.items; }; Compilation-Failed = ; Version = { &RevDate : (e ' ' v.rev ' ' e) (e ' ' v.date ' ' e) = '2.0-beta-' v.rev ', ' v.date; '2.0-unknown-beta'; };