Changeset 712


Ignore:
Timestamp:
May 3, 2003, 1:44:31 PM (18 years ago)
Author:
orlov
Message:
  • Added support for objects. DECL-OBJ form in ASAIL.
  • Added INT form in ASAIL for defining integer variables.
  • Worked on clashes compilation (not finished yet).
Location:
to-imperative/trunk/compiler
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • to-imperative/trunk/compiler/rfp_asail.rf

    r694 r712  
    1111$box Module-Name;
    1212
    13 $box Func-Names;
    14 
    1513$box Current-Namespace;
    1614
     
    2523$func Expr-To-CPP (e.ASAIL-Expr-init ) e.ASAIL-Expr-rest = e.ASAIL-Expr;
    2624
    27 $func Expr-Ref-To-CPP s.inner-call? e.ASAIL-Expr-Ref = e.CPP-Expr-Ref;
     25$func Expr-Ref-To-CPP e.ASAIL-Expr-Ref = e.CPP-Expr-Ref;
    2826
    2927$func Expr-Int-To-CPP e.ASAIL-Expr-Int = e.CPP-Expr-Int;
     
    4745RFP-ASAIL-To-CPP (e.ModuleName) e.asail =
    4846  <Store &Module-Name e.ModuleName>,
    49   <Store &Func-Names /*empty*/>,
    5047  <Store &Current-Namespace /*empty*/>,
    5148  <Store &Entry (e.ModuleName Main)>,
     
    5754      } :: e.close-namespace,
    5855      <Store &Current-Namespace /*empty*/>,
    59       <Box> :: s.func-decls,
    60       {
    61         <? &Func-Names> : e t.name e,
    62           <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
    63           <Put s.func-decls
    64             <Namespace-Control e.qualifiers>
    65             ('RF_DECL (' <Rfp2Cpp e.name> ');')
    66           >, $fail;
    67         <? s.func-decls> : v = <Put s.func-decls ('}')>;;
    68       },
    6956      {
    7057        <? &Entry-Name> : v.name = ('rfrt::Entry rf_entry (' v.name ');');;
     
    7259      ('namespace refal\n{')
    7360      ('using namespace rfrt;')
    74       <? s.func-decls> v.cpp e.close-namespace e.entry
     61      v.cpp e.close-namespace e.entry
    7562      ('}');;
    7663  };
     
    7966  e.asail : t.item e.rest, t.item : {
    8067    (FUNC t.name (e.args) (e.ress) e.body) =
    81       <Put &Func-Names t.name>,
    8268      { <? &Entry> : t.name = <Store &Entry-Name <Rfp2Cpp t.name>>;; },
    8369      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
     
    11298    FATAL = ('error ("Unexpected fail");');
    11399    (LSPLIT e.expr (e.min) t.var1 t.var2) =
    114       ('lsplit (' <Expr-Ref-To-CPP 0 e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
     100      ('lsplit (' <Expr-Ref-To-CPP e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
    115101      <Rfp2Cpp t.var1> ', ' <Rfp2Cpp t.var2> ');');
    116102    (RSPLIT e.expr (e.min) t.var1 t.var2) =
    117       ('rsplit (' <Expr-Ref-To-CPP 0 e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
     103      ('rsplit (' <Expr-Ref-To-CPP e.expr> ', ' <Expr-Int-To-CPP e.min> ', '
    118104      <Rfp2Cpp t.var1> ', ' <Rfp2Cpp t.var2 > ');');
    119105    (ASSIGN t.var e.expr) =
     
    121107    (DECL s.type t.var) =
    122108      (s.type ' ' <Rfp2Cpp t.var> ';');
     109    (INT  t.var e.expr) =
     110      ('uintptr_t ' <Rfp2Cpp t.var> ' = ' <Expr-Int-To-CPP e.expr> ';');
    123111    (EXPR t.var e.expr) =
    124       ('Expr ' <Rfp2Cpp t.var> ' (' <Expr-Ref-To-CPP 0 e.expr> ');');
     112      ('Expr ' <Rfp2Cpp t.var> ' (' <Expr-Ref-To-CPP e.expr> ');');
    125113    (DEREF t.var e.expr (e.pos)) =
    126       ('Expr ' <Rfp2Cpp t.var> ' (' <Expr-Ref-To-CPP 0 e.expr> ', '
     114      ('Expr ' <Rfp2Cpp t.var> ' (' <Expr-Ref-To-CPP e.expr> ', '
    127115      <Expr-Int-To-CPP e.pos> ');');
    128116    (SUBEXPR t.var e.expr (e.pos) (e.len)) =
    129117      ('Expr ' <Rfp2Cpp t.var> ' ('
    130       <Expr-Ref-To-CPP 0 e.expr> ', ' <Expr-Int-To-CPP e.pos> ', '
     118      <Expr-Ref-To-CPP e.expr> ', ' <Expr-Int-To-CPP e.pos> ', '
    131119      <Expr-Int-To-CPP e.len> ');');
    132120    (DROP t.var) =
     
    137125      ('goto ' <Rfp2Cpp (LABEL t.label)> ';');
    138126    (ERROR e.expr) =
    139       ('error (' <Expr-Ref-To-CPP 0 e.expr> ');');
     127      ('error (' <Expr-Ref-To-CPP e.expr> ');');
    140128    (CONSTEXPR s.linkage t.name (e.comment) e.expr) =
    141129      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
     
    147135      (e.linkage 'const Expr ' <Rfp2Cpp e.name> ' = '
    148136        <Const-Expr-To-CPP e.expr> ';');
    149     (DECL-CONST t.name) =
     137    (DECL-OBJ s.linkage s.tag t.name) =
     138      { s.linkage : LOCAL = 'static ';; } :: e.linkage,
     139      <To-Chars s.tag> : s1 e2,
    150140      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
    151141      <Namespace-Control e.qualifiers>
    152       ('extern const Expr ' <Rfp2Cpp e.name> ';');
    153     (DECL-FUNC t.name) =
     142      (e.linkage 'const Expr ' <Rfp2Cpp e.name>
     143        ' = new rftype::' s1 <To-Lower e2> ' ();');
     144    (DECL-FUNC s.linkage t.name) =
    154145      <RFP-Extract-Qualifiers t.name> :: (e.qualifiers) e.name,
    155146      <Namespace-Control e.qualifiers>
     
    170161 */
    171162Expr-To-CPP  (e.init) e.expr-all, e.expr-all : {
    172   /*empty*/ = <Expr-Ref-To-CPP 0 e.init>;
     163  /*empty*/ = <Expr-Ref-To-CPP e.init>;
    173164//  s.ObjectSymbol e.rest, {
    174165//    <Int? s.ObjectSymbol> = <Expr-Int-To-CPP e.init e.expr-all>;
    175 //    <Expr-Ref-To-CPP 0 e.expr-all>;
     166//    <Expr-Ref-To-CPP e.expr-all>;
    176167//  };   
    177   (PAREN e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
    178   (EXPR e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
    179   (DEREF e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
    180   (SUBEXPR e.expr) e.rest = <Expr-Ref-To-CPP 0 e.init e.expr-all>;
     168  (PAREN e.expr) e.rest = <Expr-Ref-To-CPP e.init e.expr-all>;
     169  (EXPR e.expr) e.rest = <Expr-Ref-To-CPP e.init e.expr-all>;
     170  (DEREF e.expr) e.rest = <Expr-Ref-To-CPP e.init e.expr-all>;
     171  (SUBEXPR e.expr) e.rest = <Expr-Ref-To-CPP e.init e.expr-all>;
    181172  (LENGTH e.expr) e.rest = <Expr-Int-To-CPP e.init e.expr-all> ;
    182173  (MAX e.args) e.rest = <Expr-Int-To-CPP e.init e.expr-all>;         
     
    187178};
    188179
    189 Expr-Ref-To-CPP s.inner-call? e.expr-ref, e.expr-ref : {
    190   t.item e.rest =
     180
     181$func Term-Ref-To-CPP e = e;
     182
     183Expr-Ref-To-CPP {
     184  /*empty*/ = 'empty';
     185  term = <Term-Ref-To-CPP term>;
     186  expr = '(' <Infix-To-CPP &Term-Ref-To-CPP "+" <Paren expr>> ')';
     187};
     188
     189Term-Ref-To-CPP {
     190  (PAREN e.expr) =
     191    <Expr-Ref-To-CPP e.expr> ' ()';
     192  (EXPR e.expr) =
     193    'Expr (' <Expr-Ref-To-CPP e.expr> ')';
     194  (DEREF e.expr (e.pos)) =
     195    'Expr (' <Expr-Ref-To-CPP e.expr> ', ' <Expr-Int-To-CPP e.pos> ')';
     196  (SUBEXPR e.expr (e.pos) (e.len)) =
     197    'Expr (' <Expr-Ref-To-CPP e.expr> ', '
     198        <Expr-Int-To-CPP e.pos>   ', ' <Expr-Int-To-CPP e.len> ')';
     199  (REF t.name) = <Name-To-CPP t.name>;
     200  (s.var-tag t.name) = <Rfp2Cpp (s.var-tag t.name)>;
     201};
     202
     203Expr-Int-To-CPP {
     204  /*empty*/ = /*empty*/;
     205  s.ObjectSymbol =
    191206    {
    192       e.rest : v = ' + ';
    193       /*empty*/;
    194     } :: e.plus,
    195     t.item : {
    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         };
    202       (EXPR e.expr) =
    203         'Expr (' <Expr-Ref-To-CPP 0 e.expr> ')';
    204       (DEREF e.expr (e.pos)) =
    205         'Expr (' <Expr-Ref-To-CPP 0 e.expr> ', '
    206              <Expr-Int-To-CPP e.pos> ')';
    207       (SUBEXPR e.expr (e.pos) (e.len)) =
    208         'Expr (' <Expr-Ref-To-CPP 0 e.expr> ', '
    209              <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
    210       (s.var-tag (e.QualifiedName)) = <Rfp2Cpp t.item>;
    211       ex = $error ("Illegal type ref-expr : " ex );
    212     } :: e.cpp-item,
    213     e.cpp-item e.plus <Expr-Ref-To-CPP 1 e.rest>;
    214   /*empty*/ =
    215     {
    216       s.inner-call? : 1 = /*empty*/;
    217       'empty';
     207      <Int? s.ObjectSymbol> = s.ObjectSymbol;
     208      $error ("Illegal type int-symbol: " s.ObjectSymbol);
    218209    };
    219 };
    220 
    221 Expr-Int-To-CPP {
    222   t.item e.rest =
    223     {
    224       e.rest : v = ' + ';
    225       /*empty*/;
    226     } :: e.plus,
    227     t.item : {
    228       s.ObjectSymbol =
    229         {
    230           <Int? s.ObjectSymbol> = s.ObjectSymbol;
    231           $error ("Illegal type int-symbol: " s.ObjectSymbol);
    232         };
    233       (LENGTH e.expr) =
    234         '(int) ' <Expr-Ref-To-CPP 0 e.expr> '.get_len ()';
    235       (MAX e.args) =
    236         'pxx_max (' <Args-To-CPP () Ints e.args> ')';
    237       (MIN e.args) =
    238         'pxx_min (' <Args-To-CPP () Ints e.args> ')';
    239       (INFIX s.op e.args) =
    240         '(' <Infix-To-CPP &Expr-Int-To-CPP s.op e.args> ')';
    241       (s.var-tag (e.QualifiedName)) = <Rfp2Cpp t.item>;
    242       ex = $error ("Illegal type ref-int : " ex );
    243     } :: e.cpp-item,
    244     e.cpp-item e.plus <Expr-Int-To-CPP e.rest>;
    245   /*empty*/ = /*empty*/;
     210  (LENGTH e.expr) =
     211    <Expr-Ref-To-CPP e.expr> '.get_len ()';
     212  (MAX e.args) =
     213    'pxx_max (' <Args-To-CPP () Ints e.args> ')';
     214  (MIN e.args) =
     215    'pxx_min (' <Args-To-CPP () Ints e.args> ')';
     216  (INFIX s.op e.args) =
     217    '(' <Infix-To-CPP &Expr-Int-To-CPP s.op e.args> ')';
     218  (REF t.name) = <Name-To-CPP t.name>;
     219  (s.var-tag t.name) = <Rfp2Cpp (s.var-tag t.name)>;
     220  expr = '(' <Infix-To-CPP &Expr-Int-To-CPP "+" <Paren expr>> ')';
    246221};
    247222
    248223Cond-To-CPP {
    249224  /*empty*/ = /*empty*/;
    250   t.cond-term e.rest =
    251     {
    252       e.rest : v = ' && ';
    253       /*empty*/;
    254     } :: e.and,
    255     t.cond-term : {
    256       (CALL t.name (e.exprs) (e.ress)) =
    257         'RF_CALL (' <Name-To-CPP t.name> ', '
    258         '(' <Args-To-CPP () Exprs e.exprs> '), '
    259         '(' <Args-To-CPP () Vars e.ress> '))';
    260       (SYMBOL? e.expr (e.pos)) =
    261          <Expr-Ref-To-CPP 0 e.expr> '.symbol_at (' <Expr-Int-To-CPP e.pos> ')';
    262       (FLAT-SUBEXPR? e.expr (e.pos) (e.len)) =
    263          <Expr-Ref-To-CPP 0 e.expr> '.flat_at ('
    264           <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
    265       /*
    266        * EQ -> to function eq() with 6 arg.
    267        */
    268       (EQ (e.expr1) (e.pos1) (e.len1) (e.expr2) (e.pos2) (e.len2)) =
    269         'Expr::eq ('<Expr-Ref-To-CPP 0 e.expr1> ', '
    270               <Expr-Int-To-CPP e.pos1>    ', ' <Expr-Int-To-CPP e.len1> ', '
    271               <Expr-Ref-To-CPP 0 e.expr2> ', '
    272               <Expr-Int-To-CPP e.pos2>    ', ' <Expr-Int-To-CPP e.len2> ')';
    273       /*
    274        * FLAT-EQ -> to function flat_eq() with 5 arg.
    275        */
    276       (FLAT-EQ (e.expr1) (e.pos1) (e.expr2) (e.pos2) (e.len)) =
    277         'Expr::flat_eq ('<Expr-Ref-To-CPP 0 e.expr1> ', ' <Expr-Int-To-CPP e.pos1>
    278               ', ' <Expr-Ref-To-CPP 0 e.expr2> ', ' <Expr-Int-To-CPP e.pos2>
    279               ', ' <Expr-Int-To-CPP e.len> ')';
    280       (NOT e.cond) =
    281         '!' <Cond-To-CPP e.cond>;
    282       (INFIX s.op e.args) =
    283         '(' <Infix-To-CPP <Op-Arg-To-CPP s.op> s.op e.args> ')';
    284     } :: e.cpp-term,
    285     e.cpp-term e.and <Cond-To-CPP e.rest>;
     225  (CALL t.name (e.exprs) (e.ress)) =
     226    'RF_CALL (' <Name-To-CPP t.name> ', '
     227    '(' <Args-To-CPP () Exprs e.exprs> '), '
     228    '(' <Args-To-CPP () Vars e.ress> '))';
     229  (SYMBOL? e.expr (e.pos)) =
     230    <Expr-Ref-To-CPP e.expr> '.symbol_at (' <Expr-Int-To-CPP e.pos> ')';
     231  (FLAT-SUBEXPR? e.expr (e.pos) (e.len)) =
     232    <Expr-Ref-To-CPP e.expr> '.flat_at ('
     233      <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
     234  /*
     235   * EQ -> to function eq() with 6 arg.
     236   */
     237  (EQ (e.expr1) (e.pos1) (e.len1) (e.expr2) (e.pos2) (e.len2)) =
     238    'Expr::eq ('<Expr-Ref-To-CPP e.expr1> ', '
     239          <Expr-Int-To-CPP e.pos1>  ', ' <Expr-Int-To-CPP e.len1> ', '
     240          <Expr-Ref-To-CPP e.expr2> ', '
     241          <Expr-Int-To-CPP e.pos2>  ', ' <Expr-Int-To-CPP e.len2> ')';
     242  /*
     243   * FLAT-EQ -> to function flat_eq() with 5 arg.
     244   */
     245  (FLAT-EQ (e.expr1) (e.pos1) (e.expr2) (e.pos2) (e.len)) =
     246    'Expr::flat_eq ('<Expr-Ref-To-CPP e.expr1> ', ' <Expr-Int-To-CPP e.pos1>
     247          ', ' <Expr-Ref-To-CPP e.expr2> ', ' <Expr-Int-To-CPP e.pos2>
     248          ', ' <Expr-Int-To-CPP e.len> ')';
     249  (NOT e.cond) =
     250    '!' <Cond-To-CPP e.cond>;
     251  (INFIX s.op e.args) =
     252    '(' <Infix-To-CPP <Op-Arg-To-CPP s.op> s.op e.args> ')';
     253  expr = '(' <Infix-To-CPP &Cond-To-CPP "&&" <Paren expr>> ')';
    286254};
    287255
    288256Infix-To-CPP s.arg2cpp s.op e.args, {
    289257  e.args : (e.arg) e.rest =
     258    <Apply s.arg2cpp e.arg> :: e.arg,
     259    <Infix-To-CPP s.arg2cpp s.op e.rest> :: e.rest,
    290260    {
    291       e.rest : v = ' ' s.op ' ';
    292       /*empty*/;
    293     } :: e.cpp-op,
    294     '(' <Apply s.arg2cpp e.arg> ')' e.cpp-op <Infix-To-CPP s.arg2cpp s.op e.rest>;;
     261      e.arg : v, e.rest : v = e.arg ' ' s.op ' ' e.rest;
     262      e.arg e.rest;
     263    };;
    295264};
    296265
    297266Op-Arg-To-CPP s.op, {
    298   s.op : \{ "&&"; "||"; } = &Cond-To-CPP;
    299   s.op : \{ "<"; ">"; "<="; ">="; "=="; "+"; "-"; "%"; "*"; "/"; } = &Expr-Int-To-CPP;
     267  s.op : \{ "&&"; "||"; } =
     268    &Cond-To-CPP;
     269  s.op : \{ "<"; ">"; "<="; ">="; "=="; "!="; "+"; "-"; "%"; "*"; "/"; } =
     270    &Expr-Int-To-CPP;
    300271};
    301272 
     
    330301    (PAREN e.paren-expr) =
    331302      ' + (' <Const-Expr-To-CPP e.paren-expr> ') ()';
    332     (REF (e.QualifiedName)) =
    333       ' + ' <Name-To-CPP (e.QualifiedName)>;
     303    (REF t.name) =
     304      ' + ' <Name-To-CPP t.name>;
    334305    (STATIC e) =
    335306      ' + ' <Rfp2Cpp t.item>;
     
    382353        s.tag : {
    383354          Vars = e.rest (e.cpp-args <Rfp2Cpp (e.arg)> e.comma);
    384           Exprs = e.rest (e.cpp-args <Expr-Ref-To-CPP 0 e.arg> e.comma);
     355          Exprs = e.rest (e.cpp-args <Expr-Ref-To-CPP e.arg> e.comma);
    385356          Ints = e.rest (e.cpp-args <Expr-Int-To-CPP e.arg> e.comma);
    386357        };
  • to-imperative/trunk/compiler/rfp_compile.rf

    r694 r712  
    6565$box Less-Ineqs;
    6666
    67 $const New-Clash-Tags = Unknown-length Ties Check-symbols Dereference Compare;
    68 
    6967$table Static-Exprs;
    7068
     
    7775$func Length-of e.Re = e.length;
    7876
    79 $func Ref-Len t.name = s.length;
     77$func? Flat-Const? e.const = ;
    8078
    8179$func? Hard-Exp? e.expr = ;
     
    166164
    167165************ Get AS-Items and targets, and pass it to Compile ************
     166
     167/*
     168 * Ящик для объявлений статических функций, констант и объектов.  Все они
     169 * выписываются в самом начале тела модуля.
     170 */
     171$box Declarations;
    168172
    169173RFP-Compile e.Items =
    170174  { <Lookup &RFP-Options ITEMS>;; } :: e.targets,
     175  <Store &Declarations /*empty*/>,
    171176  <Init-Consts>,
    172177  <Compile (e.targets) () e.Items> :: e.Items t.Interface,
    173   t.Interface (MODULE <Comp-Consts> e.Items);
     178  t.Interface (MODULE <? &Declarations> <Comp-Consts> e.Items);
    174179
    175180
     
    183188        e.targets : e t.name e,
    184189        t.item : (t t t t.name e);;
    185     }, \{
    186       t.item : (s.link s.tag t.pragma t.name (e.in) (e.out) e.body) =
    187 //        <WriteLN s.link s.tag t.name>,
    188         { s.link : EXPORT = (DECL-FUNC t.name);; } :: e.decl,
     190    },
     191    t.item : {
     192      (IMPORT e) = () /*empty*/;
     193      (s.link s.tag t.pragma t.name (e.in) (e.out) e.body), FUNC FUNC? : e s.tag e =
     194        {
     195          s.link : EXPORT = (DECL-FUNC EXPORT t.name);
     196          <Put &Declarations (DECL-FUNC LOCAL t.name)> = /*empty*/;
     197        } :: e.decl,
    189198        {
    190199          e.body : (BRANCH t.p e.branch) =
     
    192201        } :: e.comp-func,
    193202        (e.decl) e.comp-func;
    194       t.item : (s.link CONST t.pragma t.name e.expr) =
     203      (s.link CONST t.pragma t.name e.expr) =
     204        (CONSTEXPR s.link t.name (e.expr) e.expr) :: t.const,
    195205        {
    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             };
     206          s.link : EXPORT = (t.const) /*empty*/;
     207          <Put &Declarations t.const> = () /*empty*/;
    203208        };
     209      (EXPORT s.tag t.pragma t.name) = ((DECL-OBJ EXPORT s.tag t.name)) /*empty*/;
     210      (LOCAL  s.tag t.pragma t.name) =
     211        <Put &Declarations (DECL-OBJ LOCAL s.tag t.name)>,
     212        () /*empty*/;
    204213    } :: (e.decl) e.item =
    205214    e.item <Compile (e.targets) (e.headers e.decl) e.rest>;
     
    240249//!     <RFP-Clear-Table &Vars-Tab>,
    241250  <Init-Vars>,
    242   <Ref-To-Var e.Sentence> :: e.Sentence,
     251//!     <Ref-To-Var e.Sentence> :: e.Sentence,
    243252//!     <Store-Vars <Vars e.out>> :: e.res-vars,
    244253  <Vars <Gener-Vars (e.out) "res">> :: e.res-vars,
     
    764773  t.var : e.Re = /*empty*/;
    765774  <Generated-Var? e.Re> = <Gener-Var-Assign t.var e.Re>;
    766   <Declared? t.var> = (ASSIGN <Vars-Print t.var> e.Re);
     775  <Get-Var Decl t.var> : s = (ASSIGN <Vars-Print t.var> e.Re);
    767776  <Vars-Decl t.var> : e, (EXPR <Vars-Print t.var> e.Re);
    768777};
     
    10931102//      } :: e.asail-Clashes (e.hards),
    10941103//      e.hards : /*empty*/ =
    1095 //!                     e.asail-Clashes
    1096       e.asail-Others;
     1104//!                     e.asail-Clashes e.asail-Others;
    10971105    e.asail-Others;
    10981106//    <Comp-Sentence () e.Other-Snts>;
     
    12411249//  e.vars : /*empty*/;
    12421250
     1251$func CC (e.clashes) s.tail? (v.fails) e.Snt = e.asail-Snt;
     1252
     1253$const New-Clash-Tags = Unknown-length Ties Check-symbols Dereference Compare;
     1254
    12431255Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence =
    12441256//  <WriteLN Clashes e.clashes>,
     
    12481260   */
    12491261  e.clashes () $iter {
    1250     e.old-clashes : t.R t.P e.rest =
    1251       e.rest (e.clashes (<Gener-Label "clash"> &New-Clash-Tags t.R t.P));
     1262    e.old-clashes : (e.Re) (s.dir e.Pe) e.rest =
     1263      <Comp-Static-Exprs (e.Re) (e.Pe)> : (e.R1) (e.P1),
     1264      <Map &Ref-Set-Var (<Vars e.R1 e.P1>)> : e,
     1265      e.rest (e.clashes (<Gener-Label "clash"> &New-Clash-Tags (e.R1) (s.dir e.P1)));
    12521266  } :: e.old-clashes (e.clashes),
    12531267  e.old-clashes : /*empty*/ =
    1254  
    1255   /*empty*/ (/*!e.clashes!*/) () $iter {
    1256     /*
    1257      * First of all see if we have a clash with all variables of known length
    1258      * and without length conditions written out.
    1259      */
    1260     e.clashes : e1 (e.t1 Known-length e.t2 (e.Re) (s.dir e.Pe)) e2,
    1261       <Hard-Exp? e.Re e.Pe> =
    1262       e.cond
    1263       (Cond IF ((INFIX "==" (<Length-of e.Re>) (<Length-of e.Pe>))))
    1264       (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2) (e.fail);
    1265     /*
    1266      * Next see if we can compute length of some variable.
    1267      */
    1268     e.cond <Find-Var-Length e.clashes> (e.fail);
    1269     /*
    1270      * Write out restrictions for the cyclic variables.
    1271      */
    1272     e.cond <Cyclic-Restrictions e.clashes> (e.fail);
    1273 //    <Cyclic-Restrictions e.clashes> :: e.new-cond (e.clashes),
    1274 //      {
    1275 //        e.fail : v = e.cond e.new-cond (Clear-Restricted) (e.clashes) (e.fail);
    1276 //        e.cond e.new-cond (e.clashes) (e.fail);
    1277 //      };
    1278     /*
    1279      * After checking all possible lengthes at the upper level change
    1280      * <<current_label_if_fail>>.
    1281      */
    1282     e.fail : v =
    1283       (Contin e.fail) e.cond (Fail e.fail) (Clear-Restricted) (e.clashes) ();
    1284     /*
    1285      * For all clashes with known left part check unwatched terms whether they
    1286      * are symbols or reference terms or not any.
    1287      */
    1288     \?
    1289     {
    1290       <Check-Symbols e.clashes> : {
    1291         v.new-cond (e.new-clashes) s =
    1292           e.cond (Cond IF (v.new-cond)) (e.new-clashes) ();
    1293         (e.new-clashes) New = e.cond (e.new-clashes) ();
    1294         e \! $fail;
    1295       };
    1296       <PrintLN "Check-Symbols: don't know what to do... ;-)">, $fail;
     1268  <CC (e.clashes) s.tail? (v.fails) e.Sentence>;
     1269
     1270$func Get-Known-Length e.expr = e.length-of-known-part (e.unknown-vars);
     1271
     1272$func Compare-Subexprs (e.fail) e.clashes = e.cond;
     1273
     1274$func Assign-Value e = e;
     1275
     1276CC (e.clashes) s.tail? (e.prev-fails (e.fail)) e.Snt, {
     1277  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2,
     1278    <Get-Known-Length e.Re> :: e.len-Re (e.vars-Re),
     1279    <Get-Known-Length e.Pe> :: e.len-Pe (e.vars-Pe),
     1280    \{
     1281      /*
     1282       * Если длины всех переменных на верхних уровнях e.Re и e.Pe
     1283       * известны, то надо просто выписать условие на равенство длин
     1284       * выражения и образца.
     1285       */
     1286      e.vars-Re : /*empty*/, e.vars-Pe : /*empty*/ =
     1287        (IF ((INFIX "!=" (e.len-Re) (e.len-Pe))) e.fail)
     1288        <CC (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2)
     1289          s.tail? (e.prev-fails (e.fail)) e.Snt>;
     1290      /*
     1291       * Если неизвестная переменная во всём клэше ровно одна, и она
     1292       * входит в левую и правую части разное кол-во раз, то её длину
     1293       * можно вычислить.
     1294       */
     1295      <"-" <Length e.vars-Re> <Length e.vars-Pe>> :: s.diff,
     1296        <"/=" (s.diff) (0)>,
     1297        <Nub e.vars-Re e.vars-Pe> : t.var =
     1298        {
     1299          <"<" (s.diff) (0)> =
     1300            <"*" s.diff -1> (INFIX "-" (e.len-Re) (e.len-Pe));
     1301          s.diff (INFIX "-" (e.len-Pe) (e.len-Re));
     1302        } :: s.mult e.diff,
     1303        <Create-Int-Var ("len_") t.var e.diff> :: t.len-var e.len-assign,
     1304        <Set-Var (Length (INFIX "/" (t.var) (s.mult))) t.len-var>,
     1305        {
     1306          <Get-Var Max t.var> : v.max =
     1307            (INFIX ">" (t.len-var) ((INFIX "*" (s.mult) (v.max))));
     1308          /*empty*/;
     1309        } :: e.max-cond,
     1310        <Get-Var Min t.var> : {
     1311          0 = /*empty*/;
     1312          e.min = (INFIX "<" (t.len-var) ((INFIX "*" (s.mult) (e.min))));
     1313        } :: e.min-cond,
     1314        e.len-assign
     1315        (IF ((INFIX "||"
     1316            (e.max-cond) (e.min-cond) ((INFIX "%" (t.len-var) (s.mult)))
     1317          ))
     1318          e.fail)
     1319        <CC (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2)
     1320          s.tail? (e.prev-fails (e.fail)) e.Snt>;
    12971321    };
    1298     /*
    1299      * And then try to compose new clash by dereferencing a part of some one.
    1300      */
    1301     e.cond <Dereference-Subexpr e.clashes> ();
    1302     /*
    1303      * If previous doesn't work then compare recursively all known
    1304      * subexpressions and all unknown repeated subexpressions with
    1305      * corresponding parts of source.
    1306      */
    1307     <Compare-Subexpr e.clashes> :: e.new-cond (e.asserts) (e.new-clashes) s.new?,
    1308       \{
    1309         e.new-cond : v, {
    1310           e.asserts : v =
    1311             e.cond (Assert e.asserts) (Cond IF (e.new-cond)) (e.new-clashes) ();
    1312           e.cond (Cond IF (e.new-cond)) (e.new-clashes) ();
    1313         };
    1314         e.asserts : v = e.cond (Assert e.asserts) (e.new-clashes) ();
    1315         s.new? : New = e.cond (e.new-clashes) ();
    1316       };
    1317     /*
    1318      * Then get first uncatenated source and bring it to the normal
    1319      * form, i.e. concatenate and parenthesize until it became single
    1320      * known expression.
    1321      */
    1322     e.cond <Get-Source e.clashes> ();
    1323     /*
    1324      * Now it's time to deal with cycles.
    1325      */
    1326     e.cond <Comp-Cyclic e.clashes>;
    1327     /*
    1328      * At last initialize all new subexpressions from all clashes.
    1329      */
    1330     e.clashes () $iter {
    1331       e.clashes : (e t.Re (s.dir e.Pe)) e.rest,
    1332         e.rest (e.new-cond <Get-Subexprs <Vars e.Pe>>);
    1333     } :: e.clashes (e.new-cond),
    1334       e.clashes : /*empty*/ =
    1335       {
    1336         e.new-cond : /*empty*/ = e.cond () ();
    1337         e.cond (Assert e.new-cond) () ();
    1338       };
    1339   } :: e.cond (e.clashes) (e.fail),
    1340 //  <WriteLN CC-Clashes e.clashes>,
    1341 //  <WriteLN CC-Cond e.cond>,
    1342   e.clashes : /*empty*/ =
    1343 
    1344   e.cond () 0 $iter {
    1345     e.cond : (Contin (CONTINUE t.label)) e.rest =
    1346       e.rest (e.contin (Comp Continue t.label)) 0;
    1347     e.cond (e.contin) 1;
    1348   } :: e.cond (e.contin) s.stop?,
    1349   s.stop? : 1 =
    1350 //!     <Comp-Sentence () e.Current-Snt e.contin e.Other-Snts> :: e.asail-Snt,
    1351   <Comp-Sentence s.tail? (v.fails) () e.Sentence> :: e.asail-Snt,
    1352   e.cond (e.asail-Snt) () $iter {
    1353     e.cond : e.some (e.last),
    1354       e.last : {
    1355         Cond e.condition =
    1356           e.some ((e.condition e.asail-Snt)) (e.vars);
    1357         Assert e.assertion =
    1358           e.some (e.assertion e.asail-Snt) (e.vars);
    1359         Fail e.fail1 =
    1360           e.some (e.asail-Snt e.fail1) (e.vars);
    1361         Restricted t.var =
    1362           e.some (e.asail-Snt) (e.vars t.var);
    1363         If-not-restricted t.var e.restr-cond, {
    1364           e.vars : e t.var e = e.some (e.asail-Snt) (e.vars);
    1365           e.some e.restr-cond (e.asail-Snt) (e.vars);
    1366         };
    1367         Clear-Restricted = e.some (e.asail-Snt) ();
    1368       };
    1369   } :: e.cond (e.asail-Snt) (e.vars),
    1370   e.cond : /*empty*/ =
    1371   e.asail-Snt/* <Comp-Sentence () e.Other-Snts>*/;
    1372 
    1373 Find-Var-Length e.clashes =
     1322
     1323  /*
     1324   * If previous doesn't work then compare recursively all known
     1325   * subexpressions and all unknown repeated subexpressions with
     1326   * corresponding parts of source.
     1327   */
     1328  <Compare-Subexprs (e.fail) e.clashes> :: e.cond,
     1329    e.clashes (/*e.assigns*/) $iter {
     1330      e.clashes : (e (e.Re) (s.dir e.Pe)) e.rest =
     1331        e.rest (e.assigns <Map &Assign-Value (<Vars e.Pe>)>);
     1332    } :: e.clashes (e.assigns),
     1333    e.clashes : /*empty*/ =
     1334    e.cond e.assigns <Comp-Sentence s.tail? (e.prev-fails (e.fail)) () e.Snt>;
     1335};
     1336
     1337Assign-Value t.var =
     1338  {
     1339    <Get-Var Value t.var> : (expr) (e.pos) (e.len) =
     1340      (SUBEXPR t.var expr (e.pos) (e.len));
     1341    /*empty*/;
     1342  };
     1343
     1344
     1345
     1346*       /*e.cond*/ (/*!e.clashes!*/) (/*e.fail*/) $iter {
     1347*               /*
     1348*                * First of all see if we have a clash with all variables of known length
     1349*                * and without length conditions written out.
     1350*                */
     1351*               e.clashes : e1 (e.t1 Known-length e.t2 (e.Re) (s.dir e.Pe)) e2,
     1352*                       <Hard-Exp? e.Re e.Pe> =
     1353*                       e.cond
     1354*                       (Cond IF ((INFIX "==" (<Length-of e.Re>) (<Length-of e.Pe>))))
     1355*                       (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2) (e.fail);
     1356*               /*
     1357*                * Next see if we can compute length of some variable.
     1358*                */
     1359*               e.cond <Find-Var-Length e.clashes> (e.fail);
     1360*               /*
     1361*                * Write out restrictions for the cyclic variables.
     1362*                */
     1363*               e.cond <Cyclic-Restrictions e.clashes> (e.fail);
     1364* //            <Cyclic-Restrictions e.clashes> :: e.new-cond (e.clashes),
     1365* //                    {
     1366* //                            e.fail : v = e.cond e.new-cond (Clear-Restricted) (e.clashes) (e.fail);
     1367* //                            e.cond e.new-cond (e.clashes) (e.fail);
     1368* //                    };
     1369*               /*
     1370*                * After checking all possible lengthes at the upper level change
     1371*                * <<current_label_if_fail>>.
     1372*                */
     1373*               e.fail : v =
     1374*                       (Contin e.fail) e.cond (Fail e.fail) (Clear-Restricted) (e.clashes) ();
     1375*               /*
     1376*                * For all clashes with known left part check unwatched terms whether they
     1377*                * are symbols or reference terms or not any.
     1378*                */
     1379*               \?
     1380*               {
     1381*                       <Check-Symbols e.clashes> : {
     1382*                               v.new-cond (e.new-clashes) s =
     1383*                                       e.cond (Cond IF (v.new-cond)) (e.new-clashes) ();
     1384*                               (e.new-clashes) New = e.cond (e.new-clashes) ();
     1385*                               e \! $fail;
     1386*                       };
     1387*                       <PrintLN "Check-Symbols: don't know what to do... ;-)">, $fail;
     1388*               };
     1389*               /*
     1390*                * And then try to compose new clash by dereferencing a part of some one.
     1391*                */
     1392*               e.cond <Dereference-Subexpr e.clashes> ();
     1393*               /*
     1394*                * If previous doesn't work then compare recursively all known
     1395*                * subexpressions and all unknown repeated subexpressions with
     1396*                * corresponding parts of source.
     1397*                */
     1398*               <Compare-Subexpr e.clashes> :: e.new-cond (e.asserts) (e.new-clashes) s.new?,
     1399*                       \{
     1400*                               e.new-cond : v, {
     1401*                                       e.asserts : v =
     1402*                                               e.cond (Assert e.asserts) (Cond IF (e.new-cond)) (e.new-clashes) ();
     1403*                                       e.cond (Cond IF (e.new-cond)) (e.new-clashes) ();
     1404*                               };
     1405*                               e.asserts : v = e.cond (Assert e.asserts) (e.new-clashes) ();
     1406*                               s.new? : New = e.cond (e.new-clashes) ();
     1407*                       };
     1408*               /*
     1409*                * Then get first uncatenated source and bring it to the normal
     1410*                * form, i.e. concatenate and parenthesize until it became single
     1411*                * known expression.
     1412*                */
     1413*               e.cond <Get-Source e.clashes> ();
     1414*               /*
     1415*                * Now it's time to deal with cycles.
     1416*                */
     1417*               e.cond <Comp-Cyclic e.clashes>;
     1418*               /*
     1419*                * At last initialize all new subexpressions from all clashes.
     1420*                */
     1421*               e.clashes () $iter {
     1422*                       e.clashes : (e t.Re (s.dir e.Pe)) e.rest,
     1423*                               e.rest (e.new-cond <Get-Subexprs <Vars e.Pe>>);
     1424*               } :: e.clashes (e.new-cond),
     1425*                       e.clashes : /*empty*/ =
     1426*                       {
     1427*                               e.new-cond : /*empty*/ = e.cond () ();
     1428*                               e.cond (Assert e.new-cond) () ();
     1429*                       };
     1430*       } :: e.cond (e.clashes) (e.fail),
     1431* //    <WriteLN CC-Clashes e.clashes>,
     1432* //    <WriteLN CC-Cond e.cond>,
     1433*       e.clashes : /*empty*/ =
     1434*
     1435*       e.cond () 0 $iter {
     1436*               e.cond : (Contin (CONTINUE t.label)) e.rest =
     1437*                       e.rest (e.contin (Comp Continue t.label)) 0;
     1438*               e.cond (e.contin) 1;
     1439*       } :: e.cond (e.contin) s.stop?,
     1440*       s.stop? : 1 =
     1441* //!   <Comp-Sentence () e.Current-Snt e.contin e.Other-Snts> :: e.asail-Snt,
     1442*       <Comp-Sentence s.tail? (v.fails) () e.Sentence> :: e.asail-Snt,
     1443*       e.cond (e.asail-Snt) () $iter {
     1444*               e.cond : e.some (e.last),
     1445*                       e.last : {
     1446*                               Cond e.condition =
     1447*                                       e.some ((e.condition e.asail-Snt)) (e.vars);
     1448*                               Assert e.assertion =
     1449*                                       e.some (e.assertion e.asail-Snt) (e.vars);
     1450*                               Fail e.fail1 =
     1451*                                       e.some (e.asail-Snt e.fail1) (e.vars);
     1452*                               Restricted t.var =
     1453*                                       e.some (e.asail-Snt) (e.vars t.var);
     1454*                               If-not-restricted t.var e.restr-cond, {
     1455*                                       e.vars : e t.var e = e.some (e.asail-Snt) (e.vars);
     1456*                                       e.some e.restr-cond (e.asail-Snt) (e.vars);
     1457*                               };
     1458*                               Clear-Restricted = e.some (e.asail-Snt) ();
     1459*                       };
     1460*       } :: e.cond (e.asail-Snt) (e.vars),
     1461*       e.cond : /*empty*/ =
     1462*       e.asail-Snt/* <Comp-Sentence () e.Other-Snts>*/;
     1463
     1464
     1465Find-Var-Length (e.fail) e.clashes =
    13741466//  <WriteLN Find-Var-Length e.clashes>,
    13751467  e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2 \?
     
    17571849      (e1 (e.t1 e.t2 (e.Re) (s.dir e.Pe)) e2);
    17581850  };
     1851
     1852
     1853
     1854$func Compare-Terms-Left  (e.fail) (e.pos) (e.Re) e.Pe = e.cond (e.rest-Pe);
     1855$func Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = e.cond (e.rest-Pe);
     1856
     1857Compare-Subexprs (e.fail) e.clashes, {
     1858  e.clashes : (e.t (e.Re) (s.dir e.Pe)) e.rest =
     1859    <Compare-Terms-Left (e.fail) (0) (e.Re) e.Pe> :: e.left-cond (e.rest-Pe),
     1860    <Compare-Terms-Right (e.fail) (0) (e.Re) e.rest-Pe> :: e.right-cond t,
     1861    e.left-cond e.right-cond <Compare-Subexprs (e.fail) e.rest>;
     1862  /*empty*/;
     1863};
     1864
     1865Compare-Terms-Left (e.fail) (e.pos) (e.Re) e.Pe, {
     1866  e.Pe : t.Pt e.rest, {
     1867    <Get-Known-Length t.Pt> : e.len (), {
     1868      \{
     1869        <Get-Var Instantiated? t.Pt> : True =
     1870          {
     1871            <Get-Var Flat? t.Pt> : True = FLAT-EQ;
     1872            EQ;
     1873          };
     1874        t.Pt : \{
     1875          (REF e) = t.Pt;
     1876          (STATIC e) = <Get-Static t.Pt>;
     1877        } :: e.Pt =
     1878          {
     1879            <Flat-Const? e.Pt> = FLAT-EQ;
     1880            EQ;
     1881          };
     1882        <Var? t.Pt> =
     1883          <Set-Var (Value (e.Re) (e.pos) (e.len)) t.Pt>,
     1884          $fail;
     1885      } :: s.eq =
     1886        (IF ((NOT (EQ (e.Re) (e.pos) (e.len) (t.Pt) (0) (e.len)))) e.fail);
     1887      /*empty*/;
     1888    } :: e.cond =
     1889      e.cond <Compare-Terms-Left (e.fail) (e.pos e.len) (e.Re) e.rest>;
     1890    (e.Pe);
     1891  };
     1892  ();
     1893};
     1894
     1895Compare-Terms-Right (e.fail) (e.pos) (e.Re) e.Pe = ();
     1896
     1897
    17591898
    17601899Compare-Subexpr e.clashes =
     
    19382077  (PAREN e.expr) =
    19392078    /*empty*/ Continue;
    1940 //!     (VAR t.name), {
    1941   (s t.name), { // STUB!
     2079  (VAR t.name), {
    19422080    <Hard-Exp? (VAR t.name)>, {
    19432081      <?? t.name Instantiated> : True = Instantiated;
     
    21342272  e.decls;
    21352273
    2136 /*
    2137  * Returns those parts of e.expr which lengthes are known. Also returns a list
    2138  * of variables with unknown lengthes.
    2139  */
    2140 Unknown-Vars e.expr =
    2141   e.expr () () $iter {
    2142     e.expr : t.first e.rest, {
    2143       t.first : (VAR t.name), {
    2144         <?? t.name Instantiated> : True =
    2145           e.new-expr t.first (e.unknown);
    2146         <?? t.name Max> :: e.max, <?? t.name Min> : e.max =
    2147           e.new-expr t.first (e.unknown);
    2148         e.new-expr (e.unknown t.first);
    2149       };
    2150       e.new-expr t.first (e.unknown);
    2151     } :: e.new-expr (e.unknown) =
    2152       e.rest (e.new-expr) (e.unknown);
    2153   } :: e.expr (e.new-expr) (e.unknown),
    2154   e.expr : /*empty*/ =
    2155   e.new-expr (e.unknown);
    2156  
    21572274Split-Hard-Left e.expr =
    21582275  e.expr () $iter {
     
    22342351};
    22352352
     2353
     2354
     2355$func Ref-Len t.name = e.length;
     2356
     2357/*
     2358 * Из верхнего уровня выражения изымаются все переменные, длина которых не
     2359 * может быть посчитана (она неизвестна из формата, и переменная ещё не
     2360 * получила значение в run-time).  Список этих переменных возвращается вторым
     2361 * параметром.  Первым параметром возвращается длина оставшегося после их
     2362 * изъятия выражения.
     2363 */
     2364Get-Known-Length e.Re =
     2365  e.Re (/*e.length*/) (/*e.unknown-vars*/) $iter {
     2366    e.Re : t.Rt e.rest, t.Rt : {
     2367      s.ObjectSymbol = 1 ();    // Может появиться из константы.
     2368      (PAREN e) = 1 ();
     2369      (REF t.name) = <Ref-Len t.name> ();
     2370      (STATIC t.name) = <Get-Known-Length <Get-Static t.Rt>>;
     2371      t, <Var? t.Rt>, {
     2372        <Get-Var Length t.Rt> : v.len = v.len ();
     2373        <Get-Var Instantiated? t.Rt> : True = (LENGTH t.Rt) ();
     2374        /*empty*/ (t.Rt);
     2375      };
     2376    } :: e.len (e.var),
     2377      e.rest (e.length e.len) (e.unknown-vars e.var);
     2378  } :: e.Re (e.length) (e.unknown-vars),
     2379  e.Re : /*empty*/ =
     2380  {
     2381    e.length : /*empty*/ = 0 (e.unknown-vars);
     2382    e.length (e.unknown-vars);
     2383  };
     2384
    22362385Length-of {
    22372386  /*empty*/ = 0;
     
    22392388    e.Re () $iter {
    22402389      e.Re : t.Rt e.rest, t.Rt : {
    2241         s.ObjectSymbol = 1;
     2390        s.ObjectSymbol = 1;     // Может появиться из константы.
    22422391        (PAREN e) = 1;
    22432392        (REF t.name) = <Ref-Len t.name>;
    2244         (VAR t.name), {
    2245           <?? t.name Length>;
    2246           (Used t.Rt) (LENGTH t.Rt);
     2393        (STATIC t.name) = <Length-of <Get-Static t.Rt>>;
     2394        t, <Var? t.Rt>, {
     2395          <Get-Var Length t.Rt> : v.len = v.len;
     2396          (LENGTH t.Rt);
    22472397        };
    2248         t = (LENGTH t.Rt); // STUB!
    22492398      } :: e.new-len,
    22502399      e.rest (e.Length e.new-len);
    22512400    } :: e.Re (e.Length),
    22522401    e.Re : /*empty*/ =
    2253 //    (INFIX "+" e.Length);
    2254 //    <WriteLN Length e.Length>,
    22552402    e.Length;
    22562403};
    22572404
    22582405Ref-Len t.name = {
    2259   <To-Int <Lookup &Const-Len t.name>>;
    2260   <Length <Length-of <Lookup &Const t.name>>> :: s.len =
    2261     <Bind &Const-Len (t.name) (s.len)>,
    2262     s.len;
     2406  <Lookup &Const-Len t.name>;
     2407  <Length-of <Middle 3 0 <Lookup &Const t.name>>> :: e.len =
     2408    <Bind &Const-Len (t.name) (e.len)>,
     2409    e.len;
     2410  1;
    22632411};
    22642412
     2413Flat-Const? {
     2414  (PAREN e) e = $fail;
     2415  (REF t.name) e.rest, {
     2416    <Middle 3 0 <Lookup &Const t.name>> :: e.const =
     2417      <Flat-Const? e.const> <Flat-Const? e.rest>;
     2418    <Flat-Const? e.rest>;
     2419  };
     2420  s.ObjectSymbol e.rest = <Flat-Const? e.rest>;
     2421  /*empty*/;
     2422};
     2423
    22652424/*
    2266  * Ends good if lengths of all variables in e.expr can be calculated.
     2425 * Ends good if lengths of all variables in the upper level of e.expr can be
     2426 * calculated.
    22672427 */
    22682428Hard-Exp? e.expr =
     
    22702430    e.expr : t.first e.rest =
    22712431    {
    2272       t.first : (VAR t.name), {
    2273         <?? t.name Instantiated> : True;
    2274         <?? t.name Max> :: e.max, <?? t.name Min> : e.max;
     2432      <Var? t.first>, {
     2433        <Get-Var Instantiated? t.first> : True;
     2434        <Get-Var Length t.first> : v;
    22752435        = $fail;
    22762436      };;
     
    22782438      e.rest;
    22792439  } :: e.expr,
    2280   e.expr : /*empty*/,
    2281   = $fail; // STUB!
     2440  e.expr : /*empty*/;
     2441
     2442/*
     2443 * Returns those parts of e.expr which lengthes are known. Also returns a list
     2444 * of variables with unknown lengthes.
     2445 */
     2446Unknown-Vars e.expr =
     2447  e.expr () () $iter {
     2448    e.expr : t.first e.rest, {
     2449      t.first : (VAR t.name), {
     2450        <?? t.name Instantiated> : True =
     2451          e.new-expr t.first (e.unknown);
     2452        <?? t.name Max> :: e.max, <?? t.name Min> : e.max =
     2453          e.new-expr t.first (e.unknown);
     2454        e.new-expr (e.unknown t.first);
     2455      };
     2456      e.new-expr t.first (e.unknown);
     2457    } :: e.new-expr (e.unknown) =
     2458      e.rest (e.new-expr) (e.unknown);
     2459  } :: e.expr (e.new-expr) (e.unknown),
     2460  e.expr : /*empty*/ =
     2461  e.new-expr (e.unknown);
     2462
     2463
    22822464
    22832465Print-Error s.WE e.Descrip t.Pragma =
  • to-imperative/trunk/compiler/rfp_const.rf

    r683 r712  
    2525
    2626Create-Static expr, {
     27  expr : (REF t.name) = (REF t.name);
    2728  <? &Static> : e (t.name expr) e = (STATIC t.name);    // FIXME: Add comment?
    2829  (<Length <? &Static>>) :: t.name,
    2930    <Put &Static (t.name expr)>, (STATIC t.name);
    3031};
     32
     33
     34
     35Get-Static (STATIC t.name), <? &Static> : e (t.name expr) e = expr;
    3136
    3237
  • to-imperative/trunk/compiler/rfp_const.rfi

    r683 r712  
    1919
    2020/*
     21 * Получить по STATIC-форме изначальное выражение.
     22 */
     23$func Get-Static t.static-form = expr;
     24
     25/*
    2126 * Скомпилировать накопленные константные выражения и выдать получившийся
    2227 * ASAIL-код.
  • to-imperative/trunk/compiler/rfp_vars.rf

    r694 r712  
    1111
    1212
    13 ***************************** Free indices. ******************************
    14 
    15 $table Free-Indices;
    16 
    17 
    18 $func Free-Index e.key = s.idx;
    19 
    20 Free-Index e.key, {
    21   <Lookup &Free-Indices e.key> : s.idx = s.idx;
    22   1;
    23 };
    24 
    25 
    26 $func Set-Index (e.key) s.idx = ;
    27 
    28 Set-Index (e.key) s.idx = <Bind &Free-Indices (e.key) (s.idx)>;
    29 
     13Var? (s.tag t.name), s.tag : \{ SVAR; TVAR; VVAR; EVAR; VAR; };
     14
     15
     16//***************************** Free indices. ******************************
     17//
     18//$table Free-Indices;
     19//
     20//
     21//$func Free-Index e.key = s.idx;
     22//
     23//Free-Index e.key, {
     24//  <Lookup &Free-Indices e.key> : s.idx = s.idx;
     25//  1;
     26//};
     27//
     28//
     29//$func Set-Index (e.key) s.idx = ;
     30//
     31//Set-Index (e.key) s.idx = <Bind &Free-Indices (e.key) (s.idx)>;
    3032
    3133
     
    4042
    4143Init-Vars =
    42   <Store &State /*empty*/>,
    43   <RFP-Clear-Table &Free-Indices>;
    44 
    45 
    46 
    47 $func Create-Var e = e;
    48 
    49 New-Vars e.vars = <Map &Create-Var (e.vars)> : e;
    50 
    51 Create-Var t.var, t.var : {
    52   (SVAR t.name) = <Put &State (t.var (SVAR) (1) (1) Non-Declared)>;
    53   (TVAR t.name) = <Put &State (t.var (TVAR) (1) (1) Non-Declared)>;
    54   (VVAR t.name) = <Put &State (t.var (VVAR) (1) ( ) Non-Declared)>;
    55   (EVAR t.name) = <Put &State (t.var (EVAR) (0) ( ) Non-Declared)>;
    56   ( VAR t.name) = <Put &State (t.var (VAR)  (0) ( ) Non-Declared)>;
    57 };
     44  <Store &State /*empty*/>;
     45//  <RFP-Clear-Table &Free-Indices>;
     46
     47
     48
     49//! $func Create-Var e = e;
     50
     51//! New-Vars e.vars = <Map &Create-Var (e.vars)> : e;
     52
     53//! Create-Var t.var, t.var : {
     54//!     (SVAR t.name) = <Put &State (t.var (SVAR) (1) (1) Non-Declared Non-Instantiated)>;
     55//!     (TVAR t.name) = <Put &State (t.var (TVAR) (1) (1) Non-Declared Non-Instantiated)>;
     56//!     (VVAR t.name) = <Put &State (t.var (VVAR) (1) ( ) Non-Declared Non-Instantiated)>;
     57//!     (EVAR t.name) = <Put &State (t.var (EVAR) (0) ( ) Non-Declared Non-Instantiated)>;
     58//!     ( VAR t.name) = <Put &State (t.var (VAR)  (0) ( ) Non-Declared Non-Instantiated)>;
     59//! };
     60
     61$func Normalize-Info e.info t.var = ;
     62
     63Normalize-Info e.info t.var =
     64  /*
     65   * Если дана длина, приравнять к ней минимум и максимум.
     66   */
     67  {
     68    e.info : e (Length e.len) e =
     69      {
     70        e.info : e1 (Min e.min) e2 =
     71          {
     72            e.min : e.len = e.info;
     73            (Min e.len) e1 e2;
     74          };
     75        (Min e.len) e.info;
     76      } :: e.info,
     77      {
     78        e.info : e1 (Max e.max) e2 =
     79          {
     80            e.max : e.len = e.info;
     81            e1 e2 (Max e.len);
     82          };
     83        e.info (Max e.len);
     84      };
     85    e.info;
     86  } :: e.info,
     87  /*
     88   * Если минимум не установлен, установить его, исходя из типа переменной.
     89   */
     90  {
     91    e.info : e (Min e) e = e.info;
     92    t.var : {
     93      (SVAR e) = 1;
     94      (TVAR e) = 1;
     95      (VVAR e) = 1;
     96      (EVAR e) = 0;
     97      ( VAR e) = 0;
     98    } :: s.min =
     99      e.info (Min s.min);
     100  } :: e.info,
     101  /*
     102   * Для s- и t-переменных установить максимум, если не установлен.
     103   */
     104  {
     105    t.var : \{ (SVAR e); (TVAR e); } =
     106      {
     107        e.info : e (Max e) e = e.info;
     108        e.info (Max 1);
     109      };
     110    e.info;
     111  } :: e.info,
     112  /*
     113   * Если минимум совпадает с максимумом, то установить длину.
     114   * FIXME: не нужно ли здесь упрощать выражения для минимума и максимума?
     115   */
     116  {
     117    e.info : e (Length e) e = e.info;
     118    e.info : e (Max s.max) e, e.info : e (Min s.max) e = e.info (Length s.max);
     119    e.info;
     120  } :: e.info,
     121  <Put &State (t.var e.info)>;
     122
     123Set-Var e.info t.var, {
     124  <? &State> : $r e1 (t.var e.old-info) e2 =
     125    e.old-info (e.info) (/*e.new-info*/) $iter {
     126      e.old-info : (t.key e.val) e.rest, {
     127        e.info : e3 (t.key e.new-val) e4 = e3 e4 (t.key e.new-val);
     128        e.info (t.key e.val);
     129      } :: e.info t.item =
     130        e.rest (e.info) (e.new-info t.item);
     131    } :: e.old-info (e.info) (e.new-info),
     132    e.old-info : /*empty*/ =
     133    <Store &State e1 e2>,
     134    e.info e.new-info t.var;
     135  e.info t.var;
     136} :: e.info t.var =
     137  <Normalize-Info e.info t.var>;
     138
     139Get-Var t.key t.var,
     140  <? &State> : $r e1 (t.var e.info) e2 =
     141  {
     142    e.info : e (t.key e.val) e = e.val;
     143    /*empty*/;
     144  };
     145
     146Ref-Set-Var e.info t.var = <Set-Var e.info t.var>;
    58147
    59148
     
    68157
    69158
     159
    70160$func Decl-Var e = e;
    71161
     
    74164
    75165Decl-Var t.var, {
    76  
    77   <? &State> : $r e1 (t.var tag t.min t.max s.decl e.rest) e2 =
    78     {
    79       <Box? s.decl> = s.decl;
    80       <Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
    81         <Store &State e1 (t.var tag t.min t.max s.decl e.rest) e2>,
    82         s.decl;
    83     } :: s.decl,
     166  <Get-Var Decl t.var> : s.box;
     167  <Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
     168    <Set-Var (Decl s.decl) t.var>,
    84169    (Declare s.decl);
    85  
    86   <Create-Var t.var> : e, <Decl-Var t.var>;
     170
     171//!     <? &State> : $r e1 (t.var tag t.min t.max s.decl e.rest) e2 =
     172//!             {
     173//!                     <Box? s.decl> = s.decl;
     174//!                     <Box (DECL "Expr" <Print-Var t.var>)> :: s.decl,
     175//!                             <Store &State e1 (t.var tag t.min t.max s.decl e.rest) e2>,
     176//!                             s.decl;
     177//!             } :: s.decl,
     178//!             (Declare s.decl);
     179//!
     180//!     <Create-Var t.var> : e, <Decl-Var t.var>;
    87181};
    88182
    89183
    90 Declared? t.var =
    91   <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>;
    92 
    93 
    94 $func? Decl-Box t.var = s.box;
    95 
    96 Decl-Box t.var =
    97   <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>, s.decl;
     184
     185Create-Int-Var (e.prefix) t.var e.expr =
     186  <Gener-Vars ((VAR)) e.prefix t.var> : t.int-var,
     187  t.int-var (INT t.int-var e.expr);
     188
     189
     190
     191//!Declared? t.var =
     192//!     <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>;
     193
     194
     195//!$func? Decl-Box t.var = s.box;
     196
     197//!Decl-Box t.var =
     198//!     <? &State> : $r e (t.var tag t.min t.max s.decl e.rest) e = <Box? s.decl>, s.decl;
     199
     200
     201//!Instantiated? t.var =
     202//! <Var? t.var>,
     203//! <? &State> : $r e (t.var tag t.min t.max s.decl s.inst) e = s.inst : Instantiated;
    98204
    99205
     
    110216*       <Del-Pragmas e.Re> :: e.Re,
    111217  {
    112     e.format : (s.tag) e.Fe, s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
    113       (s.tag <Box 0 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
     218    e.format : (s.tag) e.Fe, {
     219      s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
     220        (s.tag <Box 0 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
     221      (s.tag <Box 1 e.prefix>) <Gener-Vars (e.Fe) e.prefix>;
     222    };
    114223    e.format : (e1) e2 =
    115224      (<Gener-Vars (e1) e.prefix>) <Gener-Vars (e2) e.prefix>;
     
    129238  <Store s.box <Print-Var t.var>>,
    130239  {
    131     <Declared? t.var>, <Store <Decl-Box (s.tag s.box)> /*empty*/>;;
     240    <Get-Var Decl t.var> : s =
     241      <Get-Var Decl (s.tag s.box)> : s.decl-box,
     242      <Store s.decl-box /*empty*/>;;
    132243  };
    133244
     
    139250$func Boxes-To-Vars e.expr-with-boxes = e.expr-with-var-names;
    140251
    141 $func Gener-Name s.name = s.unique-name;
     252$func Gener-Name s.form-one? s.name = s.unique-name;
    142253
    143254
     
    149260
    150261Boxes-To-Vars {
    151   (s.tag s.box) expr, s.tag : \{ EVAR; VVAR; TVAR; SVAR; } =
     262  (s.tag s.box) expr, s.tag : \{ EVAR; VVAR; TVAR; SVAR; VAR; } =
    152263    <? s.box> : {
    153264      0 e.name =
    154         (VAR (<Gener-Name <To-Word e.name>>)) :: t.var,
     265        (VAR (<Gener-Name From-One <To-Word e.name>>)) :: t.var,
     266        <Store s.box t.var>,
     267        t.var <Boxes-To-Vars expr>;
     268      1 e.prefix t.var =
     269        <Boxes-To-Vars t.var> : (s (e.name)),
     270        (VAR (<Gener-Name From-Two <To-Word e.prefix e.name>>)) :: t.var,
    155271        <Store s.box t.var>,
    156272        t.var <Boxes-To-Vars expr>;
     
    164280
    165281
    166 Gener-Name s.name =
     282Gener-Name s.form-one? s.name =
    167283  {
    168284    <Lookup &Var-Indices s.name>;
     
    171287  <"+" s.idx 1> :: s.idx,
    172288  <Bind &Var-Indices (s.name) (s.idx)>,
    173   <To-Word s.name s.idx> :: s.n,
    174   {
    175     <? &Var-Names> : $r e s.n e = <Gener-Name s.name>;
     289  {
     290    # \{ s.form-one? : From-One; }, s.idx : 1 = /*empty*/;
     291    s.idx;
     292  } :: e.idx,
     293  <To-Word s.name e.idx> :: s.n,
     294  {
     295    <? &Var-Names> : $r e s.n e = <Gener-Name s.form-one? s.name>;
    176296    <Put &Var-Names s.n>, s.n;
    177297  };
     
    216336        s.ObjectSymbol = /*empty*/;
    217337        (REF t.Name) = /*empty*/;
     338        (STATIC t.Name) = /*empty*/;
    218339        (PAREN e.ResultExpression) = <Vars e.ResultExpression>;
    219340        (CALL (PRAGMA (e) e) t.Fname e.ResultExpression) =
    220341          <Vars e.ResultExpression>;
    221342        (CALL t.Fname e.ResultExpression) = <Vars e.ResultExpression>;
    222 //        (STATIC t.Name) = /*empty*/;
    223343        t.var = t.var;  // t.var ::= (EVAR t.Name) | (VVAR t.Name)
    224344                //         | (TVAR t.Name) | (SVAR t.Name)
     
    338458  <Lookup s.tab e.key>;
    339459
    340 Set-Var t.name (e.key) (e.val) =
     460//!Set-Var t.name (e.key) (e.val) =
    341461//  <WriteLN Set-Var t.name (e.key)>,
    342   <Lookup &Vars-Tab t.name> : s.tab,
    343   <Bind s.tab (e.key) (e.val)>;
    344 
    345 
     462//!     <Lookup &Vars-Tab t.name> : s.tab,
     463//!     <Bind s.tab (e.key) (e.val)>;
     464
     465
  • to-imperative/trunk/compiler/rfp_vars.rfi

    r694 r712  
    22// $Revision$
    33// $Date$
     4
     5$func? Var? term = ;
     6$func Set-Var e.info t.var = ;
     7$func? Get-Var t.key t.var = e.val;
     8$func Ref-Set-Var e = e;
    49
    510$func Vars-Copy-State = t.vars;
     
    813$func Init-Vars = ;
    914
    10 $func New-Vars e = ;
     15//! $func New-Vars e = ;
    1116$func Vars-Print e = e;
    1217$func Vars-Decl e = e;
     18
     19$func Create-Int-Var (e.prefix) t.var e.expr = t.int-var e.int-assign;
    1320
    1421$func Vars e.expr = e.vars;
     
    2835$func Strip-STVE expr = expr;
    2936
    30 $func Set-Var t.name (e.key) (e.val) = ;
     37//!$func Set-Var t.name (e.key) (e.val) = ;
    3138
    3239$func Store-Vars e.vars = e.vars;
     
    3441$func Declare-Vars s.type e.vars = e.decls;
    3542
    36 $func? Declared? t.var = ;
     43//!$func? Declared? t.var = ;
     44
     45//!$func? Instantiated? t.var = ;
    3746
    3847$func Instantiate-Vars e.vars = ;
Note: See TracChangeset for help on using the changeset viewer.