Changeset 1146


Ignore:
Timestamp:
Aug 11, 2003, 2:36:28 AM (17 years ago)
Author:
orlov
Message:
  • Support for references to functions. Including ones with formats other then

e = e.

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

are added.

Location:
to-imperative/trunk/compiler
Files:
9 edited

Legend:

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

    r1093 r1146  
    211211       */
    212212      t.Statement : (s.block t.Pragma e.branches), s.block : \{ BLOCK; BLOCK?; } =
     213        /*
     214         * As well as after-block patterns, formats should be scaned
     215         * for res-vars.  See samples/Syntax/block1.rf for example.
     216         */
    213217        e.rest : {
    214218          (LEFT t e.Pe) e = <Vars e.Pe>;
  • to-imperative/trunk/compiler/rfp_asail.rf

    r1115 r1146  
    240240    <Expr-Ref-To-CPP e.expr> '.flat_at ('
    241241      <Expr-Int-To-CPP e.pos> ', ' <Expr-Int-To-CPP e.len> ')';
    242   (CHECK-ITER t.var) =
    243     'iter(' <Rfp2Cpp t.var> ')';
     242  (CHECK-ITER e.expr) =
     243    'iter(' <Expr-Ref-To-CPP e.expr> ')';
    244244  (EQ e.expr1 (e.expr2) (e.pos)) =
    245245    <Expr-Ref-To-CPP e.expr1> '.eq ('
     
    274274Step-To-CPP {
    275275  /*empty*/ = /*empty*/;
    276   (INC-ITER t.var) = 'iter(' <Rfp2Cpp t.var> ')++';
     276  (INC-ITER e.expr) = 'iter(' <Expr-Ref-To-CPP e.expr> ')++';
     277  (DEC-ITER e.expr) = 'iter(' <Expr-Ref-To-CPP e.expr> ')--';
    277278};
    278279
     
    306307    (STATIC e) =
    307308      ' + ' <Rfp2Cpp t.item>;
     309    (FUNC t.name) =
     310      ' + Func::create_expr (' <Name-To-CPP t.name> ')';
    308311    s.sym, {
    309312      <Int? s.sym> =
  • to-imperative/trunk/compiler/rfp_clashes.rf

    r1006 r1146  
    5252
    5353
    54 $box Parenth1;
    55 $box Parenth2;
     54$box Parenth;
     55
     56
     57$box Unready-Source;
    5658
    5759
     
    146148  <Store &Checked-Lengths /*empty*/>,
    147149  <Store &Eqs /*empty*/>,
    148   <Store &Parenth1 /*empty*/>,
    149   <Store &Parenth2 /*empty*/>,
     150  <Store &Parenth /*empty*/>,
     151  <Store &Unready-Source /*empty*/>,
    150152  <RFP-Clear-Table &Hard-Parts>,
    151153  <Store &FreeIdx 0>,
     
    162164        e.Re : (STATIC e);
    163165      };
    164       {
    165         e.Re : t = &Parenth1;
    166         &Parenth2;
    167       } :: s.box,
     166      e.Pe : e1 (PAREN e) e2 =
     167        <Vars e.Re> :: e.Re-vars,
     168        <Put &Parenth (s.idx (e.Re-vars) <Vars e1>)>,
    168169        {
    169           e.Pe : e1 (PAREN e) e2 =
    170             <Put s.box (s.idx (<Vars e.Re>) <Vars e1>)>,
    171             {
    172               e2 : $r e (PAREN e) e3 =
    173                 <Put s.box (s.idx (<Vars e.Re>) <Vars e3>)>;;
    174             };;
    175         };
     170          e2 : $r e (PAREN e) e3 =
     171            <Put &Parenth (s.idx (e.Re-vars) <Vars e3>)>;;
     172        },
     173        <Put &Unready-Source (s.idx e.Re-vars)>;
     174      <Put &Unready-Source (s.idx <Vars e.Re>)>;
    176175    },
    177176    (s.idx (e.Re) (s.dir e.Pe) e.boxes) <Compose-Clashes e.rest>;;
     
    234233 * то, что в результатном выражении в этом месте тоже стоят скобки, и завести
    235234 * переменную, обозначающую их содержимое.
    236  *
    237235 * Данная функция возвращает всю информацию, необходимую для этих действий.
    238236 */
     
    265263
    266264Prepare-Source {
    267   t.Re =
    268     {
    269       \{
    270         <Get-Var Instantiated? t.Re> : True;
    271         t.Re : (REF e);
    272         t.Re : (STATIC e);
    273       } =
    274         t.Re /*empty*/;
    275       t.Re <Define-Vars t.Re>;
    276     };
     265  t.Re, \{
     266    <Get-Var Instantiated? t.Re> : True;
     267    t.Re : (REF e);
     268    t.Re : (STATIC e);
     269  } =
     270    t.Re /*empty*/;
     271  t.Re, <Var? t.Re> =
     272    t.Re <Define-Vars t.Re>;
    277273  e.Re =
    278274    <Gener-Vars ((EVAR)) "compose"> : t.var,
     
    285281  t.var e.rest =
    286282    {
    287       <Get-Var Instantiated? t.var> : True;
     283      <Get-Var Instantiated? t.var> : True = <Define-Vars e.rest>;
    288284      <? &Eqs> : e1 (t.Re t.pos t.var t.len) e2 =
    289285        <Store &Eqs e1 e2>,
    290286        (t.Re t.pos t.var t.len) <Define-Vars e.rest>;
    291       <Set-Var (Instantiated? True) t.var>; // STUB!!!
    292287    };
    293288  /*empty*/ = /*empty*/;
     
    298293$func Find-SFD e.parenth = e.parenth (e.idx);
    299294
    300 Compose-Source-For-Deref =
    301   <Find-SFD <? &Parenth1>> :: e.parenth1 (e.idx),
    302   <Store &Parenth1 e.parenth1>,
     295$func? Not-Instantiated-Var e = e;
     296
     297$func? Not-Idx e = e;
     298
     299Not-Idx {
     300  s.idx (s.idx e) = $fail;
     301  e.else-true;
     302};
     303
     304Compose-Source = \{
     305  <Find-SFD <? &Parenth>> : e.parenth (s.idx) =
     306    <Store &Parenth e.parenth>,
     307    <Store &Unready-Source <Filter &Not-Idx s.idx (<? &Unready-Source>)>>,
     308    s.idx;
     309  <? &Unready-Source> : e.l (s.idx e.vars) e.r,
     310    <Filter &Not-Instantiated-Var (e.vars)> : /*empty*/ =
     311    <Store &Unready-Source e.l e.r>,
     312    <Store &Parenth <Filter &Not-Idx s.idx (<? &Parenth>)>>,
     313    s.idx;
     314} :: s.idx,
    303315  {
    304     e.idx : s.i = s.i;
    305     <Find-SFD <? &Parenth2>> :: e.parenth2 (e.idx),
    306       <Store &Parenth2 e.parenth2>,
    307       e.idx : s.i = s.i;
    308     /*else*/ = $fail;
    309   } :: s.idx,
    310   <? &Clashes> : e1 (s.idx (e.Re) (s.dir e.Pe) e) e2 =
    311   <Prepare-Source e.Re> :: t.var e.assign,
    312   <Store &Clashes e1 <Compose-Clashes (t.var) (s.dir e.Pe)> e2>,
    313   e.assign;
    314 
    315 $func? Not-Instantiated-Var e = e;
     316    <? &Clashes> : e1 (s.idx (e.Re) (s.dir e.Pe) e.boxes) e2,
     317      <Prepare-Source e.Re> :: t.var e.assign,
     318      <Store &Clashes e1 (s.idx (t.var) (s.dir e.Pe) e.boxes) e2>,
     319      e.assign;
     320  };
    316321
    317322Find-SFD {
     
    321326      /*empty*/ = <Get-Known-Length e.Pe-vars> : {
    322327        e (v.p-vars) = (s.idx () v.p-vars) <Find-SFD e.rest>;
    323         e () = e.rest (s.idx);
     328        e () = <Filter &Not-Idx s.idx (e.rest)> (s.idx);
    324329      };
    325330    };
     
    335340
    336341Get-Cycle =
    337   <? &Clashes> : e (s.idx (e.Re) (s.dir e.Pe) e.b1 &Unknown-Lengths e.b2) e.rest =
    338   <Prepare-Source e.Re> :: t.var e.assign,
     342  <? &Clashes> : e (s.idx (t.var) (s.dir e.Pe) e.b1 &Unknown-Lengths e.b2) e.rest =
    339343  <Get-Known-Length t.var> : e.len (),
    340344  <Lookup &Hard-Parts s.idx> : (e.left) (e.right) e.expr,
     
    342346    LEFT =
    343347      e.expr : t.var-e1 e.Pe-rest,
    344       t.var-e1 "lsplit_" e.Pe-rest;
     348      LSPLIT t.var-e1 "lsplit_" e.Pe-rest;
    345349    RIGHT =
    346350      e.expr : e.Pe-rest t.var-e1,
    347       t.var-e1 "rsplit_" e.Pe-rest;
    348   } :: t.var-e1 s.pref-e2 e.Pe-rest,
     351      RSPLIT t.var-e1 "rsplit_" e.Pe-rest;
     352  } :: s.split t.var-e1 s.pref-e2 e.Pe-rest,
    349353  {
    350354    <Var? e.Pe-rest> = e.Pe-rest ();
     
    357361  <Get-Var Clashes t.var-e1> :: e.clashes,
    358362  <Map &Reclassify-Clash (<Sub (e.clashes) <? &Checked-Lengths>>)> : e,
    359   e.assign (e.left) (e.right) (e.len) t.var t.var-e1 t.var-e2;
     363  s.split (e.left) (e.right) (e.len) t.var t.var-e1 t.var-e2;
    360364
    361365
  • to-imperative/trunk/compiler/rfp_clashes.rfi

    r1006 r1146  
    2222
    2323
    24 $func? Compose-Source-For-Deref = e.assign;
     24$func? Compose-Source = e.assign;
    2525
    2626
    27 $func? Get-Cycle = e.assign (e.left) (e.right) (e.len) t.var t.left t.right;
     27$func? Get-Cycle = s.split-dir (e.left) (e.right) (e.len) t.var t.left t.right;
    2828
    2929
  • to-imperative/trunk/compiler/rfp_compile.rf

    r1006 r1146  
    3131
    3232/*
    33  * Table for storing referenced functions.
    34  */
    35 $table Ref-To-Funcs;
     33 * Table for storing parameters of referenced functions.
     34 */
     35$table Stub-Funcs;
    3636
    3737/*
     
    5858$table Prep-Vars;
    5959
    60 $box Greater-Ineqs;
    61 $box Less-Ineqs;
    62 
    63 $table Static-Exprs;
    6460
    6561$func Compile (e.targets) (e.headers) e.Items = e.Compiled-Items (INTERFACE e.headers);
    6662
    67 $func Length-of e.Re = e.length;
    68 
    69 $func? Hard-Exp? e.expr = ;
    70 
    7163$func Comp-Func-Stubs = e.asail-funcs;
    7264
     
    8981$func? Without-Calls? e.Re = ;
    9082
    91 //$func Old-Vars e.expr = e.expr;
    92 
    93 //$func Find-Known-Lengths e.clashes = (e.known-len-clashes) e.clashes;
    94 
    95 //$func? Known-Vars? e.vars = ;
    96 
    9783$func Comp-Clashes (e.clashes) s.tail? (v.fails) e.Sentence = e.asail-sentence;
    9884
    99 $func? Find-Var-Length e.clashes = e.cond (e.clashes);
    100 
    101 $func Update-Ties t.var e.clashes = e.clashes;
    102 
    103 $func Known-Length-of e.expr = e.known-length (e.unknown-vars);
    104 
    105 $func? Cyclic-Restrictions e.clashes = e.cond (e.clashes);
    106 
    107 $func Cyclic-Min t.var = e.min;
    108 
    109 $func? Cyclic-Max t.var = e.max;
    110 
    111 $func? Get-Source e.clashes = e.cond (e.clashes);
    112 
    113 $func Compose-Expr e.expr = e.compose (e.not-instantiated-vars) s.flat?;
    114 
    115 $func? Comp-Cyclic e.clashes = e.cond (e.clashes) (e.fail);
    116 
    117 $func Get-Subexprs e.vars = e.asail-decls;
    118 
    119 $func Unknown-Vars e.expr = e.known-expr (e.unknown-vars);
    120 
    121 $func Split-Hard-Left e.expr = e.hard;
    122 
    123 $func Split-Hard-Right e.expr = e.hard;
    124 
    12585$func Gener-Label e.QualifiedName = t.label;
    12686
     
    13696
    13797$func Comp-Format (e.last-Re) e.He = e.assignments;
    138 
    139 $func Get-Static-Exprs e.expr = e.expr (e.decls);
    140 
    141 $func Get-Static-Var e.expr = e.var (e.decl);
    14298
    14399
     
    153109RFP-Compile e.Items =
    154110  { <Lookup &RFP-Options ITEMS>;; } :: e.targets,
     111  <RFP-Clear-Table &Stub-Funcs>,
    155112  <Store &Declarations /*empty*/>,
    156113  <Init-Consts>,
    157114  <Compile (e.targets) () e.Items> :: e.Items t.Interface,
    158   t.Interface (MODULE <? &Declarations> <Comp-Consts> e.Items);
     115  <Comp-Func-Stubs> :: e.stub-funcs,
     116  t.Interface (MODULE <? &Declarations> <Comp-Consts> e.Items e.stub-funcs);
    159117
    160118
     
    196154};
    197155
     156
     157
     158$func Gener-Stub e = e;
     159
    198160/*
    199161 * For each referenced function generate a stub one with format e = e.
    200162 */
    201 Comp-Func-Stubs =
    202   <Domain &Ref-To-Funcs> () $iter {
    203     e.funcs : ((e.QualifiedName)) e.rest,
    204       (e.QualifiedName 0) :: t.Fname,
    205 //      <Bind &Ref-To-Funcs ((e.QualifiedName)) (t.Fname)>,
    206 //      {
    207 //        <In-Table? &Fun? (e.QualifiedName)> =
    208 //          <Bind &Back-Funcs (t.Fname) ()>;;
    209 //      },
    210 //      <Bind &Fin (t.Fname) ((EVAR))>,
    211 //      <Bind &Fout (t.Fname) ((EVAR))>,
    212       <Lookup-Func (e.QualifiedName)> :: s.linkage s.tag t.pragma (e.Fin) (e.Fout),
    213       <Gener-Vars (e.Fin) "stub"> :: e.He,
    214       <Comp-Func s.tag t.Fname ((EVAR ("arg" 1))) ((EVAR ("res" 1)))
    215         (LEFT e.He) (RESULT (CALL (e.QualifiedName) e.He))
    216       > :: e.asail,
    217       e.rest (e.asail-funcs e.asail);
    218   } :: e.funcs (e.asail-funcs),
    219   e.funcs : /*empty*/ =
    220   // Here is place to define expressions - references to stub functions.
    221   // Use &Ref-To-Funcs for that.
    222   e.asail-funcs;
     163Comp-Func-Stubs = <Map &Gener-Stub (<Domain &Stub-Funcs>)>;
     164
     165Gener-Stub (t.name) =
     166  <Lookup &Stub-Funcs t.name> : t.stub-name s.tag (e.Fin) (e.Fout),
     167  <Put &Declarations (DECL-FUNC LOCAL t.stub-name)>,
     168  <Gener-Vars (e.Fin) "stub"> :: e.He,
     169  <Comp-Func s.tag t.stub-name ((EVAR ("arg" 1))) ((EVAR))
     170    (LEFT e.He) (RESULT (CALL t.name e.He))>;
     171
     172
    223173
    224174Comp-Func s.tag t.name (e.in) (e.out) e.Sentence =
    225175  <RFP-Clear-Table &Labels>,
    226   <RFP-Clear-Table &Static-Exprs>,
    227   <Store &Greater-Ineqs /*empty*/>,
    228   <Store &Less-Ineqs /*empty*/>,
    229176  <RFP-Clear-Table &Prep-Vars>,
    230177  <Init-Vars>,
    231 //!     <Ref-To-Var e.Sentence> :: e.Sentence,
    232178  <Vars <Gener-Vars (e.out) "res">> :: e.res-vars,
    233179  <Vars-Decl e.res-vars> : e,
     
    256202//  e.vars : /*empty*/,
    257203//  (e.func-decl e.var-decls e.func-body);
    258 
    259 Ref-To-Var e.Snt =
    260   () e.Snt $iter {
    261     e.Snt : t.Statement e.rest, t.Statement : {
    262       (REF t.name) = (e.new-Snt /*<New-Vars (VAR REF t.name)>*/) e.rest;
    263 
    264 //!                     <Table> :: s.tab,
    265 //!                     <Bind &Vars-Tab (t.name) (s.tab)>,
    266 //!                     <Set-Var t.name (Format) (<Format-Exp (REF t.name)>)>,
    267 //!                     <Set-Var t.name (Declared) (True)>,
    268 //!                     <Set-Var t.name (Instantiated) (True)>,
    269 //!                     <Set-Var t.name (Left-compare) ()>,
    270 //!                     <Set-Var t.name (Right-compare) ()>,
    271 //!                     <Set-Var t.name (Left-checks) ()>,
    272 //!                     <Set-Var t.name (Right-checks) ()>,
    273 //!                     (e.new-Snt (VAR t.name)) e.rest;
    274 
    275       (e.expr) = (e.new-Snt (<Ref-To-Var e.expr>)) e.rest;
    276       t = (e.new-Snt t.Statement) e.rest;
    277     };
    278   } :: (e.new-Snt) e.Snt,
    279   e.Snt : /*empty*/ =
    280   e.new-Snt;
    281204
    282205Set-Drops (e.declared) e.comp-func =
     
    429352      } :: e.expr =
    430353        <Prepare-Vars <Vars e.expr>> :: e.vars,
    431 *                               <New-Vars e.vars>,
    432         (<Vars-Decl e.vars>) ((Comp If-not-error) t.first)
     354        (e.vars) ((Comp If-not-error) t.first)
    433355        ((Comp Source)) e.rest;
    434356      (Comp Error) e.rest =
     
    437359        () (e.Snt) () /*empty*/;
    438360      e = () () () e.Snt;
    439     } :: (e.decls) (e.next-terms) (e.source?) e.Snt,
     361    } :: (e.out-vars) (e.next-terms) (e.source?) e.Snt,
    440362    /*
    441363     * The block is a source if after it goes pattern or format expression
     
    455377     */
    456378    v.fails e.source? e.fatal? :: v.branch-fails,
     379    /*
     380     * Before compile the branches mark all out-vars as declared.
     381     */
     382    <Vars-Decl e.out-vars> :: e.decls,
    457383    /*
    458384     * We put all compiled branches in a block, so positive return from a
     
    491417    > :: e.last-branch,
    492418    <Pop-Snt-State>,
     419    <Map &Set-Var- (Instantiated? True) (e.out-vars)> : e,
    493420    e.decls (LABEL (t.label) e.comp-branches e.last-branch)
    494421    <Comp-Sentence s.tail? (v.fails) () e.Snt>;
     
    678605    <Prepare-Res <Split-Re (e.Fin) e.last-Re>> :: e.splited-Re,
    679606    <RFP-Extract-Qualifiers t.name> :: t e.prefix,
    680 *               <Del-Pragmas <Gener-Vars 0 (e.Fout) e.prefix>> : e.Re s,
    681 //!             <Store-Vars <Vars e.res-Re>> :: e.ress,
    682 //!             <Instantiate-Vars e.ress>,
    683 //!             <Ref-To-Var <Strip-STVE e.res-Re>> :: e.res-Re,
    684 //!             e.decls <Declare-Vars "Expr" e.ress> :: e.decls,
    685     <Gener-Vars (e.Fout) e.prefix> :: /*(e.vars)*/ e.Re,
     607    <Gener-Subst-Vars (e.Fout) e.prefix> :: e.Re,
    686608    <Vars e.Re> :: e.vars,
    687609    <Map &Set-Var- (Instantiated? True) (e.vars)> : e,
     
    720642$func Static-Term? t.Rt = static? t.Rt;
    721643
     644$func Find-Ref-Funcs expr = expr;
     645
     646$func Stub-Name t.name = t.stub-name;
     647
    722648
    723649/*
     
    741667  s.create? t.Rt e.Re =
    742668    <Static-Term? t.Rt> : {
    743       Static t.Rt =
     669      Static t.st-Rt =
    744670        {
    745671          e.Re : e1 t2 e3, <Static-Term? t2> : Dynamic t.dyn-Rt =
    746672            <Static-Expr? Create e3> :: s e3,
    747             Dynamic <Create-Static t.Rt e1> t.dyn-Rt e3;
     673            Dynamic
     674            <Create-Static <Find-Ref-Funcs t.st-Rt e1>> t.dyn-Rt e3;
    748675          {
    749             s.create? : Create = Static <Create-Static t.Rt e.Re>;
    750             Static t.Rt e.Re;
     676            s.create? : Create =
     677              Static
     678              <Create-Static <Find-Ref-Funcs t.st-Rt e.Re>>;
     679            Static <Find-Ref-Funcs t.st-Rt e.Re>;
    751680          };
    752681        };
     
    784713
    785714
     715$func Ref-Func? e = e;
     716
     717Find-Ref-Funcs expr = <Map &Ref-Func? (expr)>;
     718
     719Ref-Func? {
     720  (REF t.name) =
     721    {
     722      <Lookup-Func t.name> : {
     723        t t t ((EVAR)) ((EVAR)) = (FUNC t.name);
     724        s.linkage s.tag t.pragma (e.Fin) (e.Fout) =
     725          {
     726            <Lookup &Stub-Funcs t.name> : t.stub-name e =
     727              (FUNC t.stub-name);
     728            <Stub-Name t.name> :: t.stub-name,
     729              <Bind &Stub-Funcs (t.name)
     730                (t.stub-name s.tag (e.Fin) (e.Fout))>,
     731              (FUNC t.stub-name);
     732          };
     733      };
     734      (REF t.name);
     735    };
     736  term = term;
     737};
     738
     739
     740/*
     741 * Генерируем уникальные внутри модуля имена для функций-заглушек.
     742 */
     743Stub-Name (e.qualifiers s.name) =
     744  <To-Chars s.name> : {
     745    e1 '_' s.n, <Int? s.n> = e1 '_' <"+" s.n 1>;
     746    e1 = e1 '_' 0;
     747  } :: e.name,
     748  (e.qualifiers <To-Word e.name>) :: t.name,
     749  {
     750    <Lookup-Func t.name> : e = <Stub-Name t.name>;
     751    t.name;
     752  };
     753
     754
    786755
    787756***************** Compilation of assignment to variables *****************
     
    792761  {
    793762    t.var : e.Re = /*empty*/;
    794     <Generated-Var? e.Re>,
    795       # \{ <Get-Var Instantiated? t.var> : True; },
    796       <Get-Var Decl e.Re> : s.box =
    797       <Gener-Var-Assign t.var e.Re>;
    798763    <Set-Var (Instantiated? True) t.var>, $fail;
     764    <Substitutable-Var? e.Re> = <Gener-Var-Assign t.var e.Re>;
    799765    <Get-Var Decl t.var> : s = (ASSIGN <Vars-Print t.var> e.Re);
    800766    <Vars-Decl t.var> : e, (EXPR <Vars-Print t.var> e.Re);
     
    11031069$func CC-Eqs t.fail (e.assigns) e.eqs = e.actions;
    11041070
    1105 $func CC-Compose-And-Compare t.fail = e.actions;
    1106 
    11071071CC s.tail? (v.fails) t.end-cycle e.Snt, {
    11081072  <Domain &Known-Lengths> : v.clashes =
     
    11191083        <CC s.tail? (v.fails) t.end-cycle e.Snt>;
    11201084      /*empty*/ =
     1085        e.conds <CC-Eqs <R 0 v.fails> () <? &Eqs>> :: e.actions,
     1086        <Store &Eqs /*empty*/>,
    11211087        {
    1122           <Compose-Source-For-Deref> :: e.assign =
    1123             e.conds <CC-Eqs <R 0 v.fails> () e.assign>
     1088          <Compose-Source> :: e.assign =
     1089            e.actions <CC-Eqs <R 0 v.fails> () e.assign>
    11241090            <CC s.tail? (v.fails) t.end-cycle e.Snt>;
    1125           e.conds <CC-Compose-And-Compare <R 0 v.fails>> :: e.actions,
    1126             {
    1127               <Get-Cycle>
    1128               :: e.assign (e.left) (e.right) (e.len)
     1091          {
     1092            <Get-Cycle> :: s.split (e.left) (e.right) (e.len)
    11291093                    t.var t.l-var t.r-var =
    1130                 {
    1131                   e.left : 0, e.right : 0 = /*empty*/ t.var;
    1132                   <Gener-Vars ((VAR)) "subexpr_" t.var> : t.sub-var,
    1133                     (SUBEXPR t.sub-var t.var (e.left)
    1134                       ((INFIX "-" (e.len) (e.left e.right))))
    1135                     t.sub-var;
    1136                 } :: e.subexpr t.var,
    1137                 <Gener-Label "continue"> :: t.cont-label,
    1138                 <Gener-Label "exit"> :: t.break-label,
    1139                 e.actions
    1140                 <CC-Eqs <R 0 v.fails> () e.assign> e.subexpr
    1141                 (LSPLIT t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
    1142                 (FOR (t.cont-label) (t.break-label) () ((INC-ITER t.var))
    1143                   (IF ((NOT (CHECK-ITER t.var))) <Concat <R 0 v.fails>>)
    1144                   <CC s.tail?   (v.fails ((CONTINUE t.cont-label)))
    1145                     <R 0 v.fails> e.Snt>
    1146                   (BREAK t.break-label)
    1147                 );
    1148               e.actions <Comp-Sentence s.tail? (v.fails) () e.Snt>;
    1149             };
     1094              {
     1095                e.left : 0, e.right : 0 = /*empty*/ t.var;
     1096                <Gener-Vars ((VAR)) "subexpr_" t.var> : t.sub-var,
     1097                  (SUBEXPR t.sub-var t.var (e.left)
     1098                    ((INFIX "-" (e.len) (e.left e.right))))
     1099                  t.sub-var;
     1100              } :: e.subexpr t.var,
     1101              {
     1102                s.split : RSPLIT =
     1103                  t.r-var t.l-var DEC-ITER;
     1104                t.l-var t.r-var INC-ITER;
     1105              } :: t.l-var t.r-var s.iter-op,
     1106              <Gener-Label "continue"> :: t.cont-label,
     1107              <Gener-Label "exit"> :: t.break-label,
     1108              e.actions e.subexpr
     1109              (s.split t.var (<Get-Var Min t.l-var>) t.l-var t.r-var)
     1110              (FOR (t.cont-label) (t.break-label) () ((s.iter-op t.var))
     1111                (IF ((NOT (CHECK-ITER t.var))) <Concat <R 0 v.fails>>)
     1112                <CC s.tail?     (v.fails ((CONTINUE t.cont-label)))
     1113                  <R 0 v.fails> e.Snt>
     1114                (BREAK t.break-label)
     1115              );
     1116            e.actions <Comp-Sentence s.tail? (v.fails) () e.Snt>;
     1117          };
    11501118        };
    11511119    };
     
    12841252        (IF ((NOT (s.eq el (er) (e.pos)))) e.fail) :: t.cond,
    12851253        {
    1286           e.assigns : $r e1 (SUBEXPR t.Pt e.def) e2 =
    1287             <CC-Eqs (e.fail) (e1 (SUBEXPR t.Pt e.def) t.cond e2) e.rest>;
     1254          /*
     1255           * Мы предполагаем, что во всех пришедших e.eqs все e.Re
     1256           * уже были определены ранее.
     1257           */
     1258          e.assigns : $r e1 (s.op t.Pt e.def) e2 =
     1259            <CC-Eqs (e.fail) (e1 (s.op t.Pt e.def) t.cond e2) e.rest>;
    12881260          t.cond <CC-Eqs (e.fail) (e.assigns) e.rest>;
    12891261        };
    12901262      <Set-Var (Instantiated? True) t.Pt>,
    1291         <CC-Eqs (e.fail) (e.assigns (SUBEXPR t.Pt e.Re (e.pos) (e.len))) e.rest>;
     1263        {
     1264          t.Pt : (SVAR e) =
     1265            (IF
     1266              ((NOT (SYMBOL? e.Re (<Pos (e.Re) s.dir e.pos>))))
     1267              e.fail
     1268            );;
     1269        } :: e.cond,
     1270        {
     1271          <Get-Var Decl t.Pt> : s =
     1272            e.cond <CC-Eqs (e.fail) (e.assigns
     1273              (ASSIGN t.Pt (SUBEXPR e.Re (e.pos) (e.len))))
     1274              e.rest>;
     1275          <Vars-Decl t.Pt> : e,
     1276            e.cond <CC-Eqs (e.fail) (e.assigns
     1277              (SUBEXPR t.Pt e.Re (e.pos) (e.len))) e.rest>;
     1278        };
    12921279    };
    12931280  e.assigns e.eqs;
    12941281};
    12951282
    1296 CC-Compose-And-Compare (e.fail) =
    1297   {
    1298     <? &Eqs> : v.eqs =
    1299       <CC-Eqs (e.fail) () v.eqs> :: e.actions,
    1300       <Store &Eqs /*empty*/>,
    1301       <Update-Hard-Parts> : e,
    1302       e.actions <CC-Compose-And-Compare (e.fail)>;;
    1303   };
    1304 
    1305 
    1306 
    1307 
    1308 
    1309 
    1310 *       /*e.cond*/ (/*!e.clashes!*/) (/*e.fail*/) $iter {
    1311 *               /*
    1312 *                * First of all see if we have a clash with all variables of known length
    1313 *                * and without length conditions written out.
    1314 *                */
    1315 *               e.clashes : e1 (e.t1 Known-length e.t2 (e.Re) (s.dir e.Pe)) e2,
    1316 *                       <Hard-Exp? e.Re e.Pe> =
    1317 *                       e.cond
    1318 *                       (Cond IF ((INFIX "==" (<Length-of e.Re>) (<Length-of e.Pe>))))
    1319 *                       (e1 (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe)) e2) (e.fail);
    1320 *               /*
    1321 *                * Next see if we can compute length of some variable.
    1322 *                */
    1323 *               e.cond <Find-Var-Length e.clashes> (e.fail);
    1324 *               /*
    1325 *                * Write out restrictions for the cyclic variables.
    1326 *                */
    1327 *               e.cond <Cyclic-Restrictions e.clashes> (e.fail);
    1328 * //            <Cyclic-Restrictions e.clashes> :: e.new-cond (e.clashes),
    1329 * //                    {
    1330 * //                            e.fail : v = e.cond e.new-cond (Clear-Restricted) (e.clashes) (e.fail);
    1331 * //                            e.cond e.new-cond (e.clashes) (e.fail);
    1332 * //                    };
    1333 *               /*
    1334 *                * After checking all possible lengthes at the upper level change
    1335 *                * <<current_label_if_fail>>.
    1336 *                */
    1337 *               e.fail : v =
    1338 *                       (Contin e.fail) e.cond (Fail e.fail) (Clear-Restricted) (e.clashes) ();
    1339 *               /*
    1340 *                * For all clashes with known left part check unwatched terms whether they
    1341 *                * are symbols or reference terms or not any.
    1342 *                */
    1343 *               \?
    1344 *               {
    1345 *                       <Check-Symbols e.clashes> : {
    1346 *                               v.new-cond (e.new-clashes) s =
    1347 *                                       e.cond (Cond IF (v.new-cond)) (e.new-clashes) ();
    1348 *                               (e.new-clashes) New = e.cond (e.new-clashes) ();
    1349 *                               e \! $fail;
    1350 *                       };
    1351 *                       <PrintLN "Check-Symbols: don't know what to do... ;-)">, $fail;
    1352 *               };
    1353 *               /*
    1354 *                * And then try to compose new clash by dereferencing a part of some one.
    1355 *                */
    1356 *               e.cond <Dereference-Subexpr e.clashes> ();
    1357 *               /*
    1358 *                * If previous doesn't work then compare recursively all known
    1359 *                * subexpressions and all unknown repeated subexpressions with
    1360 *                * corresponding parts of source.
    1361 *                */
    1362 *               <Compare-Subexpr e.clashes> :: e.new-cond (e.asserts) (e.new-clashes) s.new?,
    1363 *                       \{
    1364 *                               e.new-cond : v, {
    1365 *                                       e.asserts : v =
    1366 *                                               e.cond (Assert e.asserts) (Cond IF (e.new-cond)) (e.new-clashes) ();
    1367 *                                       e.cond (Cond IF (e.new-cond)) (e.new-clashes) ();
    1368 *                               };
    1369 *                               e.asserts : v = e.cond (Assert e.asserts) (e.new-clashes) ();
    1370 *                               s.new? : New = e.cond (e.new-clashes) ();
    1371 *                       };
    1372 *               /*
    1373 *                * Then get first uncatenated source and bring it to the normal
    1374 *                * form, i.e. concatenate and parenthesize until it became single
    1375 *                * known expression.
    1376 *                */
    1377 *               e.cond <Get-Source e.clashes> ();
    1378 *               /*
    1379 *                * Now it's time to deal with cycles.
    1380 *                */
    1381 *               e.cond <Comp-Cyclic e.clashes>;
    1382 *               /*
    1383 *                * At last initialize all new subexpressions from all clashes.
    1384 *                */
    1385 *               e.clashes () $iter {
    1386 *                       e.clashes : (e t.Re (s.dir e.Pe)) e.rest,
    1387 *                               e.rest (e.new-cond <Get-Subexprs <Vars e.Pe>>);
    1388 *               } :: e.clashes (e.new-cond),
    1389 *                       e.clashes : /*empty*/ =
    1390 *                       {
    1391 *                               e.new-cond : /*empty*/ = e.cond () ();
    1392 *                               e.cond (Assert e.new-cond) () ();
    1393 *                       };
    1394 *       } :: e.cond (e.clashes) (e.fail),
    1395 * //    <WriteLN CC-Clashes e.clashes>,
    1396 * //    <WriteLN CC-Cond e.cond>,
    1397 *       e.clashes : /*empty*/ =
    1398 *
    1399 *       e.cond () 0 $iter {
    1400 *               e.cond : (Contin (CONTINUE t.label)) e.rest =
    1401 *                       e.rest (e.contin (Comp Continue t.label)) 0;
    1402 *               e.cond (e.contin) 1;
    1403 *       } :: e.cond (e.contin) s.stop?,
    1404 *       s.stop? : 1 =
    1405 * //!   <Comp-Sentence () e.Current-Snt e.contin e.Other-Snts> :: e.asail-Snt,
    1406 *       <Comp-Sentence s.tail? (v.fails) () e.Sentence> :: e.asail-Snt,
    1407 *       e.cond (e.asail-Snt) () $iter {
    1408 *               e.cond : e.some (e.last),
    1409 *                       e.last : {
    1410 *                               Cond e.condition =
    1411 *                                       e.some ((e.condition e.asail-Snt)) (e.vars);
    1412 *                               Assert e.assertion =
    1413 *                                       e.some (e.assertion e.asail-Snt) (e.vars);
    1414 *                               Fail e.fail1 =
    1415 *                                       e.some (e.asail-Snt e.fail1) (e.vars);
    1416 *                               Restricted t.var =
    1417 *                                       e.some (e.asail-Snt) (e.vars t.var);
    1418 *                               If-not-restricted t.var e.restr-cond, {
    1419 *                                       e.vars : e t.var e = e.some (e.asail-Snt) (e.vars);
    1420 *                                       e.some e.restr-cond (e.asail-Snt) (e.vars);
    1421 *                               };
    1422 *                               Clear-Restricted = e.some (e.asail-Snt) ();
    1423 *                       };
    1424 *       } :: e.cond (e.asail-Snt) (e.vars),
    1425 *       e.cond : /*empty*/ =
    1426 *       e.asail-Snt/* <Comp-Sentence () e.Other-Snts>*/;
    1427 
    1428 
    1429 Find-Var-Length (e.fail) e.clashes =
    1430 //  <WriteLN Find-Var-Length e.clashes>,
    1431   e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2 \?
    1432   <Unknown-Vars e.Pe> :: e.new-Pe (e.Pe-unknown),
    1433   <Unknown-Vars e.Re> :: e.new-Re (e.Re-unknown),
    1434 //  <Write Unknown>, <Write (e.Re-unknown)>, <WriteLN (e.Pe-unknown)>,
    1435   e.Re-unknown e.Pe-unknown : {
    1436     /*empty*/ =
    1437       (e1 (e.t1 Known-length e.t2 (e.Re) (s.dir e.Pe)) e2);
    1438     (VAR t.name) e.rest,
    1439       e.rest $iter \{
    1440         e.unknown : (VAR t.name) e.rest1 = e.rest1;
    1441       } :: e.unknown,
    1442       e.unknown : /*empty*/,
    1443       <"-" <Length e.Re-unknown> <Length e.Pe-unknown>> : {
    1444         0 \! $fail;
    1445         s.diff, {
    1446           <"<" (s.diff) (0)> =
    1447             <"*" s.diff -1>
    1448             (INFIX "-" (<Length-of e.new-Re>) (<Length-of e.new-Pe>));
    1449           <">" (s.diff) (0)> =
    1450             s.diff
    1451             (INFIX "-" (<Length-of e.new-Pe>) (<Length-of e.new-Re>));
    1452         } :: s.mult e.diff,
    1453           t.name : (e.QualifiedName),
    1454           (VAR ("len" e.QualifiedName)) :: t.len-var,
    1455           {
    1456             <?? t.name Max> :: e.max =
    1457               (INFIX "<="
    1458                 (t.len-var)
    1459                 ((INFIX "*" (s.mult) (e.max)))
    1460               );
    1461             /*empty*/;
    1462           } :: e.cond,
    1463           e.cond
    1464           (INFIX ">="
    1465             (t.len-var)
    1466             ((INFIX "*" (s.mult) (<?? t.name Min>)))
    1467           )
    1468           (NOT (INFIX "%"
    1469             (t.len-var)
    1470             (s.mult)
    1471           )) :: e.cond,
    1472           <Set-Var t.name (Max) (//(LENGTH (VAR t.name))
    1473             (INFIX "/" (t.len-var) (s.mult))
    1474           )>,
    1475           <Set-Var t.name (Min) (<?? t.name Max>)>,
    1476           <Set-Var t.name (Length) (<?? t.name Max>)>,
    1477 //          <WriteLN Unknown-Num s.mult> =
    1478           (Restricted (VAR t.name))
    1479           (Assert
    1480             <Declare-Vars "int" t.len-var>
    1481             (ASSIGN t.len-var e.diff)
    1482           )
    1483           (Cond IF (e.cond))
    1484           (<Update-Ties (VAR t.name) e1>
    1485             (e.t1 Checked-length e.t2 (e.Re) (s.dir e.Pe))
    1486           <Update-Ties (VAR t.name) e2>);
    1487       };
    1488     e.unknown \!
    1489       e.t1 Unknown-length e.t2 : e.t3 Ties e.t4 =
    1490       e.t1 : t.id e,
    1491       e.unknown () $iter {
    1492         e.unknown : (VAR t.name) e.rest, {
    1493           e.tied : e (VAR t.name) e = e.rest (e.tied);
    1494           <Entries (VAR t.name) (e.Re)> :: s.Re-ent e.new-Re,
    1495             <Entries (VAR t.name) (e.Pe)> :: s.Pe-ent e.new-Pe,
    1496             <"-" s.Re-ent s.Pe-ent> :: s.diff,
    1497             {
    1498               s.diff : 0 = e.rest (e.tied (VAR t.name));
    1499               {
    1500                 <"<" (s.diff) (0)> =
    1501                   <"*" s.diff -1> (e.new-Re) (e.new-Pe);
    1502                 s.diff (e.new-Pe) (e.new-Re);
    1503               } :: s.diff (e.plus) (e.minus),
    1504                 (
    1505                   t.id
    1506                   (<Known-Length-of e.plus>)
    1507                   (<Known-Length-of e.minus>)
    1508                   s.diff
    1509                 ) :: t.tie,
    1510                 {
    1511                   <?? t.name Ties> : {
    1512                     e.c1 (t.id e) e.c2 = e.c1 e.c2;
    1513                     e.ties = e.ties;
    1514                   };
    1515                   /*empty*/;
    1516                 } :: e.ties,
    1517                 {
    1518                   e.ties : e t.tie e;
    1519                   <Set-Var t.name (Ties) (e.ties t.tie)>;
    1520                 },
    1521                 e.rest (e.tied (VAR t.name));
    1522             };
    1523         };
    1524       } :: e.unknown (e.tied),
    1525       e.unknown : /*empty*/ =
    1526       {
    1527         e.t3 e.t4 : e Cyclic e = e.t3 e.t4;
    1528         e.t3 e.t4 Cyclic;
    1529       } :: e.tags,
    1530       (e1 (e.tags (e.Re) (s.dir e.Pe)) e2);
    1531   };
    1532 
    1533 Known-Length-of e.expr =
    1534   <Unknown-Vars e.expr> :: e.expr (e.vars),
    1535   <Length-of e.expr> (e.vars);
    1536 
    1537 Update-Ties t.var e.clashes =
    1538   e.clashes () $iter {
    1539     e.clashes : t.clash e.rest,
    1540       t.clash : (e.tags (e.Re) (s.dir e.Pe)),
    1541       {
    1542         e.tags : e Ties e = e.rest (e.new-clashes t.clash);
    1543         e.Re e.Pe : e t.var e =
    1544           e.rest (e.new-clashes (e.tags Ties (e.Re) (s.dir e.Pe)));
    1545         e.rest (e.new-clashes t.clash);
    1546       };
    1547   } :: e.clashes (e.new-clashes),
    1548   e.clashes : /*empty*/ =
    1549   e.new-clashes;
    1550 
    1551 Cyclic-Restrictions e.clashes =
    1552   e.clashes : e1 (e.t1 Cyclic e.t2 (e.Re) (s.dir e.Pe)) e2 =
    1553   <Unknown-Vars e.Re e.Pe> :: e (e.unknown),
    1554   e.unknown () $iter {
    1555     e.unknown : t.var e.rest,
    1556       t.var : (VAR (e.QualifiedName)),
    1557       (VAR ("min" e.QualifiedName)) :: t.min-var,
    1558       <Cyclic-Min t.var> :: e.min,
    1559       {
    1560         <Cyclic-Max t.var> :: e.max =
    1561           e.rest (e.cond (Restricted t.var) (If-not-restricted t.var
    1562             (Assert
    1563               <Declare-Vars "int" t.min-var> (ASSIGN t.min-var e.min)
    1564             )
    1565             (Cond IF ((INFIX "<=" (t.min-var) (e.max))))
    1566         ));
    1567         e.rest (e.cond);
    1568       };
    1569   } :: e.unknown (e.cond),
    1570   e.unknown : /*empty*/ =
    1571   e.cond (e1 (e.t1 e.t2 (e.Re) (s.dir e.Pe)) e2);
    1572 
    1573 Cyclic-Min (VAR t.name) =
    1574   <?? t.name Ties> () $iter {
    1575     e.ties : (t (e.plus (e.plus-vars)) (e.minus (e.minus-vars)) s.mult) e.rest, {
    1576       e.minus-vars () $iter \{
    1577         e.minus-vars : t.var e.vars-rest,
    1578           e.vars-rest (e.minus-maxes <Cyclic-Max t.var>);
    1579       } :: e.minus-vars (e.minus-maxes),
    1580         e.minus-vars : /*empty*/ =
    1581         e.plus-vars () $iter {
    1582           e.plus-vars : (VAR t.var-name) e.vars-rest =
    1583             e.vars-rest (e.plus-mins <?? t.var-name Min>);
    1584         } :: e.plus-vars (e.plus-mins),
    1585         e.plus-vars : /*empty*/ =
    1586         e.rest (e.mins ((INFIX "/"
    1587           ((INFIX "-" (e.plus e.plus-mins) (e.minus e.minus-maxes))) (s.mult)
    1588         )));
    1589       e.rest (e.mins);
    1590     };
    1591   } :: e.ties (e.mins),
    1592   e.ties : /*empty*/ =
    1593   (<?? t.name Min>) e.mins :: e.mins,
    1594   {
    1595     e.mins : (e.min) = e.min;
    1596     (MAX e.mins);
    1597   };
    1598 
    1599 Cyclic-Max (VAR t.name) =
    1600   <?? t.name Ties> () $iter {
    1601     e.ties : (t (e.plus (e.plus-vars)) (e.minus (e.minus-vars)) s.mult) e.rest, {
    1602       e.plus-vars () $iter \{
    1603         e.plus-vars : (VAR t.var-name) e.vars-rest,
    1604           e.vars-rest (e.plus-maxes <?? t.var-name Max>);
    1605       } :: e.plus-vars (e.plus-maxes),
    1606         e.plus-vars : /*empty*/ =
    1607         e.minus-vars () $iter {
    1608           e.minus-vars : (VAR t.var-name) e.vars-rest =
    1609             e.vars-rest (e.minus-mins <?? t.var-name Min>);
    1610         } :: e.minus-vars (e.minus-mins),
    1611         e.minus-vars : /*empty*/ =
    1612         e.rest (e.maxes ((INFIX "/"
    1613           ((INFIX "-" (e.plus e.plus-maxes) (e.minus e.minus-mins))) (s.mult)
    1614         )));
    1615       e.rest (e.maxes);
    1616     };
    1617   } :: e.ties (e.maxes),
    1618   e.ties : /*empty*/ =
    1619   {
    1620     (<?? t.name Max>) e.maxes;
    1621     e.maxes;
    1622   } :: e.maxes,
    1623   {
    1624     e.maxes : /*empty*/ = $fail;
    1625     e.maxes : (e.max) = e.max;
    1626     (MIN e.maxes);
    1627   };
    1628 
    1629 
    1630 
    1631 
    1632 $const New-Clash-Tags = Unknown-length Ties Check-symbols Deref Compare;
    1633 
    1634 
    1635 Get-Source e.clashes =
    1636   e.clashes : e1 (e.tags (e.Re) (s.dir e.Pe)) e2,
    1637   \{
    1638     /*
    1639      * If source is an instantiated variable then go to the next clash.
    1640      */
    1641     e.Re : (VAR t.name),
    1642       <?? t.name Instantiated> : True = $fail;
    1643     /*
    1644      * If in source there is unknown variable then we can't compute it, so
    1645      * go to the next clash.
    1646      */
    1647     e.Re $iter e.Re : {               
    1648       (VAR t.name) e.rest =           
    1649         \{                   
    1650           <?? t.name Instantiated> : True; 
    1651           <?? t.name Left-compare> : v;   
    1652         }, e.rest;               
    1653       t e.rest = e.rest;             
    1654     } :: e.Re,                   
    1655       e.Re : /*empty*/;             
    1656   } =
    1657 //  <WriteLN Get-Source (e.tags (e.Re) (s.dir e.Pe))>,
    1658   {
    1659     e.Re : /*empty*/ =
    1660       <Store-Vars (EVAR ("empty" 0))> : t.empty,
    1661       <Set-Var ("empty") (Instantiated) (True)>,
    1662       () () (e.tags (t.empty) (s.dir e.Pe));
    1663     e.Re : (VAR t.name) =
    1664       (e.Re) () (e.tags (e.Re) (s.dir e.Pe));
    1665     {
    1666       e.tags : e Without-object-symbols e =
    1667         /*empty*/ (e.tags (e.Re) (s.dir e.Pe));
    1668       <Get-Static-Exprs e.Re> :: e.Re (e.Re-decls),
    1669         <Get-Static-Exprs e.Pe> :: e.Pe (e.Pe-decls) =
    1670         e.Re-decls e.Pe-decls (e.tags Without-object-symbols (e.Re) (s.dir e.Pe));
    1671     } :: e.asserts (e.tags (e.Re) (s.dir e.Pe)), {
    1672       e.Re : (VAR t.name) =
    1673         () (e.asserts) (e.tags (e.Re) (s.dir e.Pe));
    1674       <Compose-Expr e.Re> :: e.compose (e.not-inst) s.flat?,
    1675         <Gener-Label "compose"> :: t.name,
    1676         <Declare-Vars "Expr" (VAR t.name)> :: e.decl,
    1677         <Instantiate-Vars (VAR t.name)>,
    1678         {
    1679           s.flat? : 0 = <Set-Var t.name (Flat) (True)>;;
    1680         },
    1681         <Set-Var t.name (Length) (<Length-of e.Re>)>,
    1682         <Set-Var t.name (Format) (<Format-Exp e.Re>)> =
    1683         (e.not-inst) (e.asserts e.decl (ASSIGN (VAR t.name) e.compose))
    1684         (e.tags ((VAR t.name)) (s.dir e.Pe));
    1685     };
    1686   } :: (e.not-inst) (e.decl) t.clash,
    1687   (Assert <Get-Subexprs e.not-inst> e.decl) (e1 t.clash e2);
    1688 
    1689 Compose-Expr e.Re =
    1690   e.Re () () 0 $iter {
    1691     e.Re : t.Rt e.rest, t.Rt : {
    1692       s.ObjectSymbol =
    1693         <PrintLN "Compose-Expr: can't deal with object symbols!">, $fail;
    1694       (PAREN e.expr) =
    1695         <Compose-Expr e.expr> :: e.expr (e.new-not-inst) s,
    1696         (PAREN e.expr) (e.new-not-inst) 1;
    1697       (VAR t.name) =
    1698         {
    1699           <?? t.name Instantiated> : True = /*empty*/;
    1700           t.Rt;
    1701         } :: e.new-not-inst,
    1702         {
    1703           <?? t.name Flat> : True = 0;
    1704           1;
    1705         } :: s.new-flat?,
    1706         (Used t.Rt) t.Rt (e.new-not-inst) s.new-flat?;
    1707       t = t.Rt () 0; // STUB!
    1708     } :: e.new-compose (e.new-not-inst) s.new-flat? =
    1709       e.rest (e.compose e.new-compose) (e.not-inst e.new-not-inst)
    1710       <"+" s.flat? s.new-flat?>;
    1711   } :: e.Re (e.compose) (e.not-inst) s.flat?,
    1712   e.Re : /*empty*/ =
    1713   e.compose (e.not-inst) s.flat?;
    1714 
    1715 Get-Subexprs e.vars =
    1716 //  <WriteLN Get-Subexprs e.vars>,
    1717   e.vars () $iter {
    1718     e.vars : (VAR t.name) e.rest,
    1719       # \{ <?? t.name Instantiated> : True; },
    1720       <?? t.name Left-compare> : (t.var s.dir (e.pos) (0) e.len) e =
    1721       <Instantiate-Vars (VAR t.name)>,
    1722       <Declare-Vars "Expr" (VAR t.name)> : e,
    1723       {
    1724         s.dir : Right =
    1725           (INFIX "-" (<Length-of t.var>) (e.pos e.len));
    1726         e.pos;
    1727       } :: e.pos,
    1728       e.rest (e.decls (Used t.var) (SUBEXPR (VAR t.name) t.var (e.pos) (e.len)));
    1729     // STUB:
    1730     e.vars : t e.rest = e.rest (e.decls);
    1731   } :: e.vars (e.decls),
    1732   e.vars : /*empty*/ =
    1733   e.decls;
    1734 
    1735 Comp-Cyclic e.clashes =
    1736   e.clashes : e1 (e.t1 Unknown-length e.t2 (e.Re) (s.dir e.Pe)) e2 =
    1737   e.Re : (VAR (e.QualifiedName)),
    1738   <Split-Hard-Left e.Pe> :: e.left-hard,
    1739   <Split-Hard-Right e.Pe> :: e.right-hard,
    1740   e.Pe : e.left-hard e.Cycle e.right-hard,
    1741   {
    1742     e.left-hard e.right-hard : /*empty*/ = /*empty*/ (e.QualifiedName) ();
    1743     <Gener-Label "ref" e.QualifiedName> :: t.name,
    1744       t.name : (e.CycleName),
    1745       <Declare-Vars "Expr" (VAR t.name)> : e,
    1746       <Instantiate-Vars (VAR t.name)>,
    1747       <Set-Var t.name (Format) (<Format-Exp e.Cycle>)>,
    1748       (INFIX "-" (<Length-of e.Re>) (<Length-of e.right-hard>)) :: e.len,
    1749       (Used e.Re)
    1750       (SUBEXPR (VAR t.name) e.Re (<Length-of e.left-hard>) (e.len)) :: e.decl,
    1751       <Set-Var t.name (Left-compare)
    1752         ((e.Re Left (<Length-of e.left-hard>) (0) <Length-of (VAR t.name)>))>,
    1753       <Set-Var (e.QualifiedName) (Left-compare) ((
    1754         (VAR t.name) Left (0) (<Length-of e.left-hard>) <Length-of (VAR t.name)>
    1755       ))> =
    1756       (e.t1 Checked-length e.t2 (e.Re) (s.dir e.left-hard (VAR t.name) e.right-hard))
    1757       (e.CycleName) (e.decl);
    1758   } :: e.old-clash (e.CycleName) (e.decl),
    1759   (VAR (e.CycleName)) :: t.var,
    1760   <Gener-Label L "For" "Break"> :: t.break-label,
    1761   <Gener-Label L "For" "Cont"> :: t.cont-label,
    1762   s.dir : {
    1763     LEFT =
    1764       e.Cycle : t.var-e1 e.rest,
    1765       t.var-e1 : (VAR (e.SplitName)),
    1766       {
    1767 //        e.rest : t.var-e2 = t.var-e2;
    1768         (VAR <Gener-Label "lsplit" e.CycleName>);
    1769       } :: t.var-e2,
    1770       <Declare-Vars "Expr" t.var-e2> : e,
    1771 //!                     <Instantiate-Vars t.var-e1 t.var-e2>
    1772       (Assert
    1773         e.decl
    1774         (LSPLIT t.var ((VAR ("min" e.SplitName))) t.var-e1 t.var-e2)
    1775       )
    1776       (Cond LABEL (t.break-label))
    1777       (Cond FOR (t.cont-label) () ((INC-ITER t.var)))
    1778       (Fail (BREAK t.break-label))
    1779       (Clear-Restricted)
    1780       (<Update-Ties t.var-e2 <Update-Ties t.var-e1 e1>>
    1781         e.old-clash
    1782         (<Gener-Label "clash"> &New-Clash-Tags (t.var-e2) (s.dir e.rest))
    1783       <Update-Ties t.var-e2 <Update-Ties t.var-e1 e2>>)
    1784       ((CONTINUE t.cont-label));
    1785     RIGHT =
    1786       e.Cycle : e.rest t.var-e2,
    1787       t.var-e2 : (VAR (e.SplitName)),
    1788       {
    1789 //        e.rest : t.var-e2 = t.var-e2;
    1790         (VAR <Gener-Label "lsplit" e.CycleName>);
    1791       } :: t.var-e1,
    1792       <Declare-Vars "Expr" t.var-e1> : e,
    1793       <Instantiate-Vars t.var-e1 t.var-e2>
    1794       (Assert
    1795         e.decl
    1796         (RSPLIT t.var ((VAR ("min" e.SplitName))) t.var-e1 t.var-e2)
    1797       )
    1798       (Cond LABEL (t.break-label))
    1799       (Cond FOR (t.cont-label) () ((INC-ITER t.var)))
    1800       (Fail (BREAK t.break-label))
    1801       (Clear-Restricted)
    1802       (<Update-Ties t.var-e2 <Update-Ties t.var-e1 e1>>
    1803         e.old-clash
    1804         (<Gener-Label "clash"> &New-Clash-Tags (t.var-e1) (s.dir e.rest))
    1805       <Update-Ties t.var-e2 <Update-Ties t.var-e1 e2>>)
    1806       ((CONTINUE t.cont-label));
    1807   };
    1808 
    1809 Split-Hard-Left e.expr =
    1810   e.expr () $iter {
    1811     e.expr : t.Pt e.rest, {
    1812       <Hard-Exp? t.Pt> = e.rest (e.hard t.Pt);
    1813       (e.hard);
    1814     };
    1815   } :: e.expr (e.hard),
    1816   e.expr : /*empty*/ =
    1817   e.hard;
    1818 
    1819 Split-Hard-Right e.expr =
    1820   e.expr () $iter {
    1821     e.expr : e.some t.Pt, {
    1822       <Hard-Exp? t.Pt> = e.some (t.Pt e.hard);
    1823       (e.hard);
    1824     };
    1825   } :: e.expr (e.hard),
    1826   e.expr : /*empty*/ =
    1827   e.hard;
     1283
     1284
    18281285
    18291286Gener-Label e.QualifiedName =
     
    18381295Add-To-Label (e.label) e.name = <Gener-Label e.label "_" e.name>;
    18391296
    1840 Get-Static-Exprs e.Re =
    1841   e.Re () () () $iter {
    1842     e.Re : t.Rt e.rest, t.Rt : {
    1843       s.ObjectSymbol, {
    1844         <Char? t.Rt> =
    1845           e.rest (e.new-Re) (e.decls) (e.expr t.Rt);
    1846         <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
    1847           {
    1848             <Int? t.Rt> = "int";
    1849             <Word? t.Rt> = "word";
    1850           } :: s.prefix,
    1851           <Get-Static-Var s.prefix t.Rt> :: e.Rt-var (e.Rt-decl) =
    1852           e.rest (e.new-Re e.expr-var e.Rt-var)
    1853           (e.decls e.expr-decl e.Rt-decl) ();
    1854       };
    1855       (PAREN e.paren-Re) =
    1856         <Get-Static-Exprs e.paren-Re> :: e.new-paren-Re (e.paren-decls),
    1857         <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
    1858         e.rest (e.new-Re e.expr-var (PAREN e.new-paren-Re))
    1859         (e.decls e.expr-decl e.paren-decls) ();
    1860       t.var =
    1861         <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
    1862         e.rest (e.new-Re e.expr-var t.var) (e.decls e.expr-decl) ();
    1863     };
    1864   } :: e.Re (e.new-Re) (e.decls) (e.expr),
    1865 //  <WriteLN Get-Static-Exprs e.Re>,
    1866   e.Re : /*empty*/ =
    1867   <Get-Static-Var "chars" e.expr> :: e.expr-var (e.expr-decl),
    1868   e.new-Re e.expr-var (e.decls e.expr-decl);
    1869 
    1870 Get-Static-Var s.prefix e.expr, {
    1871   e.expr : /*empty*/ = /*empty*/ ();
    1872   {
    1873     <Lookup &Static-Exprs s.prefix e.expr> : t.var = t.var ();
    1874     ("const" s.prefix e.expr) :: t.name,
    1875       <Bind &Static-Exprs (s.prefix e.expr) ((VAR t.name))>,
    1876       <Declare-Vars "Expr" (VAR t.name)> : e,
    1877       <Instantiate-Vars (VAR t.name)>,
    1878       <Set-Var t.name (Flat) (True)>,
    1879       <Length e.expr> :: s.len,
    1880       <Set-Var t.name (Length) (s.len)>,
    1881       <Set-Var t.name (Min) (s.len)>,
    1882       <Set-Var t.name (Max) (s.len)>,
    1883       <Set-Var t.name (Format) (e.expr)> =
    1884       (VAR t.name) ((EXPR (VAR t.name) e.expr));
    1885   };
    1886 };
    1887 
    1888 
    1889 
    1890 
    1891 Length-of {
    1892   /*empty*/ = 0;
    1893   e.Re =
    1894     e.Re () $iter {
    1895       e.Re : t.Rt e.rest, t.Rt : {
    1896         s.ObjectSymbol = 1;     // Может появиться из константы.
    1897         (PAREN e) = 1;
    1898         (REF t.name) = ; //<Ref-Len t.name>;  STUB!!!
    1899         (STATIC t.name) = <Length-of <Get-Static t.Rt>>;
    1900         t, <Var? t.Rt>, {
    1901           <Get-Var Length t.Rt> : v.len = v.len;
    1902           (LENGTH t.Rt);
    1903         };
    1904       } :: e.new-len,
    1905       e.rest (e.Length e.new-len);
    1906     } :: e.Re (e.Length),
    1907     e.Re : /*empty*/ =
    1908     e.Length;
    1909 };
    1910 
    1911 
    1912 
    1913 /*
    1914  * Ends good if lengths of all variables in the upper level of e.expr can be
    1915  * calculated.
    1916  */
    1917 Hard-Exp? e.expr =
    1918   e.expr $iter {
    1919     e.expr : t.first e.rest =
    1920     {
    1921       <Var? t.first>, {
    1922         <Get-Var Instantiated? t.first> : True;
    1923         <Get-Var Length t.first> : v;
    1924         = $fail;
    1925       };;
    1926     },
    1927       e.rest;
    1928   } :: e.expr,
    1929   e.expr : /*empty*/;
    1930 
    1931 /*
    1932  * Returns those parts of e.expr which lengthes are known. Also returns a list
    1933  * of variables with unknown lengthes.
    1934  */
    1935 Unknown-Vars e.expr =
    1936   e.expr () () $iter {
    1937     e.expr : t.first e.rest, {
    1938       t.first : (VAR t.name), {
    1939         <?? t.name Instantiated> : True =
    1940           e.new-expr t.first (e.unknown);
    1941         <?? t.name Max> :: e.max, <?? t.name Min> : e.max =
    1942           e.new-expr t.first (e.unknown);
    1943         e.new-expr (e.unknown t.first);
    1944       };
    1945       e.new-expr t.first (e.unknown);
    1946     } :: e.new-expr (e.unknown) =
    1947       e.rest (e.new-expr) (e.unknown);
    1948   } :: e.expr (e.new-expr) (e.unknown),
    1949   e.expr : /*empty*/ =
    1950   e.new-expr (e.unknown);
    19511297
    19521298
  • to-imperative/trunk/compiler/rfp_compile.rfi

    r963 r1146  
    2222$func? Lookup-Func t.Fname = s.linkage s.tag t.pragma (e.Fin) (e.Fout);
    2323
    24 $func Ref-To-Var e.Snt = e.Snt;
    25 
    26 
    27 
  • to-imperative/trunk/compiler/rfp_vars.rf

    r963 r1146  
    222222
    223223
    224 Generated-Var? (s.tag s.box), s.tag : \{ EVAR; VVAR; TVAR; SVAR; };
     224Gener-Subst-Vars (e.format) e.prefix = <Gener-Vars (e.format) (Subst) e.prefix>;
     225
     226
     227Substitutable-Var? (s.tag s.box) =
     228  s.tag : \{ EVAR; VVAR; TVAR; SVAR; },
     229  <? s.box> : 0 (Subst) e;
    225230
    226231
     
    265270    <? s.box> : {
    266271      0 e.name =
     272        { e.name : (Subst) e.n = e.n; e.name; } :: e.name,
    267273        (VAR (<Gener-Name From-One <To-Word e.name>>)) :: t.var,
    268274        <Store s.box t.var>,
  • to-imperative/trunk/compiler/rfp_vars.rfi

    r1006 r1146  
    2121$func Vars e.expr = e.vars;
    2222
    23 $func Gener-Vars (e.format) e.prefix = /*(e.vars)*/ e.Re;
     23$func Gener-Vars (e.format) e.prefix = e.Re;
    2424
    2525$func Gener-Err-Var = t.var;
    2626
    27 $func? Generated-Var? e.Re = ;
     27$func Gener-Subst-Vars (e.format) e.prefix = e.Re;
     28
     29$func? Substitutable-Var? e.Re = ;
    2830
    2931$func Gener-Var-Assign t.var e.generated-var = ;
  • to-imperative/trunk/compiler/rfpc.rf

    r897 r1146  
    3131$use "rfp_helper";
    3232$use "rfp_format";
     33$use "rfp_mangle";
    3334$use "rfp_asail_optim"; //rfp_asail_optim.rfi
    3435
     
    121122        e.basename;
    122123      } :: e.headname,
    123       <Subst (&RFP-Dir-Separator) (('__')) e.headname> :: e.headname,
     124      <Subst (&RFP-Dir-Separator) (('_')) e.headname> :: e.headname,
     125      <Rfp2Cpp <To-Word e.headname>> :: e.headname,
    124126      {
    125127        e.ext : \{ ' .rf'; ' .rfi'; } =
Note: See TracChangeset for help on using the changeset viewer.