Changeset 683


Ignore:
Timestamp:
Apr 27, 2003, 6:32:36 PM (18 years ago)
Author:
orlov
Message:
  • Main compiler loop has been rewritten in a much more clear way with a lot of

comments.

  • Variable uses analysis is temporarily removed to reappear in the as2as

transformations phase.

  • Constant expressions are compiled into static objects rather then variables

as was before.

  • Difference between R+ and R6 notions for = is supported on the level of AS.

R6 = should be parsed in NOFAIL. For supplying R+ = abstract syntax terms
BLOCK, BLOCK?, and CUTALL are provided.

  • Yet, compilation of cyclic clashes DOESN'T WORK. So nothing interesting can be compiled by this version. Use previous one for that purposes.
Location:
to-imperative/trunk/compiler
Files:
4 added
16 edited

Legend:

Unmodified
Added
Removed

  • to-imperative/trunk/compiler/Makefile

    r639 r683  
    2121  rfp_mangle \
    2222  reserved-c++ \
     23  rfp_vars \
     24  rfp_const \
    2325  rfp_asail_optim
    2426

  • to-imperative/trunk/compiler/rfp_as2as.rf

    r222 r683  
    88$use "rfp_list";
    99$use "rfp_helper";
     10$use "rfp_vars";
    1011
    1112$use Arithm Class StdIO Table;
    … …  
    7475 */
    7576Unstick-Blocks e.Sentence, e.Sentence : eL e.Snt, e.Snt : \{
    76   (BLOCK t.Pragma e.branches) eR =
     77  (s.block t.Pragma e.branches) eR, s.block : \{ BLOCK; BLOCK?; } =
    7778    e.branches () () $iter {
    7879      e.branches : (BRANCH t.p e.branch) e.rest,
    … …  
    8485    {
    8586      eR : \{
    86         (BLOCK t (BRANCH t (LEFT e) e) e) e;
    87         (BLOCK t (BRANCH t (RIGHT e) e) e) e;
    88         NOFAIL (BLOCK t (BRANCH t (LEFT e) e) e) e;
    89         NOFAIL (BLOCK t (BRANCH t (RIGHT e) e) e) e;
     87        (BLOCK  t (BRANCH t (LEFT e) e) e) e;
     88        (BLOCK  t (BRANCH t (RIGHT e) e) e) e;
     89        (BLOCK? t (BRANCH t (LEFT e) e) e) e;
     90        (BLOCK? t (BRANCH t (RIGHT e) e) e) e;
    9091      } =
    91         <Gener-Vars 0 (<MSG e.Fes>) "aux" "block"> :: e.aux s,
    92         eL (BLOCK t.Pragma e.br) (FORMAT e.aux) (RESULT e.aux) <Unstick-Blocks eR>;
     92        <Gener-Var-Indices 1 (<MSG e.Fes>) "aux" "block"> :: e.aux s,
     93        eL (s.block t.Pragma e.br) (FORMAT e.aux)
     94        (RESULT e.aux) <Unstick-Blocks eR>;
    9395      eR : /*empty*/ =
    94         eL (BLOCK t.Pragma e.br) (<MSG e.Fes>);
    95       eL (BLOCK t.Pragma e.br) <Unstick-Blocks eR>;
     96        eL (s.block t.Pragma e.br) (<MSG e.Fes>);
     97      eL (s.block t.Pragma e.br) <Unstick-Blocks eR>;
    9698    };
    9799  (RESULT t.Pragma e.Re) =
    … …  
    129131  } :: (e.Pe) e.Snt =
    130132    {
    131       <Format-Exp e.Pe> : e.in,
     133      <Format-Exp e.Pe> : e.in,  // FIXME: here should be checked format equality
    132134        <Vars e.Pe> :: e.args,
    133135        # \{ e.args : e (e t1) e (e t1) e; } =
    134136        (e.Pe) e.Snt;
    135       <Gener-Vars 0 (e.in) "arg"> :: e.in-expr s =
     137      <Gener-Var-Indices 1 (e.in) "arg"> :: e.in-expr s =
    136138        (e.in-expr) (RESULT (PRAGMA) e.in-expr) e.Sentence;
    137139    };
    … …  
    140142   * branch. Input parameters for the function will be arg_1...arg_N. If
    141143   * first pattern in the branch satisfies the conditions then drop it out
    142    * and rename variables in the branch to arg_1...arg_N istead of pattern
     144   * and rename variables in the branch to arg_1...arg_N instead of pattern
    143145   * variables.
    144146   */
    145   e.Sentence : e.NOFAIL (BLOCK t.Pragma e.branches) e.Snt =
    146     <Gener-Vars 0 (e.in) "arg"> :: e.in-expr s,
     147  e.Sentence : (s.block t.Pragma e.branches) e.Snt =
     148    <Gener-Var-Indices 1 (e.in) "arg"> :: e.in-expr s,
    147149    <Vars e.in-expr> :: e.in-vars,
    148150    (/*e.br*/) e.branches $iter {
    149151      e.branches : (BRANCH t.p (s.dir t.pp e.Pe) e.br-snt) e.rest, {
    150         <Format-Exp e.Pe> : e.in,
     152        <Format-Exp e.Pe> : e.in,  // FIXME: here should be checked format equality
    151153          <Vars e.Pe> :: e.vars,
    152154          # \{ e.vars : e (e t1) e (e t1) e; } =
    … …  
    158160    } :: (e.br) e.branches,
    159161    e.branches : /*empty*/ =
    160     (e.in-expr) e.NOFAIL (BLOCK t.Pragma e.br) e.Snt;
     162    (e.in-expr) (s.block t.Pragma e.br) e.Snt;
    161163  /*
    162164   * Else sentence already hasn't begun with pattern, so left it as it is.
    163165   * It can be only if e.in and e.out are both empty.
    164166   */
    165   (e.in) e.Sentence;
     167//!     (e.in) e.Sentence;
    166168} :: (e.in) e.Sentence =
    167   <Gener-Vars 0 (e.out) "res"> :: e.out s,
     169//  <Gener-Var-Indices 1 (e.out) "res"> :: e.out s,
    168170  (e.in) (e.out) e.Sentence;
    169171
    … …  
    210212       * block).
    211213       */
    212       t.Statement : (BLOCK t.Pragma e.branches) =
     214      t.Statement : (s.block t.Pragma e.branches), s.block : \{ BLOCK; BLOCK?; } =
    213215        e.rest : {
    214216          (LEFT t e.Pe) e = <Vars e.Pe>;
    … …  
    231233        <Map &Rename-Vars <"+" s.num 1> (e.vars) (e.brv) (e.branches)>
    232234          :: e.branches,
    233         (e.vars) (e.new-Snt (BLOCK t.Pragma e.branches)) e.rest;
     235        (e.vars) (e.new-Snt (s.block t.Pragma e.branches)) e.rest;
    234236      t.Statement : (BRANCH t.Pragma e.Sentence) =
    235237        () (e.new-Snt (BRANCH t.Pragma
    … …  
    293295  () ();
    294296};
     297
     298
     299/////////////////////////// Varibles Using Analysis /////////////////////////
     300//
     301//$func Post-Comp (e.used-vars) e.comp-func = (e.used-vars) e.result-func;
     302//
     303//Post-Comp (e.used-vars) e.comp-func, e.comp-func : {
     304//  /*
     305//   * As well as "Used" shouldn't be "Declare" statements added?
     306//   */
     307//  e.something (Used e.vars) =
     308//    <Post-Comp (<Or (e.used-vars) e.vars>) e.something>;
     309//  e.something (If-used (e.vars) e.statements), {
     310//    <Split &Elem? e.vars (e.used-vars)> : (v.true-used) (e.yet-not-used) =
     311//      <Post-Comp (v.true-used) e.statements> :: (e.expr-vars) e.expr,
     312//      <Post-Comp (<Or (e.yet-not-used) e.expr-vars>) e.something> e.expr;
     313//    <Post-Comp (e.used-vars) e.something>;
     314//  };
     315//  e.something (e.expr) =
     316//    <Post-Comp (e.used-vars) e.expr> :: (e.expr-vars) e.expr,
     317//    <Post-Comp (e.expr-vars) e.something> (e.expr);
     318//  e.something s.symbol =
     319//    <Post-Comp (e.used-vars) e.something> s.symbol;
     320//  /*empty*/ = (e.used-vars);
     321//};
     322
    295323
    296324/////////////////////////// Static Clash Analysis ///////////////////////////

  • to-imperative/trunk/compiler/rfp_asail.rf

    r662 r683  
    33// $Date$
    44
    5 $use Apply Box Class Convert StdIO Table;
     5$use Apply Box Class Compare Convert StdIO Table;
    66$use "rfpc";
    77$use "rfp_helper";
    … …  
    99$use "rfp_mangle";
    1010
     11$box Module-Name;
     12
    1113$box Func-Names;
    1214
    … …  
    3537$func Symbol-To-CPP s.RFP-Symbol = e.CPP-String;
    3638
    37 $func Chars-To-CPP e.expr = e.CPP-String;
    38 
    3939$func Name-To-CPP t.name = e.CPP-Name;
    4040
    … …  
    4646
    4747RFP-ASAIL-To-CPP (e.ModuleName) e.asail =
     48  <Store &Module-Name e.ModuleName>,
    4849  <Store &Func-Names /*empty*/>,
    4950  <Store &Current-Namespace /*empty*/>,
    5051  <Store &Entry (e.ModuleName Main)>,
    5152  <Store &Entry-Name /*empty*/>,
    52   { 
    53      <ASAIL-To-CPP e.asail> : v.cpp,
     53  {
     54    <ASAIL-To-CPP e.asail> : v.cpp,
    5455      {
    5556        <? &Current-Namespace> : v = ('}');;  // close last namespace
    … …  
    7677
    7778ASAIL-To-CPP e.asail, {
    78   e.asail : t.item e.rest,
    79 // <PrintLN ' $$$$$ ' t.item '%%%%%%'>,
    80 t.item : {
     79  e.asail : t.item e.rest, t.item : {
    8180    (FUNC t.name (e.args) (e.ress) e.body) =
    8281      <Put &Func-Names t.name>,
    … …  
    9493    (FOR (e.label) (e.cond) (e.step) e.body) =
    9594      {
    96         e.label : /*empty*/ = /*empty*/;
    97         (LABEL <Rfp2Cpp (LABEL e.label)> ': {}');
     95        e.label : t = (LABEL <Rfp2Cpp (LABEL e.label)> ': {}');;
    9896      } :: e.label,
    9997      ('for ( ; ' <Cond-To-CPP e.cond> '; ' <Step-To-CPP e.step> ')')
    … …  
    10199    (LABEL (e.label) e.body) =
    102100      {
    103         e.label : /*empty*/ = ('{' (<ASAIL-To-CPP e.body>) '}' );
     101        e.label : /*empty*/ =
     102          ('{' (<ASAIL-To-CPP e.body>) '}' );
    104103        ('{' (<ASAIL-To-CPP e.body>) '}')
    105           (LABEL <Rfp2Cpp (LABEL (e.label))> ': {}');
     104        (LABEL <Rfp2Cpp (LABEL (e.label))> ': {}');
    106105      };
    107106    (TRY e.body) =
    … …  
    123122      (s.type ' ' <Rfp2Cpp t.var> ';');
    124123    (EXPR t.var e.expr) =
    125       ('Expr ' <Rfp2Cpp t.var> ' (' <Chars-To-CPP e.expr> ');');
     124      ('Expr ' <Rfp2Cpp t.var> ' (' <Expr-Ref-To-CPP 0 e.expr> ');');
    126125    (DEREF t.var e.expr (e.pos)) =
    127126      ('Expr ' <Rfp2Cpp t.var> ' (' <Expr-Ref-To-CPP 0 e.expr> ', '
    … …  
    139138    (ERROR e.expr) =
    140139      ('error (' <Expr-Ref-To-CPP 0 e.expr> ');');
    141     (CONSTEXPR t.name e.expr) =
     140    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
     141      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
     142      {
     143        t.name : (STATIC e) = (<? &Module-Name>) t.name;
     144        <RFP-Extract-Qualifiers t.name>;
     145      } :: (e.qualifiers) e.name,
     146      <Namespace-Control e.qualifiers>
     147      (e.linkage 'const Expr ' <Rfp2Cpp e.name> ' = '
     148        <Const-Expr-To-CPP e.expr> ';');
     149    (DECL-CONST t.name) =
    142150      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
    143151      <Namespace-Control e.qualifiers>
    144       ('const Expr ' <Rfp2Cpp e.name> ' = ' <Const-Expr-To-CPP e.expr> ';');
     152      ('extern const Expr ' <Rfp2Cpp e.name> ';');
    145153    (DECL-FUNC t.name) =
    146154      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
    … …  
    154162      '(' <Args-To-CPP () Exprs e.exprs> '), (' <Args-To-CPP () Vars e.ress> '));');
    155163  } :: e.cpp-item,
    156 //    <PrintLN e.cpp-item>,
    157164    e.cpp-item <ASAIL-To-CPP e.rest>;
    158165  /*empty*/;
    … …  
    164171Expr-To-CPP  (e.init) e.expr-all, e.expr-all : {
    165172  /*empty*/ = <Expr-Ref-To-CPP 0 e.init>;
    166   (VAR (e.QualifiedName)) e.rest =
    167     <Expr-To-CPP (e.init (VAR (e.QualifiedName))) e.rest>;
    168   s.ObjectSymbol e.rest, {
    169     <Int? s.ObjectSymbol> = <Expr-Int-To-CPP e.init e.expr-all>;
    170     <Expr-Ref-To-CPP 0 e.expr-all>;
    171   };   
     173//  s.ObjectSymbol e.rest, {
     174//    <Int? s.ObjectSymbol> = <Expr-Int-To-CPP e.init e.expr-all>;
     175//    <Expr-Ref-To-CPP 0 e.expr-all>;
     176//  };   
    172177  (PAREN e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
    173178  (EXPR e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
    … …  
    178183  (MIN e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;
    179184  (INFIX s.op e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;
     185  (s.var-tag (e.QualifiedName)) e.rest =
     186    <Expr-To-CPP (e.init (s.var-tag (e.QualifiedName))) e.rest>;
    180187};
    181188
    … …  
    187194    } :: e.plus,
    188195    t.item : {
    189       s.ObjectSymbol = <Symbol-To-CPP s.ObjectSymbol>;
    190       (PAREN e.expr) = <Expr-Ref-To-CPP 0 e.expr> ' ()';
     196//      s.ObjectSymbol = <Symbol-To-CPP s.ObjectSymbol>;
     197      (PAREN e.expr) =
     198        {
     199          e.expr : t t e = '(' <Expr-Ref-To-CPP 0 e.expr> ') ()';
     200          <Expr-Ref-To-CPP 0 e.expr> ' ()';
     201        };
    191202      (EXPR e.expr) =
    192         'Expr (' <Chars-To-CPP e.expr> ')';
     203        'Expr (' <Expr-Ref-To-CPP 0 e.expr> ')';
    193204      (DEREF e.expr (e.pos)) =
    194205        'Expr (' <Expr-Ref-To-CPP 0 e.expr> ', '
    … …  
    197208        'Expr (' <Expr-Ref-To-CPP 0 e.expr> ', '
    198209             <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
    199       (VAR (e.QualifiedName)) = <Rfp2Cpp (VAR (e.QualifiedName))>;
     210      (s.var-tag (e.QualifiedName)) = <Rfp2Cpp t.item>;
    200211      ex = $error ("Illegal type ref-expr : " ex );
    201212    } :: e.cpp-item,
    … …  
    217228      s.ObjectSymbol =
    218229        {
    219           <Int? s.ObjectSymbol> = <Symbol-To-CPP s.ObjectSymbol>;
     230          <Int? s.ObjectSymbol> = s.ObjectSymbol;
    220231          $error ("Illegal type int-symbol: " s.ObjectSymbol);
    221232        };
    … …  
    228239      (INFIX s.op e.args) =
    229240        '(' <Infix-To-CPP &Expr-Int-To-CPP s.op e.args> ')';
    230       (VAR (e.QualifiedName)) = <Rfp2Cpp (VAR (e.QualifiedName))>;
     241      (s.var-tag (e.QualifiedName)) = <Rfp2Cpp t.item>;
    231242      ex = $error ("Illegal type ref-int : " ex );
    232243    } :: e.cpp-item,
    … …  
    294305};
    295306
     307
     308
     309$func Const-Expr-Aux e.expr = e.cpp-expr;
     310
    296311Const-Expr-To-CPP {
    297312  /*empty*/ = 'empty';
     313  (SUBEXPR t.name s.pos s.len) = 'Expr (' <Rfp2Cpp t.name> ', ' s.pos ', ' s.len ')';
     314                  //FIXME: надо проверять, что s.pos и s.len
     315                  //       не превышают допустимых величин.
     316                  //       Задавать эти величины опциями.
    298317  e.expr =
    299     {
    300       e.expr : (e) e = /*empty*/;
    301       '(Expr) ';
    302     } :: e.cpp-expr,
    303     e.expr (e.cpp-expr) $iter {
    304       e.expr : t.item e.rest,
    305       {
    306         e.rest : v = ' + ';
    307         /*empty*/;
    308       } :: e.plus,
    309         t.item : \{
    310           (PAREN e.paren-expr) =
    311             '(' <Const-Expr-To-CPP e.paren-expr> ') ()';
    312           (REF (e.QualifiedName)) =
    313             <Name-To-CPP (e.QualifiedName)>;
    314         } :: e.cpp-item =
    315         e.rest (e.cpp-expr e.cpp-item e.plus);
    316       e.expr : e.chars (e1) e2 =
    317         (e1) e2 (e.cpp-expr <Chars-To-CPP e.chars> ' + ');
    318       /*empty*/ (e.cpp-expr <Chars-To-CPP e.expr>);
    319     } :: e.expr (e.cpp-expr),
    320     e.expr : /*empty*/ =
    321     e.cpp-expr;
    322 };
     318    <Const-Expr-Aux () e.expr> : {
     319      ' + ' e.cpp-expr = e.cpp-expr;
     320      e.cpp-expr = e.cpp-expr;
     321    };
     322};
     323
     324Const-Expr-Aux (e.accum) e.expr, {
     325  e.expr : s.sym e.rest, <Char? s.sym> =
     326    <Const-Expr-Aux (e.accum <Symbol-To-CPP s.sym>) e.rest>;
     327  e.accum : v =
     328    ' + Char::create_expr ("' e.accum '")' <Const-Expr-Aux () e.expr>;
     329  e.expr : t.item e.rest, t.item : {
     330    (PAREN e.paren-expr) =
     331      ' + (' <Const-Expr-To-CPP e.paren-expr> ') ()';
     332    (REF (e.QualifiedName)) =
     333      ' + ' <Name-To-CPP (e.QualifiedName)>;
     334    (STATIC e) =
     335      ' + ' <Rfp2Cpp t.item>;
     336    s.sym, {
     337      <Int? s.sym>, {
     338        <"<" (<Abs s.sym>) (2147483648)> =              //FIXME: значение должно
     339                            //       задаваться опцией.
     340          ' + ShortInt::create_expr (' s.sym ')';
     341        ' + Int::create_expr (' s.sym ')';
     342      };
     343      <Word? s.sym> =
     344        ' + Word::create_expr ("' <Symbol-To-CPP s.sym> '")';
     345    };
     346  } :: e.cpp-item =
     347    e.cpp-item <Const-Expr-Aux () e.rest>;
     348  = /*empty*/;
     349};
     350
     351Symbol-To-CPP s.ObjectSymbol, {
     352  <To-Chars s.ObjectSymbol> () $iter {
     353    e.symbol : s.char e.rest, s.char : {
     354      '\\' = '\\\\';
     355      '\n' = '\\n';
     356      '\t' = '\\t';
     357//        '\v' = '\\v';
     358//        '\b' = '\\b';
     359      '\r' = '\\r';
     360//        '\f' = '\\f';
     361      '\"' = '\\"';
     362      '\'' = '\\\'';
     363      s = s.char;
     364    } :: e.cpp-char,
     365    e.rest (e.cpp-symbol e.cpp-char);
     366  } :: e.symbol (e.cpp-symbol),
     367    e.symbol : /*empty*/ =
     368    e.cpp-symbol;
     369};
     370
     371
    323372
    324373Args-To-CPP {
    … …  
    341390};
    342391
    343 Symbol-To-CPP s.ObjectSymbol, {
    344   <Int? s.ObjectSymbol> = s.ObjectSymbol;
    345   <To-Chars s.ObjectSymbol> () $iter {
    346     e.symbol : s.char e.rest, s.char : {
    347       '\\' = '\\\\';
    348       '\n' = '\\n';
    349       '\t' = '\\t';
    350 //        '\v' = '\\v';
    351 //        '\b' = '\\b';
    352       '\r' = '\\r';
    353 //        '\f' = '\\f';
    354       '\"' = '\\"';
    355       '\'' = '\\\'';
    356       s = s.char;
    357     } :: e.cpp-char,
    358     e.rest (e.cpp-symbol e.cpp-char);
    359   } :: e.symbol (e.cpp-symbol),
    360     e.symbol : /*empty*/,
    361     '\"' e.cpp-symbol '\"';
    362 };
    363 
    364 Chars-To-CPP e.expr = <Symbol-To-CPP <To-Word e.expr>>;
    365 
    366392Name-To-CPP t.obj-name =
    367393  <RFP-Extract-Qualifiers t.obj-name> :: (e.qualifiers) e.name,

  • to-imperative/trunk/compiler/rfp_check.rf

    r222 r683  
    1010$use "rfp_helper";
    1111$use "rfp_list";
     12$use "rfp_vars";
    1213
    1314// verifies that all constructions in e.Sentence have right formats
    … …  
    7879//            <Print-Error Error! Re t.Statement>, $fail;
    7980//          };
    80         (BLOCK t e.Branches) =
    81           {
    82             {
    83               e.Snt : \{ NOFAIL; /*empty*/; } = /*empty*/;
    84               (Comp Branch);
    85             } :: e.pref,
    86               e.Branches : e (BRANCH t e.Snt1) e,
     81        (s.block t e.Branches), s.block : \{ BLOCK; BLOCK?; } =
     82          {
     83            e.Snt : /*empty*/ = /*empty*/;
     84            (Comp Branch);
     85          } :: e.pref,
     86          {
     87            e.Branches : e (BRANCH t e.Snt1) e,
    8788              <Satisfies-Format? (e.InFormat) (e.OutFormat) e.pref e.Snt1>,
    8889              $fail;
    … …  
    103104          <Satisfies-Format? ((EVAR)) (e.OutFormat) t.CatchBlock>,
    104105          e.Snt ();
    105         (s.tag t.Pragma e.PatternExpression), s.tag : \{ LEFT; RIGHT; } = \?
     106        (s.tag t.Pragma e.PatternExpression), s.tag : \{ LEFT; RIGHT; } =
    106107//          {
    107108//            <Subformat? (e.OutFormat) ()>,
    108109              {
    109                 e.Snt : \{ NOFAIL; /*empty*/; },
     110                e.Snt : /*empty*/ =
    110111                  <Format-Exp e.PatternExpression> :: e.PatternFormat,
    111112                  {
    112113                    <Subformat? (e.InFormat) (e.PatternFormat)> =
    113114                      /*empty*/ ();
    114                     <Print-Error Error! Pattern t.Pragma>,
    115                       \! $fail;
     115                    <Print-Error Error! Pattern t.Pragma> = $fail;
    116116                  };
    117117                e.Snt ((EVAR));
    … …  
    119119//            <Print-Error Error! Re t.Statement> \! $fail;
    120120//          };
    121         NOFAIL = e.Snt (e.OutFormat);
     121        NOFAIL = e.Snt ();
    122122        (FAIL t) = e.Snt ();
    123123        (CUTALL t) = e.Snt ();
    … …  
    186186            <Update-Vars Format (e.vars) <Reverse e.He-vars>>;
    187187          };
    188         (LEFT t e.Pe) = <Update-Vars Pattern (e.vars) <Vars e.Pe>>;
     188        (LEFT  t e.Pe) = <Update-Vars Pattern (e.vars) <Vars e.Pe>>;
    189189        (RIGHT t e.Pe) = <Update-Vars Pattern (e.vars) <Vars e.Pe>>;
    190         (BLOCK t e.Branches) =
     190        (s.block t e.Branches), s.block : \{ BLOCK; BLOCK?; } =
    191191          {
    192192            e.Branches : e t.branch e,
    … …  
    258258        { <Print-Error Error! Cut <R 0 <Get-Cuts t.Branch>>>;; },
    259259        e.cuts;
    260       (BLOCK t e.Branches) =
     260      (s.block t e.Branches), s.block : \{ BLOCK; BLOCK?; } =
    261261        () e.Branches $iter {
    262262          e.Branches : t.Branch e.rest =

  • to-imperative/trunk/compiler/rfp_compile.rf

    r420 r683  
    1010$use "rfp_as2as";
    1111$use "rfp_format";
     12$use "rfp_vars";
     13$use "rfp_const";
    1214
    1315$use StdIO;
    … …  
    6971$func Compile (e.targets) (e.headers) e.Items = e.Compiled-Items (INTERFACE e.headers);
    7072
    71 $func Del-Pragmas e.Sentence = e.Sentence;
    72 
    7373$func Print-Pragma s.channel t.Pragma = ;
    7474
    … …  
    8383$func Comp-Func-Stubs = e.asail-funcs;
    8484
    85 $func Parenthesize-Operators e.Snt = e.Snt;
    86 
    87 //$func Paren-Op t.Op = t.Op;
    88 $func Paren-Op e = e;
    89 
    90 //$func Get-Hard ... = (e.hard) e.matchings;
    91 
    9285$func Comp-Func s.tag t.name e.params-and-body = e.compiled-func;
    9386
    94 $func Post-Comp (e.used-vars) e.comp-func = (e.used-vars) e.result-func;
    95 
    9687$func Set-Drops (e.declared-exprs) e.comp-func = (e.declared-exprs) e.result-func;
    9788
    9889$func Comp-Sentence e.Sentence = e.asail-sentence;
    9990
    100 //$func? Not-Ref? t.var = ;
    101 $func? Not-Ref? e = e;
    102 
    103 //$func? Contents-First? e.list (t.item e) = ;
    104 $func? Contents-First? e = e;
    105 
    106 //$func Zip-With-Vars e.col-vars (t.var (e.Re)) =
    107 //  (t.var (e.Re) (e.all-collapsed-vars-from-Re));
    108 $func Zip-With-Vars e = e;
    109 
    110 $func Comp-Ready-Formats e.collapses =
    111   e.compiled-assignments (e.rest-collapses) (e.used-aux-vars);
    112 
    113 //$func? Independent? e.collapses (t.var t.Re t.collapsed-vars) = ;
    114 $func? Independent? e = e;
    115 
    116 //$func Remove-Independ e.independ (t.var t.Re (e.var-list)) =
    117 //  (t.var t.Re (e.new-var-list));
    118 $func Remove-Independ e = e;
    119 
    120 //$func Get-Aux-Indexes (t (e.Re) t) = e.list-of-lists-of-aux-indexes;
    121 $func Get-Aux-Indexes e = e;
    122 
    123 //$func Get-Var-Index t.var = e.aux-index-or-empty;
    124 $func Get-Var-Index e = e;
    125 
    126 //$func Longest-Re e.collapses (t.var t.Re t.col-vars) = (t.var t.Re t.col-vars s.num);
    127 $func Longest-Re e = e;
    128 
    129 //$func Longest-Re-Value t.var (t.var1 t.Re (e.col-vars)) s.value = s.new-value;
    130 $func Longest-Re-Value e = e;
    131 
    132 //$func Next-Collaps e.collapses (t.var t.Re (e.col-vars) s.len) (t.sel-var t t s.sel-len) =
    133 //  (t.new-sel-var t t s.new-sel-len);
    134 $func Next-Collaps e = e;
    135 
    136 //$func Var-To-Len e.collapses t.var = s.len;
    137 $func Var-To-Len e = e;
    138 
    139 //$func Create-Aux t.var t.aux-var (t.var1 (e.Re) (e.col-vars) s.num) = e.collaps-or-empty;
    140 $func Create-Aux e = e;
    141 
    142 //$func Del-Checks s.Vars t.var = ;
    143 $func Del-Checks e = e;
     91$func Save-Snt-State = ;
     92
     93$func Recall-Snt-State = ;
     94
     95$func Pop-Snt-State = ;
     96
     97$func Extract-Calls e.Re = (e.last-Re) e.calls;
     98
     99$func Comp-Static-Exprs e.Reult-exprs = e.Result-exprs;
     100
     101$func Get-Clash-Sequence (e.last-Re) e.Snt = (e.clashes) e.rest-of-the-Sentence;
    144102
    145103$func Comp-Pattern t.Pattern e.Snt = e.asail-Snt;
    … …  
    147105$func? Without-Calls? e.Re = ;
    148106
    149 $func Norm-Vars (e.vars) e.Snt = (e.vars) e.Snt;
    150 
    151107//$func Old-Vars e.expr = e.expr;
    152108
    … …  
    155111//$func? Known-Vars? e.vars = ;
    156112
    157 $func Comp-Clashes (e.clashes) (e.Current-Snt) e.Other-Snts = e.asail-Snt;
     113$func Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence = e.asail-sentence;
    158114
    159115$func? Find-Var-Length e.clashes = e.cond (e.clashes);
    … …  
    195151$func Gener-Label e.QualifiedName = t.label;
    196152
    197 $func Comp-Re e.Re (e.Snt) = e.asail-Snt;
    198 
    199 //$func? Second-Empty? (t.var ()) = ;
    200 $func? Second-Empty? e = e;
    201 
    202 //$func? Good-Res-Var? (t.var (t.F-var)) = ;
    203 $func? Good-Res-Var? e = e;
     153$func Add-To-Label t.label e.name = t.label;
    204154
    205155$func Comp-Calls e.Re = e.calls;
    206156
    207 $func Store-Vars e.vars = e.vars;
    208 
    209 $func Declare-Vars s.type e.vars = e.decls;
    210 
    211 $func Instantiate-Vars e.vars = ;
    212 
    213 $func Comp-Assigns (e.vars) e.expressions = e.assignments;
     157$func Comp-Assigns e.assignments = e.asail-assignments;
     158
     159$func Comp-Format (e.last-Re) e.He = e.assignments;
    214160
    215161$func Get-Static-Exprs e.expr = e.expr (e.decls);
    … …  
    217163$func Get-Static-Var e.expr = e.var (e.decl);
    218164
    219 $func Strip-STVE expr = expr;
    220 
    221 $func Set-Var t.name (e.key) (e.val) = ;
     165
     166
     167************ Get AS-Items and targets, and pass it to Compile ************
    222168
    223169RFP-Compile e.Items =
    224170  { <Lookup &RFP-Options ITEMS>;; } :: e.targets,
     171  <Init-Consts>,
    225172  <Compile (e.targets) () e.Items> :: e.Items t.Interface,
    226   t.Interface (MODULE e.Items);
     173  t.Interface (MODULE <Comp-Consts> e.Items);
     174
     175
     176
     177****************** Choose needed items and compile them ******************
    227178
    228179Compile (e.targets) (e.headers) e.Items, {
    … …  
    234185    }, \{
    235186      t.item : (s.link s.tag t.pragma t.name (e.in) (e.out) e.body) =
     187        <WriteLN s.link s.tag t.name>,
    236188        { s.link : EXPORT = (DECL-FUNC t.name);; } :: e.decl,
    237189        {
    … …  
    241193        (e.decl) e.comp-func;
    242194      t.item : (s.link CONST t.pragma t.name e.expr) =
    243         (CONSTEXPR t.name <Del-Pragmas e.expr>) :: t.const-decl,
    244195        {
    245           s.link : EXPORT = (t.const-decl) /*empty*/;
    246           () t.const-decl;
     196          s.link : IMPORT = () (DECL-CONST t.name);
     197          <Del-Pragmas e.expr> :: e.expr,
     198            (CONSTEXPR s.link t.name (e.expr) e.expr) :: e.const,
     199            {
     200              s.link : EXPORT = (e.const) /*empty*/;
     201              () e.const;
     202            };
    247203        };
    248204    } :: (e.decl) e.item =
    249205    e.item <Compile (e.targets) (e.headers e.decl) e.rest>;
    250206  /*<Comp-Func-Stubs>*/ (INTERFACE e.headers);
    251 };
    252 
    253 Del-Pragmas {
    254   eL t.Item eR, t.Item : \{
    255     (PRAGMA e) = eL <Del-Pragmas eR>;
    256     (expr) = eL (<Del-Pragmas expr>) <Del-Pragmas eR>;
    257   };
    258   e1 = e1;
    259207};
    260208
    … …  
    274222//      <Bind &Fout (t.Fname) ((EVAR))>,
    275223      <Lookup-Func (e.QualifiedName)> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
    276       <Gener-Vars 0 (e.Fin) "stub"> :: e.He s,
     224      <Gener-Vars (e.Fin) "stub"> :: e.He,
    277225      <Comp-Func s.tag t.Fname ((EVAR ("arg" 1))) ((EVAR ("res" 1)))
    278226        (LEFT e.He) (RESULT (CALL (e.QualifiedName) e.He))
    … …  
    290238  <Store &Greater-Ineqs /*empty*/>,
    291239  <Store &Less-Ineqs /*empty*/>,
    292   <RFP-Clear-Table &Var-Tags>,
    293   <RFP-Clear-Table &Vars-Tab>,
     240//!     <RFP-Clear-Table &Vars-Tab>,
     241  <Init-Vars>,
    294242  <Ref-To-Var e.Sentence> :: e.Sentence,
    295   <Store-Vars <Vars e.out>> :: e.res-vars,
     243//!     <Store-Vars <Vars e.out>> :: e.res-vars,
     244  <Vars <Gener-Vars (e.out) "res">> :: e.res-vars,
     245  <Vars-Decl e.res-vars> : e,
    296246  <Store &Res-Vars e.res-vars>,
    297247  <Store &Out-Format <Format-Exp e.out>>,
    298   <Norm-Vars (<Vars e.in>) e.Sentence> :: (e.arg-vars) e.Sentence,
    299   <Declare-Vars Expr e.arg-vars> : e,
    300   <Instantiate-Vars e.arg-vars>,
     248//!     <Norm-Vars (<Vars e.in>) e.Sentence> :: (e.arg-vars) e.Sentence,
     249//!     <Declare-Vars Expr e.arg-vars> : e,
     250  <Vars <Gener-Vars (e.in) "arg">> :: e.arg-vars,
     251  <Vars-Decl e.res-vars> : e,
     252*       <Instantiate-Vars e.arg-vars>,
    301253  <Store &Last-Re /*empty*/>,
    302254  s.tag : {
    303     FUNC = (Comp Fatal);
    304     FUNC? = (Comp Retfail);
     255    FUNC = FATAL;
     256    FUNC? = RETFAIL;
    305257  } :: t.retfail,
    306   (FUNC t.name (e.arg-vars) (e.res-vars)
    307       <Comp-Sentence () e.Sentence (Comp Sentence) t.retfail>
     258  (FUNC t.name (<Vars-Print e.arg-vars>) (<Vars-Print e.res-vars>)
     259    <Comp-Sentence Tail ((t.retfail)) () e.Sentence>
    308260  ) :: e.comp-func,
    309   <Set-Drops () e.comp-func> :: t e.comp-func,
    310   <Post-Comp (e.res-vars) e.comp-func> :: t e.result,
    311   e.result;
     261  <Set-Drops () <Gener-Var-Names e.comp-func>> :: t e.comp-func,
     262//!     <Post-Comp (e.res-vars) e.comp-func> :: t e.result,
     263//!     e.result;
     264  e.comp-func;
    312265//  :: (e.func-decl) e.func-body,
    313266//  () <Domain &Declarations> $iter {
    … …  
    321274  () e.Snt $iter {
    322275    e.Snt : t.Statement e.rest, t.Statement : {
    323       (REF t.name) =
    324         <Table> :: s.tab,
    325         <Bind &Vars-Tab (t.name) (s.tab)>,
    326         <Set-Var t.name (Format) (<Format-Exp (REF t.name)>)>,
    327         <Set-Var t.name (Declared) (True)>,
    328         <Set-Var t.name (Instantiated) (True)>,
    329         <Set-Var t.name (Left-compare) ()>,
    330         <Set-Var t.name (Right-compare) ()>,
    331         <Set-Var t.name (Left-checks) ()>,
    332         <Set-Var t.name (Right-checks) ()>,
    333         (e.new-Snt (VAR t.name)) e.rest;
     276      (REF t.name) = (e.new-Snt /*<New-Vars (VAR REF t.name)>*/) e.rest;
     277
     278//!                     <Table> :: s.tab,
     279//!                     <Bind &Vars-Tab (t.name) (s.tab)>,
     280//!                     <Set-Var t.name (Format) (<Format-Exp (REF t.name)>)>,
     281//!                     <Set-Var t.name (Declared) (True)>,
     282//!                     <Set-Var t.name (Instantiated) (True)>,
     283//!                     <Set-Var t.name (Left-compare) ()>,
     284//!                     <Set-Var t.name (Right-compare) ()>,
     285//!                     <Set-Var t.name (Left-checks) ()>,
     286//!                     <Set-Var t.name (Right-checks) ()>,
     287//!                     (e.new-Snt (VAR t.name)) e.rest;
     288
    334289      (e.expr) = (e.new-Snt (<Ref-To-Var e.expr>)) e.rest;
    335290      t = (e.new-Snt t.Statement) e.rest;
    … …  
    338293  e.Snt : /*empty*/ =
    339294  e.new-Snt;
    340 
    341 Post-Comp (e.used-vars) e.comp-func, e.comp-func : {
    342   /*
    343    * As well as "Used" shouldn't be "Declare" statements added?
    344    */
    345   e.something (Used e.vars) =
    346     <Post-Comp (<Or (e.used-vars) e.vars>) e.something>;
    347   e.something (If-used (e.vars) e.statements), {
    348     <Split &Elem? e.vars (e.used-vars)> : (v.true-used) (e.yet-not-used) =
    349       <Post-Comp (v.true-used) e.statements> :: (e.expr-vars) e.expr,
    350       <Post-Comp (<Or (e.yet-not-used) e.expr-vars>) e.something> e.expr;
    351     <Post-Comp (e.used-vars) e.something>;
    352   };
    353   e.something (e.expr) =
    354     <Post-Comp (e.used-vars) e.expr> :: (e.expr-vars) e.expr,
    355     <Post-Comp (e.expr-vars) e.something> (e.expr);
    356   e.something s.symbol =
    357     <Post-Comp (e.used-vars) e.something> s.symbol;
    358   /*empty*/ = (e.used-vars);
    359 };
    360295
    361296Set-Drops (e.declared) e.comp-func =
    … …  
    383318                e.rest (e.result-func (ASSIGN t.var (s.method e.args)))
    384319                (e1 e2 t.var s.init);
     320                /*
     321                 * FIXME: if s.method is EXPR, it shouldn't be written.
     322                 */
    385323            };
    386324          };
    … …  
    400338  (e.declared) e.result-func;
    401339
    402 Comp-Sentence (e.cuts) e.Sentence =
    403 //  <WriteLN Snt e.Sentence>,
    404 //  <WriteLN Last-Re <? &Last-Re>>,
    405 //  <WriteLN Vars <Domain &Vars-Tab>>,
    406 //  {
    407 //    <Domain &Vars-Tab> : e (t.name) e,
    408 //      <WriteLN '  ' t.name>,
    409 //      {
    410 //        <Lookup &Vars-Tab t.name> : s.tab,
    411 //          <WriteLN '      ' s.tab>,
    412 //          <Domain s.tab> : e (e.field) e,
    413 //          <WriteLN '      ' e.field ':' <?? t.name e.field>>,
    414 //          $fail;;
    415 //      }, $fail;;
    416 //  },
    417 //  <WriteLN Greater-Ineqs <? &Greater-Ineqs>>,
    418 //  <WriteLN Less-Ineqs <? &Less-Ineqs>>,
    419 //  <WriteLN Static-Exprs <Domain &Static-Exprs>>,
    420 //  <WriteLN Var-Tags <Domain &Var-Tags>>,
    421 //  <WriteLN Cuts e.cuts>,
    422   e.Sentence : {
    423     (Comp Cut) e.Snt =
    424       <Comp-Sentence (e.cuts Cut) e.Snt>;
    425     t.Statement e.Snt =
    426       \{
    427         e.cuts : /*empty*/ = t.Statement : \{
    428           (Comp Empty) = /*empty*/;
    429           (Comp Used e.vars) =
    430             (Used e.vars) <Comp-Sentence () e.Snt>;
    431           (Comp Notail) =
    432             <Comp-Sentence () e.Snt>;
    433           (Comp Trap) =
    434             <Comp-Sentence () e.Snt>;
    435           (Comp Vars e.Preserve-Re? s.Vars-Tab s.Static (e.greater) (e.less)) =
    436             <Store &Greater-Ineqs e.greater>,
    437             <Store &Less-Ineqs e.less>,
    438             <RFP-Double-Copy s.Vars-Tab> :: s.tmp-Tab,
    439             {
    440               e.Preserve-Re? : Preserve-Re =
    441                 <Nub <Vars <? &Last-Re>>> $iter {
    442                   e.vars : (VAR t.name) e.rest,
    443                     <Lookup &Vars-Tab t.name> : s.tab,
    444                     <Table-Copy s.tab> :: s.new-tab,
    445                     <Bind s.tmp-Tab (t.name) (s.new-tab)>,
    446                     e.rest;
    447                 } :: e.vars,
    448                 e.vars : /*empty*/;;
    449             },
    450             <Replace-Table &Vars-Tab s.tmp-Tab>,
    451             <Replace-Table &Static-Exprs s.Static>,
    452             <Comp-Sentence () e.Snt>;
    453           (Comp Re e.Re) =
    454             <Store &Last-Re e.Re>,
    455             <Comp-Sentence () e.Snt>;
    456           (Comp Fatal) = FATAL;
    457           (Comp Retfail) = RETFAIL;
    458           (Comp Sentence) = RETURN;
    459           (Comp Not) =
    460             e.Snt : (Comp Sentence) e.Current (Comp Sentence) e.Others =
    461             <Comp-Sentence () e.Others>;
    462           (Comp Continue t.label) = (CONTINUE t.label);
    463           (Comp Break t.label) = (BREAK t.label);
    464           (Comp Error) =
    465             <Get-Static-Exprs <? &Last-Re>> :: e.Re (e.decls),
    466             e.decls (ERROR e.Re);
    467           (Comp Remove-next-sentence) =
    468             e.Snt : e.Curr-Snt (Comp Sentence)
    469                 e.Next-Snt (Comp Sentence) e.Other-Snts,
    470             <Comp-Sentence () e.Curr-Snt (Comp Sentence) e.Other-Snts>;
    471           (Comp Cutall) =
    472             e.Snt : {
    473               e.Snt1 (Comp Not) e (Comp Sentence) e.Rest,
    474                 {
    475                   e.Snt1 : e (Comp Notail) e (Comp Sentence)
    476                   e (Comp Sentence) e.Rest1 =
    477                     e.Rest1;
    478                   e.Rest;
    479                 } :: e.Rest =
    480                 <Comp-Sentence () e.Rest>;
    481               e (Comp Notail) e (Comp Sentence) e (Comp Sentence) e.Rest =
    482                 <Comp-Sentence () e.Rest>;
    483               e t.retfail =
    484                 <Comp-Sentence () t.retfail>;
    485             };
    486           (Comp Stake) =
    487             <Comp-Sentence () e.Snt>;
    488           (RESULT e.Re) =
    489             <Comp-Re e.Re (e.Snt)>;
    490           (FORMAT e.Hard) =
    491             <Norm-Vars (<Nub <Vars e.Hard>>) e.Snt> :: (e.vars) e.Snt,
    492             <Filter &Not-Ref? (e.vars)> :: e.vars,
    493             <? &Last-Re> :: e.Re,
    494             <Split-Re (<Format-Exp e.Hard>) e.Re> :: e.splited-Re,
    495             <Split &Contents-First? <Vars e.Re>
    496               (<Zip (e.vars) (e.splited-Re)>)> :: (e.collapses) (e.normals),
    497             /* Each var in e.collapses is presented in at least one
    498              * of Re from e.collapses and e.normals. And any var
    499              * from e.normals isn't contented in any Re at all. So
    500              * we can compute e.normals in the end - we can't get
    501              * much use of them anyway.
    502              */
    503             <Map &Get-Elem 0 (e.collapses)> :: e.collaps-vars,
    504             <Map &Zip-With-Vars e.collaps-vars (e.collapses)> :: e.collapses,
    505             /*
    506              * Now each "collaps" has the following structure:
    507              *  t.var (e.Re) (e.all-collapsed-vars-from-Re)
    508              * And e.all-collapsed-vars-from-Re does NOT contain t.var.
    509              */
    510             <Comp-Ready-Formats e.collapses> $iter {
    511               <Map &Longest-Re e.collapses (e.collapses)> :: e.collapses,
    512                 /*
    513                  * Now each "collaps" has the following structure:
    514                  *   t.var (e.Re) (e.vars) s.num
    515                  * where s.num is maximum number of callapsed
    516                  * vars which including t.var are needed for
    517                  * computing some variable.
    518                  *   Next function chooses t.var with minimized
    519                  * maximum of all used in it variable's s.num.
    520                  */
    521                 <Foldr1 &Next-Collaps e.collapses (e.collapses)>
    522                   : (t.next-var (e.next-Re) e),
    523                 /*
    524                  * Choose free number for auxiliary variable index.
    525                  */
    526                 1 e.aux $iter {
    527                   e.aux : e s.ind e = <"+" s.ind 1> e.aux;
    528                   s.ind /*empty*/;
    529                 } :: s.ind e.aux,
    530                 e.aux : /*empty*/ =
    531                 <Store-Vars (EVAR ("aux" s.ind))> : t.aux-var,
    532                 /*
    533                  * Create-Aux changes all t.var to t.aux-var and
    534                  * removes s.num from the end of collaps.
    535                  */
    536                 e.comp-formats
    537                 <Declare-Vars "Expr" t.aux-var>
    538                 <Comp-Ready-Formats
    539                   (t.aux-var (t.next-var) ())
    540                   (t.next-var (e.next-Re) ())
    541                   <Map &Create-Aux t.next-var t.aux-var (e.collapses)>>;
    542             } :: e.comp-formats (e.collapses) (e.aux),
    543             e.collapses : /*empty*/ =
    544             <Map &Get-Elem 0 (e.normals)> :: e.normal-vars,
    545             e.comp-formats
    546             /*
    547              * Wouldn't be constructor in the form Expr(const_expr)
    548              * better?
    549              */
    550             <Declare-Vars "Expr" e.normal-vars>
    551             <Comp-Assigns (e.normal-vars) <Map &Get-Elem 1 (e.normals)>>
    552             <Comp-Sentence () e.Snt>;
    553           (STAKE) =
    554             e.Snt : e.Current (Comp Sentence) e.Others =
    555             <Comp-Sentence () e.Current (Comp Sentence) (Comp Stake) e.Others>;
    556           (CUT) =
    557             e.Snt : e.Current (Comp Sentence) e.Others =
    558             <Comp-Sentence () e.Current (Comp Sentence) (Comp Cut) e.Others>;
    559           (CUTALL) =
    560             e.Snt : e.Current (Comp Sentence) e.Others =
    561             {
    562               e.Current : e1 (Comp Remove-next-sentence) e2 (Comp Notail) e3 =
    563                 e.Others : e (Comp Sentence) e.rest,
    564                 e1 e2 (Comp Notail) e3 :: e.Current,
    565                 e.Current (Comp Sentence) e.rest;
    566               e.Current (Comp Sentence) (Comp Cutall) e.Others;
    567             } :: e.Snt,
    568             <Comp-Sentence () e.Snt>;
    569           (FAIL) =
    570             e.Snt : e.Current (Comp Sentence) e.Others =
    571             <Comp-Sentence () e.Others>;
    572           (NOT (BRANCH e.Snt1)) =
    573             <RFP-Double-Copy &Vars-Tab> :: s.Vars-Tab,
    574             <Table-Copy &Static-Exprs> :: s.Static,
    575             <? &Greater-Ineqs> :: e.greater,
    576             <? &Less-Ineqs> :: e.less,
    577             <Comp-Sentence () e.Snt1
    578               (Comp Not) (Comp Sentence) (RESULT)
    579               (Comp Vars s.Vars-Tab s.Static (e.greater) (e.less)) e.Snt>;
    580             //  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ?????????
    581           (LEFT e.Pattern) =
    582             <Comp-Pattern (LEFT e.Pattern) e.Snt>;
    583           (RIGHT e.Pattern) =
    584             <Comp-Pattern (RIGHT e.Pattern) e.Snt>;
    585           (Comp Source s.Vars-Tab s.Static t.NOFAIL e.next-terms) = e.Snt : {
    586             (BLOCK) e.Snt1 =
    587               {
    588                 t.NOFAIL : (Nofail) = FATAL;
    589                 e.Snt : e.Current (Comp Sentence) e.Others =
    590                   <Comp-Sentence () e.Others>;
    591               };
    592             (BLOCK (BRANCH e.Branch) e.Branches) e.Snt1 =
    593               <? &Last-Re> :: e.Re,
    594               <? &Greater-Ineqs> :: e.greater,
    595               <? &Less-Ineqs> :: e.less,
    596               <Gener-Label L "Branch"> :: t.label,
    597               (LABEL t.label
    598               <Comp-Sentence ()
    599                 (Comp Vars s.Vars-Tab s.Static (e.greater) (e.less))
    600                 e.Branch e.next-terms
    601                 (Comp Sentence) (Comp Break t.label)
    602                 (Comp Source t.NOFAIL) e.Snt1>
    603               ) <Comp-Sentence ()
    604                 (Comp Re e.Re)
    605                 (Comp Source s.Vars-Tab s.Static t.NOFAIL e.next-terms)
    606                 (BLOCK e.Branches) e.Snt1>;
     340
     341Comp-Sentence s.tail? (v.fails) (e.last-Re) e.Sentence, e.Sentence : {
     342
     343  /*empty*/ = /*empty*/;
     344
     345  /*
     346   * In case of Re look if we should do a tailcall.  If not, then compile
     347   * function calls from the Re and assign results to the out parameters or
     348   * use them in compilation of the rest of the sentence.
     349   */
     350  (RESULT e.Re) e.Snt =
     351    {
     352      /*
     353       * If the Re is the last action in the sentence then we can do
     354       * tailcall if one of the following is true:
     355       *  - Re is a call of non-failable function;
     356       *  - Re is a call of a failable function, current function is
     357       *  failable, and the failures stack is empty.
     358       * In both cases out format of the called function should coincide
     359       * with those of compiled one.
     360       * FIXME: really we can do tailcall if all the parameters of
     361       * compiled function that won't get their values from the call can
     362       * be assigned from other sources.  Some support from runtime is
     363       * needed though.
     364       */
     365      e.Snt : /*empty*/, s.tail? : Tail, e.Re : (CALL t.name e.arg),
     366        { <In-Table? &Fun? t.name> = v.fails : (RETFAIL);; },
     367        <Lookup-Func t.name> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
     368        <Subformat? (e.Fout) (<? &Out-Format>)> =
     369        <Extract-Calls e.arg> :: (e.last-Re) e.calls,
     370        <Comp-Static-Exprs <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
     371        <Comp-Calls <R 0 v.fails> e.calls>
     372        (TAILCALL t.name (e.splited-Re) (<? &Res-Vars>));
     373
     374      <Extract-Calls e.Re> :: (e.last-Re) e.calls,
     375        <Comp-Calls <R 0 v.fails> e.calls> :: e.comp-calls,
     376        {
     377          e.Snt : /*empty*/, s.tail? : Tail =
     378            <Split-Re (<? &Out-Format>) e.last-Re> :: e.splited-Re,
     379            <Comp-Static-Exprs e.splited-Re> :: e.splited-Re,
     380            e.comp-calls <Comp-Assigns <Zip (<? &Res-Vars>) (e.splited-Re)>>;
     381
     382          e.comp-calls <Comp-Sentence s.tail? (v.fails) (e.last-Re) e.Snt>;
     383        };
     384    };
     385
     386  /*
     387   * In case of He compile assignments from last Re and then (with new state
     388   * of variables) proceed with the rest of the sentence.
     389   */
     390  (FORMAT e.He) e.Snt =
     391    <Comp-Format (e.last-Re) e.He>
     392    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
     393
     394  /*
     395   * In case of Pe get from the begining of the sentence a maximum possible
     396   * sequence of clashes and compile it.  New values of variables from the
     397   * clashes use in the compilation of the rest of the sentence.
     398   */
     399  (s.dir e.Pattern) e.Snt, s.dir : \{ LEFT; RIGHT; } =
     400    <Get-Clash-Sequence (e.last-Re) e.Sentence> :: (e.clashes) e.Sentence,
     401    <WriteLN !!! e.clashes>,
     402    <Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence>;
     403
     404  (s.block) e, BLOCK BLOCK? : e s.block e = <WriteLN! &StdErr "Empty block?">, $fail;
     405
     406  /*
     407   * In case of a block first see if its results are needed for something
     408   * after the block and determine whether the block is a source.  Then
     409   * compile each branch in turn.
     410   */
     411  (s.block e.branches) e.Snt,
     412    s.block : \{
     413      BLOCK = (FATAL);
     414      BLOCK?;
     415    } :: e.fatal? =
     416    /*
     417     * If the block initializes an $iter then extract from the $iter the He
     418     * for placing it in the end of each branch.
     419     * Then look if the block is used by a pattern or format expression.
     420     * If so, we should declare variables from that expression before
     421     * entering any branch -- those should be visible after the block.
     422     * If next after the block is (Comp Error) then block results should be
     423     * used as values for $error, so place (Comp Error) in the end of each
     424     * branch.
     425     */
     426    {
     427      e.Snt : (ITER t.body t.format t.cond) e.rest =
     428        t.format (Comp Iter t.body t.format t.cond) e.rest;
     429      e.Snt;
     430    } :: e.Snt,
     431    e.Snt : {
     432      t.first e.rest, t.first : \{
     433        (LEFT e.pattern) = e.pattern;
     434        (RIGHT e.pattern) = e.pattern;
     435        (FORMAT e.format) = e.format;
     436      } :: e.expr =
     437        <Vars e.expr> :: e.vars,
     438*                               <New-Vars e.vars>,
     439        (<Vars-Decl e.vars>) (t.first) ((Comp Source)) e.rest;
     440      (Comp Error) e.rest =
     441        () ((Comp Error)) () /*empty*/;
     442      e = () () () e.Snt;
     443    } :: (e.decls) (e.next-term) (e.source?) e.Snt,
     444    /*
     445     * The block is a source if after it goes pattern or format expression
     446     * (in that case e.source? isn't empty) or e.Snt isn't empty.
     447     * Branches in the block are tail sentences if the current sentence is
     448     * tail and the block isn't a source.
     449     */
     450    {
     451      \{ e.source? : v; e.Snt : v; } = ((Comp Source)) Notail;
     452      s.tail? : Tail = () Tail;
     453      () Notail;
     454    } :: (e.source?) s.tail-branch?,
     455    /*
     456     * In case our block is a source we should mark the position in the
     457     * failures stack, so that we can jump to it after CUTALL.  And if our
     458     * block isn't failable we should add (FATAL) to the end of the stack.
     459     */
     460    v.fails e.source? e.fatal? :: v.branch-fails,
     461    /*
     462     * We put all compiled branches in a block, so positive return from a
     463     * branch is a break from that block.
     464     * Each branch in its turn is placed in its own block, so for a $fail
     465     * to the next branch we should just break from that inner block.
     466     * Each branch is compiled with the current sentence state and the
     467     * state is recalled after that.  When all branches are compiled the
     468     * state is popped out from the stack.
     469     * If last branch fails then the whole block fails, and return from the
     470     * last branch is return from the block.  So the last branch isn't
     471     * placed in a block and is processed with the failures stack that was
     472     * before entering the block.  Note: this trick helps us find more
     473     * tailcalls.  If the call of a failable function is on the last branch
     474     * of the block and the failures stack is empty we can do tailcall.
     475     * When the last branch is compiled with the block's stack, all we
     476     * should do is to check it.
     477     */
     478    <Gener-Label "block"> :: t.label,
     479    <Save-Snt-State>,
     480    (e.branches) /*e.comp-branches*/ $iter {
     481      e.branches : (BRANCH e.branch) e.rest-br =
     482        <Add-To-Label t.label "branch"> :: t.br-label,
     483        <Comp-Sentence
     484          s.tail-branch?
     485          (v.branch-fails ((BREAK t.br-label)))
     486          (e.last-Re)
     487          e.branch e.next-term
     488        > :: e.comp-br,
     489        <Recall-Snt-State>,
     490        (e.rest-br) e.comp-branches (LABEL t.br-label e.comp-br (BREAK t.label));
     491    } :: (e.branches) e.comp-branches,
     492    e.branches : (BRANCH e.branch) =
     493    <Comp-Sentence
     494      s.tail-branch? (v.branch-fails) (e.last-Re) e.branch e.next-term
     495    > :: e.last-branch,
     496    <Pop-Snt-State>,
     497    e.decls (LABEL t.label e.comp-branches e.last-branch)
     498    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
     499
     500  /*
     501   * In case of $iter first of all compile initial assignment to the hard
     502   * expression.
     503   */
     504  (ITER t.body t.format t.cond) e.Snt =
     505    <Comp-Sentence s.tail? (v.fails) (e.last-Re)
     506      t.format (Comp Iter t.body t.format t.cond) e.Snt
     507    >;
     508
     509  /*
     510   * Then compile $iter condition and body both with the current state of the
     511   * sentence.
     512   * e.Snt can contain only (Comp Error), so compile it together with the
     513   * condition.
     514   * If condition fails we should compute the body, so put the compiled
     515   * condition in a block and place a break from it to the failures stack.
     516   */
     517  (Comp Iter (BRANCH e.body) t.format (BRANCH e.condition)) e.Snt =
     518    <Gener-Label "iter"> :: t.label,
     519    <Save-Snt-State>,
     520    <Comp-Sentence s.tail? (v.fails ((BREAK t.label))) () e.condition e.Snt>
     521      :: e.comp-condition,
     522    <Pop-Snt-State>,
     523    <Comp-Sentence Notail (v.fails) () e.body t.format> :: e.comp-body,
     524    (FOR () () () (LABEL t.label e.comp-condition) e.comp-body);
     525
     526  /*
     527   * In case of $trap/$with at first compile try-sentence.  All $fails from
     528   * it should become errors.
     529   * Then recall the state of the sentence and compile catching of an error
     530   * with a variable err.
     531   * e.Snt can be only (Comp Error), so compile it together with both
     532   * sentences -- when either of it comuptes to an object expression it
     533   * becomes a value of the $error.
     534   */
     535  (TRY (BRANCH e.try) e.catch) e.Snt =
     536    <Save-Snt-State>,
     537    <Comp-Sentence Notail ((FATAL)) () e.try e.Snt> :: e.comp-try,
     538    <Pop-Snt-State>,
     539    <Comp-Sentence s.tail? (v.fails) () (RESULT (EVAR ("err" 0))) e.catch e.Snt>
     540      :: e.comp-catch,
     541    (TRY e.comp-try) (CATCH-ERROR e.comp-catch);
     542
     543  /*
     544   * In case of \? add Stake to the failures stack.  Add last fail after it
     545   * for <R 0 v.fails> continue to work.
     546   */
     547  (STAKE) e.Snt =
     548    <Comp-Sentence s.tail? (v.fails (Comp Stake) <R 0 v.fails>) () e.Snt>;
     549
     550  /*
     551   * In case of \! forget all failure catchers after last \?.
     552   * If there is no Stake then we are inside negation or error (we assume the
     553   * program is correct).  So the right failure catcher is in the bottom of
     554   * the stack.
     555   */
     556  (CUT) e.Snt =
     557    {
     558      v.fails : $r v.earlier-fails (Comp Stake) e = v.earlier-fails;
     559      <L 0 v.fails>;
     560    } :: v.fails,
     561    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
     562
     563  /*
     564   * In case of = clear the failures stack up to the closest source.
     565   */
     566  (CUTALL) e.Snt =
     567    {
     568      v.fails : $r v.earlier-fails (Comp Source) e = v.earlier-fails;
     569      <L 0 v.fails>;
     570    } :: v.fails,
     571    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
     572
     573  /*
     574   * In case of = in the Refal-6 sense (non-transparent hedge for the fails),
     575   * $fail(k) should become $error(Fname "Unexpected fail"), so clear the
     576   * failures stack and put that value in it.
     577   */
     578  NOFAIL e.Snt =
     579    <Comp-Sentence s.tail? ((FATAL)) (e.last-Re) e.Snt>;
     580
     581  /*
     582   * In case of $fail return last failure catcher.
     583   */
     584  (FAIL) e.Snt =
     585    v.fails : e (e.last-fail),
     586    e.last-fail;
     587
     588  /*
     589   * In case of # we should proceed with the rest if the source is computed
     590   * to $fail.
     591   * We could compile the rest of the sentence and place it in the
     592   * failures stack.  But then the compiled sentence would be copied as many
     593   * times as there are $fail's to the upper level in the source.  So we
     594   * place compiled source in the block and put the break to exit from it in
     595   * the stack.
     596   * When compiling the source mark it as Notail as usual.
     597   * If the source isn't computed to $fail we should proceed with the last
     598   * failure catcher.
     599   */
     600  (NOT (BRANCH e.branch)) e.Snt =
     601    <Gener-Label "negation"> :: t.label,
     602    v.fails : e (e.last-fail),
     603//    <Save-Snt-State>,
     604    <Comp-Sentence Notail (((BREAK t.label))) () e.branch> e.last-fail
     605      :: e.comp-negation,
     606//    <Pop-Snt-State>,
     607    (LABEL t.label e.comp-negation)     <Comp-Sentence s.tail? (v.fails) () e.Snt>;
     608
     609//  (Comp Verbatim expr) = expr;
     610
     611  /*
     612   * In case of $error all fails become $error(Fname "Unexpected fail").  So
     613   * place that value in the failures stack and then compile the computation
     614   * of the rest of the sentence and the last Re which should be the value of
     615   * $error.
     616   */
     617  (ERROR) e.Snt =
     618    <Comp-Sentence Notail ((FATAL)) e.Snt () (Comp Error)>;
     619
     620  (Comp Error) e.Snt = (ERROR e.last-Re);
     621
     622//  (Comp Fatal) = FATAL;
     623
     624//  (Comp Retfail) = RETFAIL;
     625
     626};
     627
     628
     629
     630********** Sentence state stack and functions for work with it. **********
     631
     632$box Snt-State;
     633
     634/*
     635 * Put current state in the stack.
     636 */
     637Save-Snt-State = <Put &Snt-State <Vars-Copy-State>>;
     638
     639/*
     640 * Set current state to that at the top of the stack.
     641 */
     642Recall-Snt-State = <Vars-Set-State <R 0 <? &Snt-State>>>;
     643
     644/*
     645 * Pop the top from the stack and set current state to it.
     646 */
     647Pop-Snt-State =
     648  <Recall-Snt-State>,
     649  <Store &Snt-State <Middle 0 1 <? &Snt-State>>>;
     650
     651
     652
     653********************** Function calls compilation. ***********************
     654
     655/*
     656 * $func Extract-Calls e.Re = (e.last-Re) e.calls;
     657 *
     658 *
     659 *
     660 */
     661Extract-Calls {
     662  (CALL t.name e.arg) e.rest =
     663    <Lookup-Func t.name> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
     664    <Extract-Calls e.arg> :: (e.last-Re) e.calls,
     665    <Comp-Static-Exprs <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
     666    <RFP-Extract-Qualifiers t.name> :: t e.prefix,
     667*               <Del-Pragmas <Gener-Vars 0 (e.Fout) e.prefix>> : e.Re s,
     668//!             <Store-Vars <Vars e.res-Re>> :: e.ress,
     669//!             <Instantiate-Vars e.ress>,
     670//!             <Ref-To-Var <Strip-STVE e.res-Re>> :: e.res-Re,
     671//!             e.decls <Declare-Vars "Expr" e.ress> :: e.decls,
     672    <Gener-Vars (e.Fout) e.prefix> :: /*(e.vars)*/ e.Re,
     673    <Vars e.Re> :: e.vars,
     674*               <Instantiate-Vars e.vars>,
     675    {
     676      s.tag : FUNC? =   (Failable (CALL t.name (e.splited-Re) (e.vars)));
     677      (CALL t.name (e.splited-Re) (e.vars));
     678    } :: t.call,
     679    <Extract-Calls e.rest> :: (e.rest-Re) e.rest-calls,
     680    (e.Re e.rest-Re) e.calls <Vars-Decl e.vars> t.call e.rest-calls;
     681  (PAREN e.Re) e.rest =
     682    <Extract-Calls e.Re> :: (e.last-Re) e.calls,
     683    <Extract-Calls e.rest> :: (e.rest-Re) e.rest-calls,
     684    ((PAREN e.last-Re) e.rest-Re) e.calls e.rest-calls;
     685  t.Rt e.Re =
     686    <Extract-Calls e.Re> :: (e.last-Re) e.calls,
     687    (t.Rt e.last-Re) e.calls;
     688  /*empty*/ = () /*empty*/;
     689};
     690
     691
     692Comp-Calls (e.fail) e.calls, e.calls : {
     693  (Failable t.call) e.rest =
     694    (IF ((NOT t.call)) e.fail) <Comp-Calls (e.fail) e.rest>;
     695  t.call e.rest =
     696    t.call <Comp-Calls (e.fail) e.rest>;
     697  /*empty*/ = /*empty*/;
     698};
     699
     700
     701
     702*********** Compilation of static parts of result expressions ************
     703
     704$func Static-Expr? s.create? e.Re = static? e.Re;
     705
     706$func Static-Term? t.Rt = static? t.Rt;
     707
     708
     709/*
     710 * Extract static parts from each Re.
     711 */
     712Comp-Static-Exprs {
     713  (e.Re) e.rest = <Static-Expr? Create e.Re> :: s e.Re, (e.Re) <Comp-Static-Exprs e.rest>;
     714  /*empty*/     = /*empty*/;
     715};
     716
     717
     718/*
     719 * Find all the longest static parts in the upper level of Re.  Create STATIC
     720 * form in place of each one.
     721 * Return a tag pointing whether the whole expression is static and expression
     722 * with static parts replaced by STATIC forms.  Dynamic parts are returned
     723 * unchanged.
     724 */
     725Static-Expr? {
     726  s.create? t.Rt e.Re =
     727    <Static-Term? t.Rt> : {
     728      Static t.Rt =
     729        {
     730          e.Re : e1 t2 e3, <Static-Term? t2> : Dynamic t.dyn-Rt =
     731            <Static-Expr? Create e.Re> :: s e.Re,
     732            Dynamic <Create-Static t.Rt e1> t.dyn-Rt e.Re;
     733          {
     734            s.create? : Create = Static <Create-Static t.Rt e.Re>;
     735            Static t.Rt e.Re;
    607736          };
    608           NOFAIL =
    609             e.Snt : (BLOCK e.Branches) e.rest-Snt,
    610             <Comp-Sentence () (BLOCK (Nofail) e.Branches) e.rest-Snt>;
    611           (BLOCK) =
    612             <Comp-Sentence () (BLOCK ()) e.Snt>;
    613           (BLOCK (BRANCH e.Branch) e.Branches) =
    614             <Comp-Sentence () (BLOCK () (BRANCH e.Branch) e.Branches) e.Snt>;
    615           (BLOCK t.NOFAIL e.Branches) =
    616             /*
    617              * First of all remove form the begining of e.Snt
    618              * auxiliary terms (Comp...).
    619              */
    620             () e.Snt $iter {
    621               e.Snt : t.first e.rest =
    622                 (e.comp-terms t.first) e.rest;
    623             } :: (e.comp-terms) e.Snt,
    624             # \{
    625               e.Snt : (Comp Vars e) e;
    626               e.Snt : (Comp Remove-next-sentence) e;
    627             } =
    628 //            {
    629 //              e.Snt : /*empty*/ = () e.comp-terms;
    630 //              (e.comp-terms) e.Snt;
    631 //            } :: (e.comp-terms) e.Snt,
    632             {
    633               e.Snt : (ITER t.body t.format t.cond) e.rest =
    634                 t.format (ITER Comp t.body t.format t.cond) e.rest;
    635               e.Snt;
    636             } :: e.Snt,
    637             e.Snt : t.first e.rest, {
    638               t.first : \{
    639                 (LEFT e.pattern) = e.pattern;
    640                 (RIGHT e.pattern) = e.pattern;
    641                 (FORMAT e.format) = e.format;
    642               } :: e.expr =
    643                 <Norm-Vars (<Vars e.expr>) e.Snt> : (e.vars) t.f e.r,
    644                 (<Declare-Vars "Expr" e.vars>) (t.f) e.r;
    645               () () e.Snt;
    646             } :: (e.decls) (e.next-term) e.Snt,
    647             e.Snt : e.Curr-Snt (Comp Sentence) e =
    648             {
    649               e.next-term : t1, {
    650                 e.comp-terms : /*empty*/ =
    651                   t1 (Comp Notail) (Preserve-Re);
    652                 t1 (Preserve-Re);
    653               };
    654               e.Curr-Snt : e t.item e,
    655                 # \{ t.item : (Comp e); } =
    656                 (Comp Notail) (Preserve-Re);
    657               /*empty*/ ();
    658             } :: e.next-terms (e.pres-Re),
    659             { e.next-term : (s e.nt) = e.nt; /*empty*/; } :: e.next-term,
    660             <RFP-Double-Copy &Vars-Tab> :: s.Vars-Tab, // ?????????
    661             <Table-Copy &Static-Exprs> :: s.Static,
    662             {
    663               e.comp-terms : /*empty*/ =
    664                 <? &Greater-Ineqs> :: e.greater,
    665                 <? &Less-Ineqs> :: e.less,
    666                 (Comp Vars e.pres-Re s.Vars-Tab s.Static (e.greater) (e.less))
    667                 (Comp Remove-next-sentence) e.next-terms;
    668               e.comp-terms e.next-terms;
    669             } :: e.next-terms,
    670             <Gener-Label L "Block"> :: t.label,
    671             e.decls
    672             (LABEL t.label
    673               <Comp-Sentence ()
    674                 (Comp Source s.Vars-Tab s.Static t.NOFAIL e.next-terms
    675                 (Comp Break t.label)) (BLOCK e.Branches) e.Snt>
    676             ) <Comp-Sentence ()
    677               (Comp Re e.next-term)
    678               (Comp Vars Preserve-Re s.Vars-Tab s.Static (/*???*/) (/*???*/))
    679               (Comp Empty)> :: e.tmp-Snt,
    680             <Foldr &Del-Checks s.Vars-Tab () (<Nub <Vars e.next-term>>)> : e =
    681             e.tmp-Snt <Comp-Sentence () e.Snt>;
    682           (ITER e.Comp t (FORMAT e.Hard) t) =
    683             <Norm-Vars (<Vars e.Hard>) t.Statement e.Snt> :
    684               (e.vars)
    685               (ITER e (BRANCH e.IterBody) t.Format (BRANCH e.IterCondition))
    686               e.Current-Snt (Comp Sentence) e.Other-Snts,
    687             {
    688               e.Comp : Comp = /*empty*/;
    689               <Comp-Sentence () t.Format (Comp Empty)>;
    690             } :: e.init,
    691             <Gener-Label L "Iter"> :: t.label,
    692             <RFP-Double-Unbind &Vars-Tab <Map &Get-Elem 1 (e.vars)>>,
    693             <Declare-Vars "Expr" e.vars> : e,
    694             <Instantiate-Vars e.vars>,
    695             <RFP-Double-Copy &Vars-Tab> :: s.Vars-Tab,
    696             <Comp-Sentence () e.IterCondition e.Current-Snt
    697               (Comp Sentence) (Comp Break t.label) e.Other-Snts> :: e.cond,
    698             <Replace-Table &Vars-Tab s.Vars-Tab>,
    699             <Comp-Sentence () e.IterBody t.Format (Comp Used e.vars)
    700               (Comp Empty) (Comp Sentence) e.Other-Snts> :: e.body,
    701             e.init (FOR () () () (LABEL t.label e.cond) e.body);
    702           (TRY (BRANCH e.TrySnt) e.CatchBlock) =
    703             <RFP-Double-Copy &Vars-Tab> :: s.Vars-Tab,
    704             e.Snt : e.Current-Snt (Comp Sentence) e,
    705             e.Current-Snt : {
    706               e1 (Comp Remove-next-sentence) e2 = e1 e2;
    707               e.Current-Snt;
    708             } :: e.Current-Snt,
    709             <Comp-Sentence () e.TrySnt e.Current-Snt
    710               (Comp Trap) (Comp Sentence) (Comp Fatal)> :: e.try,
    711             <Replace-Table &Vars-Tab s.Vars-Tab>,
    712             <Store-Vars (EVAR ("err" 0))> : t.err,
    713             <Declare-Vars "Expr" t.err> : e,
    714             <Instantiate-Vars t.err>,
    715             <Comp-Sentence () (Comp Re t.err) e.CatchBlock e.Snt> :: e.catch,
    716             (TRY e.try) (CATCH-ERROR e.catch);
    717           t.error, t.error : (ERROR) =  // Due to the bug in ver. 1.8.7
    718             e.Snt : e.Current-Snt (Comp Sentence) e,
    719             e.Current-Snt : $r e.CurrSnt (RESULT e.Re) e,
    720             <Comp-Sentence () e.CurrSnt (RESULT e.Re) (Comp Error)
    721               (Comp Sentence) (Comp Fatal)>;
    722737        };
    723         e.cuts : e.cuts1 Cut = \{
    724           t.Statement : (Comp Stake) =
    725             <Comp-Sentence (e.cuts1) e.Snt>;
    726           <Comp-Sentence (e.cuts) e.Snt>;
    727         };
    728       };
     738      Dynamic t.dyn-Rt =
     739        <Static-Expr? Create e.Re> :: s e.Re,
     740        Dynamic t.dyn-Rt e.Re;
     741    };
     742  s.create? /*empty*/ = Static;
     743};
     744
     745
     746/*
     747 * The same as Static-Expr? but for terms.
     748 */
     749Static-Term? {
     750  symbol       = Static symbol;
     751  (PAREN e.Re) = <Static-Expr? Not-Create e.Re> :: static? e.Re, static? (PAREN e.Re);
     752  (REF t.name) = Static (REF t.name);
     753  t.var        = Dynamic t.var;
     754};
     755
     756
     757
     758***************** Compilation of assignment to variables *****************
     759
     760$func Comp-Assign-to-Var e = e;
     761
     762Comp-Assign-to-Var (t.var (e.Re)), {
     763  t.var : e.Re = /*empty*/;
     764  <Generated-Var? e.Re> = <Gener-Var-Assign t.var e.Re>;
     765  <Declared? t.var> = (ASSIGN <Vars-Print t.var> e.Re);
     766  <Vars-Decl t.var> : e, (EXPR <Vars-Print t.var> e.Re);
     767};
     768
     769Comp-Assigns e.assigns = <Map &Comp-Assign-to-Var (e.assigns)>;
     770
     771
     772
     773************************** FORMAT compilation. ***************************
     774
     775$box Aux-Index;
     776
     777$func Gener-Aux-Var = t.new-aux-var;
     778
     779Gener-Aux-Var =
     780  <? &Aux-Index> : s.n,
     781  <Store &Aux-Index <"+" s.n 1>>,
     782  (VAR ("aux" s.n));
     783
     784
     785$func Create-Aux-Vars (e.vars) e.splited-Re = e.assigns;
     786
     787
     788Comp-Format (e.last-Re) e.He =
     789  <Vars e.He> :: e.vars,
     790  <Comp-Static-Exprs <Split-Re (<Format-Exp e.He>) e.last-Re>> :: e.splited-Re,
     791  <Store &Aux-Index 1>,
     792  <Create-Aux-Vars (e.vars) e.splited-Re> :: e.assigns,
     793  <Comp-Assigns e.assigns>;
     794
     795/*
     796 * Итак, e.vars -- все переменные, входящие в форматное выражение.  Каждая
     797 * переменная может входить в форматное выражение только один раз, поэтому
     798 * повторяющихся среди них нет.
     799 * e.splited-Re -- набор результатных выражений.  На каждую переменную из
     800 * e.vars по выражению, которое должно быть ей присвоено.
     801 *
     802 * Если переменная t.var_i используется в выражении e.Re_j, и i /= j, то
     803 * переменной t.var_j значение должно быть присвоено раньше, чем перeменной
     804 * t.var_i.  Если же, по аналогичным соображениям, t.var_i должна получить
     805 * значение раньше t.var_j, необходимо завести вспомогательную переменную.
     806 *
     807 * Пример:
     808 *
     809 * t1 (t1 t2) (t1 t3) :: t2 t1 t3
     810 *
     811 * t3 = (t1 + t3)();
     812 * aux_1 = t1;
     813 * t1 = (t1 + t2)()
     814 * t2 = aux_1;
     815 *
     816 * В общем случае вспомогательная переменная требуется, если двум переменным
     817 * необходимы старые значения друг друга (возможно, не напрямую, а через
     818 * промежуточные переменные).
     819 *
     820 * Вместо того, чтобы искать и анализировать такие циклы, будем действовать по
     821 * методу "наибольшей пользы".  А именно:
     822 *
     823 *   - Для каждой переменной выпишем все другие переменные, которым требуется
     824 *     её старое значение, а также отдельно те, старые значения которых
     825 *     требуются ей.
     826 *
     827 *   - Всем переменным, от старых значений которых ничего не зависит, можно
     828 *     смело присвоить новые значения.  При этом они исчезают из списков
     829 *     зависимостей оставшихся переменных.
     830 *
     831 *   - Все переменные, новые значения которых ни от чего не зависят, можно
     832 *     отложить, чтобы присвоить им значения тогда, когда будет удобно.  Т.е.
     833 *     тогда, когда списки зависящих от них переменных опустеют.
     834 *
     835 *   - Чтобы означить оставшиеся, нужны вспомогательные переменные.  Выберем
     836 *     одну из переменных, с максимальным списком тех, от которых она зависит,
     837 *     и положим её значение во вспомогательную переменную.  Так как мы сразу
     838 *     уменьшили кол-во зависимостей у максимального кол-ва переменных,
     839 *     локально мы добились наибольшей пользы, хотя не исключено, что глобально
     840 *     такой метод и не даст наименьшего кол-ва вспомогательных переменных.
     841 *     Кроме того, мы не пытаемся выбрать наилучшую переменную из нескольких с
     842 *     максимальным списком зависимостей.
     843 *
     844 *   - Повторяем всё это до тех пор, пока у каждой переменной не опустеет
     845 *     список зависящих от неё.
     846 *
     847 *
     848 * Для нашего примера:
     849 *
     850 * t1 (t1 t2) (t1 t3) :: t2 t1 t3
     851 *
     852 * t1 -- (t2 t3) (t2)
     853 * t2 -- (t1)    (t1)
     854 * t3 -- ()      (t1)
     855 *
     856 *
     857 * Для каждой переменной var_i найдём все j /= i, такие что в Re_j встречается
     858 * var_i -- provide[i], и а также все j /= i, такие что var_j нужна для
     859 * подсчёта var_i, т.е. встречается в Re_i.
     860 *
     861 * Res-vars <- <Map &Vars (Res)>
     862 * for var_i in vars
     863 *     provide[i] <-
     864 *     for vars-Re_j in Res-vars, j /= i
     865 *         vars-Re_j : e var_i e = j
     866 *     require[i] <- <Res-vars[i] `*` vars[^i]> : e var_j e, j
     867 *
     868 * Res-vars = map Vars Res
     869 * provide, require =
     870 *   {   [ j | vars-Re_j <- Res-vars, j /= i, var_i `in` vars-Re_j ]
     871 *     , [ j | var_j <- Res-vars[i] `*` vars, i /= j]
     872 *     | var_i <- vars
     873 *   }
     874 *
     875 */
     876
     877$func CAV e.vars (e.assigns) (e.delayed) = e.assigns;
     878
     879$func Get-Vars e = e;
     880Get-Vars (e.Re) = (<Vars e.Re>);
     881
     882Create-Aux-Vars (e.vars) e.splited-Re =
     883  <Zip (<Map &Get-Vars (e.splited-Re)>) (e.vars)> :: e.list,
     884  <Box> :: s.box,
     885  <Box> :: s.provide-i,
     886  <Box> :: s.require-i,
     887  {
     888    e.vars : e1 t.var-i e2,
     889      {
     890        e.list : e ((e.vars-Re) t.var-j) e,
     891          \{
     892            t.var-i : t.var-j = <Put s.require-i <And (e1 e2) e.vars-Re>>;
     893            e.vars-Re : e t.var-i e = <Put s.provide-i t.var-j>;
     894          },
     895          $fail;
     896        <L <Length e1> e.splited-Re> :: t.Re-i,
     897        <Put s.box (t.var-i t.Re-i (<? s.provide-i>) (<? s.require-i>))>,
     898          <Store s.provide-i /*empty*/>,
     899          <Store s.require-i /*empty*/>;
     900      },
     901      $fail;;
     902  },
     903  <CAV <? s.box> (/*assigns*/) (/*delayed*/)>;
     904
     905
     906/*
     907 * Если есть переменная, у которой список provide пуст, её можно посчитать.
     908 * Это выражается в том, что она (вместе с присваиваемым значением) добавляется
     909 * в список assigns, убирается из списка vars, а также из всех списков provide
     910 * и delayed.  В списках require её не было.
     911 *
     912 * CAV Res vars provide require assigns delayed =
     913 *   { i | var_i <- vars, provide_i == [] } ->     // Здесь неверно!  На переменные
     914 *                                                    из delayed тоже надо смотреть.
     915 *       vars    = vars - var_i
     916 *       provide = [ provide_j - i | provide_j <- provide ]
     917 *       assigns = assigns++[(var_i, Res[i])]
     918 *       delayed = [ (var_j, provide_j - i) | (var_j, provide_j) <- delayed ]
     919 *       CAV Res vars provide require assigns delayed
     920 */
     921
     922$func Assign-Empty-Provides e.vars  = e.assigns (e.vars);
     923
     924Assign-Empty-Provides {
     925  e1 (t.var-i t.Re-i (/*empty provide_i*/) (e.require-i)) e2 =
     926    <Box> :: s.vars,
     927    {
     928      e1 e2 : e (t.var-j t.Re-j (e.provide-j) (e.require-j)) e,
     929        <Put s.vars (t.var-j t.Re-j (<Sub (e.provide-j) t.var-i>) (e.require-j))>,
     930        $fail;;
     931    },
     932    (t.var-i t.Re-i) <Assign-Empty-Provides <? s.vars>>;
     933  e.vars = /*empty*/ (e.vars);
     934};
     935
     936
     937/*
     938 * Если есть переменная, у которой список require пуст, кладём её в delayed.
     939 * Она будет посчитана, когда у неё опустеет список provide, т.е. когда не
     940 * останется переменных, у которых она в списке require.
     941 */
     942$func Delay-Empty-Requires e.vars  = e.delayed (e.vars);
     943
     944Delay-Empty-Requires {
     945  e1 t.var e2, t.var : (t.var-i t.Re-i (e.provide-i) (/*empty require_i*/)) =
     946    <Delay-Empty-Requires e2> :: e.delayed (e.vars),
     947    t.var e.delayed (e1 e.vars);
     948  e.vars = /*empty*/ (e.vars);
     949};
     950
     951
     952/*
     953 * Выбор переменной (из двух) с более длинным списком требуемых ей значений.
     954 */
     955$func Max-Require e = e;
     956
     957Max-Require t.arg1 t.arg2 =
     958  t.arg1 : (t.var1 t.Re1 t.provide1 (e.require1)),
     959  t.arg2 : (t.var2 t.Re2 t.provide2 (e.require2)),
     960  {
     961    <"<" (<Length e.require1>) (<Length e.require2>)> = t.arg2;
     962    t.arg1;
    729963  };
    730964
    731 Not-Ref? (VAR t.name) = # \{ <?? t.name Format> : (REF e); };
    732 
    733 Contents-First? e.list (t.item e) = e.list : e t.item e;
    734 
    735 Zip-With-Vars e.col-vars (t.var (e.Re)) =
    736   (t.var (e.Re) (<Sub (<Filter &Elem? e.col-vars (<Nub <Vars e.Re>>)>) t.var>));
    737965
    738966/*
    739  * Finds all vars independent from collapsed ones and computes assignments to
    740  * them. Also returns new list of collapsed varibles and indexes of binded
    741  * auxiliary variables.
     967 * Подставить вспомогательную переменную вместо исходной во всех результатных выражениях.
     968 * Присваивание к исходной переменной убрать (оно к этому моменту уже выполнено).
     969 * Убрать переменную из списков зависимостей.
    742970 */
    743 Comp-Ready-Formats e.collapses =
    744   <Split &Independent? e.collapses (e.collapses)> :: (e.independ) (e.collapses),
    745   <Map &Get-Elem 0 (e.independ)> :: e.indep-vars,
    746   <Map &Remove-Independ e.indep-vars (e.collapses)> :: e.collapses,
    747   <Comp-Assigns (e.indep-vars) <Map &Get-Elem 1 (e.independ)>>
    748   (e.collapses)
    749   (<Concat <Map &Get-Aux-Indexes (e.collapses)>>);
    750 
    751 Independent? e.collapses (t.var t.Re t.collapsed-vars) =
    752   # \{ e.collapses : e (t t (e t.var e)) e; };
    753 
    754 Remove-Independ e.independ (t.var t.Re (e.var-list)) =
    755   (t.var t.Re (<Sub (e.var-list) e.independ>));
    756 
    757 Get-Aux-Indexes (t (e.Re) t) = <Map &Get-Var-Index (<Nub <Vars e.Re>>)>;
    758 
    759 Get-Var-Index {
    760   (VAR ("aux" s.ind)) = s.ind;
    761   t.var = /*empty*/;
     971$func Subst-Aux-Var e = e;
     972
     973Subst-Aux-Var t.var t.aux (t.v t.Re (e.provide) (e.require)), {
     974  t.var : t.v = /*empty*/;
     975  (
     976    t.v
     977    <Subst (t.var) ((t.aux)) t.Re>
     978    (<Sub (e.provide) t.var>)
     979    (<Sub (e.require) t.var>)
     980  );
    762981};
    763982
    764 Longest-Re e.collapses (t.var t.Re t.col-vars) =
    765   (t.var t.Re t.col-vars <Foldr &Longest-Re-Value t.var (0) (e.collapses)>);
    766 
    767 Longest-Re-Value t.var (t.var1 t.Re (e.col-vars)) s.value, {
    768   <Length e.col-vars> :: s.len,
    769     <">" (s.len) (s.value)>, e.col-vars : e t.var e = s.len;
    770   s.value;
    771 };
    772 
    773 Next-Collaps e.collapses (t.var t.Re (e.col-vars) s.len) (t.sel-var t.sel-Re t s.sel-len) =
    774   <Foldr1 &Max (<Map &Var-To-Len e.collapses (e.col-vars)>)> : s.new-len,
     983
     984/*
     985 * Извлечь присваивание из всей информации о переменной.
     986 */
     987$func Extract-Assigns e = e;
     988Extract-Assigns (t.var t.Re e) = (t.var t.Re);
     989
     990
     991/*
     992 * Основной цикл обработки присваиваний.
     993 *
     994 * 1) Из всех переменных (в том числе и отложенных), от которых больше ничего
     995 *    не зависит, сделать присваивания.
     996 * 2) Все переменные, которые больше ни от чего не зависят, отложить.
     997 * 3) Если осталось хотя бы две неотложенных переменных, выбирать из них ту,
     998 *    которая зависит от наибольшего числа переменных, подставить везде вместо
     999 *    неё вспомогательную, перейти к пункту 1.
     1000 */
     1001CAV e.vars (e.assigns) (e.delayed) =
     1002  <Assign-Empty-Provides e.vars> :: e.new-assigns (e.vars),
     1003  e.assigns e.new-assigns <Assign-Empty-Provides e.delayed> :: e.assigns (e.delayed),
     1004  e.delayed <Delay-Empty-Requires e.vars> :: e.delayed (e.vars),
    7751005  {
    776     <"<" (s.new-len) (s.sel-len)> = (t.var t.Re () s.new-len);
    777     (t.sel-var t.sel-Re () s.sel-len);
     1006    e.vars : t t e =
     1007      <Foldr1 &Max-Require (e.vars)> : (t.var t.Re e),
     1008      <Gener-Aux-Var> :: t.aux,
     1009      e.assigns (t.aux (t.var)) (t.var t.Re) :: e.assigns,
     1010      <Map &Subst-Aux-Var t.var t.aux (e.vars)> :: e.vars,
     1011      <Map &Subst-Aux-Var t.var t.aux (e.delayed)> :: e.delayed,
     1012      <CAV e.vars (e.assigns) (e.delayed)>;
     1013    e.assigns <Map &Extract-Assigns (e.vars e.delayed)>;
    7781014  };
    7791015
    780 Var-To-Len e.collapses t.var =
    781   e.collapses : e (t.var t t s.len) e = s.len;
    782 
    783 Create-Aux t.var t.aux-var (t.var1 (e.Re) (e.col-vars) s), {
    784   t.var : t.var1 = /*empty*/;
    785   (t.var1 (<Subst (t.var) ((t.aux-var)) e.Re>) (<Sub (e.col-vars) t.var>));
    786 };
    787 
    788 Del-Checks s.Vars (VAR t.name), {
    789   <Lookup s.Vars t.name> : s.tab =
    790     {
    791       Left-compare Right-compare Left-checks Right-checks : e s.field e,
    792         <Set-Var t.name (s.field) (<Lookup s.tab s.field>)>,
    793         $fail;;
    794     };
    795   <Set-Var t.name (Format) ((VAR t.name))>,
    796     {
    797       Left-compare Right-compare Left-checks Right-checks : e s.field e,
    798         <Set-Var t.name (s.field) ()>,
    799         $fail;;
    800     };
    801 };
     1016
     1017
     1018
     1019Get-Clash-Sequence (e.last-Re) t.Pattern e.Snt =
     1020  ((e.last-Re) t.Pattern) e.Snt $iter {
     1021    e.Snt : (RESULT e.Re) t.Pt e.rest =
     1022      (e.clashes (e.Re) t.Pt) e.rest;
     1023  } :: (e.clashes) e.Snt,
     1024  # \{
     1025    e.Snt : \{
     1026      (RESULT e.Re) (LEFT e) e = e.Re;
     1027      (RESULT e.Re) (RIGHT e) e = e.Re;
     1028    } :: e.Re,
     1029      <Without-Calls? e.Re>;
     1030  } =
     1031  (e.clashes) e.Snt;
     1032
    8021033
    8031034Comp-Pattern (s.dir e.PatternExp) e.Sentence =
    … …  
    8361067//      <WriteLN "Greater: " e.greater>,
    8371068//      <WriteLN "Current-Snt: " e.Current-Snt>,
    838       <Comp-Clashes (e.clashes)
    839         (e.Current-Snt (Comp Sentence)) e.Other-Snts> :: e.asail-Clashes,
     1069//!                     <Comp-Clashes (e.clashes)
     1070//!                             (e.Current-Snt (Comp Sentence)) e.Other-Snts> :: e.asail-Clashes,
    8401071//      e.asail-Clashes (e.greater) $iter {
    8411072//        e.greater : (e.vars s.num) e.rest,
    … …  
    8611092//      } :: e.asail-Clashes (e.hards),
    8621093//      e.hards : /*empty*/ =
    863       e.asail-Clashes e.asail-Others;
     1094//!                     e.asail-Clashes
     1095      e.asail-Others;
    8641096    e.asail-Others;
    8651097//    <Comp-Sentence () e.Other-Snts>;
    … …  
    8671099
    8681100Without-Calls? e.Re =
    869   e.Re $iter \{
    870     e.Re : t.Rt e.rest,
    871       t.Rt : \{
     1101  e.Re $iter {
     1102    e.Re : t.Rt e.rest =
     1103      t.Rt : {
    8721104        (CALL e) = $fail;
    8731105        (BLOCK e) = $fail;
    … …  
    8781110  } :: e.Re,
    8791111  e.Re : /*empty*/;
    880 
    881 Norm-Vars (e.vars) e.Snt =
    882   /*
    883    * Store all new variables in the &Vars-Tab table and return the list with
    884    * all variables in the (VAR t.name) form.
    885    */
    886   <Store-Vars e.vars> :: e.new-vars,
    887   /*
    888    * Rename all new variables in e.Snt. Never mind multiple occurences.
    889    */
    890   (e.vars) (e.new-vars) e.Snt $iter {
    891     e.vars : t.var e.rest, e.tmp-vars : t.new-var e.new-rest, {
    892       t.var : t.new-var =
    893         (e.rest) (e.new-rest) e.Snt;
    894       t.var : (s.tag e),
    895         <Bind &Var-Tags (t.new-var) (s.tag)>,
    896         (e.rest) (e.new-rest) <Subst (t.var) ((t.new-var)) e.Snt>;
    897     };
    898   } :: (e.vars) (e.tmp-vars) e.Snt,
    899   e.vars : /*empty*/ =
    900   (e.new-vars) e.Snt;
    9011112
    9021113//Comp-Clashes (e.clashes) (e.Current-Snt) e.Other-Snts =
    … …  
    10291240//  e.vars : /*empty*/;
    10301241
    1031 Comp-Clashes (e.clashes) (e.Current-Snt) e.Other-Snts =
     1242Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence =
    10321243//  <WriteLN Clashes e.clashes>,
    10331244  /*
    … …  
    10411252  e.old-clashes : /*empty*/ =
    10421253 
    1043   /*empty*/ (e.clashes) () $iter {
     1254  /*empty*/ (/*!e.clashes!*/) () $iter {
    10441255    /*
    10451256     * First of all see if we have a clash with all variables of known length
    … …  
    11361347  } :: e.cond (e.contin) s.stop?,
    11371348  s.stop? : 1 =
    1138   <Comp-Sentence () e.Current-Snt e.contin e.Other-Snts> :: e.asail-Snt,
     1349//!     <Comp-Sentence () e.Current-Snt e.contin e.Other-Snts> :: e.asail-Snt,
     1350  <Comp-Sentence s.tail? (v.fails) () e.Sentence> :: e.asail-Snt,
    11391351  e.cond (e.asail-Snt) () $iter {
    11401352    e.cond : e.some (e.last),
    … …  
    14521664      Ref Continue;
    14531665  };
    1454   (VAR t.Ft-name), {
     1666//!     (VAR t.Ft-name), {
     1667  (s t.Ft-name), { // STUB!
    14551668    <Hard-Exp? t.Ft>, {
    14561669      <?? t.Ft-name Flat> : True, {
    … …  
    17241937  (PAREN e.expr) =
    17251938    /*empty*/ Continue;
    1726   (VAR t.name), {
     1939//!     (VAR t.name), {
     1940  (s t.name), { // STUB!
    17271941    <Hard-Exp? (VAR t.name)>, {
    17281942      <?? t.name Instantiated> : True = Instantiated;
    … …  
    18142028        } :: s.new-flat?,
    18152029        (Used t.Rt) t.Rt (e.new-not-inst) s.new-flat?;
     2030      t = t.Rt () 0; // STUB!
    18162031    } :: e.new-compose (e.new-not-inst) s.new-flat? =
    18172032      e.rest (e.compose e.new-compose) (e.not-inst e.new-not-inst)
    … …  
    18222037
    18232038Comp-Cyclic e.clashes =
     2039  <WriteLN ??? e.clashes>,
    18242040  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2 =
    18252041  e.Re : (VAR (e.QualifiedName)),
    … …  
    18502066  s.dir : {
    18512067    LEFT =
     2068      <WriteLN XXXXX e.Cycle>,
    18522069      e.Cycle : t.var-e1 e.rest,
    1853       t.var-e1 : (VAR (e.SplitName)),
     2070//!                     t.var-e1 : (VAR (e.SplitName)),
     2071      t.var-e1 : (s (e.SplitName)), //STUB!
    18542072      {
    18552073//        e.rest : t.var-e2 = t.var-e2;
    … …  
    18572075      } :: t.var-e2,
    18582076      <Declare-Vars "Expr" t.var-e2> : e,
    1859       <Instantiate-Vars t.var-e1 t.var-e2>
     2077//!                     <Instantiate-Vars t.var-e1 t.var-e2>
    18602078      (Assert
    18612079        e.decl
    … …  
    19652183  (e.QualifiedName s.num);
    19662184
    1967 Comp-Re e.Re (e.Snt) =
    1968 //  <WriteLN Re e.Re>,
    1969   \{
    1970     e.Snt : e.rest-Snt (Comp Sentence) e.other-Snts \?
    1971       {
    1972         /*
    1973          * e.Re is NOT the last if in the e.Snt there is any term which
    1974          * differs form (Comp e) or we are inside a negation.
    1975          */
    1976         e.rest-Snt : e t.item e,
    1977           # \{
    1978             t.item : (Comp e);
    1979           } \! $fail;
    1980         e.Snt : \{
    1981           e (Comp Not) e;
    1982           e (Comp Error) e;
    1983           e (Comp Notail) e; // ?????????????
    1984         } \! $fail;
    1985         /*
    1986          * If we can reach here then our Re is the last action in the
    1987          * current path. So we should do TAILCALL or simply assign
    1988          * values to the function output variables. We can get $fail in
    1989          * the following block only in the case of an error. So we send
    1990          * this $fail to the upper sentence.
    1991          */
    1992         {
    1993           e.Re : (CALL t.Fname e.arg-Re) \?
    1994             {
    1995               <In-Table? &Fun? t.Fname> \? \{
    1996                 /*
    1997                  * If the sentence doesn't end with
    1998                  * (Comp Retfail) then we can't do tailcall.
    1999                  */
    2000                 # \{ e.Snt : e (Comp Retfail); } \!\! $fail;
    2001                 /*
    2002                  * Else, if there was '=' after all '\!' and we
    2003                  * are not inside a source block then CAN do
    2004                  * tailcall.
    2005                  */
    2006                 e.other-Snts : (Comp Cutall) e.rest,
    2007                   # \{ e.rest : e (Comp Notail) e; } \! $fail;
    2008                 /* Else, we CAN do tailcall if we are on the
    2009                  * last branch and there weren't any cuts or
    2010                  * NOFAIL blocks.
    2011                  */
    2012                 e.other-Snts : e t.item1 e, \{
    2013                   # t.item1 : \{
    2014                     (Comp s);
    2015                   } \!\! $fail;
    2016                   t.item1 : \{
    2017                     (Comp Cut);
    2018                     (Comp Source (Nofail));
    2019                   } \!\! $fail;
    2020                 };
    2021               };
    2022               \!
    2023               # \{ e.rest-Snt : e (Comp Trap) e; },
    2024                 <Lookup-Func t.Fname> :: s s.tag t (e.Fin) (e.Fout),
    2025                 <Split-Re (<? &Out-Format>) e.Fout> :: e.out,
    2026                 <Split &Second-Empty? (<Zip (<? &Res-Vars>) (e.out)>)>
    2027                   :: (e.empty) (e.res-vars),
    2028                 <Map &Good-Res-Var? (e.res-vars)> : e =
    2029                 <Comp-Calls e.arg-Re> :: e.calls,
    2030                 <Get-Static-Exprs <? &Last-Re>> :: e.comp-Re (e.decls),
    2031                 <Split-Re (e.Fin) e.comp-Re> :: e.sp-Re,
    2032                 (e.calls) e.decls
    2033                 <Comp-Assigns (<Map &Get-Elem 0 (e.empty)>)
    2034                   <Map &Get-Elem 1 (e.empty)>>
    2035                 (Used <Vars e.arg-Re>)
    2036                 (TAILCALL t.Fname (e.sp-Re)
    2037                   (<Map &Get-Elem 0 (e.res-vars)>));
    2038             };
    2039           <Comp-Calls e.Re> :: e.calls,
    2040             <Get-Static-Exprs <? &Last-Re>> :: e.comp-Re (e.decls),
    2041             <Split-Re (<? &Out-Format>) e.comp-Re> :: e.splited-Re,
    2042             (e.calls)
    2043             e.decls <Comp-Assigns (<? &Res-Vars>) e.splited-Re> RETURN;
    2044         };
    2045       };
    2046     <Comp-Calls e.Re> :: e.calls,
    2047 //      <WriteLN! &StdErr "Re Snt" e.Snt>,
    2048       (e.calls)
    2049       <Comp-Sentence () e.Snt>;
    2050   } :: (e.calls) e.asail-Snt,
    2051 //  <WriteLN! &StdErr "Re asail-Snt" e.asail-Snt>,
    2052 //  <WriteLN! &StdErr "Re calls" e.calls>,
    2053   \{
    2054     e.calls : e (Roll-back t) e =
    2055       e.Snt : e.Current-Snt (Comp Sentence) e.Other-Snts =
    2056 //      <Comp-Sentence () e.Other-Snts> :: e.asail-Others,
    2057       e.asail-Snt (e.calls) $iter {
    2058         e.calls : {
    2059           e.first-calls (Roll-back t.call) =
    2060             (IF (t.call) e.asail-Snt) (e.first-calls);
    2061           e.first-calls t.call, {
    2062 //            t.call : (CALL t.Fname t.args (e.ress)),
    2063 //              <In-Table? &Without-Sideffects t.Fname> =
    2064 //              (If-used (e.ress) t.call);
    2065             t.call;
    2066           } :: t.call =
    2067             t.call e.asail-Snt (e.first-calls);
    2068         };
    2069       } :: e.asail-Snt (e.calls),
    2070       e.calls : /*empty*/ =
    2071       e.asail-Snt // e.asail-Others;
    2072       <Comp-Sentence () e.Other-Snts>;
    2073     e.calls e.asail-Snt;
    2074   };
    2075 
    2076 Second-Empty? (t.var ()) = ;
    2077 
    2078 Good-Res-Var? (t.var (t.F-var)) = ;
    2079 
    2080 Comp-Calls e.Re =
    2081 //  <WriteLN Calls e.Re>,
    2082   e.Re () () $iter e.Re : {
    2083     (CALL t.Fname e.arg-Re) e.rest-Re =
    2084       <Lookup-Func t.Fname> :: s s.tag t (e.Fin) (e.Fout),
    2085       (Used <Vars e.arg-Re>) :: e.used,
    2086       <Comp-Calls e.arg-Re> :: e.arg-calls,
    2087       <Split-Re (e.Fin) <? &Last-Re>> :: e.splited-Re,
    2088 //      <WriteLN Comp-Calls e.splited-Re>,
    2089       <Get-Static-Exprs e.splited-Re> :: e.splited-Re (e.decls),
    2090       <RFP-Extract-Qualifiers t.Fname> : t e.prefix,
    2091       /*
    2092        * Find maximum s.num used with such prefix.
    2093        */
    2094       0 <Domain &Vars-Tab> $iter {
    2095         e.vars : e1 ((e.prefix s.n)) e2 =
    2096           <Max s.n s.num> : s.max,
    2097           s.max e2;
    2098         s.num;
    2099       } :: s.num e.vars,
    2100       e.vars : /*empty*/ =
    2101       <Del-Pragmas <Gener-Vars s.num (e.Fout) e.prefix>> : e.res-Re s,
    2102       <Store-Vars <Vars e.res-Re>> :: e.ress,
    2103       <Instantiate-Vars e.ress>,
    2104       <Ref-To-Var <Strip-STVE e.res-Re>> :: e.res-Re,
    2105       e.decls <Declare-Vars "Expr" e.ress> :: e.decls,
    2106       {
    2107         s.tag : FUNC? =
    2108           (Roll-back (CALL t.Fname (e.splited-Re) (e.ress)));
    2109         (CALL t.Fname (e.splited-Re) (e.ress));
    2110       } :: t.call,
    2111       e.rest-Re
    2112       (e.calls e.arg-calls e.decls e.used t.call)
    2113       (e.comp-Re e.res-Re);
    2114     (PAREN e.paren-Re) e.rest-Re =
    2115       <Comp-Calls e.paren-Re> :: e.paren-calls,
    2116       <? &Last-Re> :: e.comp-paren-Re,
    2117       e.rest-Re (e.calls e.paren-calls) (e.comp-Re (PAREN e.comp-paren-Re));
    2118 //    (REF e) e.rest-Re =
    2119 //      e.rest-Re (e.calls) (e.comp-Re);
    2120     t.Rt e.rest-Re =
    2121       e.rest-Re (e.calls) (e.comp-Re t.Rt);
    2122   } :: e.Re (e.calls) (e.comp-Re),
    2123   e.Re : /*empty*/,
    2124   <Store &Last-Re e.comp-Re>,
    2125   e.calls;
    2126 
    2127 /*
    2128  * For the future...
    2129  */
    2130 //Norm-Vars e.Sentence =
    2131 //  e.Sentence () $iter {
    2132 //    e.Sentence : t.Statement e.rest, {
    2133 //      t.Statement : \{
    2134 //        (SVAR e.var) = "s" e.var;
    2135 //        (TVAR e.var) = "v" e.var;
    2136 //        (EVAR e.var) = "e" e.var;
    2137 //        (VVAR e.var) = "t" e.var;
    2138 //      } : s.var-sym e.NEW (e.QualifiedName),
    2139 //        {
    2140 //          e.NEW : NEW = (e.QualifiedName);
    2141 //          (s.var-sym e.QualifiedName);
    2142 //        } :: t.name,
    2143 
    2144 Store-Vars e.vars =
    2145 //  <WriteLN Store-Vars e.vars>,
    2146   e.vars () $iter {
    2147     e.vars : (s.var-tag (e.QualifiedName s.last)) e.rest,
    2148       {
    2149         s.last : 0 = (e.QualifiedName);
    2150         <Int? s.last> = (e.QualifiedName s.last);
    2151         /*empty*/ =
    2152           s.var-tag : {
    2153             SVAR = "s";
    2154             TVAR = "t";
    2155             VVAR = "v";
    2156             EVAR = "e";
    2157             VAR = /*empty*/;
    2158           } :: e.var-sym,
    2159           (e.var-sym e.QualifiedName s.last);
    2160       } :: t.name,
    2161       {
    2162         <In-Table? &Vars-Tab t.name>; // do nothing
    2163         <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
    2164           {
    2165             s.var-tag : VAR =
    2166               <Lookup &Var-Tags (VAR t.name)>;
    2167             s.var-tag;
    2168           } : {
    2169             SVAR =
    2170               <Set-Var t.name (Min) (1)>,
    2171               <Set-Var t.name (Max) (1)>,
    2172               <Set-Var t.name (Length) (1)>,
    2173               <Set-Var t.name (Flat) (True)>;
    2174             TVAR =
    2175               <Set-Var t.name (Min) (1)>,
    2176               <Set-Var t.name (Max) (1)>,
    2177               <Set-Var t.name (Length) (1)>;
    2178             VVAR =
    2179               <Set-Var t.name (Min) (1)>;
    2180 //              <Set-Var t.name (Max) ()>;
    2181             EVAR =
    2182               <Set-Var t.name (Min) (0)>;
    2183 //              <Set-Var t.name (Max) ()>;
    2184           },
    2185           <Set-Var t.name (Left-compare) ()>,
    2186           <Set-Var t.name (Right-compare) ()>,
    2187           <Set-Var t.name (Left-checks) ()>,
    2188           <Set-Var t.name (Right-checks) ()>,
    2189           <Set-Var t.name (Format) ((VAR t.name))>;
    2190       },
    2191       e.rest (e.new-vars (VAR t.name));
    2192   } :: e.vars (e.new-vars),
    2193   e.vars : /*empty*/ =
    2194   e.new-vars;
    2195 
    2196 Declare-Vars s.type e.vars =
    2197   e.vars () $iter {
    2198     e.vars : (VAR t.name) e.rest, {
    2199       <?? t.name Declared> : True;  // do nothing
    2200       {
    2201         <In-Table? &Vars-Tab t.name>; // do nothing
    2202         <Table> :: s.tab, <Bind &Vars-Tab (t.name) (s.tab)>,
    2203           <Set-Var t.name (Left-compare) ()>,
    2204           <Set-Var t.name (Right-compare) ()>,
    2205           <Set-Var t.name (Left-checks) ()>,
    2206           <Set-Var t.name (Right-checks) ()>,
    2207           <Set-Var t.name (Format) ((VAR t.name))>,
    2208           <Set-Var t.name (Min) (0)>;
    2209       },
    2210         <Set-Var t.name (Declared) (True)>,
    2211         (DECL s.type (VAR t.name));
    2212     } :: e.new-decl,
    2213     e.rest (e.decls e.new-decl);
    2214   } :: e.vars (e.decls),
    2215   e.vars : /*empty*/ =
    2216   e.decls;
    2217 
    2218 Instantiate-Vars e.vars =
    2219   e.vars $iter {
    2220     e.vars : (VAR t.name) e.rest,
    2221       <Set-Var t.name (Instantiated) (True)>,
    2222       e.rest;
    2223   } :: e.vars,
    2224   e.vars : /*empty*/;
    2225 
    2226 Comp-Assigns (e.vars) e.splited-Re =
    2227 //  <WriteLN Comp-Assigns '<'e.vars'>' e.splited-Re>,
    2228   <Instantiate-Vars e.vars>,
    2229   e.vars (e.splited-Re) () $iter {
    2230     e.vars : t.var e.rest-vars,
    2231       e.splited-Re : (e.Re) e.rest-Re,
    2232       t.var : (VAR t.name),
    2233       <Set-Var t.name (Format) (<Format-Exp e.Re>)>,
    2234       <Get-Static-Exprs e.Re> :: e.Re (e.decls),
    2235       e.rest-vars (e.rest-Re)
    2236       (e.assignments e.decls
    2237         (If-used (t.var) (Used <Vars e.Re>) (ASSIGN t.var e.Re))
    2238       );
    2239   } :: e.vars (e.splited-Re) (e.assignments),
    2240   e.vars : /*empty*/,
    2241   e.assignments;
     2185Add-To-Label (e.label) e.name = <Gener-Label e.label "_" e.name>;
    22422186
    22432187Get-Static-Exprs e.Re =
    … …  
    22892233};
    22902234
    2291 /*
    2292  * Generates indexes for all varibles in e.Format and returns e.Format with all
    2293  * (?VAR) changed to (?VAR (e.Name)) and s.max. e.Name is all words from
    2294  * e.prefix plus unical number. Numbers are generated sequentially starting
    2295  * with s.num. s.max is the maximum of all generated numbers.
    2296  */
    2297 Gener-Vars s.num (e.Format) e.prefix, {
    2298   e.Format : t.Ft e.rest, t.Ft : {
    2299     s.ObjectSymbol = t.Ft <Gener-Vars s.num (e.rest) e.prefix>;
    2300     (REF e) = t.Ft <Gener-Vars s.num (e.rest) e.prefix>;
    2301     (PAREN e.Fe) =
    2302       <Gener-Vars s.num (e.Fe) e.prefix> :: expr s.num,
    2303       (PAREN expr) <Gener-Vars s.num (e.rest) e.prefix>;
    2304     (s.VariableTag) =
    2305       <"+" s.num 1> :: s.num,
    2306       (s.VariableTag (PRAGMA) (e.prefix s.num)) <Gener-Vars s.num (e.rest) e.prefix>;
    2307   };
    2308   /*
    2309    * e.Format is empty, so return s.num -- the last term in the answer.
    2310    */
    2311   s.num;
    2312 };
    2313 
    2314 Strip-STVE expr = <Subst (SVAR TVAR VVAR EVAR) ((VAR) (VAR) (VAR) (VAR)) expr>;
    2315 
    2316 Vars e.expr =
    2317   e.expr () $iter {
    2318     e.expr : t.first e.rest,
    2319       t.first : {
    2320         s.ObjectSymbol = /*empty*/;
    2321         (REF t.Name) = /*empty*/;
    2322         (PAREN e.ResultExpression) = <Vars e.ResultExpression>;
    2323         (CALL (PRAGMA (e) e) t.Fname e.ResultExpression) =
    2324           <Vars e.ResultExpression>;
    2325         (CALL t.Fname e.ResultExpression) = <Vars e.ResultExpression>;
    2326         t.var = t.var;  // t.var ::= (EVAR t.Name) | (VVAR t.Name)
    2327                 //         | (TVAR t.Name) | (SVAR t.Name)
    2328       } :: e.var =
    2329       e.rest (e.vars e.var);
    2330   } :: e.expr (e.vars),
    2331   e.expr : /*empty*/ =
    2332   e.vars;
    2333 
    23342235Length-of {
    23352236  /*empty*/ = 0;
    … …  
    23442245          (Used t.Rt) (LENGTH t.Rt);
    23452246        };
     2247        t = (LENGTH t.Rt); // STUB!
    23462248      } :: e.new-len,
    23472249      e.rest (e.Length e.new-len);
    … …  
    23752277      e.rest;
    23762278  } :: e.expr,
    2377   e.expr : /*empty*/;
    2378 
    2379 Parenthesize-Operators e.Snt = <Map &Paren-Op (e.Snt)>;
    2380 
    2381 Paren-Op t.Op, {
    2382   t.Op : (s.tag e),
    2383     RESULT LEFT RIGHT HARD : e s.tag e = t.Op;
    2384   NOFAIL FAIL CUTALL CUT STAKE ERROR : e t.Op e = (t.Op);
    2385   t.Op : (e.expr) = (<Parenthesize-Operators e.expr>);
    2386   t.Op;
    2387 };
    2388 
    2389 ///*
    2390 // * Add "VAR" before each SVAR, TVAR, VVAR, and EVAR.
    2391 // */
    2392 //Norm-Vars e.Snt =
    2393 //  () e.Snt $iter {
    2394 //    e.Snt : t.Statement e.rest, {
    2395 //      t.Statement : \{ (SVAR e); (TVAR e); (VVAR e); (EVAR e); } =
    2396 //        t.Statement : (e.var),
    2397 //        (e.new-Snt (VAR e.var)) e.rest;
    2398 //      t.Statement : (e.expr) =
    2399 //        (e.new-Snt (<Norm-Vars e.expr>)) e.rest;
    2400 //      /*
    2401 //       * Else we have symbol. So proceed with the rest.
    2402 //       */
    2403 //      (e.new-Snt t.Statement) e.rest;
    2404 //    };
    2405 //  } :: (e.new-Snt) e.Snt,
    2406 //  e.Snt : /*empty*/ =
    2407 //  e.new-Snt;
    2408  
     2279  e.expr : /*empty*/,
     2280  = $fail; // STUB!
     2281
    24092282Print-Error s.WE e.Descrip t.Pragma =
    24102283  <? &Error-Counter> : s.n,
    … …  
    24442317};
    24452318
    2446 ?? t.name e.key =
    2447   <Lookup &Vars-Tab t.name> : s.tab,
    2448   <Lookup s.tab e.key>;
    2449 
    2450 Set-Var t.name (e.key) (e.val) =
    2451 //  <WriteLN Set-Var t.name (e.key)>,
    2452   <Lookup &Vars-Tab t.name> : s.tab,
    2453   <Bind s.tab (e.key) (e.val)>;
    2454 
    24552319Lookup-Func t.Fname, \{
    24562320  <Lookup &Fun t.Fname>;

  • to-imperative/trunk/compiler/rfp_compile.rfi

    r222 r683  
    1818$table Object;
    1919
    20 $table Var-Tags;
    21 
    2220// Print error or warning message
    2321$func Print-Error s.warning-or-error? e.description t.pragma = ;
    … …  
    2624$func? Lookup-Func t.Fname = s.linkage s.tag t.pragma (e.Fin) (e.Fout);
    2725
    28 $func Vars e.expr = e.vars;
    29 
    30 $func Gener-Vars s.num (e.Format) e.prefix = e.Re s.max;
    31 
    3226$func Ref-To-Var e.Snt = e.Snt;
    3327
    34 $func? ?? t.name e.key = e.val;
    35 

  • to-imperative/trunk/compiler/rfp_format.rf

    r222 r683  
    77$use "rfp_list";
    88$use "rfp_compile";
     9$use "rfp_vars";
    910
    1011$func Split-Rt t.Ft t.Rt = e.splited-Rt;
    … …  
    4748      // (BLOCK e.Branches) = ...
    4849      (PAREN e.Expression) = (PAREN <Format-Exp e.Expression>);
    49       (VAR t.name), {
    50         (<Lookup &Var-Tags t.first>);
    51         <?? t.name Format>;
    52       };
     50      (VAR t.name) = <?? t.name Format>;
    5351      (s.VariableTag e) = (s.VariableTag); // s.VariableTag ::= SVAR | TVAR
    5452    } :: e.first-format =          //         | VVAR | EVAR

  • to-imperative/trunk/compiler/rfp_helper.rf

    r420 r683  
    1616
    1717Put s.box expr = <Store s.box <? s.box> expr>;
     18
     19$table Empty-Table;
     20
     21RFP-Clear-Table s.tbl =
     22/*
     23  <Domain s.tbl> :: e.keys,
     24  {
     25    e.keys : e (e.key) e, <Unbind s.tbl e.key>, $fail;;
     26  };
     27*/
     28  <Replace-Table s.tbl &Empty-Table>;
     29
     30RFP-Debug? =
     31  <In-Table? &RFP-Options DEBUG>;
    1832
    1933RFP-Double-Copy s.tab =
    … …  
    3751  (e1 s2 s3 e4), <Int? s3> = (e1) s2 s3 e4;
    3852  (e1 s2) = (e1) s2;
     53};
     54
     55Del-Pragmas {
     56  eL t.Item eR, t.Item : \{
     57    (PRAGMA e) = eL <Del-Pragmas eR>;
     58    (expr) = eL (<Del-Pragmas expr>) <Del-Pragmas eR>;
     59  };
     60  e1 = e1;
    3961};
    4062

  • to-imperative/trunk/compiler/rfp_helper.rfi

    r420 r683  
    22// $Revision$
    33// $Date$
     4
     5$table RFP-Options ;
    46
    57$func Abs s.num = s.abs;
    … …  
    1012$func Put s.box expr = ;
    1113
     14$func RFP-Clear-Table s.tbl = ;
     15
     16$func? RFP-Debug? = ;
     17
    1218$func RFP-Double-Copy s.tab = s.new-tab;
    1319
    … …  
    1521
    1622$func RFP-Extract-Qualifiers t.Name = (e.qualifiers) e.name;
     23
     24$func Del-Pragmas e.Sentence = e.Sentence;
    1725
    1826// substitute replacements for each occurence of corresponding patterns in expr

  • to-imperative/trunk/compiler/rfp_lex.rf

    r420 r683  
    2222
    2323// rfp_lex.rfi
    24 $use "rfpc" ; // rfp.rfi
     24$use "rfpc" ; // rfpc.rfi
     25$use "rfp_helper" ; // rfp_helper.rfi
    2526$use "rfp_src" ; // rfp_src.rfi
    2627$use "rfp_err" ; // rfp_err.rfi

  • to-imperative/trunk/compiler/rfp_list.rf

    r222 r683  
     1// $Source$
     2// $Revision$
     3// $Date$
     4
    15$use Apply Access Arithm;
    26

  • to-imperative/trunk/compiler/rfp_list.rfi

    r222 r683  
     1// $Source$
     2// $Revision$
     3// $Date$
     4
    15$func Zip (e.list1) (e.list2) = e.new-list;
    26

  • to-imperative/trunk/compiler/rfp_mangle.rf

    r419 r683  
    6464    (TVAR (e.name)) = ('_vt_') e.name;
    6565    (SVAR (e.name)) = ('_vs_') e.name;
     66    (STATIC (e.name)) = ('_c_') e.name;
    6667    (LABEL (e.name)) = () e.name;
    6768  } :: (e.prefix) e.name =

  • to-imperative/trunk/compiler/rfp_parse.rf

    r420 r683  
    2323// rfp_parse.rfi
    2424$use "rfpc" ; // rfpc.rfi
     25$use "rfp_helper" ; // rfp_helper.rfi
    2526$use "rfp_src" ; // rfp_src.rfi
    2627$use "rfp_err" ; // rfp_err.rfi
    … …  
    476477          e.items : = (LEFT <Pragma e.pos>);
    477478          {
    478             s.type : LBRACE = NOFAIL (BLOCK <Pragma e.pos> e.items);
    479             (BLOCK <Pragma e.pos> e.items);
     479            s.type : LBRACE = (BLOCK <Pragma e.pos> e.items);
     480            (BLOCK? <Pragma e.pos> e.items);
    480481          };
    481482        };
    … …  
    559560            <Expect-Token RBRACE EMPTY> : (e) (RBRACE e),
    560561            {
    561               s.type : LBRACE = NOFAIL (BLOCK <Pragma e.pos> e.items);
    562               (BLOCK <Pragma e.pos> e.items);
     562              s.type : LBRACE = (BLOCK <Pragma e.pos> e.items);
     563              (BLOCK? <Pragma e.pos> e.items);
    563564            };
    564565    (RESULT <Pragma e.pos> <Parse-Result>);

  • to-imperative/trunk/compiler/rfpc.rf

    r638 r683  
    221221              $fail;
    222222            <In-Table? &RFP-Options CC>,
    223               e.Items : e (MODULE t.asail-mod-name e.module),
    224               { <In-Table? &RFP-Options NO-OPTIM> = e.module;
     223              e.Items : e (MODULE t.asail-mod-name v.module),
     224              {
     225                <In-Table? &RFP-Options NO-OPTIM> = v.module;
    225226                <Verbose "optimization as-ail started">,
    226                 <ASAIL-Optim e.module>::e.module,
    227                 <Verbose "optimization as-ail finished">, e.module;
     227                  <ASAIL-Optim v.module> :: e.module,
     228                  <Verbose "optimization as-ail finished"> =
     229                  e.module;
    228230              } :: e.module ,
    229231              <Verbose "compilation from as-ail to c++ started">,
    … …  
    277279    "output Abstract Syntax of Abstract Imperative" "Language")
    278280  ((('d') ('debug')) (BIND DEBUG))
    279   ((('no')('no-optim'))(BIND NO-OPTIM)"don't perform ASAIL-optimization")
     281  ((('no') ('no-optim')) (BIND NO-OPTIM) "don't perform ASAIL-optimization")
    280282>;
    281283
    … …  
    477479  <? s.includes>;
    478480
    479 $table Empty-Table;
    480 
    481 RFP-Clear-Table s.tbl =
    482 /*
    483   <Domain s.tbl> :: e.keys,
    484   {
    485     e.keys : e (e.key) e, <Unbind s.tbl e.key>, $fail;;
    486   };
    487 */
    488   <Replace-Table s.tbl &Empty-Table>;
    489 
    490 RFP-Debug? =
    491   <In-Table? &RFP-Options DEBUG>;
    492 

  • to-imperative/trunk/compiler/rfpc.rfi

    r222 r683  
    2727$box RFP-Include-Path ;
    2828$box RFP-Token-Stack ;
    29 $table RFP-Options ;
    3029
    3130$func Main = e ;
    3231$func RFP-Pretty-Print s.channel (e.indent) e.expr = ;
    3332//$func RFP-Print-Program e.program = ;
    34 $func RFP-Clear-Table s.tbl = ;
    35 $func? RFP-Debug? = ;
Note: See TracChangeset for help on using the changeset viewer.